Changeset 97 for trunk/SRC/Documentation/idldoc_html_output/search.js
- Timestamp:
- 06/09/06 17:18:59 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/SRC/Documentation/idldoc_html_output/search.js
r93 r97 1 1 a = new Array(); 2 2 3 a[1] = new Array("./Calendar/date2jul.html", "date2jul.pro", "", " gives julian day equivalent of a date in yyyymmdd format categories calendar param date in required date in yyyymmdd format keyword GRADS in optional if 1 year 2000 year if 50 year 1900 year returns date in julian day examples IDL jday juldate 19930124 IDL print date2jul 19931205 EQ julday 12 5 1993 1 IDL print date2jul 931205 grads EQ julday 12 5 1993 1 history Sebastien Masson smasson lodyc jussieu fr June 2005 function date2jul date GRADS grads year long date 10000 month long abs date 100 MOD 100 day long abs date MOD 100 if keyword_set grads then year year 1900 year GE 50 AND year LE 99 2000 year GE 1 AND year LE 49 return julday month day year end ");4 a[2] = new Array("./Calendar/date2string.html", "date2string.pro", "", " create a nice and readable format to print a date categories calendar string param yyyymmdd in required the date in the format yyyymmdd file_comments keyword parameters of string function to specify the format of the month the C format can be used returns a string containing the date in a easy readable format examples IDL print date2string 19900123 Jan 23 1990 IDL print date2string 19900123 format C CMOA JAN 23 1990 history Sebastien Masson smasson lodyc jussieu fr Creation update review June 2005 Sebastien Masson FUNCTION date2string yyyymmdd _EXTRA ex sday strtrim long yyyymmdd MOD 100 1 smonth strtrim long yyyymmdd 100 MOD 100 2 syear strtrim long yyyymmdd 10000 2 res string format C CMoa 31 fix smonth 1 _EXTRA ex sday syear return res end");5 a[3] = new Array("./Calendar/daysinmonth.html", "daysinmonth.pro", "", " give the number of days in a specific month categories calendarparam month in optional param year in optional Year is used only if the common variable key_caltype greg In that case month and year must have the same number of elements If not provided we take month and year from time common variable returns number of days in a month or 1 in case of error uses cm_4cal examples IDL ndays daysinmonth 2 2000 history Sebastien Masson smasson lodyc jussieu fr 2 7 98 update review english new commons: June 2005 Sebastien Masson function daysinmonth month year include commons cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF n_elements key_caltype EQ 0 THEN key_caltype greg CASE key_caltype OF 360d : if n_elements month GT 1 THEN return replicate 30 n_elements month ELSE return 30 noleap :BEGIN days_in_mth 31 28 31 30 31 30 31 31 30 31 30 31 IF n_elements month EQ 0 THEN caldat time month return days_in_mth month 1 END greg :BEGIN CASE n_params OF 0:caldat time month day year 2:IF n_elements month NE n_elements year THEN return report month and year must have the same number of elements ELSE:return report daysinmonth accept 0 or 2 input parameters ENDCASE days_in_mth 31 28 31 30 31 30 31 31 30 31 30 31 return days_in_mth month 1 leapyr year month EQ 2 END ELSE:return report only 3 types of calendar are accepted: greg 360d and noleap ENDCASE END ");6 a[4] = new Array("./Calendar/jul2date.html", "jul2date.pro", "", " gives yyyymmdd date equivalent of a julian day categories calendar param jday in required julian day returns date in yyyymmdd format examples IDL print jul2date julday 12 23 1999 19991223 history Sebastien Masson smasson lodyc jussieu fr June 2005 function jul2date jday caldat jday month day year res 10000L year 100L month day year GE 0 10000L year 100L month day year LT 0 return long res end");7 a[5] = new Array("./Calendar/leapyr.html", "leapyr.pro", "", " determine whether the input year is a leap year or not Very useful for finding number of days in a year eg NUM_DAYS_IN_YR 365 leapyr year categories calendar param year in required year to be tested as a leap year returns 0 then not a leap year 1 then year is a leap year uses cm_4cal examples IDL result leapyr 2000 history Originally Written by: Trevor Harris Physics Dept University of Adelaide 20 09 88 November 2004: correction for century years S Masson Every year divisible by 4 is a leap year But every year divisible by 100 is NOT a leap year Unless the year is also divisible by 400 then it is still a leap year This means that year 1800 1900 2100 2200 2300 and 2500 are NOT leap years while year 2000 and 2400 are leap years supress the automatic change 89 1989 June 2005 update for new commons Sebastien Masson function leapyr year include commons cm_4cal yr long year IF n_elements key_caltype EQ 0 THEN key_caltype greg IF key_caltype NE greg THEN BEGIN sd size yr dimensions IF sd 0 EQ 0 THEN return 0b ELSE return bytarr size yr dimensions ENDIF ELSE return yr MOD 4 EQ 0 yr MOD 100 NE 0 yr MOD 400 EQ 0 end");8 a[6] = new Array("./Calendar/monthname.html", "monthname.pro", "", " gives the name of a month categories calendar param numberin required the month number from 1 to 12 file_comments keyword parameters of string function to specify the format of the month the C format can be used returns the month s name examples IDL name monthname 2 history Sebastien Masson smasson lodyc jussieu fr 1 October 2001 FUNCTION monthname mm1 _extra ex return string format C CMoA0 31 mm1 1 _extra ex end");3 a[1] = new Array("./Calendar/date2jul.html", "date2jul.pro", "", " file_comments gives julian day equivalent of a date in yyyymmdd format categories calendar param date in required date in yyyymmdd format keyword GRADS in optional if 1 year 2000 year if 50 year 1900 year returns date in julian day examples IDL jday juldate 19930124 IDL print date2jul 19931205 EQ julday 12 5 1993 1 IDL print date2jul 931205 grads EQ julday 12 5 1993 1 history Sebastien Masson smasson lodyc jussieu fr June 2005 function date2jul date GRADS grads year long date 10000 month long abs date 100 MOD 100 day long abs date MOD 100 if keyword_set grads then year year 1900 year GE 50 AND year LE 99 2000 year GE 1 AND year LE 49 return julday month day year end "); 4 a[2] = new Array("./Calendar/date2string.html", "date2string.pro", "", " file_comments create a nice and readable format to print a date categories calendar string param yyyymmdd in required the date in the format yyyymmdd file_comments keyword parameters of string function to specify the format of the month the C format can be used returns a string containing the date in a easy readable format examples IDL print date2string 19900123 Jan 23 1990 IDL print date2string 19900123 format C CMOA JAN 23 1990 history Sebastien Masson smasson lodyc jussieu fr Creation update review June 2005 Sebastien Masson FUNCTION date2string yyyymmdd _EXTRA ex sday strtrim long yyyymmdd MOD 100 1 smonth strtrim long yyyymmdd 100 MOD 100 2 syear strtrim long yyyymmdd 10000 2 res string format C CMoa 31 fix smonth 1 _EXTRA ex sday syear return res end"); 5 a[3] = new Array("./Calendar/daysinmonth.html", "daysinmonth.pro", "", " file_comments give the number of days in a specific month categories calendar param month in optional param year in optional Year is used only if the common variable key_caltype greg In that case month and year must have the same number of elements If not provided we take month and year from time common variable returns number of days in a month or 1 in case of error uses cm_4cal examples IDL ndays daysinmonth 2 2000 history Sebastien Masson smasson lodyc jussieu fr 2 7 98 update review english new commons: June 2005 Sebastien Masson function daysinmonth month year include commons cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF n_elements key_caltype EQ 0 THEN key_caltype greg CASE key_caltype OF 360d : if n_elements month GT 1 THEN return replicate 30 n_elements month ELSE return 30 noleap :BEGIN days_in_mth 31 28 31 30 31 30 31 31 30 31 30 31 IF n_elements month EQ 0 THEN caldat time month return days_in_mth month 1 END greg :BEGIN CASE n_params OF 0:caldat time month day year 2:IF n_elements month NE n_elements year THEN return report month and year must have the same number of elements ELSE:return report daysinmonth accept 0 or 2 input parameters ENDCASE days_in_mth 31 28 31 30 31 30 31 31 30 31 30 31 return days_in_mth month 1 leapyr year month EQ 2 END ELSE:return report only 3 types of calendar are accepted: greg 360d and noleap ENDCASE END "); 6 a[4] = new Array("./Calendar/jul2date.html", "jul2date.pro", "", " file_comments gives yyyymmdd date equivalent of a julian day categories calendar param jday in required julian day returns date in yyyymmdd format examples IDL print jul2date julday 12 23 1999 19991223 history Sebastien Masson smasson lodyc jussieu fr June 2005 function jul2date jday caldat jday month day year res 10000L year 100L month day year GE 0 10000L year 100L month day year LT 0 return long res end"); 7 a[5] = new Array("./Calendar/leapyr.html", "leapyr.pro", "", " file_comments determine whether the input year is a leap year or not Very useful for finding number of days in a year eg NUM_DAYS_IN_YR 365 leapyr year categories calendar param year in required year to be tested as a leap year returns 0 then not a leap year 1 then year is a leap year uses cm_4cal examples IDL result leapyr 2000 history Originally Written by: Trevor Harris Physics Dept University of Adelaide 20 09 88 November 2004: correction for century years S Masson Every year divisible by 4 is a leap year But every year divisible by 100 is NOT a leap year Unless the year is also divisible by 400 then it is still a leap year This means that year 1800 1900 2100 2200 2300 and 2500 are NOT leap years while year 2000 and 2400 are leap years supress the automatic change 89 1989 June 2005 update for new commons Sebastien Masson function leapyr year include commons cm_4cal yr long year IF n_elements key_caltype EQ 0 THEN key_caltype greg IF key_caltype NE greg THEN BEGIN sd size yr dimensions IF sd 0 EQ 0 THEN return 0b ELSE return bytarr size yr dimensions ENDIF ELSE return yr MOD 4 EQ 0 yr MOD 100 NE 0 yr MOD 400 EQ 0 end"); 8 a[6] = new Array("./Calendar/monthname.html", "monthname.pro", "", " file_comments gives the name of a month categories calendar param mm1 in required the month number from 1 to 12 file_comments keyword parameters of string function to specify the format of the month the C format can be used returns the month s name examples IDL name monthname 2 history Sebastien Masson smasson lodyc jussieu fr 1 October 2001 FUNCTION monthname mm1 _extra ex return string format C CMoA0 31 mm1 1 _extra ex end"); 9 9 a[7] = new Array("./Commons/all_cm.html", "all_cm.pro", "", ""); 10 10 a[8] = new Array("./Commons/cm_4cal.html", "cm_4cal.pro", "", ""); … … 14 14 a[12] = new Array("./Commons/cm_demomode.html", "cm_demomode.pro", "", ""); 15 15 a[13] = new Array("./Commons/cm_general.html", "cm_general.pro", "", ""); 16 a[14] = new Array("./Documentation/xmldoc/idldoc_html_16774.html", "idldoc_html_16774.pro", "", ""); 17 a[15] = new Array("./Documentation/xmldoc/idlfiles/init_example.html", "init_example.pro", "", ""); 18 a[16] = new Array("./ForOldVersion/keep_compatibility.html", "keep_compatibility.pro", "", " NAME: keep_compatibility PURPOSE: 1 define key_forgetold 1b keyword_set flag 2 remove all oldcm_used pro found in path 3 define and create myuniquetmpdir and add it to path 4 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro CATEGORY: compatibility with old version CALLING SEQUENCE:keep_compatibility flag INPUTS: flag: 1 or 0 to keep or forget the compatibility dir: the directory where we create oldcm_used pro if omitted is automatically defined to 1b keyword_set key_forgetold COMMON BLOCKS: cm_general SIDE EFFECTS: see purpose RESTRICTIONS: copy oldcm_full or oldcm_empty must be found in the path dir must aslo be in the path MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2005 PRO keep_compatibility flag cm_general version should be at least 6 0 IF fix strmid version release 0 1 LT 6 THEN BEGIN print print ERROR print print This version of SAXO needs at least IDL version 6 0 print print ERROR print return ENDIF IF n_elements myuniquetmpdir NE 0 THEN BEGIN path path : expand_path myuniquetmpdir return ENDIF if n_elements flag eq 0 then flag 1b keyword_set key_forgetold 1 automatic definition of key_forgetold key_forgetold 1b keyword_set flag 2 remove all oldcm_used pro found in path to_rm find oldcm_used IF to_rm 0 NE NOT FOUND THEN file_delete to_rm 3 define and create myuniquetmpdir and add it to path def_myuniquetmpdir 4 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro select which file should be copied to oldcm_used pro IF key_forgetold THEN BEGIN oldcm find oldcm_empty print We forget the compatibility with the old version ENDIF ELSE BEGIN oldcm find oldcm_full print We keep the compatibility with the old version ENDELSE oldcm oldcm 0 IF oldcm EQ NOT FOUND THEN BEGIN print Error: oldcm_full or oldcm_empty must be found in the path stop ENDIF copy file_copy oldcm myuniquetmpdir oldcm_used pro overwrite make sure we can make the plots enev if we are using the demo mode demomode_compatibility make sure that the common variables are correctly initialized IF size ccmeshparameters type NE 8 THEN BEGIN computegrid 1 1 1 1 1 1 fullcgrid cm_4data varname vargrid T vardate 0 varexp varunit valmask 1 e20 ENDIF return END"); 19 a[17] = new Array("./ForOldVersion/oldcm_empty.html", "oldcm_empty.pro", "", ""); 20 a[18] = new Array("./ForOldVersion/oldcm_full.html", "oldcm_full.pro", "", ""); 21 a[19] = new Array("./ForOldVersion/updatekwd.html", "updatekwd.pro", "", ""); 22 a[20] = new Array("./ForOldVersion/updatenew.html", "updatenew.pro", "", ""); 23 a[21] = new Array("./ForOldVersion/updateold.html", "updateold.pro", "", ""); 24 a[22] = new Array("./Grid/computegrid.html", "computegrid.pro", "", " NAME:computegrid PURPOSE:compute the grid parameters from cm_4mesh common: horizontal parameters: glam tf gphi tf e1t and e2t and if FULLCGRID keyword is defined: glam uv gphi uv e1 uvf and e2 uvf verticals parameters: gdep tw e3 tw masks: tmask and if FULLCGRID keyword is defined: uv maskred fmaskred xy triangulation: triangles_list key_ parameters: key_shift key_periodic key_zreverse key_yreverse key_stride key_onearth key_partialstep CATEGORY:grid CALLING SEQUENCE: computegrid startx starty stepx stepy nx ny computegrid startx starty stepx stepy computegrid xaxis xaxis yaxis yaxis or a suitable mix INPUTS: startx:scalar x starting point starty:scalar y starting point stepx:scalar or vector: x direction step must be 0 if vector nx is not used stepy:scalar or vector: y direction step could be 0 south to north or lon1 and lon2 lon1 le 360 key_shift will be defined automaticaly computed according to glamboundary by using the FIRST LINE of glamt but key_shift will 0 only if key_periodic 1 MASK: to specify the mask with a 2 or 3 dimension array ONEARTH 0 or 1: to force the manual definition of key_onearth to specify if the data are on earth use longitude latitude etc By default key_onearth 1 note that ONEARTH 0 forces PERIODIC 0 SHIFT 0 and is cancelling GLAMBOUNDARY PERIODIC 0 or 1: to force the manual definition of key_periodic By default key_periodic is automaticaly computed by using the first line of glamt PLAIN: force PERIODIC 0 SHIFT 0 STRIDE 1 1 1 and suppress the automatic redefinition of the domain in case of x periodicity overlap y periodicity overlap ORCA type only and mask border to 0 SHIFT scalar to force the manual definition of key_shift By debault key_shift is automaticaly computed according to glamboundary when defined by using the FIRST LINE of glamt if key_periodic 0 then in any case key_shift 0 STRCALLING: a string containing the calling command used to call computegrid this is used by xxx pro STRIDE : a 3 elements vector to specify the stride in x y z direction Default definition is 1 1 1 The resulting value will be stored in the common cm_4mesh variable key_stride XAXIS: to specify longitude1 with a 1 or 2 dimension array in this case startx stepx and nx are not used but could be necessary if the y axis is not defined with yaxis It must be possible to sort the first line of xaxis in the increasing order by shifting its elements YAXIS: to specify latitudes with a 1 or 2 dimension array in this case starty stepy and ny are not used but starty and stepy could be necessary if the x axis is not defined with xaxis It must be sorted in the increasing or deceasing order along each column if 2d array XYINDEX: activate to specify that the horizontal grid should be simply defined by using the index of the points xaxis findgen nx and yaxis findgen ny using this keyword forces key_onearth 0 XYZ MINMESH: to define the common variables i xyz minmesh used to define the grid only in a zoomed part of the original grid Defaut values are 0L max value is XYZ MAXMESH XYZ MAXMESH: to define the common variables i xyz maxmesh used to define the grid only in a zoomed part of the original grid Defaut values are jp ijk glo 1 max value is jp ijk glo 1 if XYZ MAXMESH is negative then we define i xyz maxmesh as jp ijk glo 1 XYZ MAXMESH instead of XYZ MAXMESH ZAXIS: to specify the vertical axis with a 1 dimension array Must be sorted in the increasing or deceasing order OUTPUTS: COMMON BLOCKS: cm_4mesh cm_4data cm_4cal SIDE EFFECTS: if the grid has x y periodicity orverlap and or if the mask has 0 everywhere at the border like a close sea and if we did not activate plain and xminmesh xmaxmesh yminmesh ymaxmesh keywords are defined to their default values we redefine xminmesh xmaxmesh yminmesh ymaxmesh in order to reove the overlapping part and or to open the domain avoid ti be forced to use cell_fill 1 RESTRICTIONS:FUV points definition EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 04 20 Sept 2004 several bug fixs to suit C grid type Aug 2005 rewritte almost everything PRO computegrid startx starty stepxin stepyin nxin nyin XAXIS xaxis YAXIS yaxis ZAXIS zaxis MASK mask GLAMBOUNDARY glamboundary XMINMESH xminmesh XMAXMESH xmaxmesh YMINMESH yminmesh YMAXMESH ymaxmesh ZMINMESH zminmesh ZMAXMESH zmaxmesh ONEARTH onearth PERIODIC periodic PLAIN plain SHIFT shift STRIDE stride FULLCGRID fullcgrid XYINDEX xyindex FBASE2TBASE fbase2tbase STRCALLING strcalling _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF time1 systime 1 for key_performance Check input parameters xaxis related parameters if n_elements xaxis NE 0 then BEGIN CASE size xaxis 0 OF 0:nx 1L 1:nx size xaxis 1 2:nx size xaxis 1 ENDCASE ENDIF ELSE BEGIN IF n_elements startx EQ 0 THEN BEGIN dummy report If xaxis is not given startx must be defined return ENDIF CASE n_elements stepxin OF 0:BEGIN dummy report If xaxis is not given stepxin must be defined return END 1:BEGIN IF n_elements nxin EQ 0 THEN BEGIN dummy report If xaxis is not given and stepxin has only one element nx must be defined return ENDIF ELSE nx nxin END ELSE:nx n_elements stepxin ENDCASE ENDELSE yaxis related parameters if n_elements yaxis NE 0 then BEGIN CASE size yaxis 0 OF 0:ny 1L 1:ny size yaxis 1 2:ny size yaxis 2 ENDCASE ENDIF ELSE BEGIN IF n_elements starty EQ 0 THEN BEGIN dummy report If yaxis is not given starty must be defined return ENDIF CASE n_elements stepyin OF 0:BEGIN dummy report If yaxis is not given stepyin must be defined return END 1:BEGIN IF n_elements nyin EQ 0 THEN BEGIN dummy report If yaxis is not given and stepyin has only one element ny must be defined return ENDIF ELSE ny nyin END ELSE:ny n_elements stepyin ENDCASE ENDELSE zaxis related parameters if n_elements zaxis NE 0 then BEGIN CASE size zaxis 0 OF 0:nz 1L 1:nz size zaxis 1 ELSE:BEGIN print not coded stop END ENDCASE ENDIF ELSE nz 1L Others automatic definitions jpiglo long nx jpjglo long ny jpkglo long nz impact of plain keyword: IF keyword_set plain THEN BEGIN periodic 0 shift 0 stride 1 1 1 ENDIF IF n_elements xminmesh NE 0 THEN ixminmesh long xminmesh 0 ELSE ixminmesh 0l IF n_elements xmaxmesh NE 0 THEN ixmaxmesh long xmaxmesh 0 ELSE ixmaxmesh jpiglo 1 IF n_elements yminmesh NE 0 THEN iyminmesh long yminmesh 0 ELSE iyminmesh 0l IF n_elements ymaxmesh NE 0 THEN iymaxmesh long ymaxmesh 0 ELSE iymaxmesh jpjglo 1 IF n_elements zminmesh NE 0 THEN izminmesh long zminmesh 0 ELSE izminmesh 0l IF n_elements zmaxmesh NE 0 THEN izmaxmesh long zmaxmesh 0 ELSE izmaxmesh jpkglo 1 iymaxmesh iymaxmesh keyword_set fbase2tbase IF ixmaxmesh LT 0 THEN ixmaxmesh jpiglo 1 ixmaxmesh IF iymaxmesh LT 0 THEN iymaxmesh jpjglo 1 iymaxmesh IF izmaxmesh LT 0 THEN izmaxmesh jpkglo 1 izmaxmesh avoid basics errors ixmaxmesh 0 ixmaxmesh ixminmesh iymaxmesh iyminmesh izmaxmesh izminmesh temporary glamf gphif temporary glamu gphiu temporary glamv gphiv gdept stepz 2 ENDIF ELSE BEGIN stepz 1 gdepw gdept ENDELSE e3 tw : e3t stepz IF n_elements stepz GT 1 THEN BEGIN e3w 0 5 stepz shift stepz 1 e3w 0 0 5 e3t 0 ENDIF ELSE e3w e3t Mask defaut mask eq 1 if NOT keyword_set mask then mask 1 if mask 0 NE 1 then BEGIN tmask byte mask ixminmesh:ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh tmask reform tmask jpi jpj jpk over if key_shift NE 0 then tmask shift tmask key_shift 0 0 because tmask reverse tmask 2 is not working if the 3rd dimension of tmask 1 we call reform IF jpk EQ 1 THEN tmask reform tmask over IF key_yreverse EQ 1 THEN tmask reverse tmask 2 IF jpk EQ 1 THEN tmask reform tmask jpi jpj jpk over IF key_zreverse EQ 1 THEN tmask reverse tmask 3 IF jpk EQ 1 THEN tmask reform tmask jpi jpj jpk over IF keyword_set fullcgrid THEN BEGIN IF keyword_set key_periodic THEN BEGIN msk tmask shift tmask 1 0 0 umaskred msk jpi 1 ENDIF ELSE umaskred tmask jpi 1 vmaskred tmask jpj 1 fmaskredy tmask jpi 1 fmaskredx tmask jpj 1 ENDIF ENDIF ELSE BEGIN tmask replicate 1b jpi jpj jpk IF keyword_set fullcgrid THEN BEGIN umaskred replicate 1b jpj jpk vmaskred replicate 1b jpi jpk fmaskredy replicate 1b jpj jpk fmaskredx replicate 1b jpi jpk ENDIF ENDELSE IF jpi GT 2 AND jpj GT 2 AND NOT keyword_set plain AND ixminmesh EQ 0l AND ixmaxmesh eq jpiglo 1 AND iyminmesh EQ 0l AND iymaxmesh eq jpjglo 1 AND total tmask 0 EQ 0 AND total tmask jpj 1 EQ 0 AND total tmask 0 EQ 0 AND total tmask jpi 1 EQ 0 THEN BEGIN xminmesh 1 xmaxmesh 1 yminmesh 1 ymaxmesh 1 computegrid XAXIS glamt YAXIS gphit ZAXIS zaxis MASK mask GLAMBOUNDARY glamboundary XMINMESH xminmesh XMAXMESH xmaxmesh YMINMESH yminmesh YMAXMESH ymaxmesh ZMINMESH zminmesh ZMAXMESH zmaxmesh ONEARTH onearth PERIODIC periodic PLAIN plain SHIFT shift STRIDE stride FULLCGRID fullcgrid XYINDEX xyindex FBASE2TBASE fbase2tbase STRCALLING strcalling _extra ex return ENDIF IF NOT keyword_set fullcgrid THEN BEGIN umaskred values f_nan vmaskred values f_nan fmaskredy values f_nan fmaskredx values f_nan ENDIF stride IF total key_stride GT 3 THEN BEGIN IF key_shift NE 0 THEN BEGIN for explanation see header of read_ncdf_varget pro jpiright key_shift jpileft jpi key_shift key_stride 0 1 key_shift 1 MOD key_stride 0 jpi jpiright 1 key_stride 0 1 jpileft 1 key_stride 0 1 ENDIF ELSE jpi jpi 1 key_stride 0 1 jpj jpj 1 key_stride 1 1 jpk jpk 1 key_stride 2 1 glamt temporary glamt 0: :stride 0 0: :stride 1 gphit temporary gphit 0: :stride 0 0: :stride 1 e1t temporary e1t 0: :stride 0 0: :stride 1 e2t temporary e2t 0: :stride 0 0: :stride 1 tmask temporary tmask 0: :stride 0 0: :stride 1 0: :stride 2 gdept gdept 0: :stride 2 gdepw gdepw 0: :stride 2 e3t e3t 0: :stride 2 e3w e3w 0: :stride 2 we must recompute glamf and gphif IF jpi GT 1 THEN BEGIN if keyword_set key_onearth AND keyword_set xnotsorted OR keyword_set key_periodic AND key_irregular then BEGIN stepxf glamt 720 MOD 360 stepxf shift stepxf 1 1 stepxf stepxf stepxf stepxf 360 stepxf 360 stepxf min abs stepxf dimension 3 IF NOT keyword_set key_periodic THEN stepxf jpi 1 stepxf jpi 2 ENDIF ELSE BEGIN stepxf shift glamt 1 1 glamt IF keyword_set key_periodic THEN stepxf jpi 1 360 stepxf jpi 1 ELSE stepxf jpi 1 stepxf jpi 2 ENDELSE IF jpj GT 1 THEN BEGIN stepxf jpj 1 stepxf jpj 2 stepxf jpi 1 jpj 1 stepxf jpi 2 jpj 2 ENDIF glamf glamt 0 5 stepxf ENDIF ELSE glamf glamt 0 5 IF jpj GT 1 THEN BEGIN we must compute stepyf: y distance between T i j T i 1 j 1 stepyf shift gphit 1 1 gphit stepyf jpj 1 stepyf jpj 2 IF jpi GT 1 THEN BEGIN if NOT keyword_set key_periodic THEN stepyf jpi 1 stepyf jpi 2 stepyf jpi 1 jpj 1 stepyf jpi 2 jpj 2 ENDIF gphif gphit 0 5 stepyf ENDIF ELSE gphif gphit 0 5 IF jpj EQ 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over e1t reform e1t jpi jpj over e2t reform e2t jpi jpj over ENDIF IF keyword_set fullcgrid THEN BEGIN glamu temporary glamu 0: :stride 0 0: :stride 1 gphiu temporary gphiu 0: :stride 0 0: :stride 1 e1u temporary e1u 0: :stride 0 0: :stride 1 e2u temporary e2u 0: :stride 0 0: :stride 1 glamv temporary glamv 0: :stride 0 0: :stride 1 gphiv temporary gphiv 0: :stride 0 0: :stride 1 e1v temporary e1v 0: :stride 0 0: :stride 1 e2v temporary e2v 0: :stride 0 0: :stride 1 e1f temporary e1f 0: :stride 0 0: :stride 1 e2f temporary e2f 0: :stride 0 0: :stride 1 umaskred temporary umaskred 0 0: :stride 1 0: :stride 2 vmaskred temporary vmaskred 0: :stride 0 0 0: :stride 2 fmaskredy temporary fmaskredy 0 0: :stride 1 0: :stride 2 fmaskredx temporary fmaskredx 0: :stride 0 0 0: :stride 2 IF jpj EQ 1 THEN BEGIN glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over e1u reform e1u jpi jpj over e2u reform e2u jpi jpj over glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over e1v reform e1v jpi jpj over e2v reform e2v jpi jpj over e1f reform e1f jpi jpj over e2f reform e2f jpi jpj over ENDIF ENDIF ENDIF apply all the grid parameters updateold domdef Triangulation IF total tmask EQ jpi jpj jpk AND NOT keyword_set key_irregular THEN triangles_list 1 ELSE BEGIN are we using ORCA2 IF jpiglo EQ 182 AND jpi EQ 181 AND jpjglo EQ 149 AND jpj EQ 148 THEN triangles_list triangule ELSE triangles_list triangule keep_cont ENDELSE time axis default definition IF n_elements time EQ 0 OR n_elements jpt EQ 0 THEN BEGIN jpt 1 time 0 ENDIF IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF grid parameters used by xxx IF NOT keyword_set strcalling THEN BEGIN IF n_elements ccmeshparameters EQ 0 THEN strcalling computegrid ELSE strcalling ccmeshparameters filename ENDIF IF n_elements glamt GE 2 THEN BEGIN glaminfo moment glamt IF finite glaminfo 2 EQ 0 THEN glaminfo glaminfo 0:1 gphiinfo moment gphit IF finite gphiinfo 2 EQ 0 THEN gphiinfo gphiinfo 0:1 ENDIF ELSE BEGIN glaminfo glamt gphiinfo gphit ENDELSE ccmeshparameters filename:strcalling glaminfo:float string glaminfo format E11 4 gphiinfo:float string gphiinfo format E11 4 jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift key_periodic:key_periodic key_stride:key_stride key_gridtype:key_gridtype key_yreverse:key_yreverse key_zreverse:key_zreverse key_partialstep:key_partialstep key_onearth:key_onearth ccreadparameters funclec_name: read_ncdf jpidta:jpidta jpjdta:jpjdta jpkdta:jpkdta ixmindta:ixmindta ixmaxdta:ixmaxdta iymindta:iymindta iymaxdta:iymaxdta izmindta:izmindta izmaxdta:izmaxdta IF keyword_set key_performance EQ 1 THEN print time computegrid systime 1 time1 return end "); 25 a[23] = new Array("./Grid/micromeshmask.html", "micromeshmask.pro", "", " NAME: micromeshmask pro PURPOSE: reduce the size of the NetCDF meshmask created by OPA by using bit and not byte format for the masks and the foat format for the other fields CATEGORY:for OPA meshmask files CALLING SEQUENCE: reducencmeshmask ncfilein ncfileout INPUTS: ncfilein: 1 the name of the meshmask file to be reduced In that case there is only one meshmask file OR 2 the xxx part in the names: xxx mesh_hgr nc xxx mesh_zgr nc xxx mask nc In that case the meshmask is split into 3 files ncfileout: the name of the uniq reduced meshmask file default definition is micromeshmask nc KEYWORD PARAMETERSSAT: IODIR:to define the files path OUTPUTS: no COMMON BLOCKS: no EXAMPLE: IDL meshdir d1fes2 raid2 smasson DATA ORCA05 IDL micromeshmask meshmask_ORCA_R05 nc iodir meshdir MODIFICATION HISTORY: July 2004 Sebastien Masson smasson lodyc jussieu fr PRO ncdf_transfer inid outid inname outname IF n_elements outname EQ 0 THEN outname inname ncdf_varget inid inname zzz ncdf_varput outid outname float reform zzz over RETURN END PRO micromeshmask ncfilein ncfileout IODIR iodir filein isafile FILE ncfilein IODIR iodir NEW test findfile filein 0 IF test EQ THEN BEGIN filein_hgr findfile filein mesh_hgr nc 0 filein_zgr findfile filein mesh_zgr nc 0 filein_msk findfile filein mask nc 0 IF filein_hgr EQ OR filein_zgr EQ OR filein_msk EQ THEN BEGIN print meshmask file s not found print filein does not exist print filein mesh_hgr nc does not exist print filein mesh_zgr nc does not exist print filein mask nc does not exist return ENDIF ENDIF ELSE filein test get the horizontal dimensions IF n_elements filein_hgr NE 0 THEN cdfid ncdf_open filein_hgr ELSE cdfid ncdf_open filein ncdf_diminq cdfid x name jpi ncdf_diminq cdfid y name jpj for the mask we use its byte representation its y dimension will be extended to be a multiple of 8 then it will be divided by 8 if jpj mod 8 eq 0 the jpj_m jpi 8 else jpj_m jpi 8 1 jpj_m jpj 7 8 get the vertical dimensions IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpk ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpk ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth return ENDELSE ENDELSE get the variables list related to the partial steps varlist_ps ncdf_listvars cdfid varlist_ps strtrim strlowcase varlist_ps 2 define the output file IF n_elements ncfileout EQ 0 THEN ncfileout micromeshmask nc cdfidout ncdf_create isafile FILE ncfileout IODIR iodir NEW clobber ncdf_control cdfidout nofill dimension dimidx ncdf_dimdef cdfidout x jpi dimidy ncdf_dimdef cdfidout y jpj dimidy_m ncdf_dimdef cdfidout y_m jpj_m dimidz ncdf_dimdef cdfidout z jpk global attributs ncdf_attput cdfidout IDL_Program_Name micromeshmask pro GLOBAL ncdf_attput cdfidout Creation_Date systime GLOBAL declaration des variables varid lonarr 20 horizontal variables hgrlist glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f FOR h 0 n_elements hgrlist 1 DO varid h ncdf_vardef cdfidout hgrlist h dimidx dimidy float vertical variables zgrlist e3t e3w gdept gdepw FOR z 0 n_elements zgrlist 1 DO varid 16 z ncdf_vardef cdfidout zgrlist z dimidz float variables related to the partial steps IF where varlist_ps EQ hdept 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdept dimidx dimidy float IF where varlist_ps EQ hdepw 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdepw dimidx dimidy float old variable name keep for compatibility with old run Change e3tp to e3t_ps IF where varlist_ps EQ e3tp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float old variable name keep for compatibility with old run Change e3wp to e3w_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3t_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float IF where varlist_ps EQ e3w_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3u_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3u_ps dimidx dimidy float IF where varlist_ps EQ e3v_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3v_ps dimidx dimidy float mask variable msklist tmask umask vmask fmask FOR m 0 n_elements msklist 1 DO BEGIN varid varid ncdf_vardef cdfidout msklist m dimidx dimidy_m dimidz byte ncdf_attput cdfidout varid n_elements varid 1 Comment the mask is stored as bit You must use the binary representation of the byte to get back the data ENDFOR ncdf_control cdfidout endef get the horizontal variables IF n_elements filein_hgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_hgr ENDIF FOR h 0 n_elements hgrlist 1 DO ncdf_transfer cdfid cdfidout hgrlist h get the vertical variables IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF FOR z 0 n_elements zgrlist 1 DO ncdf_transfer cdfid cdfidout zgrlist z partial step variables IF where varlist_ps EQ hdept 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdept IF where varlist_ps EQ hdepw 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdepw IF where varlist_ps EQ e3tp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3tp e3t_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3wp e3w_ps IF where varlist_ps EQ e3t_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3t_ps IF where varlist_ps EQ e3w_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3w_ps IF where varlist_ps EQ e3u_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3u_ps IF where varlist_ps EQ e3v_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3v_ps mask IF n_elements filein_msk NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_msk ENDIF loop on the vertical levels to limit the memory use FOR k 0 jpk 1 DO BEGIN FOR m 0 3 DO BEGIN CASE ncdf_varinq cdfid msklist m ndims OF 3:ncdf_varget cdfid msklist m zzz offset 0 0 k count jpi jpj 1 4:ncdf_varget cdfid msklist m zzz offset 0 0 k 0 count jpi jpj 1 1 ENDCASE zzz byte temporary zzz zzz must contain only 0 or 1 zzz temporary zzz MOD 2 we transpose zzz because we need to work with the y dimension as the first dimension zzz transpose temporary zzz extend jpj to be a multiple of 8 jpjadd jpj_m 8 jpj IF jpjadd NE 0 THEN zzz temporary zzz bytarr jpjadd jpi reform zzz to look like output of binary pro zzz reform zzz 8 1 jpj_m jpi over convert into its byte form zzz inverse_binary temporary zzz ncdf_varput cdfidout msklist m transpose temporary zzz offset 0 0 k count jpi jpj_m 1 ENDFOR ENDFOR ncdf_close cdfid ncdf_close cdfidout RETURN END"); 26 a[24] = new Array("./Grid/n128gaussian.html", "n128gaussian.pro", "", " NAME:n128gaussian PURPOSE:compute the latitudes of the n128 gaussian grid See: http: www ecmwf int products data technical gaussian n128FIS html CATEGORY:grid CALLING SEQUENCE:lat n128gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n128gaussian latitude reduced regular latitude number points points n128 1 18 512 89 46282 2 25 512 88 76695 3 36 512 88 06697 4 40 512 87 36606 5 45 512 86 66480 6 50 512 85 96337 7 60 512 85 26184 8 64 512 84 56026 9 72 512 83 85863 10 72 512 83 15698 11 80 512 82 45531 12 90 512 81 75363 13 90 512 81 05194 14 100 512 80 35023 15 108 512 79 64852 16 120 512 78 94681 17 120 512 78 24509 18 125 512 77 54336 19 128 512 76 84163 20 144 512 76 13990 21 144 512 75 43817 22 150 512 74 73644 23 160 512 74 03470 24 160 512 73 33296 25 180 512 72 63123 26 180 512 71 92949 27 180 512 71 22774 28 192 512 70 52600 29 192 512 69 82426 30 200 512 69 12252 31 216 512 68 42077 32 216 512 67 71903 33 216 512 67 01728 34 225 512 66 31554 35 240 512 65 61379 36 240 512 64 91204 37 240 512 64 21030 38 250 512 63 50855 39 250 512 62 80680 40 256 512 62 10505 41 270 512 61 40330 42 270 512 60 70156 43 288 512 59 99981 44 288 512 59 29806 45 288 512 58 59631 46 300 512 57 89456 47 300 512 57 19281 48 320 512 56 49106 49 320 512 55 78931 50 320 512 55 08756 51 320 512 54 38581 52 324 512 53 68406 53 360 512 52 98231 54 360 512 52 28056 55 360 512 51 57881 56 360 512 50 87705 57 360 512 50 17530 58 360 512 49 47355 59 360 512 48 77180 60 375 512 48 07005 61 375 512 47 36830 62 375 512 46 66655 63 375 512 45 96479 64 384 512 45 26304 65 384 512 44 56129 66 400 512 43 85954 67 400 512 43 15779 68 400 512 42 45604 69 400 512 41 75428 70 405 512 41 05253 71 432 512 40 35078 72 432 512 39 64903 73 432 512 38 94728 74 432 512 38 24552 75 432 512 37 54377 76 432 512 36 84202 77 432 512 36 14027 78 450 512 35 43851 79 450 512 34 73676 80 450 512 34 03501 n128 n128 81 450 512 33 33326 82 450 512 32 63150 83 480 512 31 92975 84 480 512 31 22800 85 480 512 30 52625 86 480 512 29 82449 87 480 512 29 12274 88 480 512 28 42099 89 480 512 27 71924 90 480 512 27 01748 91 480 512 26 31573 92 480 512 25 61398 93 486 512 24 91223 94 486 512 24 21047 95 486 512 23 50872 96 500 512 22 80697 97 500 512 22 10521 98 500 512 21 40346 99 500 512 20 70171 100 500 512 19 99996 101 500 512 19 29820 102 500 512 18 59645 103 512 512 17 89470 104 512 512 17 19294 105 512 512 16 49119 106 512 512 15 78944 107 512 512 15 08768 108 512 512 14 38593 109 512 512 13 68418 110 512 512 12 98243 111 512 512 12 28067 112 512 512 11 57892 113 512 512 10 87717 114 512 512 10 17541 115 512 512 9 47366 116 512 512 8 77191 117 512 512 8 07016 118 512 512 7 36840 119 512 512 6 66665 120 512 512 5 96490 121 512 512 5 26314 122 512 512 4 56139 123 512 512 3 85964 124 512 512 3 15788 125 512 512 2 45613 126 512 512 1 75438 127 512 512 1 05262 128 512 512 0 35087 n128 reform n128 4 128 over n128 reform n128 3 over n128 n128 reverse n128 return n128 end"); 27 a[25] = new Array("./Grid/n160gaussian.html", "n160gaussian.pro", "", " NAME:n160gaussian PURPOSE:compute the latitudes of the n160 gaussian grid See: http: www ecmwf int products data technical gaussian n160FIS html CATEGORY:grid CALLING SEQUENCE:lat n160gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n160gaussian latitude reduced regular latitude number points points n160 1 18 640 89 57009 2 25 640 89 01318 3 36 640 88 45297 4 40 640 87 89203 5 45 640 87 33080 6 50 640 86 76944 7 60 640 86 20800 8 64 640 85 64651 9 72 640 85 08499 10 72 640 84 52345 11 80 640 83 96190 12 90 640 83 40033 13 90 640 82 83876 14 96 640 82 27718 15 108 640 81 71559 16 120 640 81 15400 17 120 640 80 59240 18 125 640 80 03080 19 128 640 79 46920 20 135 640 78 90760 21 144 640 78 34600 22 150 640 77 78439 23 160 640 77 22278 24 160 640 76 66117 25 180 640 76 09956 26 180 640 75 53795 27 180 640 74 97634 28 192 640 74 41473 29 192 640 73 85311 30 200 640 73 29150 31 216 640 72 72988 32 216 640 72 16827 33 225 640 71 60665 34 225 640 71 04504 35 240 640 70 48342 36 240 640 69 92181 37 243 640 69 36019 38 250 640 68 79857 39 256 640 68 23695 40 270 640 67 67534 41 270 640 67 11372 42 288 640 66 55210 43 288 640 65 99048 44 288 640 65 42886 45 300 640 64 86725 46 300 640 64 30563 47 320 640 63 74401 48 320 640 63 18239 49 320 640 62 62077 50 320 640 62 05915 51 324 640 61 49753 52 360 640 60 93591 53 360 640 60 37429 54 360 640 59 81267 55 360 640 59 25105 56 360 640 58 68943 57 360 640 58 12781 58 375 640 57 56619 59 375 640 57 00457 60 375 640 56 44295 61 384 640 55 88133 62 384 640 55 31971 63 400 640 54 75809 64 400 640 54 19647 65 400 640 53 63485 66 405 640 53 07323 67 432 640 52 51161 68 432 640 51 94999 69 432 640 51 38837 70 432 640 50 82675 71 432 640 50 26513 72 450 640 49 70351 73 450 640 49 14189 74 450 640 48 58026 75 450 640 48 01864 76 480 640 47 45702 77 480 640 46 89540 78 480 640 46 33378 79 480 640 45 77216 80 480 640 45 21054 n160 n160 81 480 640 44 64892 82 480 640 44 08730 83 500 640 43 52567 84 500 640 42 96405 85 500 640 42 40243 86 500 640 41 84081 87 500 640 41 27919 88 512 640 40 71757 89 512 640 40 15595 90 540 640 39 59433 91 540 640 39 03270 92 540 640 38 47108 93 540 640 37 90946 94 540 640 37 34784 95 540 640 36 78622 96 540 640 36 22460 97 540 640 35 66298 98 576 640 35 10136 99 576 640 34 53973 100 576 640 33 97811 101 576 640 33 41649 102 576 640 32 85487 103 576 640 32 29325 104 576 640 31 73163 105 576 640 31 17000 106 576 640 30 60838 107 576 640 30 04676 108 600 640 29 48514 109 600 640 28 92352 110 600 640 28 36190 111 600 640 27 80028 112 600 640 27 23865 113 600 640 26 67703 114 600 640 26 11541 115 600 640 25 55379 116 600 640 24 99217 117 640 640 24 43055 118 640 640 23 86892 119 640 640 23 30730 120 640 640 22 74568 121 640 640 22 18406 122 640 640 21 62244 123 640 640 21 06082 124 640 640 20 49919 125 640 640 19 93757 126 640 640 19 37595 127 640 640 18 81433 128 640 640 18 25271 129 640 640 17 69109 130 640 640 17 12946 131 640 640 16 56784 132 640 640 16 00622 133 640 640 15 44460 134 640 640 14 88298 135 640 640 14 32136 136 640 640 13 75973 137 640 640 13 19811 138 640 640 12 63649 139 640 640 12 07487 140 640 640 11 51325 141 640 640 10 95162 142 640 640 10 39000 143 640 640 9 82838 144 640 640 9 26676 145 640 640 8 70514 146 640 640 8 14352 147 640 640 7 58189 148 640 640 7 02027 149 640 640 6 45865 150 640 640 5 89703 151 640 640 5 33541 152 640 640 4 77379 153 640 640 4 21216 154 640 640 3 65054 155 640 640 3 08892 156 640 640 2 52730 157 640 640 1 96568 158 640 640 1 40405 159 640 640 0 84243 160 640 640 0 28081 n160 reform n160 4 160 over n160 reform n160 3 over n160 n160 reverse n160 return n160 end"); 28 a[26] = new Array("./Grid/n256gaussian.html", "n256gaussian.pro", "", " NAME:n256gaussian PURPOSE:compute the latitudes of the n256 gaussian grid See: http: www ecmwf int products data technical gaussian n256FIS html CATEGORY:grid CALLING SEQUENCE:lat n256gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n256gaussian latitude reduced regular latitude number points points n256 1 18 1024 89 73115 2 25 1024 89 38287 3 32 1024 89 03254 4 40 1024 88 68175 5 45 1024 88 33077 6 50 1024 87 97972 7 60 1024 87 62861 8 64 1024 87 27748 9 72 1024 86 92632 10 72 1024 86 57515 11 75 1024 86 22398 12 81 1024 85 87279 13 90 1024 85 52160 14 96 1024 85 17041 15 100 1024 84 81921 16 108 1024 84 46801 17 120 1024 84 11681 18 120 1024 83 76560 19 125 1024 83 41440 20 135 1024 83 06319 21 144 1024 82 71198 22 150 1024 82 36077 23 160 1024 82 00956 24 160 1024 81 65835 25 180 1024 81 30714 26 180 1024 80 95593 27 180 1024 80 60471 28 192 1024 80 25350 29 192 1024 79 90229 30 200 1024 79 55107 31 216 1024 79 19986 32 216 1024 78 84864 33 216 1024 78 49743 34 225 1024 78 14621 35 240 1024 77 79500 36 240 1024 77 44378 37 243 1024 77 09256 38 250 1024 76 74135 39 256 1024 76 39013 40 270 1024 76 03891 41 270 1024 75 68770 42 288 1024 75 33648 43 288 1024 74 98526 44 288 1024 74 63405 45 300 1024 74 28283 46 300 1024 73 93161 47 320 1024 73 58040 48 320 1024 73 22918 49 320 1024 72 87796 50 324 1024 72 52674 51 360 1024 72 17552 52 360 1024 71 82431 53 360 1024 71 47309 54 360 1024 71 12187 55 360 1024 70 77065 56 360 1024 70 41944 57 375 1024 70 06822 58 375 1024 69 71700 59 384 1024 69 36578 60 384 1024 69 01456 61 400 1024 68 66334 62 400 1024 68 31213 63 400 1024 67 96091 64 432 1024 67 60969 65 432 1024 67 25847 66 432 1024 66 90725 67 432 1024 66 55603 68 432 1024 66 20482 69 450 1024 65 85360 70 450 1024 65 50238 71 450 1024 65 15116 72 480 1024 64 79994 73 480 1024 64 44872 74 480 1024 64 09750 75 480 1024 63 74629 76 480 1024 63 39507 77 486 1024 63 04385 78 500 1024 62 69263 79 500 1024 62 34141 80 500 1024 61 99019 n256 n256 81 512 1024 61 63897 82 512 1024 61 28776 83 540 1024 60 93654 84 540 1024 60 58532 85 540 1024 60 23410 86 540 1024 59 88288 87 540 1024 59 53166 88 576 1024 59 18044 89 576 1024 58 82922 90 576 1024 58 47800 91 576 1024 58 12679 92 576 1024 57 77557 93 576 1024 57 42435 94 600 1024 57 07313 95 600 1024 56 72191 96 600 1024 56 37069 97 600 1024 56 01947 98 600 1024 55 66825 99 640 1024 55 31703 100 640 1024 54 96581 101 640 1024 54 61460 102 640 1024 54 26338 103 640 1024 53 91216 104 640 1024 53 56094 105 640 1024 53 20972 106 640 1024 52 85850 107 648 1024 52 50728 108 675 1024 52 15606 109 675 1024 51 80484 110 675 1024 51 45362 111 675 1024 51 10241 112 675 1024 50 75119 113 675 1024 50 39997 114 720 1024 50 04875 115 720 1024 49 69753 116 720 1024 49 34631 117 720 1024 48 99509 118 720 1024 48 64387 119 720 1024 48 29265 120 720 1024 47 94143 121 720 1024 47 59021 122 720 1024 47 23899 123 729 1024 46 88778 124 729 1024 46 53656 125 750 1024 46 18534 126 750 1024 45 83412 127 750 1024 45 48290 128 750 1024 45 13168 129 750 1024 44 78046 130 768 1024 44 42924 131 768 1024 44 07802 132 768 1024 43 72680 133 768 1024 43 37558 134 800 1024 43 02436 135 800 1024 42 67315 136 800 1024 42 32193 137 800 1024 41 97071 138 800 1024 41 61949 139 800 1024 41 26827 140 800 1024 40 91705 141 800 1024 40 56583 142 810 1024 40 21461 143 810 1024 39 86339 144 864 1024 39 51217 145 864 1024 39 16095 146 864 1024 38 80973 147 864 1024 38 45851 148 864 1024 38 10730 149 864 1024 37 75608 150 864 1024 37 40486 151 864 1024 37 05364 152 864 1024 36 70242 153 864 1024 36 35120 154 864 1024 35 99998 155 864 1024 35 64876 156 864 1024 35 29754 157 864 1024 34 94632 158 900 1024 34 59510 159 900 1024 34 24388 160 900 1024 33 89266 n256 n256 161 900 1024 33 54145 162 900 1024 33 19023 163 900 1024 32 83901 164 900 1024 32 48779 165 900 1024 32 13657 166 900 1024 31 78535 167 900 1024 31 43413 168 900 1024 31 08291 169 960 1024 30 73169 170 960 1024 30 38047 171 960 1024 30 02925 172 960 1024 29 67803 173 960 1024 29 32681 174 960 1024 28 97559 175 960 1024 28 62438 176 960 1024 28 27316 177 960 1024 27 92194 178 960 1024 27 57072 179 960 1024 27 21950 180 960 1024 26 86828 181 960 1024 26 51706 182 960 1024 26 16584 183 960 1024 25 81462 184 960 1024 25 46340 185 960 1024 25 11218 186 960 1024 24 76096 187 960 1024 24 40974 188 960 1024 24 05852 189 960 1024 23 70731 190 960 1024 23 35609 191 972 1024 23 00487 192 972 1024 22 65365 193 972 1024 22 30243 194 972 1024 21 95121 195 972 1024 21 59999 196 1000 1024 21 24877 197 1000 1024 20 89755 198 1000 1024 20 54633 199 1000 1024 20 19511 200 1000 1024 19 84389 201 1000 1024 19 49267 202 1000 1024 19 14145 203 1000 1024 18 79023 204 1000 1024 18 43902 205 1000 1024 18 08780 206 1000 1024 17 73658 207 1000 1024 17 38536 208 1000 1024 17 03414 209 1000 1024 16 68292 210 1000 1024 16 33170 211 1000 1024 15 98048 212 1024 1024 15 62926 213 1024 1024 15 27804 214 1024 1024 14 92682 215 1024 1024 14 57560 216 1024 1024 14 22438 217 1024 1024 13 87316 218 1024 1024 13 52194 219 1024 1024 13 17073 220 1024 1024 12 81951 221 1024 1024 12 46829 222 1024 1024 12 11707 223 1024 1024 11 76585 224 1024 1024 11 41463 225 1024 1024 11 06341 226 1024 1024 10 71219 227 1024 1024 10 36097 228 1024 1024 10 00975 229 1024 1024 9 65853 230 1024 1024 9 30731 231 1024 1024 8 95609 232 1024 1024 8 60487 233 1024 1024 8 25365 234 1024 1024 7 90244 235 1024 1024 7 55122 236 1024 1024 7 20000 237 1024 1024 6 84878 238 1024 1024 6 49756 239 1024 1024 6 14634 240 1024 1024 5 79512 n256 n256 241 1024 1024 5 44390 242 1024 1024 5 09268 243 1024 1024 4 74146 244 1024 1024 4 39024 245 1024 1024 4 03902 246 1024 1024 3 68780 247 1024 1024 3 33658 248 1024 1024 2 98536 249 1024 1024 2 63415 250 1024 1024 2 28293 251 1024 1024 1 93171 252 1024 1024 1 58049 253 1024 1024 1 22927 254 1024 1024 0 87805 255 1024 1024 0 52683 256 1024 1024 0 17561 n256 reform n256 4 256 over n256 reform n256 3 over n256 n256 reverse n256 return n256 end"); 29 a[27] = new Array("./Grid/n48gaussian.html", "n48gaussian.pro", "", " NAME:n48gaussian PURPOSE:compute the latitudes of the n48 gaussian grid See: http: www ecmwf int products data technical gaussian n48FIS html CATEGORY:grid CALLING SEQUENCE:lat n48gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n48gaussian latitude reduced regular latitude number points points n48 1 20 192 88 57216 2 25 192 86 72253 3 36 192 84 86197 4 40 192 82 99894 5 45 192 81 13497 6 50 192 79 27055 7 60 192 77 40588 8 60 192 75 54106 9 72 192 73 67613 10 75 192 71 81113 11 80 192 69 94608 12 90 192 68 08099 13 96 192 66 21587 14 100 192 64 35073 15 108 192 62 48557 16 120 192 60 62039 17 120 192 58 75520 18 120 192 56 89001 19 128 192 55 02480 20 135 192 53 15959 21 144 192 51 29437 22 144 192 49 42915 23 160 192 47 56392 24 160 192 45 69869 25 160 192 43 83345 26 160 192 41 96822 27 160 192 40 10297 28 180 192 38 23773 29 180 192 36 37249 30 180 192 34 50724 31 180 192 32 64199 32 180 192 30 77674 33 192 192 28 91149 34 192 192 27 04623 35 192 192 25 18098 36 192 192 23 31573 37 192 192 21 45047 38 192 192 19 58521 39 192 192 17 71996 40 192 192 15 85470 41 192 192 13 98944 42 192 192 12 12418 43 192 192 10 25892 44 192 192 8 39366 45 192 192 6 52840 46 192 192 4 66314 47 192 192 2 79788 48 192 192 0 93262 n48 reform n48 4 48 over n48 reform n48 3 over n48 n48 reverse n48 return n48 end"); 30 a[28] = new Array("./Grid/n80gaussian.html", "n80gaussian.pro", "", " NAME:n80gaussian PURPOSE:compute the latitudes of the n80 gaussian grid See: http: www ecmwf int products data technical gaussian n80FIS html CATEGORY:grid CALLING SEQUENCE:lat n80gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n80gaussian latitude reduced regular latitude number points points n80 1 18 320 89 14152 2 25 320 88 02943 3 36 320 86 91077 4 40 320 85 79063 5 45 320 84 66992 6 54 320 83 54895 7 60 320 82 42782 8 64 320 81 30659 9 72 320 80 18531 10 72 320 79 06398 11 80 320 77 94262 12 90 320 76 82124 13 96 320 75 69984 14 100 320 74 57843 15 108 320 73 45701 16 120 320 72 33558 17 120 320 71 21414 18 128 320 70 09269 19 135 320 68 97124 20 144 320 67 84978 21 144 320 66 72833 22 150 320 65 60686 23 160 320 64 48540 24 160 320 63 36393 25 180 320 62 24246 26 180 320 61 12099 27 180 320 59 99952 28 192 320 58 87804 29 192 320 57 75657 30 200 320 56 63509 31 200 320 55 51361 32 216 320 54 39214 33 216 320 53 27066 34 216 320 52 14917 35 225 320 51 02769 36 225 320 49 90621 37 240 320 48 78473 38 240 320 47 66325 39 240 320 46 54176 40 256 320 45 42028 41 256 320 44 29879 42 256 320 43 17731 43 256 320 42 05582 44 288 320 40 93434 45 288 320 39 81285 46 288 320 38 69137 47 288 320 37 56988 48 288 320 36 44839 49 288 320 35 32691 50 288 320 34 20542 51 288 320 33 08393 52 288 320 31 96244 53 300 320 30 84096 54 300 320 29 71947 55 300 320 28 59798 56 300 320 27 47649 57 320 320 26 35500 58 320 320 25 23351 59 320 320 24 11203 60 320 320 22 99054 61 320 320 21 86905 62 320 320 20 74756 63 320 320 19 62607 64 320 320 18 50458 65 320 320 17 38309 66 320 320 16 26160 67 320 320 15 14011 68 320 320 14 01862 69 320 320 12 89713 70 320 320 11 77564 71 320 320 10 65415 72 320 320 9 53266 73 320 320 8 41117 74 320 320 7 28968 75 320 320 6 16819 76 320 320 5 04670 77 320 320 3 92521 78 320 320 2 80372 79 320 320 1 68223 80 320 320 0 56074 n80 reform n80 4 80 over n80 reform n80 3 over n80 n80 reverse n80 return n80 end"); 31 a[29] = new Array("./Grid/ncdf_meshread.html", "ncdf_meshread.pro", "", " NAME:ncdf_meshread PURPOSE:read NetCDF meshmask file created by OPA CATEGORY:grid reading CALLING SEQUENCE:ncdf_meshread filename INPUTS: filename: the name of the meshmask file to read Default is meshmask nc if this name does not contain any and if iodirectory keyword is not specify then the common variable iodir will be use to define the mesh file path KEYWORD PARAMETERS: GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be automaticaly defined according to GLAMBOUNDARY CHECKDAT: Suppressed Use micromeshmask pro to create an appropriate meshmask ONEARTH 0 or 1: to force the manual definition of key_onearth to specify if the data are on earth use longitude latitude etc By default key_onearth 1 note that ONEARTH 0 forces PERIODIC 0 SHIFT 0 and is cancelling GLAMBOUNDARY PERIODIC 0 or 1: to force the manual definition of key_periodic By default key_periodic is automaticaly computed by using the first line of glamt SHIFT : to force the manual definition of key_shift By debault key_shift is automaticaly computed according to the glamboundary when defined by using the first line of glamt if key_periodic 0 then in any case key_shift 0 STRCALLING: a string containing the calling command used to call computegrid this is used by xxx pro STRIDE : a 3 elements vector to specify the stride in x y z direction Default definition is key_stride The resulting value will be stored in the common cm_4mesh variable key_stride OUTPUTS:none COMMON BLOCKS: cm_4mesh cm_4data cm_4cal SIDE EFFECTS: define and or use common variables from cm_4mesh cm_4data cm_4cal RESTRICTIONS: ixminmesh ixmaxmesh iyminmesh iymaxmesh izminmesh izmaxmesh must be defined febore calling ncdf_meshread if some of those value are equal to 1 they will be automatically defined EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 12 1999 July 2004 Sebastien Masson: Several modifications micromeshmask clean partial steps clean use of key_stride automatic definition of key_shift Oct 2004 Sebastien Masson: add PERIODIC and SHIFT Aug 2005 Sebastien Masson: some cleaning english PRO ncdf_meshread filename GLAMBOUNDARY glamboundary CHECKDAT checkdat ONEARTH onearth GETDIMENSIONS getdimensions PERIODIC periodic SHIFT shift STRIDE stride STRCALLING strcalling _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 for key_performance IF keyword_set CHECKDAT THEN BEGIN print The keyword CHECKDAT has been suppressed it could create bugs print Remove it from the call of ncdf_meshread print Please use smallmeshmask pro or micromeshmask pro to create a print meshmask that has manageable size return ENDIF find meshfile name and open it def de filename par defaut IF n_params EQ 0 then filename meshmask nc meshname isafile file filename iodirectory iodir _EXTRA ex meshname meshname 0 noticebase xnotice Reading file C meshname C if the meshmask is on tape archive get it back IF version OS_FAMILY EQ unix THEN spawn file meshname dev null cdfid ncdf_open meshname contient ncdf_inquire cdfid dimensions ncdf_diminq cdfid x name jpiglo ncdf_diminq cdfid y name jpjglo listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpkglo ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpkglo ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth stop ENDELSE ENDELSE if keyword_set getdimensions then begin widget_control noticebase bad_id nothing destroy ncdf_close cdfid return endif check that all i xyz min ax mesh are well defined if n_elements ixminmesh EQ 0 THEN ixminmesh 0 if n_elements ixmaxmesh EQ 0 then ixmaxmesh jpiglo 1 if ixminmesh EQ 1 THEN ixminmesh 0 IF ixmaxmesh EQ 1 then ixmaxmesh jpiglo 1 if n_elements iyminmesh EQ 0 THEN iyminmesh 0 IF n_elements iymaxmesh EQ 0 then iymaxmesh jpjglo 1 if iyminmesh EQ 1 THEN iyminmesh 0 IF iymaxmesh EQ 1 then iymaxmesh jpjglo 1 if n_elements izminmesh EQ 0 THEN izminmesh 0 IF n_elements izmaxmesh EQ 0 then izmaxmesh jpkglo 1 if izminmesh EQ 1 THEN izminmesh 0 IF izmaxmesh EQ 1 then izmaxmesh jpkglo 1 definition of jpi jpj jpj jpi long ixmaxmesh ixminmesh 1 jpj long iymaxmesh iyminmesh 1 jpk long izmaxmesh izminmesh 1 check onearth and its consequences IF n_elements onearth EQ 0 THEN key_onearth 1 ELSE key_onearth keyword_set onearth IF NOT key_onearth THEN BEGIN periodic 0 shift 0 ENDIF automatic definition of key_periodic IF n_elements periodic EQ 0 THEN BEGIN IF jpi GT 1 THEN BEGIN varinq ncdf_varinq cdfid glamt CASE varinq ndims OF 2:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh count jpi 1 3:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 count jpi 1 1 4:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 0 count jpi 1 1 1 ENDCASE xaxis xaxis 720 MOD 360 xaxis xaxis sort xaxis key_periodic xaxis jpi 1 2 xaxis jpi 1 xaxis jpi 2 GE xaxis 0 360 ENDIF ELSE key_periodic 0 ENDIF ELSE key_periodic keyword_set periodic automatic definition of key_shift IF n_elements shift EQ 0 THEN BEGIN key_shift long testvar var key_shift key_shift will be defined according to the first line of glamt if keyword_set glamboundary AND jpi GT 1 AND key_periodic EQ 1 THEN BEGIN varinq ncdf_varinq cdfid glamt CASE varinq ndims OF 2:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh count jpi 1 3:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 count jpi 1 1 4:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 0 count jpi 1 1 1 ENDCASE xaxis between glamboundary 0 and glamboundary 1 xaxis xaxis MOD 360 smaller where xaxis LT glamboundary 0 if smaller 0 NE 1 then xaxis smaller xaxis smaller 360 bigger where xaxis GE glamboundary 1 if bigger 0 NE 1 then xaxis bigger xaxis bigger 360 key_shift where xaxis EQ min xaxis 0 IF key_shift NE 0 THEN BEGIN key_shift jpi key_shift xaxis shift xaxis key_shift ENDIF IF array_equal sort xaxis lindgen jpi NE 1 THEN BEGIN print the x axis 1st line of glamt is not sorted in the inceasing order after the automatic definition of key_shift print please use the keyword shift and periodic to suppress the automatic definition of key_shift and key_periodic and define by hand a more suitable value widget_control noticebase bad_id nothing destroy return ENDIF ENDIF ELSE key_shift 0 ENDIF ELSE key_shift long shift key_periodic EQ 1 check key_stride and related things if n_elements stride eq 3 then key_stride stride if n_elements key_stride LE 2 then key_stride 1 1 1 key_stride 1l long key_stride IF total key_stride NE 3 THEN BEGIN IF key_shift NE 0 THEN BEGIN for explanation see header of read_ncdf_varget pro jpiright key_shift jpileft jpi key_shift key_stride 0 1 key_shift 1 MOD key_stride 0 jpi jpiright 1 key_stride 0 1 jpileft 1 key_stride 0 1 ENDIF ELSE jpi jpi 1 key_stride 0 1 jpj jpj 1 key_stride 1 1 jpk jpk 1 key_stride 2 1 ENDIF default definitions to be able to use read_ncdf_varget default definitions to be able to use read_ncdf_varget ixmindtasauve testvar var ixmindta iymindtasauve testvar var iymindta izmindtasauve testvar var izmindta ixmindta 0l iymindta 0l izmindta 0l jpt 1 time 1 firsttps 0 firstx 0 lastx jpi 1 firsty 0 lasty jpj 1 firstz 0 lastz jpk 1 nx jpi ny jpj nz 1 izminmeshsauve izminmesh izminmesh 0 2d arrays: list the 2d variables that must be read namevar glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f for the variables related to the partial steps allvarname ncdf_listvars cdfid IF where allvarname EQ hdept 0 NE 1 THEN BEGIN key_partialstep 1 namevar namevar hdept hdepw ENDIF ELSE BEGIN key_partialstep 0 hdept 1 hdepw 1 ENDELSE for compatibility with old versions of meshmask partial steps IF where allvarname EQ e3tp 0 NE 1 THEN namevar namevar e3tp e3wp ELSE BEGIN e3t_ps 1 e3w_ps 1 ENDELSE IF where allvarname EQ e3t_ps 0 NE 1 THEN namevar namevar e3t_ps e3w_ps ELSE BEGIN e3t_ps 1 e3w_ps 1 ENDELSE IF where allvarname EQ e3u_ps 0 NE 1 THEN namevar namevar e3u_ps e3v_ps ELSE BEGIN e3u_ps 1 e3v_ps 1 ENDELSE read all the 2d variables for i 0 n_elements namevar 1 do begin varcontient ncdf_varinq cdfid namevar i name varcontient name read_ncdf_varget commande namevar i float res rien execute commande ENDFOR for compatibility with old versions of meshmask partial steps change e3 tw p to e3 tw _ps IF n_elements e3tp NE 0 THEN e3t_ps temporary e3tp IF n_elements e3wp NE 0 THEN e3w_ps temporary e3wp in the kase of key_stride ne 1 1 1 redefine f points coordinates: they must be in the middle of 3 T points if key_stride 0 NE 1 OR key_stride 1 NE 1 then BEGIN we must recompute glamf and gphif IF jpi GT 1 THEN BEGIN if keyword_set key_onearth AND keyword_set xnotsorted OR keyword_set key_periodic AND key_irregular then BEGIN stepxf glamt 720 MOD 360 stepxf shift stepxf 1 1 stepxf stepxf stepxf stepxf 360 stepxf 360 stepxf min abs stepxf dimension 3 IF NOT keyword_set key_periodic THEN stepxf jpi 1 stepxf jpi 2 ENDIF ELSE BEGIN stepxf shift glamt 1 1 glamt IF keyword_set key_periodic THEN stepxf jpi 1 360 stepxf jpi 1 ELSE stepxf jpi 1 stepxf jpi 2 ENDELSE IF jpj GT 1 THEN BEGIN stepxf jpj 1 stepxf jpj 2 stepxf jpi 1 jpj 1 stepxf jpi 2 jpj 2 ENDIF glamf glamt 0 5 stepxf ENDIF ELSE glamf glamt 0 5 IF jpj GT 1 THEN BEGIN we must compute stepyf: y distance between T i j T i 1 j 1 stepyf shift gphit 1 1 gphit stepyf jpj 1 stepyf jpj 2 IF jpi GT 1 THEN BEGIN if NOT keyword_set key_periodic THEN stepyf jpi 1 stepyf jpi 2 stepyf jpi 1 jpj 1 stepyf jpi 2 jpj 2 ENDIF gphif gphit 0 5 stepyf ENDIF ELSE gphif gphit 0 5 ENDIF 3d arrays: nz jpk izminmesh izminmeshsauve listdims ncdf_listdims cdfid micromask where listdims EQ y_m 0 varcontient ncdf_varinq cdfid tmask name varcontient name IF micromask NE 1 THEN BEGIN keep original values iyminmeshtrue iyminmesh key_stridetrue key_stride yyy1 firsty key_stridetrue 1 iyminmeshtrue yyy2 lasty key_stridetrue 1 iyminmeshtrue the mask is stored as the bit values of the byte array along the y dimension see micromeshmask pro we must modify several parameters iyminmesh 0L firsty yyy1 8 lasty yyy2 8 ny lasty firsty 1 key_stride key_stride 0 1 key_stride 2 read_ncdf_varget tmask bytarr jpi jpj jpk now we must get back the mask loop on the level to save memory the loop is short and thus should be fast enough FOR k 0 jpk 1 DO BEGIN zzz transpose res k zzz reform binary zzz 8 ny nx over zzz transpose temporary zzz zzz zzz yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN BEGIN IF float strmid version release 0 3 LT 5 6 THEN BEGIN nnny size zzz 2 yind key_stridetrue 1 lindgen nnny 1 key_stridetrue 1 1 tmask k temporary zzz yind ENDIF ELSE tmask k temporary zzz 0: :key_stridetrue 1 ENDIF ELSE tmask k temporary zzz ENDFOR ENDIF ELSE BEGIN read_ncdf_varget tmask byte res ENDELSE boudary conditions used to compute umask varcontient ncdf_varinq cdfid umask name varcontient name nx 1L firstx jpi 1 lastx jpi 1 IF micromask NE 1 THEN BEGIN read_ncdf_varget umaskred reform binary res 8 ny jpk over umaskred umaskred yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN umaskred temporary umaskred yind ENDIF ELSE BEGIN read_ncdf_varget umaskred reform byte res over ENDELSE boudary conditions used to compute fmask 1 varcontient ncdf_varinq cdfid fmask name varcontient name IF micromask NE 1 THEN BEGIN read_ncdf_varget fmaskredy reform binary res 8 ny jpk over fmaskredy fmaskredy yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN fmaskredy temporary fmaskredy yind ENDIF ELSE BEGIN read_ncdf_varget fmaskredy reform byte res over fmaskredy temporary fmaskredy MOD 2 ENDELSE boudary conditions used to compute vmask varcontient ncdf_varinq cdfid vmask name varcontient name nx jpi firstx 0L lastx jpi 1L ny 1L firsty jpj 1 lasty jpj 1 IF micromask NE 1 THEN BEGIN yyy1 firsty key_stridetrue 1 iyminmeshtrue yyy2 lasty key_stridetrue 1 iyminmeshtrue iyminmesh 0L firsty yyy1 8 lasty yyy2 8 ny lasty firsty 1 read_ncdf_varget vmaskred transpose temporary res 1 0 2 vmaskred reform binary vmaskred 8 ny nx nz over vmaskred transpose temporary vmaskred 1 0 2 vmaskred reform vmaskred yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 ENDIF ELSE BEGIN read_ncdf_varget vmaskred reform byte res over ENDELSE boudary conditions used to compute fmask 2 varcontient ncdf_varinq cdfid fmask name varcontient name IF micromask NE 1 THEN BEGIN read_ncdf_varget fmaskredx transpose temporary res 1 0 2 fmaskredx reform binary fmaskredx 8 ny nx nz over fmaskredx transpose temporary fmaskredx 1 0 2 fmaskredx reform fmaskredx yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 iyminmesh iyminmeshtrue key_stride key_stridetrue ENDIF ELSE BEGIN read_ncdf_varget fmaskredx reform byte res over fmaskredx fmaskredx MOD 2 ENDELSE 1d arrays namevar e3t e3w gdept gdepw for i 0 n_elements namevar 1 do begin varcontient ncdf_varinq cdfid namevar i CASE n_elements varcontient dim OF 4:BEGIN commande ncdf_varget cdfid namevar i namevar i offset 0 0 izminmesh 0 count 1 1 jpk 1 if key_stride 2 NE 1 then commande commande stride 1 1 key_stride 2 1 END 2:BEGIN commande ncdf_varget cdfid namevar i namevar i offset izminmesh 0 count jpk 1 if key_stride 2 NE 1 then commande commande stride key_stride 2 END 1:BEGIN commande ncdf_varget cdfid namevar i namevar i offset izminmesh count jpk if key_stride 2 NE 1 then commande commande stride key_stride 2 END ENDCASE rien execute commande commande namevar i float namevar i rien execute commande commande if size namevar i n_dimension gt 0 then namevar i reform namevar i over rien execute commande ENDFOR ncdf_close cdfid Apply Glamboudary if keyword_set glamboundary AND key_onearth then BEGIN if glamboundary 0 NE glamboundary 1 then BEGIN glamt glamt MOD 360 smaller where glamt LT glamboundary 0 if smaller 0 NE 1 then glamt smaller glamt smaller 360 bigger where glamt GE glamboundary 1 if bigger 0 NE 1 then glamt bigger glamt bigger 360 glamu glamu MOD 360 smaller where glamu LT glamboundary 0 if smaller 0 NE 1 then glamu smaller glamu smaller 360 bigger where glamu GE glamboundary 1 if bigger 0 NE 1 then glamu bigger glamu bigger 360 glamv glamv MOD 360 smaller where glamv LT glamboundary 0 if smaller 0 NE 1 then glamv smaller glamv smaller 360 bigger where glamv GE glamboundary 1 if bigger 0 NE 1 then glamv bigger glamv bigger 360 glamf glamf MOD 360 smaller where glamf LT glamboundary 0 if smaller 0 NE 1 then glamf smaller glamf smaller 360 bigger where glamf GE glamboundary 1 if bigger 0 NE 1 then glamf bigger glamf bigger 360 toosmall where glamu EQ glamboundary 0 IF toosmall 0 NE 1 THEN glamu toosmall glamu toosmall 360 toosmall where glamf EQ glamboundary 0 IF toosmall 0 NE 1 THEN glamf toosmall glamf toosmall 360 endif endif make sure we do have 2d arrays when jpj eq 1 IF jpj EQ 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over e1t reform e1t jpi jpj over e2t reform e2t jpi jpj over glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over e1u reform e1u jpi jpj over e2u reform e2u jpi jpj over glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over e1v reform e1v jpi jpj over e2v reform e2v jpi jpj over glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over e1f reform e1f jpi jpj over e2f reform e2f jpi jpj over IF keyword_set key_partialstep THEN BEGIN hdept reform hdept jpi jpj over hdepw reform hdepw jpi jpj over e3t_ps reform e3t_ps jpi jpj over e3w_ps reform e3w_ps jpi jpj over ENDIF ENDIF ixmindta ixmindtasauve iymindta iymindtasauve izmindta izmindtasauve widget_control noticebase bad_id nothing destroy key_yreverse 0 key_zreverse 0 key_gridtype c grid parameters used by xxx IF NOT keyword_set strcalling THEN BEGIN IF n_elements ccmeshparameters EQ 0 THEN strcalling ncdf_meshread ELSE strcalling ccmeshparameters filename ENDIF IF n_elements glamt GE 2 THEN BEGIN glaminfo moment glamt IF finite glaminfo 2 EQ 0 THEN glaminfo glaminfo 0:1 gphiinfo moment gphit IF finite gphiinfo 2 EQ 0 THEN gphiinfo gphiinfo 0:1 ENDIF ELSE BEGIN glaminfo glamt gphiinfo gphit ENDELSE ccmeshparameters filename:strcalling glaminfo:float string glaminfo format E11 4 gphiinfo:float string gphiinfo format E11 4 jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift key_periodic:key_periodic key_stride:key_stride key_gridtype:key_gridtype key_yreverse:key_yreverse key_zreverse:key_zreverse key_partialstep:key_partialstep key_onearth:key_onearth if keyword_set key_performance THEN print time ncdf_meshread systime 1 tempsun updateold return end"); 32 a[30] = new Array("./Grid/restoreboxparam.html", "restoreboxparam.pro", "", " NAME: restoreboxparam PURPOSE: restore all the zoom parameters defined by calling domdef perviously defined by saveboxparam CATEGORY: CALLING SEQUENCE: restoreboxparam filename INPUTS: filename a scalar string defining the file name KEYWORD PARAMETERS: none OUTPUTS:none COMMON BLOCKS: cm_4mesh and cm_demomode_used if we are in demo mode SIDE EFFECTS: call def_myuniquetmpdir if myuniquetmpdir is undefined: define create and add it to path RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 2005 PRO restoreboxparam filename cm_4mesh IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used lon1 boxzoomparam bound 0 lon2 boxzoomparam bound 1 lat1 boxzoomparam bound 2 lat2 boxzoomparam bound 3 vert1 boxzoomparam bound 4 vert2 boxzoomparam bound 5 firstxt boxzoomparam indexes 0 lastxt boxzoomparam indexes 1 firstyt boxzoomparam indexes 2 lastyt boxzoomparam indexes 3 firstxu boxzoomparam indexes 4 lastxu boxzoomparam indexes 5 firstyu boxzoomparam indexes 6 lastyu boxzoomparam indexes 7 firstxv boxzoomparam indexes 8 lastxv boxzoomparam indexes 9 firstyv boxzoomparam indexes 10 lastyv boxzoomparam indexes 11 firstxf boxzoomparam indexes 12 lastxf boxzoomparam indexes 13 firstyf boxzoomparam indexes 14 lastyf boxzoomparam indexes 15 firstzt boxzoomparam indexes 16 lastzt boxzoomparam indexes 17 firstzw boxzoomparam indexes 18 lastzw boxzoomparam indexes 19 nxt boxzoomparam indexes 20 nyt boxzoomparam indexes 21 nxu boxzoomparam indexes 22 nyu boxzoomparam indexes 23 nxv boxzoomparam indexes 24 nyv boxzoomparam indexes 25 nxf boxzoomparam indexes 26 nyf boxzoomparam indexes 27 nzt boxzoomparam indexes 28 nzw boxzoomparam indexes 29 key_irregular boxzoomparam key boxzoomparam 1 ENDIF ELSE BEGIN restore myuniquetmpdir filename file_delete myuniquetmpdir filename ENDELSE updateold return end "); 33 a[31] = new Array("./Grid/saveboxparam.html", "saveboxparam.pro", "", " NAME: saveboxparam PURPOSE: save all the zoom parameters defined by calling domdef in a file using save command located in myuniquetmpdir common variable defined by def_myuniquetmpdir CATEGORY: CALLING SEQUENCE: saveboxparam filename INPUTS: filename a scalar string defining the file name KEYWORD PARAMETERS: none OUTPUTS:none COMMON BLOCKS: cm_4mesh and cm_demomode_used if we are in demo mode SIDE EFFECTS: call def_myuniquetmpdir if myuniquetmpdir is undefined: define create and add it to path RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2005 PRO saveboxparam filename cm_4mesh def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used boxzoomparam bound: lon1 lon2 lat1 lat2 vert1 vert2 indexes: firstxt lastxt firstyt lastyt firstxu lastxu firstyu lastyu firstxv lastxv firstyv lastyv firstxf lastxf firstyf lastyf firstzt lastzt firstzw lastzw nxt nyt nxu nyu nxv nyv nxf nyf nzt nzw key:key_irregular ENDIF ELSE BEGIN save lon1 lon2 lat1 lat2 vert1 vert2 firstxt lastxt firstyt lastyt firstxu lastxu firstyu lastyu firstxv lastxv firstyv lastyv firstxf lastxf firstyf lastyf firstzt lastzt firstzw lastzw nxt nyt nxu nyu nxv nyv nxf nyf nzt nzw key_irregular filename myuniquetmpdir filename ENDELSE return end"); 34 a[32] = new Array("./Grid/smallmeshmask.html", "smallmeshmask.pro", "", " NAME: smallmeshmask pro PURPOSE: reduce the size of the NetCDF meshmask created by OPA by using byte format for the masks and the foat format for the other fields CATEGORY:for OPA meshmask files CALLING SEQUENCE: smallmeshmask ncfilein ncfileout INPUTS: ncfilein: 1 the name of the meshmask file to be reduced In that case there is only one meshmask file OR 2 the xxx part in the names: xxx mesh_hgr nc xxx mesh_zgr nc xxx mask nc In that case the meshmask is split into 3 files ncfileout: the name of the reduced meshmask file default definition is smallmeshmask nc KEYWORD PARAMETERS: IODIR:to define the files path OUTPUTS: no COMMON BLOCKS: no EXAMPLE: IDL meshdir d1fes2 raid2 smasson DATA ORCA05 IDL smallmeshmask meshmask_ORCA_R05 nc iodir meshdir MODIFICATION HISTORY: July 2004 Sebastien Masson smasson lodyc jussieu fr PRO ncdf_transfer inid outid inname outname IF n_elements outname EQ 0 THEN outname inname ncdf_varget inid inname zzz ncdf_varput outid outname float reform zzz over RETURN END PRO smallmeshmask ncfilein ncfileout IODIR iodir filein isafile FILE ncfilein IODIR iodir NEW test findfile filein 0 IF test EQ THEN BEGIN filein_hgr findfile filein mesh_hgr nc 0 filein_zgr findfile filein mesh_zgr nc 0 filein_msk findfile filein mask nc 0 IF filein_hgr EQ OR filein_zgr EQ OR filein_msk EQ THEN BEGIN print meshmask file s not found print filein does not exist print filein mesh_hgr nc does not exist print filein mesh_zgr nc does not exist print filein mask nc does not exist return ENDIF ENDIF ELSE filein test get the horizontal dimensions IF n_elements filein_hgr NE 0 THEN cdfid ncdf_open filein_hgr ELSE cdfid ncdf_open filein ncdf_diminq cdfid x name jpi ncdf_diminq cdfid y name jpj get the vertical dimensions IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpk ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpk ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth return ENDELSE ENDELSE get the variables list related to the partial steps varlist_ps ncdf_listvars cdfid varlist_ps strtrim strlowcase varlist_ps 2 define the output file IF n_elements ncfileout EQ 0 THEN ncfileout smallmeshmask nc cdfidout ncdf_create isafile FILE ncfileout IODIR iodir NEW clobber ncdf_control cdfidout nofill dimension dimidx ncdf_dimdef cdfidout x jpi dimidy ncdf_dimdef cdfidout y jpj dimidz ncdf_dimdef cdfidout z jpk global attributs ncdf_attput cdfidout IDL_Program_Name smallmeshmask pro GLOBAL ncdf_attput cdfidout Creation_Date systime GLOBAL declaration des variables varid lonarr 20 horizontal variables hgrlist glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f FOR h 0 n_elements hgrlist 1 DO varid h ncdf_vardef cdfidout hgrlist h dimidx dimidy float vertical variables zgrlist e3t e3w gdept gdepw FOR z 0 n_elements zgrlist 1 DO varid 16 z ncdf_vardef cdfidout zgrlist z dimidz float variables related to the partial steps IF where varlist_ps EQ hdept 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdept dimidx dimidy float IF where varlist_ps EQ hdepw 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdepw dimidx dimidy float old variable name keep for compatibility with old run Change e3tp to e3t_ps IF where varlist_ps EQ e3tp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float old variable name keep for compatibility with old run Change e3wp to e3w_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3t_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float IF where varlist_ps EQ e3w_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3u_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3u_ps dimidx dimidy float IF where varlist_ps EQ e3v_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3v_ps dimidx dimidy float mask variable msklist tmask umask vmask fmask FOR m 0 n_elements msklist 1 DO varid varid ncdf_vardef cdfidout msklist m dimidx dimidy dimidz byte ncdf_control cdfidout endef get the horizontal variables IF n_elements filein_hgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_hgr ENDIF FOR h 0 n_elements hgrlist 1 DO ncdf_transfer cdfid cdfidout hgrlist h get the vertical variables IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF FOR z 0 n_elements zgrlist 1 DO ncdf_transfer cdfid cdfidout zgrlist z partial step variables IF where varlist_ps EQ hdept 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdept IF where varlist_ps EQ hdepw 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdepw IF where varlist_ps EQ e3tp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3tp e3t_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3wp e3w_ps IF where varlist_ps EQ e3t_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3t_ps IF where varlist_ps EQ e3w_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3w_ps IF where varlist_ps EQ e3u_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3u_ps IF where varlist_ps EQ e3v_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3v_ps mask IF n_elements filein_msk NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_msk ENDIF loop on the vertical levels to limit the memory use FOR k 0 jpk 1 DO BEGIN FOR m 0 3 DO BEGIN CASE ncdf_varinq cdfid msklist m ndims OF 3:ncdf_varget cdfid msklist m zzz offset 0 0 k count jpi jpj 1 4:ncdf_varget cdfid msklist m zzz offset 0 0 k 0 count jpi jpj 1 1 ENDCASE ncdf_varput cdfidout msklist m byte temporary zzz offset 0 0 k count jpi jpj 1 ENDFOR ENDFOR ncdf_close cdfid ncdf_close cdfidout RETURN END"); 35 a[33] = new Array("./Interpolation/angle.html", "angle.pro", "", " NAME:angle pro fom angle F v 2 2 in OPA8 2 PURPOSE:Compute angles between grid lines and direction of the North CALLING SEQUENCE: angle fileocemesh gcosu gsinu gcosv gsinv gcost gsint INPUTS: fileocemesh a netcdf file that contains at least : glamu gphiu: longitudes and latitudes at U points glamv gphiv: longitudes and latitudes at V points glamf gphif: longitudes and latitudes at F points KEYWORD PARAMETERS: IODIRECTORY: the directory path where is located fileocemesh DOUBLE: use double precision default is float OUTPUTS: gsinu gcosu : sinus and cosinus of the angle gsinv gcosv between north south direction gsint gcost and the j direction of the mesh RESTRICTIONS: to compute the lateral boundary conditions we assume that: 1 the first line is similar to the second line gcosu 0 gcosu 1 gsinu 0 gsinu 1 2 the grid follows OPA x periodicity rule first column is equal to the next to last column gcosv 0 gcosv jpj 2 gsinv 0 gsinv jpj 2 MODIFICATION HISTORY: Original : 96 07 O Marti 98 06 G Madec Feb 2005: IDL adaptation S Masson fsnspp: north stereographic polar projection FUNCTION fsnspp plam pphi DOUBLE double IF keyword_set double THEN BEGIN a 2 d tan dpi 4 d dpi 180 d pphi 2 d x cos dpi 180 d plam a y sin dpi 180 d plam a ENDIF ELSE BEGIN a 2 tan pi 4 pi 180 float pphi 2 x cos pi 180 float plam a y sin pi 180 float plam a ENDELSE RETURN x:x y:y END PRO angle fileocemesh gcosu gsinu gcosv gsinv gcost gsint IODIRECTORY iodirectory DOUBLE double 0 read oceanic grid parameters IF keyword_set IODIRECTORY THEN BEGIN IF strpos iodirectory reverse_search NE strlen iodirectory 1 THEN iodirectory iodirectory ENDIF ELSE iodirectory fileoce iodirectory fileocemesh fileoce findfile fileoce count okfile IF okfile NE 1 THEN BEGIN print the file fileoce is not found we stop stop ENDIF cdfido ncdf_open fileoce 0 ncdf_varget cdfido glamt glamt ncdf_varget cdfido glamu glamu ncdf_varget cdfido glamv glamv ncdf_varget cdfido glamf glamf ncdf_varget cdfido gphit gphit ncdf_varget cdfido gphiu gphiu ncdf_varget cdfido gphiv gphiv ncdf_varget cdfido gphif gphif ncdf_close cdfido glamt reform glamt over glamu reform glamu over glamv reform glamv over glamf reform glamf over gphit reform gphit over gphiu reform gphiu over gphiv reform gphiv over gphif reform gphif over jpj size glamf dimension 1 I Compute the cosinus and sinus computation done on the north stereographic polar plan north pole direction modulous at t point znpt fsnspp glamt gphit DOUBLE double glamt 1 gphit 1 free memory znpt x znpt x znpt y znpt y znnpt znpt x znpt x znpt y znpt y north pole direction modulous at u point znpu fsnspp glamu gphiu DOUBLE double glamu 1 gphiu 1 free memory znpu x znpu x znpu y znpu y znnpu znpu x znpu x znpu y znpu y north pole direction modulous at v point znpv fsnspp glamv gphiv DOUBLE double znpv00 znpv znpv01 fsnspp shift glamv 0 1 shift gphiv 0 1 DOUBLE double glamv 1 gphiv 1 free memory znpv x znpv x znpv y znpv y znnpv znpv x znpv x znpv y znpv y f point znpf00 fsnspp glamf gphif DOUBLE double znpf01 fsnspp shift glamf 0 1 shift gphif 0 1 DOUBLE double znpf10 fsnspp shift glamf 1 0 shift gphif 1 0 DOUBLE double glamf 1 gphif 1 free memory j direction: v point segment direction t point zxvvt znpv00 x znpv01 x zyvvt znpv00 y znpv01 y zmnpvt sqrt temporary znnpt zxvvt zxvvt zyvvt zyvvt znpv00 1 free memory znpv01 1 free memory IF keyword_set double THEN zmnpvt 1 e 14 zmnpvt ELSE zmnpvt 1 e 6 zmnpvt j direction: f point segment direction u point zxffu znpf00 x znpf01 x zyffu znpf00 y znpf01 y zmnpfu sqrt temporary znnpu zxffu zxffu zyffu zyffu znpf01 1 free memory IF keyword_set double THEN zmnpfu 1 e 14 zmnpfu ELSE zmnpfu 1 e 6 zmnpfu i direction: f point segment direction v point zxffv znpf00 x znpf10 x zyffv znpf00 y znpf10 y znpf00 1 znpf10 1 free memory zmnpfv sqrt temporary znnpv zxffv zxffv zyffv zyffv IF keyword_set double THEN zmnpfv 1 e 14 zmnpfv ELSE zmnpfv 1 e 6 zmnpfv cosinus and sinus using scalar and vectorial products gsint znpt x zyvvt znpt y zxvvt zmnpvt gcost znpt x zxvvt znpt y zyvvt zmnpvt cosinus and sinus using scalar and vectorial products gsinu znpu x zyffu znpu y zxffu zmnpfu gcosu znpu x zxffu znpu y zyffu zmnpfu cosinus and sinus using scalar and vectorial products caution rotation of 90 degres gsinv znpv x zxffv znpv y zyffv zmnpfv gcosv znpv x zyffv znpv y zxffv zmnpfv II Geographic mesh bad where abs glamf shift glamf 0 1 LT 1 e 8 IF bad 0 NE 1 THEN BEGIN gcosu bad 1 gsinu bad 0 ENDIF bad where abs gphif shift gphif 1 0 LT 1 e 8 IF bad 0 NE 1 THEN BEGIN gcosv bad 1 gsinv bad 0 ENDIF III Lateral boundary conditions gcost 0 gcost 1 gsint 0 gsint 1 gcosu 0 gcosu 1 gsinu 0 gsinu 1 gcosv 0 gcosv jpj 2 gsinv 0 gsinv jpj 2 RETURN END"); 36 a[34] = new Array("./Interpolation/clickincell.html", "clickincell.pro", "", " NAME:clickincell PURPOSE: click on a map and find in which cell the click was CATEGORY:finding where is a point on a grid CALLING SEQUENCE: res clickincell Click with the left button to select a cell Clicking one more time in the same cell remove the cell from the selection Click on the right button to quit INPUTS:None KEYWORD PARAMETERS: CELLTYPE T W U V or F : This this the type of point that is located in the center of the cell which the click is located default is T type of cell with corner defined by F points DRAWCELL: to draw the cell in which we clicked COLOR the color used to draw the cells Clicking one more time in the same cell will draw the cell with the white color ORIGINAL: to get the position of the cell regarding the original grid with no key_shift ixminmesh iyminmesh IJ: see outpus _EXTRA: to pass extra keywords to inquad and plot when drawcell OUTPUTS: the the index of the selected cells regarding to the grid which is in memory in the variable of the common If ij keyword is activated give 2D array 2 n which are the i j position of the n selected cells COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL plt findgen jpi jpj nodata map 90 0 0 ortho IDL print clickincell draw color 150 xy MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 FUNCTION clickincell CELLTYPE celltype DRAWCELL drawcell COLOR color ORIGINAL original IJ ij _EXTRA extra common initialization cellnum 1L selected 0 Cell list get the grid parameter according to celltype oldgrid vargrid IF NOT keyword_set celltype THEN celltype T CASE strupcase celltype OF T :vargrid F W :vargrid F U :vargrid V V :vargrid U F :vargrid T ENDCASE grille 1 glam gphi 1 nx ny nz firstx firsty firstz lastx lasty lastz vargrid oldgrid define the corner of the cells in the clockwise direction IF keyword_set key_periodic AND nx EQ jpi THEN BEGIN x1 glam 0:ny 2 y1 gphi 0:ny 2 x2 glam 1:ny 1 y2 gphi 1:ny 1 x3 shift glam 1:ny 1 1 0 y3 shift gphi 1:ny 1 1 0 x4 shift glam 0:ny 2 1 0 y4 shift gphi 0:ny 2 1 0 ENDIF ELSE BEGIN x1 glam 0:nx 2 0:ny 2 y1 gphi 0:nx 2 0:ny 2 x2 glam 0:nx 2 1:ny 1 y2 gphi 0:nx 2 1:ny 1 x3 glam 1:nx 1 1:ny 1 y3 gphi 1:nx 1 1:ny 1 x4 glam 1:nx 1 0:ny 2 y4 gphi 1:nx 1 0:ny 2 ENDELSE glam 1 free memory gphi 1 free memory get mousse position on the reference map cursor x y data up while mouse button ne 4 do BEGIN IF finite x finite x EQ 0 THEN GOTO outwhile case mouse button of 1:BEGIN What is the longitude WHILE x GT x range 1 DO x x 360 WHILE x LT x range 0 DO x x 360 IF x GT x range 1 THEN GOTO outwhile IF y GT y range 1 THEN GOTO outwhile IF y LT y range 0 THEN GOTO outwhile cell inquad x y x1 y1 x2 y2 x3 y3 x4 y4 onsphere _extra extra IF cell 0 EQ 1 OR n_elements cell GT 1 THEN GOTO outwhile cell cell 0 already where cellnum EQ cell 0 IF already EQ 1 THEN BEGIN cellnum cellnum cell selected selected 1 already n_elements selected 1 ENDIF ELSE selected already 1 selected already IF keyword_set drawcell THEN BEGIN oplot x1 cell x2 cell x3 cell x4 cell x1 cell y1 cell y2 cell y3 cell y4 cell y1 cell color color selected already d n_colors 255 1 selected already _extra extra ENDIF END 2: middle button ELSE: ENDCASE get mousse position on the reference map outwhile: cursor x y data up ENDWHILE good where selected NE 0 IF good 0 EQ 1 THEN RETURN 1 cellnum cellnum good yy cellnum nx 1 key_periodic nx EQ jpi xx cellnum MOD nx 1 key_periodic nx EQ jpi CASE strupcase celltype OF T :BEGIN xx xx firstx 1 yy yy firsty 1 END W :BEGIN xx xx firstx 1 yy yy firsty 1 END U :BEGIN xx xx firstx yy yy firsty 1 END V :BEGIN xx xx firstx 1 yy yy firsty END F :BEGIN xx xx firstx yy yy firsty END ENDCASE bad where xx GE jpi IF bad 0 NE 1 THEN BEGIN xx bad xx bad jpi yy bad yy bad 1 ENDIF bad where yy GE jpj IF bad 0 NE 1 THEN stop IF keyword_set original THEN BEGIN xx xx key_shift bad where xx LT 0 IF bad 0 NE 1 THEN xx bad xx bad jpi xx xx MOD jpi xx xx ixminmesh yy yy iyminmesh ENDIF ncell n_elements xx IF keyword_set ij THEN RETURN reform xx 1 ncell over reform yy 1 ncell over IF keyword_set original THEN RETURN xx jpiglo yy ELSE RETURN xx jpi yy END "); 37 a[35] = new Array("./Interpolation/compute_fromreg_bilinear_weigaddr.html", "compute_fromreg_bilinear_weigaddr.pro", "", " NAME: compute_fromreg_bilinear_weigaddr PURPOSE: compute the weight and address neede to interpolate data from a regular grid to any grid using the bilinear method CATEGORY:interpolation CALLING SEQUENCE: compute_fromreg_bilinear_weigaddr alon alat olon olat weig addr INPUTS: lonin and latin: longitude latitude of the input data lonout and latout: longitude latitude of the output data KEYWORD PARAMETERS: NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: weig addr: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: the input grid must be a regular grid defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude We supposed the data are located on a sphere with a periodicity along the longitude points located out of the southern and northern boundaries are interpolated using a linear interpolation only along the longitudinal direction EXAMPLE: MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr PRO compute_fromreg_bilinear_weigaddr alonin alatin olonin olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs alon alonin alat alatin olon olonin jpia n_elements alon jpja n_elements alat jpio size olon dimensions 0 jpjo size olon dimensions 1 alon minalon min alon max maxalon IF maxalon minalon GE 360 THEN stop alon must be monotonically increasing IF array_equal sort alon lindgen jpia NE 1 THEN BEGIN shiftx where alon EQ min alon 0 alon shift alon shiftx IF array_equal sort alon lindgen jpia NE 1 THEN stop ENDIF ELSE shiftx 0 for longitude periodic bondary condition we add the fist column on the right side of the array and alon alon alon 0 360 jpia jpia 1L alat revy alat 0 GT alat 1 IF revy THEN alat reverse alat alat must be monotonically increasing IF array_equal sort alat lindgen jpja NE 1 THEN stop if keyword_set nonorthernline then BEGIN jpja jpja 1L alat alat 0: jpja 1L ENDIF if keyword_set nosouthernline then BEGIN alat alat 1: jpja 1L jpja jpja 1L ENDIF olon between minalon et minalon 360 out where olon LT minalon WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon LT minalon ENDWHILE out where olon GE minalon 360 WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon GE minalon 360 ENDWHILE make sure that all values of olon are located within values of alon IF min olon max ma LT minalon THEN stop IF ma GE minalon 360 THEN stop we want to do biliear interpolation for each ocean point we must find in which atm cell it is located if the ocean point is out of the atm grid we use closest neighbor interpolation for each T point of oce grid we find in which armospheric cell it is located As the atmospheric grid is regular we can use inrecgrid instead of inquad pos inrecgrid olon olat alon 0:jpia 2L alat 0:jpja 2L checkout alon jpia 1L alat jpja 1L output2d checks for longitude each ocean points must be located in atm cell IF where pos 0 EQ 1 0 NE 1 THEN stop no ocean point should be located westward of the left bondary of the atm cell in which it is supposed to be located IF total olon LT alon pos 0 NE 0 THEN stop no ocean point should be located eastward of the right bondary of the atm cell in which it is supposed to be located IF total olon GT alon pos 0 1 NE 0 THEN stop we use bilinear interpolation we change the coordinates of each ocean points to fit into a rectangle defined by: y2 y1 x1 x2 X x x1 x2 x1 Y y y1 y2 y1 indx pos 0 indy temporary pos 1 points located out of the atmospheric grid too much northward or southward bad where indy EQ 1 indy 0 indy IF max indx GT jpia 2 THEN stop checks IF max indy GT jpja 2 THEN stop checks x coordinates of the atm cell x1 alon indx x2 alon indx 1 new x coordinates of the ocean points in each cell divi temporary x2 x1 glamnew olon x1 temporary divi x1 1 free memory olon 1 free memory y coordinates of the atm cell y1 alat indy y2 alat indy 1 new y coordinates of the ocean points in each cell divi temporary y2 y1 zero where divi EQ 0 IF zero 0 NE 1 THEN divi zero 1 gphinew olat y1 temporary divi y1 1 free memory checks IF min glamnew LT 0 THEN stop IF max glamnew GT 1 THEN stop weight and address array used for bilinear interpolation xaddr lonarr 4 jpio jpjo xaddr 0 indx xaddr 1 indx 1L xaddr 2 indx 1L xaddr 3 indx yaddr lonarr 4 jpio jpjo yaddr 0 indy yaddr 1 indy yaddr 2 indy 1L yaddr 3 indy 1L compute the weight for the bilinear interpolation weig fltarr 4 jpio jpjo weig 0 1 glamnew 1 gphinew weig 1 glamnew 1 gphinew weig 2 glamnew gphinew weig 3 1 glamnew gphinew free memory gphinew 1 IF bad 0 EQ 1 THEN glamnew 1 ELSE glamnew temporary glamnew bad we work now on the bad points linear interpolation only along the longitudinal direction IF bad 0 NE 1 THEN BEGIN ybad olat bad the ocean points that are not located into an atm cell should be located northward of the northern boudary of the atm grid or southward of the southern boudary of the atm grid IF total ybad GE min alat AND ybad LE max alat GE 1 THEN stop weig 0 bad 1 glamnew weig 1 bad temporary glamnew weig 2 bad 0 weig 3 bad 0 south where ybad LT alat 0 IF south 0 NE 1 THEN yaddr bad temporary south 0L north where ybad GT alat jpja 1 IF north 0 NE 1 THEN yaddr bad temporary north 0L ybad 1 bad 1 free memory ENDIF check totalweight 1 totalweig abs 1 total weig 1 IF where temporary totalweig GE 1 e 5 0 NE 1 THEN stop come back to the original atm grid without longitudinal overlap jpia jpia 1L xaddr temporary xaddr MOD jpia take into account shiftx if needed IF shiftx NE 0 THEN xaddr temporary xaddr shiftx MOD jpia take into account nosouthernline and nonorthernline if keyword_set nosouthernline then BEGIN yaddr temporary yaddr 1L jpja jpja 1L ENDIF if keyword_set nonorthernline then jpja jpja 1L take into account revy if needed IF revy EQ 1 THEN yaddr jpja 1L temporary yaddr addr temporary yaddr jpia temporary xaddr return end "); 38 a[36] = new Array("./Interpolation/compute_fromreg_imoms3_weigaddr.html", "compute_fromreg_imoms3_weigaddr.pro", "", " NAME: compute_fromreg_imoms3_weigaddr PURPOSE: compute the weight and address neede to interpolate data from a regular grid to any grid using the imoms3 method CATEGORY:interpolation CALLING SEQUENCE: compute_fromreg_imoms3_weigaddr alon alat olon olat weig addr INPUTS: lonin and latin: longitude latitude of the input data lonout and latout: longitude latitude of the output data KEYWORD PARAMETERS: NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: weig addr: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: the input grid must be a regular rectangular grid defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude We supposed the data are located on a sphere with a periodicity along the longitude points located between the first last 2 lines are interpolated using a imoms3 interpolation along the longitudinal direction and linear interpolation along the latitudinal direction points located out of the southern and northern boundaries are interpolated using a imoms3 interpolation only along the longitudinal direction EXAMPLE: MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr March 2006: works for rectangular grids PRO compute_fromreg_imoms3_weigaddr alonin alatin olonin olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs alon alonin alat alatin olon olonin jpia n_elements alon jpja n_elements alat jpio size olon dimensions 0 jpjo size olon dimensions 1 alon minalon min alon max maxalon IF maxalon minalon GE 360 THEN stop alon must be monotonically increasing IF array_equal sort alon lindgen jpia NE 1 THEN BEGIN shiftx where alon EQ min alon 0 alon shift alon shiftx IF array_equal sort alon lindgen jpia NE 1 THEN stop ENDIF ELSE shiftx 0 alon is it regularly spaced step alon shift alon 1 step 0 step 0 360 IF total step step 0 GE 1 e 6 NE 0 THEN noregx 1 we extend the longitude range of alon easy interpolation even near minalon et maxalon toadd 10 jpia 360 1 alon alon jpia toadd:jpia 1 360 alon alon 0:toadd 1 360 jpia jpia 2 toadd alat revy alat 0 GT alat 1 IF revy THEN alat reverse alat alat must be monotonically increasing IF array_equal sort alat lindgen jpja NE 1 THEN stop alat is it regularly spaced step alat shift alat 1 step step 1:jpja 1L IF total step step 0 GE 1 e 6 NE 0 THEN noregy 1 if keyword_set nonorthernline then BEGIN jpja jpja 1L alat alat 0: jpja 1L ENDIF if keyword_set nosouthernline then BEGIN alat alat 1: jpja 1L jpja jpja 1L ENDIF olon between minalon et minalon 360 out where olon LT minalon WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon LT minalon ENDWHILE out where olon GE minalon 360 WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon GE minalon 360 ENDWHILE make sure that all values of olon are located within values of alon IF min olon max ma LT minalon THEN stop IF ma GE minalon 360 THEN stop xaddr lonarr 16 jpio jpjo yaddr lonarr 16 jpio jpjo weig fltarr 16 jpio jpjo indexlon value_locate alon olon IF total alon indexlon GT olon NE 0 THEN stop IF total alon indexlon 1L LE olon NE 0 THEN stop IF where indexlon LE 1L 0 NE 1 THEN stop IF where indexlon GE jpia 3L 0 NE 1 THEN stop indexlat value_locate alat olat for the ocean points located below the atm line jpja 2 and above the line 1 for those points we can always find 16 neighbors imoms interpolation along longitude and latitude short where indexlat LT jpja 2L AND indexlat GE 1L ilon indexlon short ilat indexlat short IF NOT keyword_set noregy THEN BEGIN delta alat ilat 1L alat ilat IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alat ilat 1L olat short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wy0 imoms3 temporary d0 d1 alat ilat olat short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wy1 imoms3 temporary d1 d2 alat ilat 1L olat short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wy2 imoms3 temporary d2 d3 alat ilat 2L olat short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wy3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wy0 fltarr nele wy1 fltarr nele wy2 fltarr nele wy3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlat spl_incr alat ilat i 1L:ilat i 2L 1 0 1 2 olat short i IF newlat LE 0 THEN stop IF newlat GT 1 THEN stop wy0 i imoms3 newlat 1 wy1 i imoms3 newlat wy2 i imoms3 1 newlat wy3 i imoms3 2 newlat ENDFOR ENDELSE mi min wy0 wy1 wy2 wy3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 0 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0 short ilat 1L yaddr 1 short yaddr 0 short yaddr 2 short yaddr 0 short yaddr 3 short yaddr 0 short weig 0 short wx0 wy0 weig 1 short wx1 wy0 weig 2 short wx2 wy0 weig 3 short wx3 wy0 line 1 xaddr 4 short ilon 1L xaddr 5 short ilon xaddr 6 short ilon 1L xaddr 7 short ilon 2L yaddr 4 short ilat yaddr 5 short ilat yaddr 6 short ilat yaddr 7 short ilat weig 4 short wx0 wy1 weig 5 short wx1 wy1 weig 6 short wx2 wy1 weig 7 short wx3 wy1 line 2 xaddr 8 short ilon 1L xaddr 9 short ilon xaddr 10 short ilon 1L xaddr 11 short ilon 2L yaddr 8 short ilat 1L yaddr 9 short yaddr 8 short yaddr 10 short yaddr 8 short yaddr 11 short yaddr 8 short weig 8 short wx0 wy2 weig 9 short wx1 wy2 weig 10 short wx2 wy2 weig 11 short wx3 wy2 line 3 xaddr 12 short ilon 1L xaddr 13 short ilon xaddr 14 short ilon 1L xaddr 15 short ilon 2L yaddr 12 short ilat 2L yaddr 13 short yaddr 12 short yaddr 14 short yaddr 12 short yaddr 15 short yaddr 12 short weig 12 short wx0 wy3 weig 13 short wx1 wy3 weig 14 short wx2 wy3 weig 15 short wx3 wy3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop for the ocean points located between the atm lines jpja 2 and jpja 1 or between the atm lines 0 and 1 linear interpolation between line 1 and line 2 short where indexlat EQ jpja 2L OR indexlat EQ 0 IF short 0 NE 1 THEN BEGIN ilon indexlon short ilat indexlat short delta alat ilat 1L alat ilat IF NOT keyword_set noregy THEN BEGIN IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 ENDIF d1 alat ilat olat short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wy1 1 temporary d1 d2 alat ilat 1L olat short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wy2 1 temporary d2 mi min wy1 wy2 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop but imoms3 along the longitude IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0 short ilat yaddr 1 short ilat yaddr 2 short ilat yaddr 3 short ilat weig 0 short wx0 wy1 weig 1 short wx1 wy1 weig 2 short wx2 wy1 weig 3 short wx3 wy1 line 2 xaddr 4 short ilon 1L xaddr 5 short ilon xaddr 6 short ilon 1L xaddr 7 short ilon 2L yaddr 4 short ilat 1L yaddr 5 short yaddr 4 short yaddr 6 short yaddr 4 short yaddr 7 short yaddr 4 short weig 4 short wx0 wy2 weig 5 short wx1 wy2 weig 6 short wx2 wy2 weig 7 short wx3 wy2 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF for the ocean points located below the line 0 Interpolation only along the longitude short where indexlat EQ 1 IF short 0 NE 1 THEN BEGIN ilon indexlon short IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0:3 short 0 weig 0 short wx0 weig 1 short wx1 weig 2 short wx2 weig 3 short wx3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF for the ocean points located above jpia 1 Interpolation only along the longitude short where indexlat EQ jpja 1L IF short 0 NE 1 THEN BEGIN ilon indexlon short IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0:3 short jpja 1L weig 0 short wx0 weig 1 short wx1 weig 2 short wx2 weig 3 short wx3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF Come back to the original index of atm grid without longitudinal overlap xaddr temporary xaddr toadd jpia jpia 2 toadd make sure all values are ge 0 xaddr temporary xaddr jpia range the values between 0 and jpia 1 xaddr temporary xaddr mod jpia take into account shiftx if needed IF shiftx NE 0 THEN xaddr temporary xaddr shiftx MOD jpia take into account nosouthernline and nonorthernline if keyword_set nosouthernline then BEGIN yaddr temporary yaddr 1L jpja jpja 1L ENDIF if keyword_set nonorthernline then jpja jpja 1L take into account revy if needed IF revy EQ 1 THEN yaddr jpja 1L temporary yaddr addr temporary yaddr jpia temporary xaddr RETURN END"); 39 a[37] = new Array("./Interpolation/cutpar.html", "cutpar.pro", "", " NAME: cutpar PURPOSE: cut p parallelogram s into p n 2 parallelograms CATEGORY: basic work CALLING SEQUENCE:res cutpar x0 y0 x1 y1 x2 y2 x3 y3 n INPUTS: x0 y0 1d arrays of p elements giving the edge positions The edges must be given as in plot to traw the parallelogram see example n: each parallelogram will be cutted in n 2 pieces KEYWORD PARAMETERS: endpoints: see outputs onsphere: to specify that the points are located on a sphere In this case x and y corresponds to longitude and latitude in degrees OUTPUTS: defaut: 3d array 2 n 2 p giving the center position of each piece of the parallelograms endpoints: 3d array 2 n 1 2 p giving the edge positions of each piece of the parallelograms COMMON BLOCKS: no SIDE EFFECTS: need cutsegment pro RESTRICTIONS: EXAMPLE: x0 2 6 2 y0 0 2 6 x1 3 8 4 y1 4 4 6 x2 1 6 4 y2 5 6 8 x3 0 4 2 y3 1 4 8 n 4 splot 0 10 0 10 xstyle 1 ystyle 1 nodata for i 0 2 do oplot x0 i x1 i x2 i x3 i x0 i y0 i y1 i y2 i y3 i y0 i res cutpar x0 y0 x1 y1 x2 y2 x3 y3 n for i 0 2 do oplot res 0 i res 1 i color 20 10 i psym 1 thick 3 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 5th 2002 FUNCTION cutpar x0 y0 x1 y1 x2 y2 x3 y3 n endpoints endpoints onsphere onsphere is it a parallelogram eps 1e 4 IF total abs x0 x2 2 x1 x3 2 GE eps GT 0 OR total abs y0 y2 2 y1 y3 2 GE eps GT 0 THEN stop print NOT a parallelogram x0 npar npar n_elements x0 firstborder 2 n keyword_set endpoints npar firstborder cutsegment x0 y0 x1 y1 n endpoints endpoints onsphere onsphere thirdborder cutsegment x3 y3 x2 y2 n endpoints endpoints onsphere onsphere res 2 n keyword_set endpoints n keyword_set endpoints npar res cutsegment firstborder 0 firstborder 1 thirdborder 0 thirdborder 1 n endpoints endpoints onsphere onsphere free memory firstborder 1 thirdborder 1 reform the result res reform res 2 n keyword_set endpoints 2 npar overwrite RETURN res END"); 40 a[38] = new Array("./Interpolation/cutsegment.html", "cutsegment.pro", "", " NAME: cutsegment PURPOSE: cut p segments into p n equal parts CATEGORY: basic work CALLING SEQUENCE: res cutsegment x0 y0 x1 y1 n INPUTS: x0 y0 and x1 y1 1d arrays of p elements the coordinates of the endpoints of the p segmements n: the number of pieces we want to cut each segment KEYWORD PARAMETERS: endpoints: see ouputs onsphere: to specify that the points are located on a sphere In this case x and y corresponds to longitude and latitude in degrees OUTPUTS: defaut: a 3d array 2 n p that gives the coordinates of the middle of the cutted segments if endpoints a 3d array 2 n 1 p that gives the coordinates of the endpoints of the cutted segments COMMON BLOCKS: no SIDE EFFECTS: no RESTRICTIONS: EXAMPLE: IDL x0 2 5 IDL y0 5 1 IDL x1 9 3 IDL y1 1 8 IDL res cutsegment x0 y0 x1 y1 10 IDL splot 0 10 0 10 xstyle 1 ystyle 1 nodata IDL oplot x0 0 x1 0 y0 0 y1 0 IDL oplot res 0 0 res 1 0 color 20 psym 1 thick 3 IDL oplot x0 1 x1 1 y0 1 y1 1 IDL oplot res 0 1 res 1 1 color 40 psym 1 thick 3 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 5th 2002 FUNCTION cutsegment x0 y0 x1 y1 n endpoints endpoints onsphere onsphere number of segment nseg n_elements x0 number of point to find on each segment n2find n keyword_set endpoints IF keyword_set onsphere THEN BEGIN save the inputs arrays x0in temporary x0 y0in temporary y0 x1in temporary x1 y1in temporary y1 sp_cood transpose x0in transpose y0in replicate 1 1 nseg rect_coord CV_COORD FROM_SPHERE temporary sp_cood TO_RECT DEGREES x0 rect_coord 0 y0 rect_coord 1 z0 rect_coord 2 rect_coord 1 free memory sp_cood transpose x1in transpose y1in replicate 1 1 nseg rect_coord CV_COORD FROM_SPHERE temporary sp_cood TO_RECT DEGREES x1 rect_coord 0 y1 rect_coord 1 z1 rect_coord 2 rect_coord 1 free memory ENDIF resx replicate 1 n2find x0 resx temporary resx 1 n findgen n2find 5 1 keyword_set endpoints x1 x0 resx temporary resx resy replicate 1 n2find y0 resy temporary resy 1 n findgen n2find 5 1 keyword_set endpoints y1 y0 resy temporary resy IF keyword_set onsphere THEN BEGIN resz replicate 1 n2find z0 resz temporary resz 1 n findgen n2find 5 1 keyword_set endpoints z1 z0 resz temporary resz rec_cood transpose temporary resx transpose temporary resy transpose temporary resz res CV_COORD FROM_RECT temporary rec_cood TO_SPHERE DEGREES restore the input arrays x0 temporary x0in y0 temporary y0in x1 temporary x1in y1 temporary y1in ENDIF ELSE res transpose temporary resx transpose temporary resy res reform res 0:1 2 n2find nseg overwrite RETURN res END"); 41 a[39] = new Array("./Interpolation/extrapolate.html", "extrapolate.pro", "", "FUNCTION extrapolate zinput maskinput nb_iteration x_periodic x_periodic MINVAL minval MAXVAL maxval compile_opt strictarr strictarrsubs extrapolate data zinput where maskinput eq 0 by filling step by step the coastline points with the mean value of the 8 neighbourgs check the number of iteration used in the extrapolation IF n_elements nb_iteration EQ 0 THEN nb_iteration 10 E20 IF nb_iteration EQ 0 THEN return zinput nx size zinput 1 ny size zinput 2 take care of the boundary conditions for the x direction we put 2 additional columns at the left and right side of the array for the y direction we put 2 additional lines at the bottom and top side of the array These changes allow us to use shift function without taking care of the x and y periodicity ztmp bytarr nx 2 ny 2 ztmp 1:nx 1:ny byte maskinput msk temporary ztmp ztmp replicate 1 e20 nx 2 ny 2 ztmp 1:nx 1:ny zinput if keyword_set x_periodic then begin ztmp 0 1:ny zinput nx 1 ztmp nx 1 1:ny zinput 0 ENDIF remove NaN points if there is some nan where finite ztmp EQ 0 cnt_nan IF cnt_nan NE 0 THEN ztmp temporary nan 1 e20 z temporary ztmp nx2 nx 2 ny2 ny 2 extrapolation sqrtinv 1 sqrt 2 cnt 1 When we look for the coast line we don t whant to select the borderlines of the array we force the value of the mask for those lines msk 0 1b msk nx 1 1b msk 0 1b msk ny 1 1b find the land points land where msk EQ 0 cnt_land WHILE cnt LE nb_iteration AND cnt_land NE 0 DO BEGIN find the coast line points Once the land points list has been found we change back the the mask values for the boundary conditions msk 0 0b msk nx 1 0b msk 0 0b msk ny 1 0b if keyword_set x_periodic then begin msk 0 msk nx msk nx 1 msk 1 endif we compute the weighted number of sea neighbourgs those 4 neighbours have a weight of 1: those 4 neighbours have a weight of 1 sqrt 2 : As we make sure that none of the land points are located on the border of the array we can compute the weight without shift faster weight msk land 1 msk land 1 msk land nx2 msk land nx2 sqrtinv msk land nx2 1 msk land nx2 1 msk land nx2 1 msk land nx2 1 list all the points that have sea neighbourgs ok where weight GT 0 the coastline points coast land ok their weighted number of sea neighbourgs weight weight temporary ok fill the coastine points z temporary z msk zcoast z 1 coast z 1 coast z nx2 coast z nx2 coast 1 sqrt 2 z nx2 1 coast z nx2 1 coast z nx2 1 coast z nx2 1 coast IF n_elements minval NE 0 THEN zcoast minval temporary zcoast IF n_elements maxval NE 0 THEN zcoast temporary zcoast we force the value of the mask for those lines msk 0 1b msk nx 1 1b msk 0 1b msk ny 1 1b find the land points land where msk EQ 0 cnt_land ENDWHILE we return the original size of the array return z 1:nx 1:ny END "); 42 a[40] = new Array("./Interpolation/fromreg.html", "fromreg.pro", "", " NAME: fromreg PURPOSE: interpolate data from a regular rectangular grid to any grid 2 metods availables: bilinear and imoms3 A regular rectangular grid is defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude CATEGORY:interpolation CALLING SEQUENCE: dataout fromreg method datain lonin latin lonout latout INPUTS: method: a string defining the interpolation method must be bilinear or imoms3 datain: a 2D array the input data to interpolate lonin and latin: longitude latitude of the input data optionals if WEIG and ADDR keywords used lonout and latout: longitude latitude of the output data optionals if WEIG and ADDR keywords used KEYWORD PARAMETERS: WEIG ADDR: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over Those keywords can be set to named variables into which the values will be copied when the current routine exits Next they can be used to perform the interpolation whithout computing again those 2 parameters In that case lonin latin lonout and latout are not necessary NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: 2D array: the interpolated data COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS:We supposed the data are located on a sphere with a periodicity along the longitude EXAMPLE: topa fromreg bilinear tncep xncep yncep glamt gphit or t1opa fromreg bilinear t1ncep xncep yncep glamt gphit WEIG a ADDR b help a b t2opa fromreg bilinear t2ncep xncep WEIG a ADDR b MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr FUNCTION fromreg method datain lonin latin lonout latout WEIG weig ADDR addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs IF NOT keyword_set weig AND keyword_set addr THEN BEGIN atmospheric grid parameters alon lonin alat latin get_gridparams alon alat jpia jpja 1 double Oceanic grid parameters olon lonout olat latout get_gridparams olon olat jpio jpjo 2 double Compute weight and address CASE method OF bilinear :compute_fromreg_bilinear_weigaddr alon alat olon olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline imoms3 : compute_fromreg_imoms3_weigaddr alon alat olon olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline ELSE:BEGIN print unknown interpolation method we stop stop ENDELSE ENDCASE ENDIF dataout total weig datain addr 1 dataout reform dataout jpio jpjo over RETURN dataout END"); 43 a[41] = new Array("./Interpolation/get_gridparams.html", "get_gridparams.pro", "", " NAME: get_gridparams PURPOSE: 1 extract from a NetCDF file the longitude latidude and their dimensions and make sure it is 1D or 2D arrays or 2 given longitude and latitude arrays get their dimensions and make sure they are 1D or 2D arrays CATEGORY:for interpolations tools CALLING SEQUENCE: 1 get_gridparams file lonname latname lon lat jpi jpj n_dimensions or 2 get_gridparams lon lat jpi jpj n_dimensions INPUTS: 1 file: the name of the netcdf file loname: the name of the variable that contains the longitude in the NetCDF file latname: the name of the variable that contains the latitude in the NetCDF file or 2 lon and lat: 1d or 2D arrays defining longitudes and latitudes Note that these arrays are also outputs and can therefore be modified KEYWORD PARAMETERS: none OUTPUTS: lon the variable that will contain the longitudes lat the variable that will contain the latitudes jpi the number of points in the longitudinal direction jpj the number of points in the latitudinal direction n_dimensions: 1 or 2 to specify if lon and lat should be 1D jpi or jpj arrays or 2D arrays jpi jpj Note that of n_dimensions 1 then the grid must be regular each longitudes must be the same for all latitudes and each latitudes should be the sae for all longitudes COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: EXAMPLE: 1 ncdf_get_gridparams coordinates_ORCA_R05 nc glamt gphit olon olat jpio jpjo 2 2 ncdf_get_gridparams olon olat jpio jpjo 2 MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr PRO get_gridparams in1 in2 in3 in4 in5 in6 in7 in8 DOUBLE double file lonname latname lon lat jpi jpj n_dimensions lon lat jpi jpj n_dimensions CASE n_params OF 8:BEGIN get longitude and latitude IF file_test in1 EQ 0 THEN BEGIN print file in1 does not exist stop ENDIF cdfido ncdf_open in1 ncdf_varget cdfido in2 lon ncdf_varget cdfido in3 lat ncdf_close cdfido n_dimensions in8 END 5:BEGIN lon temporary in1 lat temporary in2 n_dimensions in5 END ELSE:BEGIN print Bad nimber of input parameters stop end ENDCASE sizelon size lon sizelat size lat CASE 1 OF lon and lat are 1D arrays sizelon 0 EQ 1 AND sizelat 0 EQ 1:BEGIN get jpi and jpj jpi sizelon 1 jpj sizelat 1 make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1: 2:BEGIN make lon and lat 2D arrays lon temporary lon replicate 1 jpj lat replicate 1 jpi temporary lat END ELSE:stop ENDCASE END lon is 2D array and lat is 1D array sizelon 0 EQ 2 AND sizelat 0 EQ 1:BEGIN get jpi and jpj jpi sizelon 1 jpj sizelon 2 IF jpj NE n_elements lat THEN stop make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lon lon 0 replicate 1 jpj NE 1 THEN BEGIN print Longitudes are not the same for all latitudes imposible to extract a 1D array of the longitudes stop ENDIF lon lon 0 END 2:lat replicate 1 jpi temporary lat ELSE:stop ENDCASE END lon is 1D array and lat is 2D array sizelon 0 EQ 1 AND sizelat 0 EQ 2:BEGIN get jpi and jpj jpi sizelat 1 jpj sizelat 2 IF jpi NE n_elements lon THEN stop make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lat replicate 1 jpi lat 0 NE 1 THEN BEGIN print Latitudes are not the same for all longitudes imposible to extract a 1D array of the latitudes stop ENDIF lat reform lat 0 END 2:lon temporary lon replicate 1 jpj ELSE:stop ENDCASE END lon and lat are 2D arrays sizelon 0 EQ 2 AND sizelat 0 EQ 2:BEGIN get jpi and jpj IF array_equal sizelon 1:2 sizelat 1:2 NE 1 THEN stop jpi sizelon 1 jpj sizelon 2 make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lon lon 0 replicate 1 jpj NE 1 THEN BEGIN print Longitudes are not the same for all latitudes imposible to extract a 1D array of the longitudes stop ENDIF lon lon 0 IF array_equal lat replicate 1 jpi reform lat 0 NE 1 THEN BEGIN print Latitudes are not the same for all longitudes imposible to extract a 1D array of the latitudes stop ENDIF lat reform lat 0 END 2: ELSE:stop ENDCASE END lon and lat are not 1D and or 2D arrays ELSE:stop ENDCASE double keyword if keyword_set double then BEGIN lon double temporary lon lat double temporary lat ENDIF give back the right outparameters CASE n_params OF 8:BEGIN in4 temporary lon in5 temporary lat in6 temporary jpi in7 temporary jpj END 5:BEGIN in1 temporary lon in2 temporary lat in3 temporary jpi in4 temporary jpj END ENDCASE return END"); 44 a[42] = new Array("./Interpolation/imoms3.html", "imoms3.pro", "", "FUNCTION imoms3 xin x abs xin y fltarr n_elements x test1 where x LT 1 IF test1 0 NE 1 THEN BEGIN xtmp x test1 y test1 0 5 xtmp xtmp xtmp xtmp xtmp 0 5 xtmp 1 ENDIF test1 where x LT 2 AND x GE 1 IF test1 0 NE 1 THEN BEGIN xtmp x test1 y test1 1 6 xtmp xtmp xtmp xtmp xtmp 11 6 xtmp 1 ENDIF RETURN y END"); 45 a[43] = new Array("./Interpolation/inquad.html", "inquad.pro", "", " NAME:inquad PURPOSE: to find if an x y point is in a quadrilateral x1 x2 x3 x4 CATEGORY:grid manipulation CALLING SEQUENCE: res inquad x y x1 y1 x2 y2 x3 y3 x4 y4 INPUTS: x y: the coordinates of the point we want to know where it is Must be a scalar if onsphere activated else can be scalar or array x1 y1 x2 y2 x3 y3 x4 y4: the coordinates of the quadrilateral given in the CLOCKWISE order Scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation ONSPHERE: to specify that the quadilateral are on a sphere and that teir coordinates are longitude latitude coordinates In this case est west periodicity poles singularity and other pbs related to longitude latitude coordinates are managed automatically ZOOMRADIUS:the zoom circle centred on the x y with a radius of zoomradius degree where we look for the the quadrilateral which contains the x y point used for the satellite projection when onsphere is activated Default is 4 and seems to be the minimum which can be used Can be increase if the cell size is larger than 5 degrees NOPRINT: to suppress the print messages OUTPUTS: res a n element vector Where n is the number of elements of x res i j means that the point number i is located in the quadrilateral number j with 0 j n_elements x0 1 COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: x 1 1 2 6 7 3 y 1 1 3 3 4 7 x1 1 0 4 2 y1 1 1 4 8 x2 1 1 6 4 y2 1 5 6 8 x3 1 3 8 4 y3 1 4 4 6 x4 1 2 6 2 y4 1 0 2 6 splot 0 10 0 10 xstyle 1 ystyle 1 nodata for i 0 2 do oplot x4 i x1 i x2 i x3 i x4 i y4 i y1 i y2 i y3 i y4 i oplot x y color 20 psym 1 thick 2 print inquad x y x1 y1 x2 y2 x3 y3 x4 y4 On a sphere see clickincell pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Convert_clic_ij pro written by Gurvan Madec FUNCTION inquad x y x1 y1 x2 y2 x3 y3 x4 y4 ONSPHERE onsphere DOUBLE double ZOOMRADIUS zoomradius NOPRINT noprint NEWCOORD newcoord ntofind n_elements x nquad n_elements x2 IF keyword_set onsphere THEN BEGIN save the inputs parameters xin x yin y x1in x1 y1in y1 x2in x2 y2in y2 x3in x3 y3in y3 x4in x4 y4in y4 for map_set x x MOD 360 x1 x1 MOD 360 x2 x2 MOD 360 x3 x3 MOD 360 x4 x4 MOD 360 save map save map: map x: x y: y z: z p: p do a satellite projection IF NOT keyword_set zoomradius THEN zoomradius 4 map_set y 0 x 0 0 satellite sat_p 1 zoomradius 20 6371 229 0 0 noerase iso noborder use normal coordinates to reject cells which are out of the projection tmp convert_coord x y DATA TO_NORMAL DOUBLE double tmp1 convert_coord x1 y1 DATA TO_NORMAL DOUBLE double tmp2 convert_coord x2 y2 DATA TO_NORMAL DOUBLE double tmp3 convert_coord x3 y3 DATA TO_NORMAL DOUBLE double tmp4 convert_coord x4 y4 DATA TO_NORMAL DOUBLE double remove cell which have one corner with coordinates equal to NaN test finite tmp1 0 tmp1 1 tmp2 0 tmp2 1 tmp3 0 tmp3 1 tmp4 0 tmp4 1 good where temporary test EQ 1 IF good 0 EQ 1 THEN BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p RETURN 1 ENDIF x tmp 0 y tmp 1 x1 tmp1 0 good y1 tmp1 1 good x2 tmp2 0 good y2 tmp2 1 good x3 tmp3 0 good y3 tmp3 1 good x4 tmp4 0 good y4 tmp4 1 good tmp1 1 tmp2 1 tmp3 1 tmp4 1 remove cells which are obviously bad test x1 GT x AND x2 GT x AND x3 GT x AND x4 GT x OR x1 LT x AND x2 LT x AND x3 LT x AND x4 LT x OR y1 GT y AND y2 GT y AND y3 GT y AND y4 GT y OR y1 LT y AND y2 LT y AND y3 LT y AND y4 LT y good2 where temporary test EQ 0 IF good2 0 EQ 1 THEN BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p RETURN 1 ENDIF nquad n_elements good2 x1 x1 good2 y1 y1 good2 x2 x2 good2 y2 y2 good2 x3 x3 good2 y3 y3 good2 x4 x4 good2 y4 y4 good2 ENDIF the point is inside the quadilateral if test eq 1 with test equal to: test x x1 y2 y1 GE x2 x1 y y1 x x2 y3 y2 GT x3 x2 y y2 x x3 y4 y3 GT x4 x3 y y3 x x4 y1 y4 GE x1 x4 y y4 computation of test without any do loop for ntofind points x y and nquad quadilateral x1 x2 x3 x4 y1 y2 y3 y4 test dimensions are ntofind nquad column i of test corresponds to the intersection of point i with all quadirlateral row j of test corresponds to all the points localized in cell j test x x1 x replicate 1 nquad replicate 1 ntofind x1 y2 y1 replicate 1 ntofind y2 y1 GE x2 x1 GE replicate 1 ntofind x2 x1 y y1 y replicate 1 nquad replicate 1 ntofind y1 test temporary test x x2 x replicate 1 nquad replicate 1 ntofind x2 y3 y2 replicate 1 ntofind y3 y2 GE x3 x2 GE replicate 1 ntofind x3 x2 y y2 y replicate 1 nquad replicate 1 ntofind y2 test temporary test x x3 x replicate 1 nquad replicate 1 ntofind x3 y4 y3 replicate 1 ntofind y4 y3 GE x4 x3 GE replicate 1 ntofind x4 x3 y y3 y replicate 1 nquad replicate 1 ntofind y3 test temporary test x x4 x replicate 1 nquad replicate 1 ntofind x4 y1 y4 replicate 1 ntofind y1 y4 GE x1 x4 GE replicate 1 ntofind x1 x4 y y4 y replicate 1 nquad replicate 1 ntofind y4 check test if ntofind gt 1 if ntofind gt 1 each point must be localised in one uniq cell IF ntofind GT 1 THEN BEGIN each column of test must have only 1 position equal to one chtest total test 2 points out of the cells IF where chtest EQ 0 0 NE 1 THEN BEGIN IF NOT keyword_set noprint THEN print Points number strjoin strtrim where chtest EQ 0 1 are out of the grid stop ENDIF points in more than one cell IF where chtest GT 1 0 NE 1 THEN BEGIN IF NOT keyword_set noprint THEN print Points number strjoin strtrim where chtest GT 1 1 are in more than one cell stop ENDIF ENDIF find the points for which test eq 1 found where temporary test EQ 1 if ntofind eq 1 the point may be localised in more than one grid cell ou may also be out of the cells IF ntofind EQ 1 THEN BEGIN CASE 1 OF found 0 EQ 1:BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells IF keyword_set onsphere THEN BEGIN restore old map map save map x save x y save y z save z p save p ENDIF return 1 END n_elements found GT ntofind:BEGIN IF NOT keyword_set noprint THEN print The point is in more than one cell END ELSE: ENDCASE ENDIF ELSE BEGIN if ntofind GT 1 found must be sorted i position of found this corresponds to one x y point forsort found MOD ntofind j position of found this corresponds to cell in which is one x y point found temporary found ntofind found must be sorted accordind to forsort found found sort forsort ENDELSE IF keyword_set onsphere THEN BEGIN IF arg_present newcoord THEN BEGIN newcoord x1 found y1 found x2 found y2 found x3 found y3 found x4 found y4 found x y ENDIF found good good2 found restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p ENDIF RETURN found END"); 46 a[44] = new Array("./Interpolation/inrecgrid.html", "inrecgrid.pro", "", " NAME: inrecgrid PURPOSE: given a list of points x y position the x and y limits of a rectangular grid find in which cell is located each given point CATEGORY: no DO loop use the wonderfull value_locate function CALLING SEQUENCE:res inrecgrid xin yin left bottom INPUTS: x1d: a 1d array the x position on the points y1d: a 1d array the y position on the points left: a 1d monotonically increasing array the position of the left border of each cell bottom: a 1d monotonically increasing array the position of the bottom border of each cell OPTIONAL INPUTS: KEYWORD PARAMETERS: output2d: to get the output as a 2d array 2 n_elements x1d with res 0 the x index accoring to the 1d array defined by left and res 1 the y index accoring to the 1d array defined by bottom checkout rbgrid ubgrid specify the right and upper bondaries of the grid and check if some points are out OUTPUTS:the index on the cell accoring to the 2d array defined by left and bottom OPTIONAL OUTPUTS: COMMON BLOCKS: no SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: IDL a indgen 5 IDL b indgen 7 IDL r inrecgrid 0 25 3 25 2 4 25 2 8 1 4 a b IDL print r 20 13 7 IDL r inrecgrid 0 25 3 25 2 4 25 2 8 1 4 a a 1 b b 1 output2d IDL print r 0 00000 4 00000 3 00000 2 00000 2 00000 1 00000 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 3rd 2002 October 3rd 2003: use value_locate FUNCTION inrecgrid x1d y1d left bottom output2d output2d checkout checkout ncellx n_elements left ncelly n_elements bottom xpos value_locate left x1d ypos value_locate bottom y1d IF n_elements checkout EQ 2 THEN BEGIN out where x1d GT checkout 0 IF out 0 NE 1 THEN xpos out 1 out where y1d GT checkout 1 IF out 0 NE 1 THEN ypos out 1 ENDIF IF keyword_set output2d THEN return transpose xpos transpose ypos IF NOT keyword_set checkout THEN RETURN xpos ncellx ypos res xpos ncellx ypos out where xpos EQ 1 OR ypos EQ 1 IF out 0 NE 1 THEN res out 1 RETURN res END"); 47 a[45] = new Array("./Interpolation/ll_narcs_distances.html", "ll_narcs_distances.pro", "", " NAME: LL_NARCS_DISTANCES PURPOSE: This function returns the longitude and latitude lon lat of a point a given arc distance pi lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi two_by_two IDL earthradius 6378206 4d0 IDL res ll_narcs_distances lon0 lat0 dist earthradius azi degrees IDL print reform res 0 10 000000 60 000000 280 00000 IDL print reform res 1 1 1999280e 15 10 000000 45 000000 MODIFICATION HISTORY: Based on the IDL function ll_arc_distance pro v 1 11 2003 02 03 Sebastien Masson smasson lodyc jussieu fr August 2005 Return the lon lat of the point a given arc distance pi arc_dist pi and azimuth az from lon_lat0 FUNCTION LL_NARCS_DISTANCES lon0 lat0 arc_dist az DEGREES degs IF n_elements lon0 NE n_elements lat0 OR n_elements lon0 NE n_elements arc_dist OR n_elements lon0 NE n_elements az THEN return 1 cdist cos arc_dist Arc_Dist is always in radians sdist sin arc_dist if keyword_set degs then s dpi 180 0 else s 1 0d0 ll lat0 s To radians sinll1 sin ll cosll1 cos ll azs az s phi asin sinll1 cdist cosll1 sdist cos azs ll lon0 s To radians lam ll atan sdist sin azs cosll1 cdist sinll1 sdist cos azs zero where arc_dist eq 0 count IF count NE 0 THEN BEGIN lam zero lon0 zero phi zero lat0 zero ENDIF if keyword_set degs then return transpose lam phi s ELSE return transpose lam phi end "); 48 a[46] = new Array("./Interpolation/map_npoints.html", "map_npoints.pro", "", " NAME: Map_nPoints PURPOSE: Return the distance in meter between all np0 points P0 and all np1 points P1 on a sphere If keyword TWO_BY_TWO is given then returns the distances between number n of P0 points and number n of P1 points in that case np0 and np1 must be equal Same as map_2points with the meter parameter but for n points without do loop CATEGORY: Maps CALLING SEQUENCE: Result Map_nPoints lon0 lat0 lon1 lat1 INPUTS: Lon0 Lat0 np0 elements vector longitudes and latitudes of np0 points P0 Lon1 Lat1 np1 elements vector longitude and latitude of np1 points P1 KEYWORD PARAMETERS: AZIMUTH: A named variable that will receive the azimuth of the great circle connecting the two points P0 to P1 MIDDLE: to get the longitude latitude of the middle point betwen P0 and P1 RADIANS if set inputs and angular outputs are in radians otherwise degrees RADIUS: If given return the distance between the two points calculated using the given radius Default value is the earth radius : 6378206 4d0 TWO_BY_TWO:If given then Map_nPoints returns the distances between number n of P0 points and number n of P1 points in that case np0 and np1 must be equal OUTPUTS: An np0 np1 array giving the distance in meter between np0 points P0 and np1 points P1 Element i j of the ouput is the distance between element P0 i and P1 j If keyword TWO_BY_TWO is given then Map_nPoints returns an np element vector giving the distance in meter between P0 i and P1 i in that case we have np0 np1 np if MIDDLE see this keyword EXAMPLES: IDL print map_npoints 105 15 1 40 02 1 0 07 100 50 51 30 20 0 7551369 3 5600334 8 12864354 10921254 14919237 5455558 8 IDL lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi IDL help dist azi DIST DOUBLE Array 3 3 AZI DOUBLE Array 3 3 IDL print dist 4 lindgen 3 azi 4 lindgen 3 2226414 0 4957944 5 10018863 90 000000 64 494450 4 9615627e 15 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi two_by_two IDL help dist azi DIST DOUBLE Array 3 AZI DOUBLE Array 3 IDL print dist azi 2226414 0 4957944 5 10018863 90 000000 64 494450 4 9615627e 15 IDL print map_2points lon0 0 lat0 0 lon1 0 lat1 0 20 000000 90 000000 IDL print map_npoints lon0 0 lat0 0 lon1 0 lat1 0 azi azi 6378206 4d0 dtor azi 20 000000 90 000000 IDL lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL mid map_npoints lon0 lat0 lon1 lat1 middle two_by_two IDL print reform mid 0 reform mid 1 0 0000000 40 000000 190 00000 0 0000000 1 5902773e 15 90 000000 IDL print map_2points lon0 0 lat0 0 lon1 0 lat1 0 npath 3 1 0 0000000 0 0000000 IDL print map_2points lon0 1 lat0 1 lon1 1 lat1 1 npath 3 1 40 000000 1 5902773e 15 IDL print map_2points lon0 2 lat0 2 lon1 2 lat1 2 npath 3 1 190 00000 90 000000 MODIFICATION HISTORY: Based on the IDL function map_2points pro v 1 6 2001 01 15 Sebastien Masson smasson lodyc jussieu fr October 2003 Function Map_npoints lon0 lat0 lon1 lat1 azimuth azimuth RADIANS radians RADIUS radius MIDDLE middle TWO_BY_TWO two_by_two COMPILE_OPT idl2 ON_ERROR 2 return to caller IF N_PARAMS LT 4 THEN MESSAGE Incorrect number of arguments np0 n_elements lon0 IF n_elements lat0 NE np0 THEN MESSAGE lon0 and lat0 must have the same number of elements np1 n_elements lon1 IF n_elements lat1 NE np1 THEN MESSAGE lon1 and lat1 must have the same number of elements if keyword_set two_by_two AND np0 NE np1 then MESSAGE When using two_by_two keyword P0 and P1 must have the same number of elements mx MAX ABS lat0 lat1 pi2 dpi 2 IF mx GT KEYWORD_SET radians pi2 : 90 THEN MESSAGE Value of Latitude is out of allowed range k KEYWORD_SET radians 1 0d0 : dpi 180 0 Earth equatorial radius meters Clarke 1866 ellipsoid r_sphere n_elements RADIUS NE 0 RADIUS : 6378206 4d0 coslt1 cos k lat1 sinlt1 sin k lat1 coslt0 cos k lat0 sinlt0 sin k lat0 IF np0 EQ np1 AND np1 EQ 1 THEN two_by_two 1 if NOT keyword_set two_by_two THEN BEGIN coslt1 replicate 1 0d0 np0 temporary coslt1 sinlt1 replicate 1 0d0 np0 temporary sinlt1 coslt0 temporary coslt0 replicate 1 0d0 np1 sinlt0 temporary sinlt0 replicate 1 0d0 np1 ENDIF if keyword_set two_by_two THEN BEGIN cosl0l1 cos k lon1 lon0 sinl0l1 sin k lon1 lon0 ENDIF ELSE BEGIN cosl0l1 cos k replicate 1 0d0 np0 lon1 lon0 replicate 1 0d0 np1 sinl0l1 sin k replicate 1 0d0 np0 lon1 lon0 replicate 1 0d0 np1 ENDELSE cosc sinlt0 sinlt1 coslt0 coslt1 cosl0l1 Cos of angle between pnts Avoid roundoff problems by clamping cosine range to 1 1 cosc 1 0d0 cosc 1 0d0 if arg_present azimuth OR keyword_set middle then begin sinc sqrt 1 0d0 cosc cosc bad where abs sinc le 1 0e 7 IF bad 0 NE 1 THEN sinc bad 1 cosaz coslt0 sinlt1 sinlt0 coslt1 cosl0l1 sinc sinaz sinl0l1 coslt1 sinc IF bad 0 NE 1 THEN BEGIN sinc bad 0 0d0 sinaz bad 0 0d0 cosaz bad 1 0d0 ENDIF ENDIF IF keyword_set middle then BEGIN s0 0 5d0 acos cosc coss cos s0 sins sin s0 lats asin sinlt0 coss coslt0 sins cosaz k lons atan sins sinaz coslt0 coss sinlt0 sins cosaz k if keyword_set two_by_two THEN BEGIN return transpose lon0 lons lats ENDIF ELSE BEGIN return lon0 replicate 1 0d0 np1 lons lats ENDELSE ENDIF if arg_present azimuth then begin azimuth atan sinaz cosaz IF k NE 1 0d0 THEN azimuth temporary azimuth k ENDIF return acos cosc r_sphere end"); 49 a[47] = new Array("./Interpolation/neighbor.html", "neighbor.pro", "", " NAME: neighbor PURPOSE: find the closetest point of P0 within a list of np1 points P1 Which can be on a sphere CATEGORY: Maps CALLING SEQUENCE: Result neighbor lon0 lat0 lon1 lat1 INPUTS: Lon0 Lat0 scalar longitudes and latitudes of point P0 Lon1 Lat1 np1 elements vector longitude and latitude of np1 points P1 KEYWORD PARAMETERS: RADIANS if set inputs and angular outputs are in radians otherwise degrees DISTANCE dis to get back the distances between P0 and the np1 points P1 in the variable dis SPHERE to activate if points are located on a sphere OUTPUTS: index giving the P1 index point that is the closetest point of P0 EXAMPLES: IDL print neighbor 105 15 40 02 0 07 100 50 51 30 20 0 distance dis 0 IDL print dis 105 684 206 125 160 228 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr October 2003 FUNCTION neighbor p0lon p0lat neighlon neighlat sphere sphere distance distance radians radians somme checks IF n_elements p0lon NE 1 THEN MESSAGE Sorry p0lon must be a scalar p0lon p0lon 0 IF n_elements p0lat NE 1 THEN MESSAGE Sorry p0lat must be a scalar p0lat p0lat 0 nneig n_elements neighlon IF n_elements neighlat NE nneig THEN MESSAGE neighlon and neighlat must have the same number of elements distance between P0 and the others points IF keyword_set sphere THEN BEGIN IF sphere NE 1 THEN radius sphere distance Map_nPoints p0lon p0lat neighlon neighlat radius radius radians radians ENDIF ELSE BEGIN distance neighlon p0lon 2 neighlat p0lat 2 IF arg_present distance THEN distance sqrt distance ENDELSE RETURN where distance EQ min distance END"); 50 a[48] = new Array("./Interpolation/quadrilateral2square.html", "quadrilateral2square.pro", "", " NAME:quadrilateral2square PURPOSE:warm or map an arbitrary quadrilateral onto a unit square according to the 4 point correspondences: x0 y0 0 0 x1 y1 1 0 x2 y2 1 1 x3 y3 0 1 This is the inverse function of square2quadrilateral pro The mapping is done using perspective transformation which preserve lines in all orientations and permit quadrilateral to quadrilateral mappings see ref bellow CATEGORY:image grid manipulation CALLING SEQUENCE: res square2quadrilateral x0 y0 x1 y1 x2 y2 x3 y3 xin yin INPUTS: x0 y0 x1 y1 x2 y2 x3 y3 the coordinates of the quadrilateral see above for correspondance with the unit square Can be scalar or array x0 y0 x1 y1 x2 y2 and x3 y3 are given in the anticlockwise order xin yin:the coordinates of the point s for which we want to do the mapping Can be scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation OUTPUTS: 2 n array: the new coodinates xout yout of the xin yin point s after mapping If xin is a scalar then n is equal to the number of elements of x0 If xin is an array then n is equal to the number of elements of xin COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: IDL splot 0 5 0 3 nodata xstyle 1 ystyle 1 IDL tracegrille findgen 11 1 findgen 11 1 color indgen 12 20 IDL xin findgen 11 1 replicate 1 11 IDL yin replicate 1 11 findgen 11 1 IDL out square2quadrilateral 2 1 3 0 5 1 2 3 xin yin IDL tracegrille reform out 0 11 11 reform out 1 11 11 color indgen 12 20 IDL inorg quadrilateral2square 2 1 3 0 5 1 2 3 out 0 out 1 IDL tracegrille reform inorg 0 11 11 reform inorg 1 11 11 color indgen 12 20 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Digital Image Warping by G Wolberg IEEE Computer Society Press Los Alamitos California Chapter 3 see p 52 56 FUNCTION quadrilateral2square x0in y0in x1in y1in x2in y2in x3in y3in xxin yyin PERF perf tempsone systime 1 Warning wrong definition of x2 y2 and x3 y3 at the bottom of page 54 of Wolberg s book see figure 3 7 page 56 for the good definition IF keyword_set double THEN BEGIN x0 double x0in x1 double x1in x2 double x2in x3 double x3in y0 double y0in y1 double y1in y2 double y2in y3 double y3in xin double xxin yin double yyin ENDIF ELSE BEGIN x0 float x0in x1 float x1in x2 float x2in x3 float x3in y0 float y0in y1 float y1in y2 float y2in y3 float y3in xin float xxin yin float yyin ENDELSE get the matrix A a square2quadrilateral x0in y0in x1in y1in x2in y2in x3in y3in compute the adjoint matrix IF keyword_set double THEN adj dblarr 9 n_elements x0 ELSE adj fltarr 9 n_elements x0 adj 0 a 4 a 7 a 5 adj 1 a 7 a 2 a 1 adj 2 a 1 a 5 a 4 a 2 adj 3 a 6 a 5 a 3 adj 4 a 0 a 6 a 2 adj 5 a 3 a 2 a 0 a 5 adj 6 a 3 a 7 a 6 a 4 adj 7 a 6 a 1 a 0 a 7 adj 8 a 0 a 4 a 3 a 1 IF n_elements xin EQ 1 THEN BEGIN xin replicate xin n_elements x0 yin replicate yin n_elements x0 ENDIF compute xprime yprime and wprime IF n_elements x0 EQ 1 THEN BEGIN wpr 1 adj 6 xin adj 7 yin adj 8 ENDIF ELSE BEGIN wpr 1 adj 6 xin adj 7 yin adj 8 ENDELSE xpr xin wpr ypr yin wpr IF keyword_set double THEN res dblarr 2 n_elements xin ELSE res fltarr 2 n_elements xin IF n_elements x0 EQ 1 THEN BEGIN res 0 xpr adj 0 ypr adj 1 wpr adj 2 res 1 xpr adj 3 ypr adj 4 wpr adj 5 ENDIF ELSE BEGIN res 0 xpr adj 0 ypr adj 1 wpr adj 2 res 1 xpr adj 3 ypr adj 4 wpr adj 5 ENDELSE IF keyword_set perf THEN print time quadrilateral2square systime 1 tempsone RETURN res END"); 51 a[49] = new Array("./Interpolation/spl_fstdrv.html", "spl_fstdrv.pro", "", " NAME:spl_fstdrv PURPOSE: SPL_FSTDRV returns the values of the first derivative of the interpolating function at the points X2i it is a double precision array Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that interpolated value are also in ascending order CATEGORY: CALLING SEQUENCE: y2 spl_fstdrv x y yscd x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in ascending order y: f x y An n element input vector that specifies the values of the tabulated function F Xi corresponding to Xi yscd: The output from SPL_INIT for the specified X and Y x2: The input values for which the first derivative values are desired X can be scalar or an array of values KEYWORD PARAMETERS: none OUTPUTS: y2: f x2 y2 COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May 2005 FUNCTION spl_fstdrv x y yscd x2 compute the first derivative of the spline function nx n_elements x ny n_elements y x must have at least 2 elements IF nx LT 2 THEN stop y must have the same number of elements than x IF nx NE ny THEN stop define loc in a way that if loc i eq 1 : x2 i x nx 1 else : x loc i extrapolation use x nx 2 and x nx 1 even if x2 i x nx 1 extrapolation loc 0 temporary loc nx 2 distance between to consecutive x deltax x loc 1 x loc distance between to consecutive y deltay y loc 1 y loc relative distance between x2 i and x loc i 1 a x loc 1 x2 deltax relative distance between x2 i and x loc i b 1 0d a compute the first derivative on x see numerical recipes Chap 3 3 yfrst temporary deltay deltax 1 0d 6 0d 3 0d a a 1 0d deltax yscd loc 1 0d 6 0d 3 0d b b 1 0d deltax yscd loc 1 beware of the computation precision force near zero values to be exactly 0 0 zero where abs yfrst LT 1 e 10 IF zero 0 NE 1 THEN yfrst zero 0 0d RETURN yfrst END "); 52 a[50] = new Array("./Interpolation/spl_incr.html", "spl_incr.pro", "", " NAME:spl_incr PURPOSE: Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that interpolated values are also monotonically increasing CATEGORY: CALLING SEQUENCE: y2 spl_incr x y x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in a strict ascending order y: f x y An n element input vector that specifies the values of the tabulated function F Xi corresponding to Xi As f is supposed to be monotonically increasing y values must be monotonically increasing y can have equal consecutive values x2: The input values for which the interpolated values are desired Its values must be strictly monotonically increasing KEYWORD PARAMETERS: YP0: The first derivative of the interpolating function at the point X0 If YP0 is omitted the second derivative at the boundary is set to zero resulting in a natural spline YPN_1: The first derivative of the interpolating function at the point Xn 1 If YPN_1 is omitted the second derivative at the boundary is set to zero resulting in a natural spline OUTPUTS: y2: f x2 y2 Double precision array COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: It might be possible that y2 i 1 y2 i has very small negative values amplitude smaller than 1 e 6 EXAMPLE: n 100L x dindgen n 2 y abs randomn 0 n y n 2:n 2 1 0 y n n 3 0 y n n 6:n n 6 5 0 y total y cumulative double x2 dindgen n 1 2 n2 n_elements x2 print min y 1:n 1 y 0:n 2 LT 0 y2 spl_incr x y x2 splot x y xstyle 1 ystyle 1 ysurx 25 petit 1 2 1 land oplot x2 y2 color 100 c y2 1:n2 1 y2 0:n2 2 print min c LT 0 print min c max ma ma splot c xstyle 1 ystyle 1 yrange 01 05 ysurx 25 petit 1 2 2 noerase oplot 0 n_elements c 0 0 linestyle 1 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May Dec 2005 FUNCTION pure_concave x1 x2 y1 y2 der2 x X n type xx double x double x1 double x2 double x1 f double x2 double x1 double y2 double y1 n der2 temporary f res xx n IF check_math GT 0 THEN BEGIN zero where abs res LT 1 e 10 IF zero 0 NE 1 THEN res zero 0 0d END res temporary res double y2 double y1 y1 IF array_equal sort res lindgen n_elements res NE 1 THEN stop RETURN res END FUNCTION pure_convex x1 x2 y1 y2 der2 x 1 1 X n type xx 1 0d double x double x1 double x2 double x1 f double x2 double x1 double y2 double y1 n der2 temporary f res xx n IF check_math GT 0 THEN BEGIN zero where abs res LT 1 e 10 IF zero 0 NE 1 THEN res zero 0 0d END res 1 0d temporary res res temporary res y2 y1 y1 IF array_equal sort res lindgen n_elements res NE 1 THEN stop RETURN res END FUNCTION spl_incr x y x2 YP0 yp0 YPN_1 ypn_1 check and initialisation nx n_elements x ny n_elements y nx2 n_elements x2 x must have at least 2 elements IF nx LT 2 THEN stop y must have the same number of elements than x IF nx NE ny THEN stop x be monotonically increasing IF min x 1:nx 1 x 0:nx 2 LE 0 THEN stop x2 be monotonically increasing IF N_ELEMENTS X2 GE 2 THEN IF min x2 1:nx2 1 x2 0:nx2 2 LE 0 THEN stop y be monotonically increasing IF min y 1:ny 1 y 0:ny 2 LT 0 THEN stop first check: check if two consecutive values are equal bad where y 1:ny 1 y 0:ny 2 EQ 0 cntbad IF cntbad NE 0 THEN BEGIN define the results: y2 y2 dblarr nx2 define xinx2: see help of value_locate if xinx2 i eq 1 : x bad i x2 nx2 1 else : x2 xinx2 i x2 nx2 1 else : x2 xinx2 i we have middle pieces for which we force yp0 0 0d and ypn_1 0 0d IF cntbad GT 1 THEN BEGIN we take care of the piece located wetween bad ib 1 and bad ib FOR ib 1 cntbad 1 DO BEGIN if there is x2 values smaller that x bad ib then the x2 values located between bad ib 1 and bad ib are xinx2 ib 1 1:xinx2 ib IF xinx2 ib NE 1 THEN begin y2 xinx2 ib 1 1 0 y i 1 y i 2 y reach its minimum value between x i and x i 1 0 y i 1 0 y i we do a first selection by looking for those points loc lindgen nx 1 maybebad where yscd loc LE 0 0d AND yscd loc 1 GE 0 0d cntbad IF cntbad NE 0 THEN BEGIN mbbloc loc maybebad aaa yscd mbbloc 1 yscd mbbloc 6 0d x mbbloc 1 x mbbloc bbb 0 5d yscd mbbloc ccc yifrst mbbloc ddd y mbbloc definitive selection: y can become negative if and only if 2b 2 4 3a c 0 y can become negative if and only if b 2 3a c 0 delta bbb bbb 3 0d aaa ccc bad where delta GT 0 cntbad IF cntbad NE 0 THEN BEGIN delta delta bad aaa aaa bad bbb bbb bad ccc ccc bad ddd ddd bad bad maybebad bad define xinx2_1: see help of value_locate if xinx2_1 i eq 1 : x bad i x2 nx2 1 else : x2 xinx2_1 i x2 nx2 1 else : x2 xinx2_2 i y bad ib 1 then we cannot applay the method we want to apply we use then convex concave case by changing by hand the value of yinfl and xinfl IF yzero GT y bad ib 1 THEN BEGIN yinfl 0 5d y bad ib 1 y bad ib xinfl 0 5d x bad ib 1 x bad ib GOTO convexconcave ENDIF define xinx2_3: see help of value_locate if xinx2_3 ib eq 1 : x bad ib xzero x2 nx2 1 else : x2 xinx2_3 we use then convex concave case by changing by hand the value of yinfl and xinfl IF yzero lt y bad ib THEN BEGIN yinfl 0 5d y bad ib 1 y bad ib xinfl 0 5d x bad ib 1 x bad ib GOTO convexconcave ENDIF define xinx2_3: see help of value_locate if xinx2_3 ib eq 1 : x bad ib xzero x2 nx2 1 else : x2 xinx2_3 x2 nx2 1 else : x2 xinx2_3 x bad ib xzero x2 xinx3_2 1 xinx2_3 value_locate x2 x bad ib xinfl IF xinx2_3 ge xinx2_1 ib 1 THEN BEGIN y2 xinx2_1 ib 1:xinx2_3 pure_convex x bad ib x bad ib xinfl y bad ib yinfl yifrst bad ib x2 xinx2_1 ib 1:xinx2_3 ENDIF IF xinx2_2 ib GE xinx2_3 1 THEN BEGIN y2 xinx2_3 1:xinx2_2 ib pure_concave x bad ib xinfl x bad ib 1 yinfl y bad ib 1 yifrst bad ib 1 x2 xinx2_3 1:xinx2_2 ib ENDIF END ENDCASE END ENDCASE ENDIF ENDFOR ENDIF ENDIF RETURN y2 END"); 53 a[51] = new Array("./Interpolation/spl_keep_mean.html", "spl_keep_mean.pro", "", " NAME:spl_keep_mean PURPOSE: Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that integral of the interpolated values is the same as the integral of the input values for exemple to build daily data from monthly mean and keep the monthly mean of the computed daily data equa to the original values CATEGORY: CALLING SEQUENCE: y2 spl_keep_mean x y x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in a strict ascending order y: an array with one element less than x y i represents the mean value between x i and x i 1 if GE0 is activated y must have positive values x2: The input values for which the interpolated values are desired Its values must be strictly monotonically increasing KEYWORD PARAMETERS: GE0: to force that y2 is always GE than 0 In that case y must also be GE than 0 YP0: The first derivative of the interpolating function at the point X0 If YP0 is omitted the second derivative at the boundary is set to zero resulting in a natural spline YPN_1: The first derivative of the interpolating function at the point Xn 1 If YPN_1 is omitted the second derivative at the boundary is set to zero resulting in a natural spline OUTPUTS: y2: the meean value between two consecutive values of x2 This array has one element less than y2 y2 has double precision COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: It might be possible that y2 has very small negative values amplitude smaller than 1 e 6 EXAMPLE: 12 monthly values of precipitations into daily values: yr1 1990 yr2 1992 nyr yr2 yr1 1 n1 12 nyr 1 x julday 1 findgen n1 replicate 1 n1 replicate yr1 n1 fltarr n1 n2 365 nyr total leapyr yr1 indgen nyr 1 x2 julday replicate 1 n2 1 findgen n2 replicate yr1 n2 fltarr n2 y abs randomn 0 n1 1 y2 spl_keep_mean x y x2 ge0 print min x max ma ma print min x2 max ma ma print vairdate min x max ma ma print total y x 1:n1 1 x 0:n1 2 print total y2 x2 1:n2 1 x2 0:n2 2 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May 2005 FUNCTION spl_keep_mean x yin x2 YP0 yp0 YPN_1 ypn_1 GE0 ge0 check and initialisation nx n_elements x ny n_elements yin nx2 n_elements x2 x must have at least 2 elements IF nx LT 2 THEN stop x2 must have at least 2 elements IF nx2 LT 2 THEN stop x be monotonically increasing IF min x 1:nx 1 x 0:nx 2 LE 0 THEN stop x2 be monotonically increasing IF min x2 1:nx2 1 x2 0:nx2 2 LE 0 THEN stop compute the integral of y if spl_keep_mean is called by the user and not by itself we must compute the integral of y yin must have one element less than x IF nx NE ny 1 THEN stop y double yin double x 1:nx 1 x 0:nx 2 y 0 0d temporary y y total temporary y cumulative double compute the spline interpolation IF keyword_set ge0 THEN BEGIN if the want that the interpolated values are always 0 we must have yin 0 0d IF min yin LT 0 THEN stop call spl_incr y2 spl_incr x temporary y x2 yp0 yp0 ypn_1 ypn_1 ENDIF ELSE BEGIN yscd spl_init x y yp0 yp0 ypn_1 ypn_1 double y2 spl_interp x y temporary yscd x2 double ENDELSE Compute the derivative of y yfrst y2 1:nx2 1 y2 0:nx2 2 x2 1:nx2 1 x2 0:nx2 2 it can happen that we have very small negative values 1 e 6 for ex yfrst 0 0d temporary yfrst RETURN yfrst END"); 54 a[52] = new Array("./Interpolation/square2quadrilateral.html", "square2quadrilateral.pro", "", " NAME:square2quadrilateral PURPOSE:warm or map a unit square onto an arbitrary quadrilateral according to the 4 point correspondences: 0 0 x0 y0 1 0 x1 y1 1 1 x2 y2 0 1 x3 y3 The mapping is done using perspective transformation which preserve lines in all orientations and permit quadrilateral to quadrilateral mappings see ref bellow CATEGORY:image grid manipulation CALLING SEQUENCE: res square2quadrilateral x0 y0 x1 y1 x2 y2 x3 y3 xin yin INPUTS: x0 y0 x1 y1 x2 y2 x3 y3 the coordinates of the quadrilateral see above for correspondance with the unit square Can be scalar or array x0 y0 x1 y1 x2 y2 and x3 y3 are given in the anticlockwise order xin yin:the coordinates of the point s for which we want to do the mapping Can be scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation OUTPUTS: 2 n array: the new coodinates xout yout of the xin yin point s after mapping If xin is a scalar then n is equal to the number of elements of x0 If xin is an array then n is equal to the number of elements of xin If xin and yin are omited square2quadrilateral returns the matrix A which is used for the inverse transformation COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: IDL splot 0 5 0 3 nodata xstyle 1 ystyle 1 IDL tracegrille findgen 11 1 findgen 11 1 color indgen 12 20 IDL xin findgen 11 1 replicate 1 11 IDL yin replicate 1 11 findgen 11 1 IDL out square2quadrilateral 2 1 3 0 5 1 2 3 xin yin IDL tracegrille reform out 0 11 11 reform out 1 11 11 color indgen 12 20 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Digital Image Warping by G Wolberg IEEE Computer Society Press Los Alamitos California Chapter 3 see p 52 56 FUNCTION square2quadrilateral x0in y0in x1in y1in x2in y2in x3in y3in xxin yyin Warning wrong definition of x2 y2 and x3 y3 at the bottom of page 54 of Wolberg s book see figure 3 7 page 56 for the good definition IF keyword_set double THEN BEGIN x0 double x0in x1 double x1in x2 double x2in x3 double x3in y0 double y0in y1 double y1in y2 double y2in y3 double y3in IF arg_present xxin THEN BEGIN xin double xxin yin double yyin ENDIF ENDIF ELSE BEGIN x0 float x0in x1 float x1in x2 float x2in x3 float x3in y0 float y0in y1 float y1in y2 float y2in y3 float y3in IF arg_present xxin THEN BEGIN xin float xxin yin float yyin ENDIF ENDELSE IF keyword_set double THEN a dlbarr 8 n_elements x0 ELSE a fltarr 8 n_elements x0 delx3 x0 x1 x2 x3 dely3 y0 y1 y2 y3 affinemap where delx3 EQ 0 AND dely3 EQ 0 IF affinemap 0 NE 1 THEN BEGIN xx0 x0 affinemap xx1 x1 affinemap xx2 x2 affinemap yy0 y0 affinemap yy1 y1 affinemap yy2 y2 affinemap a 0 affinemap xx1 xx0 a 1 affinemap xx2 xx1 a 2 affinemap xx0 a 3 affinemap yy1 yy0 a 4 affinemap yy2 yy1 a 5 affinemap yy0 a 6 affinemap 0 a 7 affinemap 0 ENDIF projectivemap where delx3 NE 0 OR dely3 NE 0 IF projectivemap 0 NE 1 THEN BEGIN xx0 x0 projectivemap xx1 x1 projectivemap xx2 x2 projectivemap xx3 x3 projectivemap yy0 y0 projectivemap yy1 y1 projectivemap yy2 y2 projectivemap yy3 y3 projectivemap delx1 xx1 xx2 dely1 yy1 yy2 delx2 xx3 xx2 dely2 yy3 yy2 delx3 delx3 projectivemap dely3 dely3 projectivemap div delx1 dely2 dely1 delx2 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF a13 delx3 dely2 dely3 delx2 div a23 delx1 dely3 dely1 delx3 div a 0 projectivemap xx1 xx0 a13 xx1 a 1 projectivemap xx3 xx0 a23 xx3 a 2 projectivemap xx0 a 3 projectivemap yy1 yy0 a13 yy1 a 4 projectivemap yy3 yy0 a23 yy3 a 5 projectivemap yy0 a 6 projectivemap a13 a 7 projectivemap a23 ENDIF IF NOT arg_present xxin THEN return a IF n_elements xin EQ 1 THEN BEGIN xin replicate xin n_elements x0 yin replicate yin n_elements x0 ENDIF IF keyword_set double THEN res dblarr 2 n_elements xin ELSE res fltarr 2 n_elements xin IF n_elements x0 EQ 1 THEN BEGIN div a 6 xin a 7 yin 1 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF res 0 a 0 xin a 1 yin a 2 div res 1 a 3 xin a 4 yin a 5 div ENDIF ELSE BEGIN div a 6 xin a 7 yin 1 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF res 0 a 0 xin a 1 yin a 2 div res 1 a 3 xin a 4 yin a 5 div ENDELSE RETURN res END"); 55 a[53] = new Array("./Interpolation/testinterp.html", "testinterp.pro", "", "PRO testinterp method bilinear method imoms3 jpia 300L jpja 200L torg findgen jpia jpja xorg 20 d 360 d jpia dindgen jpia yorg 89 d 178 d jpja 1 dindgen jpja jpio 400L jpjo 150L xnew 0 d 360 d jpio dindgen jpio ynew 89 5d 179 d jpjo 1 dindgen jpjo outnorth where ynew GT yorg jpja 2 noutn outsouth where ynew LT yorg 1 nouts t2 fromreg method torg xorg yorg xnew ynew t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok1 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok2 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok3 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift t3 fromreg method torg2 xorg2 yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok4 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok5 t3 fromreg method torg xorg yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok6 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok7 i t3 fromreg method torg xorg yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok8 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok9 i t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok10 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok11 i t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok12 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok13 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok14 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok15 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok16 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok17 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok18 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok19 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok20 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok21 i return end"); 56 a[54] = new Array("./Obsolete/common.html", "common.pro", "", ""); 57 a[55] = new Array("./Obsolete/cp.html", "cp.pro", "", " NAME: cp PURPOSE: copy files obsolete file_copy should be used instead MODIFICATION HISTORY: June 2005: Sebastien Masson obsolete routine PRO cp filenamein filenameout _extra ex file_copy filenamein filenameout _extra ex RETURN END"); 58 a[56] = new Array("./Obsolete/ficdate.html", "ficdate.pro", "", " NAME: ficdate PURPOSE: sets s_fichier to name of the vairmer file associated to the given date in vairmer format yymmdd CATEGORY: CALLING SEQUENCE: fic ficdate 930124 INPUTS:vdate:date vairmer ex:930124 dim: so ou vo par defaut so est choisi nomexp:nomde l experience en trois lettres par defaut prefix KEYWORD PARAMETERS: OUTPUTS:le nom du fichier vairmer depuis iodir COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 1 7 98 function ficdate vdate dim nomexp common case n_params of 1: dim SO 2: dim strupcase dim 3: begin prefix nomexp dim strupcase dim end endcase constitution de l adresse ou aller chercher le fichier date yymmdd vdate sets month year and day to the good value : rien juldate vdate constitution de la date yymmdd case 1 of year lt 10: s_year 0 string format i1 year year ge 10 and year lt 100:s_year string format i2 year year ge 100:BEGIN year year 1900 if year LT 10 then s_year 0 string format i1 year ELSE s_year string format i2 year end endcase if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day case dim of SO : begin case 1 of year eq 0 and month eq 0 : s_fichier iodir prefix O EX SO year eq 0 and month ne 0 and day eq 0 : s_fichier iodir prefix O SE SO s_month year ne 0 and month eq 0 : s_fichier iodir prefix O AN SO s_year year ne 0 and day eq 0 : s_fichier iodir prefix O MO SO s_year s_month else: s_fichier iodir prefix O SO s_year s_month s_day endcase end VO : begin case 1 of year eq 0 and month eq 0 : s_fichier iodir prefix O EX VO year eq 0 and month ne 0 and day eq 0 : s_fichier iodir prefix O SE VO s_month year ne 0 and month eq 0 : s_fichier iodir prefix O AN VO s_year year ne 0 and day eq 0 : s_fichier iodir prefix O MO VO s_year s_month else: s_fichier iodir prefix O VO s_year s_month s_day endcase end else: return report le fichier doit etre VO ou SO endcase print print adresse du fichier: fichier return s_fichier end "); 59 a[57] = new Array("./Obsolete/fictype.html", "fictype.pro", "", " NAME: fictype PURPOSE: gives fictype DA MO AN SE EX corresponding to the given date in vairmer format yymmdd CATEGORY: CALLING SEQUENCE: fictype fictype 930124 INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 function fictype vdate dim common constitution de l adresse ou aller chercher le fichier date yymmdd vdate jul juldate vdate case 1 of year eq 0 and month eq 0 : return EX year eq 0 and month ne 0 and day eq 0 : return SE year ne 0 and month eq 0 : return AN year ne 0 and day eq 0 : return MO else : return DA endcase fini: return 1 end "); 60 a[58] = new Array("./Obsolete/imprime.html", "imprime.pro", "", " NAME: imprime PURPOSE: obsolete use printps instead MODIFICATION HISTORY: June 2005: Sebastien Masson english version PRO imprime filename TRANS trans NB nb this is working only with unix linux osX machines thisOS strupcase strmid version os_family 0 3 CASE thisOS OF MAC :return WIN :return ELSE: ENDCASE call printps CASE N_PARAMS OF 0:printps 1:printps filename ELSE: BEGIN ras report imprime accept only one element: psfilename return END ENDCASE return END "); 61 a[59] = new Array("./Obsolete/jourdsmois.html", "jourdsmois.pro", "", " NAME:jourdsmois PURPOSE: obsolete used daysinmonth instead MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2005: Sebastien Masson english version function jourdsmois mois annee case n_params OF 0:return daysinmonth 1:return daysinmonth mois 2:return daysinmonth mois annee endcase end"); 62 a[60] = new Array("./Obsolete/juldate.html", "juldate.pro", "", " NAME: juldate OBSOLETE: you better use date2jul PURPOSE: gives julian date equivalent of a date in vairmer yymmdd or yyyymmdd format sets month day and year to the corresp values CATEGORY: bidouilles dates CALLING SEQUENCE: date juldate 930124 INPUTS:date de la forme yymmdd ou yyyymmdd KEYWORD PARAMETERS: VRAIDATE: pour ne pas transformer l annnee 01 en 1901 GRADS: if 1 le year le 49 then year 2000 year if 50 le year le 99 then year 1900 year OUTPUTS:date en jour julien COMONTHON BLOCKS: common pro vraidate SIDE EFFECTS: l annee 0 n existant pas qd year est nulle on calcule le jour julien de l annee 1 COMPATIBLE AVEC L AN 2000 : une date de la forme yymmdd est donvertit sous la forme yyyymmdd a l aide de vraidate Attention les variables globales year month day sont attribuees MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 function juldate vvdate _EXTRA ex vdate vvdate vdate vraidate vdate _EXTRA ex common year vdate 10000 month vdate 100 year 100 day abs vdate year 10000 month 100 month abs month mm month dd day yy year ndate n_elements vdate if total mm EQ 0 EQ ndate then mm 6 if total dd EQ 0 EQ ndate then dd 15 if total yy EQ 0 EQ ndate THEN yy 1 return julday mm dd yy _EXTRA ex return 1 end "); 63 a[61] = new Array("./Obsolete/lec.html", "lec.pro", "", " NAME:lec PURPOSE: lit les fichiers Vairmer en sort: un tableau 2d ou 3d en fonction de nomchamp qui est le nom du champ a extaire 2d s il commence par SO et 3d s il commence par VO cette fonction modifie aussi les variables globales: varname: trois lettres: nom de l experience vargrid: nom de la grille vardate: date yy yymmdd varexp: nom Vairmer du champ a tarcer CATEGORY: Graphics lecture de fichier Vaimer CALLING SEQUENCE: resultat lec nom_Vairmer date nom_experience INPUTS: nom_Vairmer: 2 choix possibles: 1 nom de champ Vairmer chaine de 8 caracteres en majuscule ou minuscule commencant par vo ou so Dans cette methode on saute directement d en tete en en tete jusqu a trouver le bon fichier 2 chaine de characteres commencant par vo ou so suivit du numero de champ a aller chercher par ex vo5 Cette methode est un peu plus rapide car elle va directement chercher le fichier qui nous interesse arguments optionnels: date:nombres de 6 ou 8 chiffres anneemoisjour par ex:19980507 nom_experience:trois lettres designant le nom de l experience KEYWORD PARAMETERS: ANOM:type du fichier vairmer par rapport auquel on doit calculer l anomalie EX AN SE MO ECRIT:permet d imprimer tous les noms vairmer que contient le fichier ds ce cas en input on met seulement vo ou so la fonction retourne le nombre de fichiers lus EXPANOM: si on calcule l anom par rapport a une exper differente FILENAME: string pour passer directement le nom du champ sans utiliser les inputs: nom_Vairmer date nom_experience Rq si ces inputs sont qd meme donnes ils ne sont pas modifies par filename GRID:lorsque ce mot clef est active lec retourne la liste des types de grilles T U auxquelles se rapportent les variables ds ce cas en input on met seulement vo ou so NAME:lorsque ce mot clef est active lec retourne la liste des noms des variables ds ce cas en input on met seulement vo ou so TOUT: oblige lec a lire le champ sur tout le domaine qui a etait selectionne pour la cession en cours jpi jpj jpk OUTPUTS: un tableau 2 ou 3d sans le mot cle TOUT sa taille est celle du sous domaine definit par domdef nx ny nz avec TOUT le champ a la taille du domaine qui a etait selectionne pour la cession en cours jpi jpj jpk pour les sous domaines cf: http: www ipsl jussieu fr smlod sousdomaine html COMMON BLOCKS: common pro isnumber pro fivardate pro SIDE EFFECTS:Retourne 1 en cas d erreur RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 26 5 98 Jerome Vialard : adaptation au format vairmer keyword anom et expanom 1 7 98 Sebastien Masson masque des terres 14 8 98 Sebastien Masson decoupe pour les sous domaines 2 99 function lec nomchamp date nomexp ECRIT ecrit ANOM anom BOITE boite EXPANOM expanom TOUT tout GRID grid NAME name filename FILENAME common tempsun systime 1 pour key_performance z 1 if keyword_set filename then BEGIN CASE strupcase strmid version os_family 0 3 of MAC :sep : WIN :sep ELSE:sep ENDCASE fname strmid filename rstrpos filename sep 1 if n_elements nomchamp EQ 0 then nomchamp strmid fname 6 2 if n_elements date EQ 0 then date long strmid fname 8 if n_elements nomexp EQ 0 then nomexp strmid fname 0 3 endif nomchamp strupcase nomchamp dim string format a2 nomchamp print nom de l experience: nomchamp specification de la date et de l experience case n_params OF 0:BEGIN if keyword_set filename then begin rien juldate date prefix nomexp ENDIF ELSE return report Donnez un argument en entree ou utilisez le mot clef FILENAME END 1:date long day long month 100 long year 10000 2:rien juldate date 3:begin rien juldate date prefix nomexp end endcase verification de la dim du fichier if dim ne SO and dim ne VO then return report le nom du champ doit commencer par VO ou SO constitution de l adresse ou aller chercher le fichier s_fichier ficdate date dim ouverture du fichier a l adresse s_fichier openr numlec s_fichier get_lun ERROR err swap_if_little_endian if err ne 0 then begin print err_string return 1 endif taille en octet du fichier infofichier fstat numlec definition de la taille du fichier a aller chercher: jpidta jpjdta jpkdta if n_elements jpidta EQ 0 THEN BEGIN if n_elements ixmindta EQ 0 OR n_elements ixmaxdta EQ 0 then jpidta jpiglo else jpidta ixmaxdta ixmindta 1 endif if n_elements jpjdta EQ 0 THEN BEGIN if n_elements iymindta EQ 0 OR n_elements iymaxdta EQ 0 then jpjdta jpjglo else jpjdta iymaxdta iymindta 1 endif if n_elements jpkdta EQ 0 THEN BEGIN if n_elements izmindta EQ 0 OR n_elements izmaxdta EQ 0 then jpkdta jpkglo else jpkdta izmaxdta izmindta 1 endif lecture des champs directement vers le champ ou l en tete que l on recherche il faut savoir que: le fortran ajoute au debut et a la fin de chaque write 4 octets de controle les reels du model sont codes sur 4 octets un charactere fait 1 octet 4 chaines de 8 characteres un tableau de reels 4 trucs de controle pour les 2 write : if dim eq VO then taillebloc 4 8 long jpidta jpjdta jpkdta 4 4 4 else taillebloc 4 8 long jpidta jpjdta 4 4 4 choix du type de lecture typelec strmid nomchamp 2 strlen nomchamp test isnumber typelec numerochamp if test eq 0 then begin 1 LECTURE DIRECTE D EN TETE en EN TETE numerochamp 1 lecture des noms de champ resname resgrid while numerochamp taillebloc le infofichier size do begin offset numerochamp 1 taillebloc 4 a assoc numlec bytarr 8 nozero offset varname string a 0 if keyword_set ecrit OR keyword_set name OR keyword_set grid then begin vargrid a 1 vargrid string vargrid 7 vardate strtrim long string a 2 2 varexp strtrim a 3 2 if keyword_set ecrit THEN print numerochamp varname vargrid vardate varexp resname resname varname resgrid resgrid vargrid endif if nomchamp eq varname then begin vargrid a 1 vargrid string vargrid 7 vardate strtrim long string a 2 2 varexp strtrim a 3 2 goto sortieboucle endif numerochamp numerochamp 1 ENDWHILE free_lun numlec close numlec case 1 of keyword_set ecrit :return numerochamp 1 keyword_set name :return resname 1:numerochamp 1 keyword_set grid : return strmid resgrid 1:numerochamp 1 0 strlen resgrid 0 2 ELSE:return report Ce nom Vairmer de champ n existe pas ds le fichier: infofichier name endcase endif else begin 2 LECTURE DIRECTEMENT DU CHAMP QUE L ON VEUT test pour savoir si numero de champ est accessible if taillebloc numerochamp gt infofichier size then return report Ce numero de champ n exite pas Le fichier infofichier name ne contient que infofichier size taillebloc champs lecture de l en tete numero numerochamp offset numerochamp 1 taillebloc 4 a assoc numlec bytarr 8 nozero offset varname string a 0 vargrid a 1 vargrid string vargrid 7 vardate string a 2 varexp string a 3 endelse sortieboucle: lecture du champ lui meme offset numerochamp 1 taillebloc 8 4 8 4 if dim eq VO then a assoc numlec fltarr jpidta jpjdta jpkdta nozero offset else a assoc numlec fltarr jpidta jpjdta nozero offset z a 0 on initialise les ixmindta iymindta au besoin if n_elements ixmindta EQ 0 OR n_elements ixmaxdta EQ 0 then BEGIN ixmindta 0 ixmaxdta jpidta 1 endif if n_elements iymindta EQ 0 OR n_elements iymaxdta EQ 0 then BEGIN iymindta 0 iymaxdta jpjdta 1 endif if n_elements izmin EQ 0 OR n_elements izmax EQ 0 then BEGIN izmindta 0 izmaxdta jpkdta 1 endif on reduit z selon les valeurs de ixmindta iymindta if dim EQ SO then z z ixminmesh ixmindta:ixmaxmesh ixmindta iyminmesh iymindta:iymaxmesh iymindta ELSE z z ixminmesh ixmindta:ixmaxmesh ixmindta iyminmesh iymindta:iymaxmesh iymindta izminmesh izmindta:izmaxmesh izmindta on shift z si key_shift est defininit if n_elements key_shift NE 0 THEN BEGIN if dim EQ SO then z shift z key_shift 0 ELSE z shift z key_shift 0 0 endif si TOUT n est pas active on coupe z pour q il soit a la taille du zoom: nx ny nz if NOT keyword_set tout then BEGIN changement de domaine if keyword_set boite then BEGIN Case 1 Of N_Elements Boite Eq 1:bte lon1 lon2 lat1 lat2 0 boite 0 N_Elements Boite Eq 2:bte lon1 lon2 lat1 lat2 boite 0 boite 1 N_Elements Boite Eq 4:bte Boite prof1 prof2 N_Elements Boite Eq 5:bte Boite 0:3 0 Boite 4 N_Elements Boite Eq 6:bte Boite Else: return report Mauvaise Definition de Boite endcase oldboite lon1 lon2 lat1 lat2 prof1 prof2 domdef bte GRILLE vargrid ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then mask reform mask nx ny nz over if dim EQ SO then z z premierx:dernierx premiery:derniery ELSE z z premierx:dernierx premiery:derniery premierz:dernierz ENDIF ELSE BEGIN case vargrid OF on recupere le mask en entier ds le cas ou TOUT U :mask umask n est pas active et on le choisit en fontion T :mask tmask de la valeur de vargrid W :mask tmask V :mask vmask F :mask fmask ENDCASE ENDELSE calcul d une anomalie si le keyword anom est active if keyword_set anom then begin case anom of EX : adate 0 AN : adate floor date 10000 10000 SE : adate floor date floor date 10000 10000 100 100 MO : adate floor date 100 100 DA : adate date floor date 10000 10000 : adate date floor date 10000 10000 else : return report Anom doit etre egal a EX AN SE MO DA endcase if keyword_set expanom then nomexpa expanom else nomexpa nomexp if keyword_set bavard THEN print nomchamp adate nomexpa z z lec nomchamp adate nomexpa TOUT tout endif on masque les terres par valmask IF n_elements valmask EQ 0 THEN valmask 1e20 if dim EQ SO then BEGIN terre where mask 0 EQ 0 if terre 0 NE 1 then z terre valmask ENDIF ELSE BEGIN terre where mask 0 EQ 0 if terre 0 NE 1 then z where mask EQ 0 valmask ENDELSE free_lun numlec close numlec if n_elements oldboite NE 0 then domdef oldboite IF keyword_set key_performance EQ 1 THEN print temps lec systime 1 tempsun return reform z end "); 64 a[62] = new Array("./Obsolete/lect.html", "lect.pro", "", " NAME:lect PURPOSE: lit les fichiers Vairmer de date1 a date2 et en sort un tableau 1D 2D ou 3D qui peut etre reutilise pour une courbe hov animation cette fonction modifie aussi les variables globales: varname: huit lettres: nom Vairmer du champ a tracer vargrid:1 lettre : nom de la grille varexp: trois lettres :nom de l experience CATEGORY: Graphics lecture de fichier Vaimer CALLING SEQUENCE: resultat lec nom_Vairmer date1 date2 nomexp direc BOITE boite INPUTS: nom_Vairmer: nom de champ Vairmer chaine de 8 caracteres commencant par VO ou SO date de depart date1 et de fin date2 de la serie temporelle a extraire nomexp nom de l experience a lire prefix pardefaut direc : x y z xy xz yz xyz xt yt zt xyt xzt yzt xyzt directions selon lesquelles effectuer les moyennes si rien n est donne on n effectue pas de moyenne KEYWORD PARAMETERS: boite : boite sur laquelle integrer par defaut tt le domaine anom : type de fichiers SE AN a relire pour calc une anomalie expanom: experience pour laquelle on veut calculer une anomalie par defaut la meme que nomexp repeat : nombre de fois que l on veut dupliquer la serie bout a bout COMMON BLOCKS: common vraidate juldate SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 1 2 3 4 5 function lect nomchamp date1 date2 nomexp direc BOITE boite ANOM anom EXPANOM expanom REPEAT repeat common tempsun systime 1 pour key_performance nomchamp strupcase nomchamp date1 vraidate date1 date2 vraidate date2 dim string format a2 nomchamp specification de la date et de l experience if fictype date1 ne fictype date2 then return report Les deux dates doivent correspondre au meme type de fic vairmer fictyp fictype date1 creation du nom du fichier if n_elements nomexp EQ 0 then nomexp prefix ficname iodir nomchamp strcompress date1 remove_all ficname ficname fictyp strcompress date2 remove_all nomexp if keyword_set anom then ficname ficname anom if keyword_set expanom then ficname ficname expanom case n_elements boite of 4 : box strcompress string format i4 _ i4 _ i4 _ i4 boite remove_all 6 : box strcompress string format i4 _ i4 _ i4 _ i4 _ i4 _ i4 boite remove_all else: box strcompress string format i4 _ i4 _ i4 _ i4 _ i4 _ i4 lon1 lon2 lat1 lat2 prof1 prof2 remove_all ENDCASE if n_elements direc EQ 0 then direc ficname ficname box direc hovdat Est ce que le fichier de hovmoller existe structure du fichier : jpt valeur de la dim temporelle dimtableau dimension du tableau dimttab 0 dimttab 1 valeur des dim time axe des tps ttab tableau a lire def du domaine lon1 lon2 prof1 prof2 get_lun numlec openr numlec ficname get_lun ERROR err swap_if_little_endian if err eq 0 then begin jpt long 1 dimtableau long 1 readu numlec jpt dimtableau case dimtableau of 1 : begin n1 long 1 readu numlec n1 ttab fltarr n1 end 2 : begin n1 long 1 n2 long 1 readu numlec n1 n2 ttab fltarr n1 n2 end 3 : begin n1 long 1 n2 long 1 n3 long 1 readu numlec n1 n2 n3 ttab fltarr n1 n2 n3 end endcase time lonarr jpt lecture axe des tps et du tableau readu numlec time ttab newboite fltarr 6 lecture du domaine readu numlec newboite domdef newboite lecture info complementaire : nom du champs de l experience varname aaaaaaaa readu numlec varname vargrid a readu numlec vargrid varexp aaa readu numlec varexp close numlec free_lun numlec return ttab ENDIF close numlec free_lun numlec changement de domaine if keyword_set boite then BEGIN Case 1 Of N_Elements Boite Eq 1:bte lon1 lon2 lat1 lat2 0 boite 0 N_Elements Boite Eq 2:bte lon1 lon2 lat1 lat2 boite 0 boite 1 N_Elements Boite Eq 4:bte Boite prof1 prof2 N_Elements Boite Eq 5:bte Boite 0:3 0 Boite 4 N_Elements Boite Eq 6:bte Boite Else: return report Mauvaise Definition de Boite endcase oldboite lon1 lon2 lat1 lat2 prof1 prof2 domdef bte ENDIF Boucle de lecture des fichiers case fictyp of DA : dec 0 MO : dec 14 SE : dec 14 AN : dec 182 endcase initialisation des variables associees au tps time lonarr jptmax jpt 0 vdat date1 debut de la boucle while vdat le date2 do begin lecture du fichier a la date vdat vairmer tab lec nomchamp vdat nomexp ANOM anom EXPANOM expanom attribution du mask et des tableaux de longitude et latitude if jpt EQ 0 THEN grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz if n_elements tab eq 1 and tab 0 eq 1 then begin goto incrdate endif else begin jpt jpt 1 if jpt gt jptmax then return report lect : augmenter jptmax endelse Moyenne du champs tab IF n_params EQ 5 THEN if direc NE then BEGIN if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN BEGIN if string format a2 nomchamp EQ SO then tab reform tab nx ny over ELSE tab reform tab nx ny nz over ENDIF tab moyenne tab direc endif if jpt eq 1 then begin ttab tab endif else BEGIN ttab colle ttab tab size tab 0 1 endelse time jpt 1 juldate vdat dec Incrementation de la date incrdate : case fictyp of DA : caldat juldate vdat 1 month day year MO : begin caldat julday month 1 year jourdsmois month day year day 0 end SE : month month 1 AN : year year 1 endcase Fin de boucle de lecture des fichiers vdat long 10000 year long 100 month day ENDWHILE if ttab 0 EQ 1 then return report Aucun fichier n a ete lu Ecriture du fichier get_lun numlec openw numlec ficname get_lun swap_if_little_endian taille size ttab writeu numlec long jpt long taille 0 case taille 0 of 1 : writeu numlec long taille 1 2 : writeu numlec long taille 1 long taille 2 3 : writeu numlec long taille 1 long taille 2 long taille 3 endcase writeu numlec long time 0:jpt 1 ttab writeu numlec float lon1 lon2 lat1 lat2 prof1 prof2 ecriture info complementaire : nom du champs de l experience writeu numlec strmid varname 0 8 writeu numlec strmid vargrid 0 1 writeu numlec strmid varexp 0 3 close numlec free_lun numlec if keyword_set repeat then begin jpt jpt repeat if jpt gt jptmax then begin print lect : augmenter jptmax goto fini endif tabadd ttab ti endif if n_elements oldboite NE 0 then domdef oldboite close all IF keyword_set key_performance THEN print temps lect systime 1 tempsun return ttab end "); 65 a[63] = new Array("./Obsolete/meshlec.html", "meshlec.pro", "", " NAME:meshlec PURPOSE: lecture du mask de des sorties d OPA les sources se trouvent ds les repertoires sur maia du type: nom_exp RESTARTS CATEGORY: CALLING SEQUENCE:meshmask nomfich INPUTS: nomfich: string c est le nom du fichier a lire Par defaut c est meshmask KEYWORD PARAMETERS: GLAMBOUNDARY: un vecteur de 2 elements specifaint le min et le max qui doivent etre imposes en longitude obligatoire si le tableau depasse 360 degres pasblabla: pour suprimer les blablas DOUBLE: pour forcer a lire les tableaux en double precision ce Mot clef est maintenant active automatiquement OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: La definition de ixminmesh ixmaxmesh iyminmesh iymaxmesh izminmesh izmaxmesh doit etre faite avant l entree dans cette routine pour attribuer automatiquement ces valeurs au maximum possible les mettre toutes a 1 et meshlec les calculera EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr Marina Levy : lecture en double precision cas calcul sur shine pro meshlec nomfich PASBLABLA pasblabla DOUBLE double GLAMBOUNDARY glamboundary GETDIMENSIONS GETDIMENSIONS common tempsun systime 1 pour key_performance jpiglo 0L jpjglo 0L jpkglo 0L tab aaaaa definition du domaine de la grille surlequel sont effectuees les sorties les indices des tableaux commencant a 1: cf le fichier wrivr2 F ds WKOPA sur le cray LECTURE DU MASK trouve ds les fichiers restart constitution de l adresse s_fichier et ouverture du fichier a l adresse s_fichier IF n_params EQ 0 then nomfich meshmask s_fichier isafile file nomfich iodir iodir if not keyword_set pasblabla then print if not keyword_set pasblabla then print adresse du fichier: s_fichier openr numlec s_fichier get_lun f77_unformatted swap_if_little_endian filepamameters fstat numlec lecture readu numlec jpiglo jpjglo jpkglo if not keyword_set pasblabla then print taille de la grille d origine: jpiglo jpjglo jpkglo if keyword_set getdimensions then begin free_lun numlec close numlec return endif on determine si le fichier a ete ecrit en double precision on non sizenumber 8l sizefile8 4l 3l 4l 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo jpkglo sizenumber 4l 1l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpkglo sizenumber 4l if filepamameters size GE sizefile8 THEN double 1 sizenumber 4l sizefile4 4l 3l 4l 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo jpkglo sizenumber 4l 1l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpkglo sizenumber 4l print filepamameters size sizefile4 sizefile8 case filepamameters size of sizefile8:double 1 sizefile4:double 0 ELSE:BEGIN nothing report The OPA Mesh file as not the good size free_lun numlec close numlec return END endcase if n_elements ixminmesh EQ 0 THEN ixminmesh 0 if n_elements ixmaxmesh EQ 0 then ixmaxmesh jpiglo 1 if ixminmesh EQ 1 THEN ixminmesh 0 IF ixmaxmesh EQ 1 then ixmaxmesh jpiglo 1 if n_elements iyminmesh EQ 0 THEN iyminmesh 0 IF n_elements iymaxmesh EQ 0 then iymaxmesh jpjglo 1 if iyminmesh EQ 1 THEN iyminmesh 0 IF iymaxmesh EQ 1 then iymaxmesh jpjglo 1 if n_elements izminmesh EQ 0 THEN izminmesh 0 IF n_elements izmaxmesh EQ 0 then izmaxmesh jpkglo 1 if izminmesh EQ 1 THEN izminmesh 0 IF izmaxmesh EQ 1 then izmaxmesh jpkglo 1 jpi long ixmaxmesh ixminmesh 1 jpj long iymaxmesh iyminmesh 1 jpk long izmaxmesh izminmesh 1 doit on reellement lire la grille meshparameters jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift noticebase xnotice Lecture du fichier C s_fichier C IF NOT keyword_set double THEN BEGIN z3d fltarr jpiglo jpjglo jpkglo z2d fltarr jpiglo jpjglo z1d fltarr jpkglo ENDIF ELSE BEGIN z3d dblarr jpiglo jpjglo jpkglo z2d dblarr jpiglo jpjglo z1d dblarr jpkglo ENDELSE if not keyword_set pasblabla then print readu numlec tab z2d GLAMT float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMT 25 31 : GLAMT 25 31 readu numlec tab z2d GLAMU float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMU 25 31 : GLAMU 25 31 readu numlec tab z2d GLAMV float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMV 25 31 : GLAMV 25 31 readu numlec tab z2d GLAMF float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMF 25 31 : z2d 25 31 if not keyword_set pasblabla then print readu numlec tab z2d GPHIT float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIT 25 31 : GPHIT 25 31 readu numlec tab z2d GPHIU float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIU 25 31 : GPHIU 25 31 readu numlec tab z2d GPHIV float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIV 25 31 : GPHIV 25 31 readu numlec tab z2d GPHIF float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIF 25 31 : z2d 25 31 if not keyword_set pasblabla then print readu numlec tab z2d E1T float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1T 25 5 : z2d 25 5 readu numlec tab z2d E1U float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1U 25 5 : z2d 25 5 readu numlec tab z2d E1V float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1V 25 5 : z2d 25 5 readu numlec tab z2d E1F float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1F 25 5 : z2d 25 5 if not keyword_set pasblabla then print readu numlec tab z2d E2T float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2T 25 5 : z2d 25 5 readu numlec tab z2d E2U float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2U 25 5 : z2d 25 5 readu numlec tab z2d E2V float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2V 25 5 : z2d 25 5 readu numlec tab z2d E2F float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2F 25 5 : z2d 25 5 if not keyword_set pasblabla then print readu numlec tab z3d TMASK byte z3d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur TMASK 25 5 0 : TMASK 25 5 0 readu numlec tab z3d UMASKred byte z3d ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh umaskred reform umaskred if not keyword_set pasblabla then print tableau: tab exemple de valeur UMASK 25 5 0 : z3d 25 5 0 readu numlec tab z3d VMASKred byte z3d ixminmesh:ixmaxmesh iymaxmesh izminmesh:izmaxmesh vmaskred reform vmaskred if not keyword_set pasblabla then print tableau: tab exemple de valeur VMASK 25 5 0 : z3d 25 5 0 readu numlec tab z3d fmaskredy byte z3d ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh coast where fmaskredy NE 0 and fmaskredy NE 1 IF coast 0 NE 1 THEN fmaskredy coast 0b fmaskredx byte z3d ixminmesh:ixmaxmesh iymaxmesh izminmesh:izmaxmesh coast where fmaskredx NE 0 and fmaskredx NE 1 IF coast 0 NE 1 THEN fmaskredx coast 0b fmaskredx reform fmaskredx fmaskredy reform fmaskredy if not keyword_set pasblabla then print tableau: tab exemple de valeur FMASK 25 5 0 : z3d 25 5 0 if not keyword_set pasblabla then print readu numlec tab z2d FF z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur FF 25 5 : z2d 25 5 readu numlec tab z1d GDEPT float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GDEPT 1 : GDEPT 1 readu numlec tab z1d GDEPW float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GDEPW 1 : GDEPW 1 readu numlec tab z1d E3T float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E3T 3 : E3T 3 readu numlec tab z1d E3W float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E3W 3 : E3W 3 free_lun numlec close numlec bornes de glam qui ne doivent pas depasser 360 degres minglam min glamt max maxglam if maxglam minglam GE 360 AND NOT keyword_set glamboundary then nothing execute glamboundary xquestion What are the longitudes boundary 180 180 chkwidget if keyword_set glamboundary then begin if glamboundary 0 NE glamboundary 1 then begin glamt glamt MOD 360 smaller where glamt LT glamboundary 0 if smaller 0 NE 1 then glamt smaller glamt smaller 360 bigger where glamt GE glamboundary 1 if bigger 0 NE 1 then glamt bigger glamt bigger 360 glamu glamu MOD 360 smaller where glamu LT glamboundary 0 if smaller 0 NE 1 then glamu smaller glamu smaller 360 bigger where glamu GE glamboundary 1 if bigger 0 NE 1 then glamu bigger glamu bigger 360 glamv glamv MOD 360 smaller where glamv LT glamboundary 0 if smaller 0 NE 1 then glamv smaller glamv smaller 360 bigger where glamv GE glamboundary 1 if bigger 0 NE 1 then glamv bigger glamv bigger 360 glamf glamf MOD 360 smaller where glamf LT glamboundary 0 if smaller 0 NE 1 then glamf smaller glamf smaller 360 bigger where glamf GE glamboundary 1 if bigger 0 NE 1 then glamf bigger glamf bigger 360 endif endif shift en x if keyword_set key_shift AND jpi NE 1 then begin glamt shift glamt key_shift 0 gphit shift gphit key_shift 0 e1t shift e1t key_shift 0 e2t shift e2t key_shift 0 glamu shift glamu key_shift 0 gphiu shift gphiu key_shift 0 e1u shift e1u key_shift 0 e2u shift e2u key_shift 0 glamv shift glamv key_shift 0 gphiv shift gphiv key_shift 0 e1v shift e1v key_shift 0 e2v shift e2v key_shift 0 glamf shift glamf key_shift 0 gphif shift gphif key_shift 0 e1f shift e1f key_shift 0 e2f shift e2f key_shift 0 if jpk EQ 1 then begin tmask shift tmask key_shift 0 vmaskred shift vmaskred key_shift fmaskredx shift fmaskredx key_shift ENDIF ELSE BEGIN tmask shift tmask key_shift 0 0 vmaskred shift vmaskred key_shift 0 fmaskredx shift fmaskredx key_shift 0 ENDELSE endif key_yreverse 0 key_zreverse 0 key_partialstep 0 key_stride 1 1 1 key_gridtype c if not keyword_set pasblabla then print lecture nomfich finie widget_control noticebase bad_id toto destroy if keyword_set key_performance THEN print temps meshlec systime 1 tempsun return end "); 66 a[64] = new Array("./Obsolete/ncdf_meshlec.html", "ncdf_meshlec.pro", "", " NAME:ncdf_meshlec PURPOSE:obsolete use ncdf_meshread instead MODIFICATION HISTORY: Aug 2005 Sebastien Masson: switch to ncdf_meshread PRO ncdf_meshlec filename _EXTRA ex CASE n_params OF 0:ncdf_meshread _EXTRA ex 1:ncdf_meshread filename _EXTRA ex ENDCASE return END"); 67 a[65] = new Array("./Obsolete/nlec.html", "nlec.pro", "", " NAME:nlec PURPOSE:lit les fichiers Net Cdf de l experience TOTEM ECMWF qui sont sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY: CALLING SEQUENCE: INPUTS:nom:nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var arguments optionnels: date:nombres de 6 ou 8 chiffres anneemoisjour par ex:19980507 nom_experience:trois lettres designant le nom de l experience KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine DATE2:stipule la seconde date pour extraire une serie temporelle DIREC: x y z xy xz yz xyz directions selon lesquelles effectuer les moyennes si rien n est donne on n effectue pas de moyenne GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: COMMON BLOCKS: common pro vraidate juldate nlec5j nlecserie SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 8 98 REF 07 790101 grid T nc REF 07 790101 grid U nc REF 07 790101 grid V nc REF 07 790101 grid W nc function nlec name debut fin nomexperience BOITE boite DIREC direc GRILLE grille TOUT tout STRUCTURE structure SEUILMIN seuilmin SEUILMAX seuilmax NAN nan _EXTRA ex common tempsun systime 1 pour key_performance nom strlowcase name specification de la date et de l experience case n_params of 1:BEGIN year year 1900 year ne 0 and year ne 1 and year lt 100 date day 100 month 10000 year end 2:BEGIN if size debut tname EQ STRING then begin prefix strupcase debut year year 1900 year ne 0 and year ne 1 and year lt 100 date day 100 month 10000 year ENDIF ELSE BEGIN date debut rien juldate date ENDELSE end 3:begin date debut rien juldate date if size fin tname EQ STRING then begin prefix strupcase fin ENDIF ELSE BEGIN date2 vraidate fin year2 date2 10000 month2 date2 100 year2 100 day2 date2 year2 10000 month2 100 ENDELSE end 4:BEGIN date debut rien juldate date if size nomexperience tname EQ STRING then begin prefix strupcase nomexperience date2 fin ENDIF ELSE BEGIN prefix strupcase fin date2 nomexperience ENDELSE date2 vraidate date2 year2 date2 10000 month2 date2 100 year2 100 day2 date2 year2 10000 month2 100 end endcase date long date if n_elements date2 NE 0 then date2 long date2 if n_elements date2 NE 0 then if date2 eq date then tempvar SIZE TEMPORARY date2 verification de la coherence des dates if n_elements date2 ne 0 then begin if day EQ 0 AND day2 NE 0 OR month EQ 0 AND month2 NE 0 OR year EQ 0 AND year2 NE 0 or day2 EQ 0 AND day NE 0 OR month2 EQ 0 AND month NE 0 OR year2 EQ 0 AND year NE 0 then return report verifier la coherence des dates if date2 le date then return report date2 doit etre posterieure a date endif case sur le type de fichiers que l on veut lire determination ds chaque cas de numsortie et nbretps if day NE 0 then begin SORTIES A 5 JOURS numsortie testjour: numsortie 1 julday month day year julday 1 1 year 5 0 if numsortie ne floor numsortie then begin if n_elements date2 ne 0 then begin caldat julday month day 1 year month day year goto testjour endif return 1 ENDIF numsortie long numsortie determination du nombre de pas de tps a extraire pour la serie temporelle entiere: nbretps if n_elements date2 ne 0 then begin testjour2: numsortie2 1 julday month2 day2 year2 julday 1 1 year2 5 if numsortie2 ne floor numsortie2 then begin caldat julday month2 day2 1 year2 month2 day2 year2 goto testjour2 endif if year eq year2 then nbretps numsortie2 numsortie 1 else nbretps 73 numsortie 1 year2 year 1 73 numsortie2 numsortie2 long numsortie2 endif else nbretps 1 nbretps long nbretps si on fait une serie temporelle on cherche a lire plutot un fichier contenant deja une serie temporelle par contre pour une sortie unique on cherche d abord a lire un fichier contenant toutes les variables IF n_elements date2 ne 0 THEN BEGIN serie: IF n_elements dejaserie eq 1 then return 1 datejul 5 numsortie 1 julday 1 1 year if n_elements date2 ne 0 then date2jul 5 numsortie2 1 julday 1 1 year2 ELSE date2jul datejul res nlecserie nom datejul date2jul BOITE boite GRILLE grille TOUT tout _EXTRA ex IF res 0 EQ 1 THEN BEGIN dejaserie 1 GOTO passerie ENDIF ENDIF ELSE BEGIN passerie: IF n_elements dejapasserie eq 1 then return 1 res nlec5j nom numsortie nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex IF res 0 EQ 1 THEN BEGIN dejapasserie 1 GOTO serie ENDIF endelse ENDIF ELSE BEGIN CASE 1 of month NE 0 AND year NE 0:BEGIN SORTIES MENSUELLES numsortie79 year 1979 12 month if n_elements date2 ne 0 then nbretps month2 month 1 12 year2 year ELSE nbretps 1 res nlecmois nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month EQ 0 AND year NE 0:BEGIN SORTIES ANNUELLES numsortie79 year 1978 if n_elements date2 ne 0 then nbretps year2 year 1 ELSE nbretps 1 res nlecan nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month NE 0 AND year EQ 0:BEGIN SORTIES SAISONNIERES numsortie79 month if n_elements date2 ne 0 then nbretps month2 month 1 ELSE nbretps 1 res nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month EQ 0 AND year EQ 0:BEGIN SORTIES CLIMATOLOGIQUE numsortie79 13 nbretps 1 res nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end endcase endelse seuil if n_elements seuilmin NE 0 then BEGIN if n_elements valmask EQ 0 then valmask 1e20 terre where res GT valmask 10 res seuilmin res if terre 0 NE 1 then res terre valmask undefine terre endif if n_elements seuilmax NE 0 then begin if n_elements valmask EQ 0 then valmask 1e20 terre where res GT valmask 10 res res seuilmax if terre 0 NE 1 then res terre valmask undefine terre endif points a metre a nan if n_elements nan NE 0 then BEGIN if n_elements valmask EQ 0 then valmask 1e20 if abs valmask LT 1e6 then terre where abs res GT abs valmask 10 ELSE terre where res EQ valmask if abs nan LT 1e6 then notan where res EQ nan ELSE notan where abs res GT abs nan if notan 0 NE 1 then res notan values f_nan notan notan 0 NE 1 if terre 0 NE 1 then res terre valmask undefine terre endif ajustement de niveau pour les tableau 2d simples if jpt EQ 1 then begin taille size res IF taille 0 EQ 2 THEN niveau 1 endif moyenne eventuelle IF keyword_set direc THEN BEGIN IF jpt EQ 1 THEN res moyenne res direc BOITE boite nan notan ELSE res grossemoyenne res direc BOITE boite nan notan ENDIF mise en placer des parametres pour le trace if keyword_set boite then legende_pltt boite ELSE legende_pltt lon1 lon2 lat1 lat2 IF n_elements res NE 1 THEN res reform res over IF NOT keyword_set direc THEN domdef lon1 lon2 lat1 lat2 prof1 prof2 _extra ex grille vargrid ELSE if direc eq t then domdef lon1 lon2 lat1 lat2 prof1 prof2 _extra ex grille vargrid if keyword_set structure then res tab:res grille:vargrid unite:varunit experience:varexp nom:varname if keyword_set key_performance THEN print temps nlec systime 1 tempsun time time 2l return res end "); 68 a[66] = new Array("./Obsolete/nlec5j.html", "nlec5j.pro", "", " NAME:NLEC5J PURPOSE:lit les fichiers Net Cdf de l experience TOTEM ECMWF qui contiennent les sorties a 5j regroupees par type de grille par paquets de 6 mois sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY:lecture de NETCDF CALLING SEQUENCE: res nlec5j nom numsortie nbretps INPUTS: nom:nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var numsortie:le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de year nbretps:nombre de pas de temps a extraire KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: res tableau 2d qd on ne demande pas de serie ou 3d ou 4d ds le cas dune serie COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS:appele par nlec EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr function nlec5j nom numsortie nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom du fichier if numsortie le 36 then BEGIN mmdd 0101 numsort numsortie ENDIF else BEGIN if leapyr year then mmdd 0629 else mmdd 0630 numsort numsortie 36 endelse case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 year LT 2000 endcase numfich year anneedepart 2 7 mmdd ne 0101 s_date s_year mmdd if numfich lt 10 then numfich 0 string format i1 numfich else numfich string format i2 numfich gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix numfich s_date grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix numfich s_date grid IF quelsfichiers 0 EQ THEN BEGIN liste vide if keyword_set bavard then ras report LES FICHIERS: iodir prefix numfich s_date grid n existe pas return 1 ENDIF for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor if keyword_set bavard then ras report La variable nom n existe pas ds les fichiers iodir prefix numfich s_date grid return 1 endelse grilletrouvee: lecture de certains attributs ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day vardate s_year s_month s_day ncdf_attget cdfid file_name value global varexp string value 0: where value EQ byte 0 0 1 extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else: return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz ENDELSE determination du nombre de pas de tps a extraire ds ce fichier if nbretps gt 36 1 mmdd ne 0101 numsort 1 then nt 36 1 mmdd ne 0101 numsort 1 else nt nbretps if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsort 1 count nx ny nt else ncdf_varget cdfid nom res offset premierx premiery premierz numsort 1 count nx ny nz nt rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers pour constituer la serie temporelle if nbretps gt 36 1 mmdd ne 0101 numsort 1 then begin if mmdd ne 0101 then year year 1 if varcontient ndims eq 3 then res res nlec5j nom 1 36 mmdd eq 0101 nbretps nt tout tout GRILLE vargrid BOITE boite ELSE BEGIN res res nlec5j nom 1 36 mmdd eq 0101 nbretps nt tout tout GRILLE vargrid BOITE boite res reform res nx ny nz nbretps over ENDELSE ncdf_varget cdfid time_counter temps offset numsort 1 count nt time long temps julday 1 5 1979 time jpt nt jpt endif else BEGIN ncdf_varget cdfid time_counter temps offset numsort 1 count nt time long temps julday 1 5 1979 jpt nt endelse ncdf_close cdfid return res end"); 69 a[67] = new Array("./Obsolete/nlecan.html", "nlecan.pro", "", " NAME:NLECAN PURPOSE:lit les moyennes annuelles sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY:lecture de NETCDF CALLING SEQUENCE:res nlecan nom numsortie79 nbretps INPUTS: nom:nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var numsortie79:le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de 79 nbretps:nombre de pas de temps a extraire KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: res tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d COMMON BLOCKS: common pro SIDE EFFECTS:appele par nlec RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr REF moyenne annuelle grid T nc function nlecan nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix moyenne annuelle grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix moyenne annuelle grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix moyenne annuelle grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix moyenne annuelle grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix lecture de l axe des temps ncdf_varget cdfid time_counter time offset numsortie79 1 count nbretps time long time julday 12 31 1978 jpt nbretps IF jpt EQ 1 THEN BEGIN caldat time 0 month day year case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 endcase vardate annee: s_year endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk glam 1 gphi 1 gdep 1 premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie79 1 count nx ny nbretps else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie79 1 count nx ny nz nbretps ncdf_close cdfid return res end"); 70 a[68] = new Array("./Obsolete/nlecmois.html", "nlecmois.pro", "", " NAME:nlecmois pro PURPOSE:lit les fichiers Net Cdf de moyenne mensuel de l experience TOTEM ECMWF qui sont sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr REF moyenne mensuelle 79 81 grid T nc function nlecmois nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 annee du nom du 1er fichier annee floor floor numsortie79 1 12 3 3 79 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE determination du nombre de pas de tps a extraire ds ce fichier numsortie numsortie79 12 annee 79 if nbretps numsortie 1 gt 36 then nt 36 numsortie 1 else nt nbretps numsortie numsortie79 12 annee 79 if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie 1 count nx ny nt else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie 1 count nx ny nz nt rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers pour constituer la serie temporelle if nbretps gt 36 numsortie 1 then begin if varcontient ndims eq 3 then res res nlecmois nom numsortie79 nt nbretps nt tout tout GRILLE vargrid BOITE boite else BEGIN res res nlecmois nom numsortie79 nt nbretps nt tout tout GRILLE vargrid BOITE boite res reform res nx ny nz nbretps over ENDELSE ncdf_varget cdfid time_counter temps offset numsortie 1 count nt time long temps julday 12 31 1978 time jpt nt jpt endif else BEGIN ncdf_varget cdfid time_counter temps offset numsortie 1 count nt time long temps julday 12 31 1978 jpt nt endelse ncdf_close cdfid IF n_elements time EQ 1 THEN BEGIN caldat time m d y if m lt 10 then m 0 string format i1 m else m string format i2 m if n_elements langage EQ 0 then langage non definit if langage EQ gb then vardate strtrim y 1 string format C CMoA 31 m 1 ELSE vardate string format C CMoA 31 m 1 strtrim y 1 endif return res end"); 71 a[69] = new Array("./Obsolete/nlecsaison.html", "nlecsaison.pro", "", " NAME:NLECAN PURPOSE:lit les moyennes annuelles sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY:lecture de NETCDF CALLING SEQUENCE:res nlecsaison nom numsortie79 nbretps INPUTS: nom:nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var numsortie79:le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de 79 nbretps:nombre de pas de temps a extraire KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: res tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d COMMON BLOCKS: common pro SIDE EFFECTS:appele par nlec RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr REF saisonnier climato grid T nc function nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix saisonnier climato grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix saisonnier climato grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix saisonnier climato grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix saisonnier climato grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix lecture de l axe des temps ncdf_varget cdfid time_counter time offset numsortie79 1 count nbretps time long time julday 12 31 1978 jpt nbretps IF jpt EQ 1 THEN BEGIN IF numsortie79 EQ 13 THEN vardate CLIMATOLOGIE prefix ELSE begin vardate climato mensuelle strtrim numsortie79 1 endelse endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk glam 1 gphi 1 gdep 1 premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN CASE N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie79 1 count nx ny nbretps else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie79 1 count nx ny nz nbretps ncdf_close cdfid return res end"); 72 a[70] = new Array("./Obsolete/nlecserie.html", "nlecserie.pro", "", " NAME:NLECSERIE PURPOSE:lit les series temporelles se rapportant a une variable sur maia: u rech eee reee217 TOTEM REF OUTPUTS CATEGORY:lecture de NETCDF CALLING SEQUENCE:res nlecserie nom date1 date2 INPUTS: nom:nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var date1 et date2 les dates vermairs qui delimitent la serie temporelle KEYWORD PARAMETERS: BOITE: boite sur laquelle integrer par defaut tt le domaine GRILLE:impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture TOUT:oblige a lire le tableau entier en non pas celui reduit a domdef OUTPUTS: res tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d COMMON BLOCKS: common pro SIDE EFFECTS:appele par nlec RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr REF sss grid T nc function nlecserie nom date1 date2 BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille et ouverture du fichier liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix nom grid IF quelsfichiers 0 EQ THEN BEGIN liste vide print LES FICHIERS: iodir prefix nom grid n existe pas return 1 ENDIF ELSE BEGIN vargrid strmid quelsfichiers 0 strpos quelsfichiers 0 grid 5 1 nom de grille IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers 0 dev null cdfid ncdf_open quelsfichiers 0 ENDELSE lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit ncdf_attget cdfid file_name value global varexp string value varexp strmid varexp 0 strpos varexp lecture de l axe des temps en entier on ja reperer la place des dates debut et fin pour faire l extraction temporelle ncdf_varget cdfid time_counter time time long time julday 1 5 1979 debut where time EQ juldate date1 fin where time EQ juldate date2 debut where time EQ date1 fin where time EQ date2 if debut 0 EQ 1 then return report l axe des temps ne contient pas la date de debut strtrim date1 1 if fin 0 EQ 1 then return report l axe des temps ne contient pas la date de fin strtrim date2 1 time time debut 0 :fin 0 jpt fin 0 debut 0 1 IF jpt EQ 1 THEN BEGIN caldat time 0 month day year case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 endcase if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day vardate s_year s_month s_day endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery ENDELSE ncdf_varget cdfid nom res offset premierx premiery debut 0 count nx ny fin 0 debut 0 1 ncdf_close cdfid return res end"); 73 a[71] = new Array("./Obsolete/vairdate.html", "vairdate.pro", "", " NAME: vairdate OBSOLETE: you better use jul2date PURPOSE: gives vairmer date equivalent of a date in julian format sets month day and year to the corresp values CATEGORY: CALLING SEQUENCE: vdate vairdate 1755087 INPUTS:jdate date en jours juliens KEYWORD PARAMETERS: MENSUEL: a activer si on veut pour que les dates dont le jour est 15 deviennent avec un jour egale a 0 par ex: 19990115 19990100 ANNUEL: a activer si on veut pour que les dates dont le mois est 6 et dont le jour est 1 deviennent avec un mois et jour egale a 0 par ex: 19990601 19990000 OUTPUTS:vdate date vairmer plus year month et day COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 13 9 1999 Sebastien Masson smasson lodyc jussieu fr ANNUEL MENSUEL _EXTRA et possibilite d utiliser vairdate avec des scalaire ou des tableaux function vairdate jdate ANNUEL annuel MENSUEL mensuel _EXTRA ex common caldat jdate month day year _EXTRA ex index where year eq 1 if index 0 NE 1 then year index 0 if keyword_set mensuel THEN BEGIN index where day EQ 15 if index 0 NE 1 then day index 0 endif if keyword_set annuel THEN BEGIN index where day EQ 1 AND month EQ 6 if index 0 NE 1 then BEGIN day index 0 month index 0 endif endif return 10000L year 100L month day end "); 74 a[72] = new Array("./Obsolete/vraidate.html", "vraidate.pro", "", " NAME:vraidate PURPOSE:donne la date en long CATEGORY: CALLING SEQUENCE:res vraidate date INPUTS:date:une date du type yyyymmdd KEYWORD PARAMETERS: GRADS: if 1 le year le 49 then year 2000 year if 50 le year le 99 then year 1900 year OUTPUTS:une date vairmer du type yyyymmdd SIDE EFFECTS:si year est nulle ou egale a 1 ne change rien EXAMPLE:vraidate 980703 donne 19980703 qui est un long MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 3 7 98 remove automatic change from year 1 to 1901 Aug 2004 function vraidate date GRADS grads _EXTRA ex IF NOT keyword_set GRADS THEN return long date date long date annee date 10000 return date 19000000L annee GE 50 and date lt 1000000 20000000L annee LT 50 and date lt 1000000 end"); 75 a[73] = new Array("./Postscript/closeps.html", "closeps.pro", "", " NAME: closeps PURPOSE: Close the Postscript mode CALLING SEQUENCE: closeps KEYWORD PARAMETERS: INFOWIDGET: A long integer giving the id of the information widget created by openps that we have de destroy at the end of closeps when the postscript is done COMMON BLOCKS: cm_4ps SIDE EFFECTS: when archive_ps ne 0 we add the name and the date at the bottom left corner of the postcript page If the postscript is called idl ps we change its name to number ps number automatically found to be 1 larger that any of the existing ps file MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 June 2005: Sebastien Masson english version with new commons PRO closeps INFOWIDGET infowidget IF lmgr demo EQ 1 THEN return include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF d name NE PS THEN GOTO last_part if archive_ps 0 we will add its name and the date at the bottom left corner of the page in case if the postscript will be archived in printps IF keyword_set archive_ps THEN BEGIN we get the name of the latest created postscript psdir isadirectory psdir title Select psdir nameps file_search psdir ps test_regular test_write nosort dates file_info nameps mtime lastdate reverse sort temporary dates 0 nameps nameps lastdate nameps file_basename nameps ps If this name is idl ps then we change it to the number ps IF nameps EQ idl then BEGIN get the name of all the ps or ps gz files available in psdir allps file_search psdir ps ps gz pdf test_regular nosort allps file_basename file_basename allps gz ps allps file_basename allps pdf find which of these names corresponds to numbers get ascii codes of the names testnumb byte allps longest name maxstrlen size testnumb dimensions 0 ascii codes can be 0 or between byte 0 and byte 9 testnumb testnumb EQ 0 OR testnumb GE byte 0 0 AND testnumb LE byte 9 0 testnumb where total testnumb 1 EQ maxstrlen count IF count NE 0 THEN BEGIN get the largest number psnumber fix allps testnumb psnumber psnumber reverse sort psnumber 0 1 ENDIF ELSE psnumber 0 nameps strtrim psnumber 2 ENDIF we annote the postscript date byte systime 0 we get the date xyouts d x_px_cm d y_px_cm nameps string date 4:10 string date 20:23 device charsize 75 ENDIF close the postcript mode device close last_part: thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE def_myuniquetmpdir colorfile myuniquetmpdir original_colors dat IF file_test colorfile regular THEN BEGIN restore colorfile file_delete colorfile quiet reload the original colors tvlct red green blue ENDIF p font 1 force background color to the last color white p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x if keyword_set infowidget then widget_control long infowidget bad_id toto destroy return end"); 76 a[74] = new Array("./Postscript/openps.html", "openps.pro", "", " NAME:openps PURPOSE:switch to postcript mode and define it CALLING SEQUENCE:openps nameps OPTIONAL INPUT: nameps: name of the postscript file Extension ps is added if missing It will be stored in the psdir directory KEYWORD PARAMETERS: FILENAME: to define the name of the postcript file through a keyword rather than with nameps inut argument in this case the keyword can be pass through different routines via _extra keyword INFOWIDGET: If INFOWIDGET is present it specifies a named variable into which the id of the widget giving informations about the postscript creation is stored as a long integer This id is needed by close ps to kill the information widget KEEP_PFONT: activate to suppress the modification of p font by defaut we force p font 0 to make smaller postscripts KEEPPFONT: same as keep_pfont LIGHTNESS: a scalar used to change the Lightness of the color palette to be abble to adjust according to the printer we use the media paper or slide lightness 1 to get darker colors _EXTRA: used to pass any keyword to device procedure COMMON BLOCKS: cm_4ps MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 1 2 98: ajout de nameps en input 1 9 1999: ajout du mot cle FILENAME et du widget June 2005: Sebastien Masson cleaning english version with new commons pro openps namepsin FILENAME filename INFOWIDGET infowidget KEEPPFONT keeppfont KEEP_PFONT keep_pfont PORTRAIT portrait LANDSCAPE landscape LIGHTNESS Lightness _extra ex IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to create a PS in demo mode return ENDIF include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF close the postcript device if we are already in postcsrit mode IF d name EQ PS THEN device close switch to postscript mode set_plot ps if we use keyword Lightness save the actual color palette in a temporary file to be restored when calling closeps IF n_elements Lightness NE 0 THEN BEGIN IF Lightness NE 1 THEN BEGIN tvlct red green blue get def_myuniquetmpdir save red green blue filename myuniquetmpdir original_colors dat palit Lightness red green blue ENDIF ENDIF we define the name of the file CASE 1 OF n_params EQ 1:nameps namepsin keyword_set filename : nameps filename ELSE:nameps xquestion Name of the postscript file idl ps chkwid ENDCASE make sure that nameps ends with ps nameps file_dirname nameps mark_directory file_basename nameps ps ps add path psdir and check that nameps is ok nameps isafile nameps iodir psdir new we define xsize ysize xoffset et yoffset IF n_elements portrait NE 0 OR n_elements landscape NE 0 THEN key_portrait keyword_set portrait 1 keyword_set landscape if key_portrait EQ 1 then begin xs min page_size ys max page_size xoff 0 yoff 0 ENDIF ELSE BEGIN xs max page_size ys min page_size xoff 0 yoff max page_size ENDELSE We define the device of the postscript mode device color palatino filename strcompress nameps remove_all LANDSCAPE 1 key_portrait PORTRAIT key_portrait xsize xs ysize ys xoffset xoff yoffset yoff bits_per_pixel 8 _extra ex to make smaller postcripts IF NOT keyword_set keeppfont OR keyword_set keep_pfont THEN p font 0 show some informations IF arg_present infowidget THEN infowidget xnotice Postcript file is currently processed RETURN END "); 77 a[75] = new Array("./Postscript/printps.html", "printps.pro", "", " NAME: printps PURPOSE: postscript visualisation archiving printing CATEGORY: for the postscripts CALLING SEQUENCE: imprime psfilename INPUTS: psfilename: the name of the postscript file we want to visualize and or print and or archive It can also refer to a gzipped postscript file If needed this name will be completed by ps and or gz KEYWORD PARAMETERS: None COMMON BLOCKS: cm_4ps SIDE EFFECTS: archiving possibilities if archive_ps common variable of cm_4ps ne 0 then the postscript can be saved for archiving if it is printed or if the button archive ps is pressed if it is printed and archive_ps 1 then the archiving is done automatically whereas we ask if the postscript file must be archived or not If the postcript name is idl ps default name then this name will be changed to number ps number automatically found to be 1 larger that any of the existing ps file RESTRICTIONS: 1 this is working only with unix linux osX machines 2 definition of the printing command the printing command is defined by the common variable print_command in cm_4ps This command must be defind build in a way that it the instruction: print_command i printer_machine_names i file ps or print_command printer_machine_names i file ps is working default definition is lpr P EXAMPLE: IDL printps MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 25 8 19999 utilisation des widgets 8 9 1999 utilisation de cw_bgroup June 2005: Sebastien Masson: cleaning english version with new commons PRO printps_event event include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF What kind of event do we have widget_control event id get_uvalue uval case on the event CASE uval name OF visualize case : postscript visualization visualize :BEGIN paper orientation if key_portrait EQ 1 then ori portrait ELSE ori seascape paper format CASE round 10 total page_size OF round 10 83 9611 118 816 : papsize a0 round 10 59 4078 83 9611 : papsize a1 round 10 41 9806 59 4078 : papsize a2 round 10 29 7039 41 9806 : papsize a3 round 10 20 9903 29 7039 : papsize a4 round 10 14 8519 20 9903 : papsize a5 round 10 10 4775 14 8519 : papsize a6 round 10 7 40833 10 4775 : papsize a7 round 10 5 22111 7 40833 : papsize a8 round 10 3 70417 5 22111 : papsize a9 round 10 2 61056 3 70417 : papsize a10 round 10 100 048 141 393 : papsize b0 round 10 70 6967 100 048 : papsize b1 round 10 50 0239 70 6967 : papsize b2 round 10 35 3483 50 0239 : papsize b3 round 10 25 0119 35 3483 : papsize b4 round 10 17 6742 25 0119 : papsize b5 round 10 22 86 30 48 : papsize archA round 10 30 48 45 72 : papsize archB round 10 45 72 60 96 : papsize archC round 10 60 96 91 44 : papsize archD round 10 91 44 121 92 : papsize archE round 10 21 59 33 02 : papsize flsa round 10 21 59 33 02 : papsize flse round 10 13 97 21 59 : papsize halfletter round 10 19 05 25 4 : papsize note round 10 21 59 27 94 : papsize letter round 10 21 59 35 56 : papsize legal round 10 27 94 43 18 : papsize 11x17 round 10 43 18 27 94 : papsize ledger ELSE:papsize a4 ENDCASE call the viewers CASE event value OF Ghostview :spawn ghostview papsize quiet ori uval nameps Ghostscript :spawn gs sPAPERSIZE papsize q uval nameps Kghostview :spawn kghostview uval nameps ENDCASE return END print case: print and archive the file if needed print :BEGIN printer selection printer printer_machine_names event value print CASE n_elements print_command OF 0:ptcmd lpr P 1:ptcmd print_command 0 n_elements printer_machine_names :ptcmd print_command event value ELSE:BEGIN ng report bad definition of print_command common variable of cm_4ps C we did not print the postscript file simple return END ENDCASE spawn ptcmd printer uval nameps printing informations spawn lpq P imprimante l info display them xdisplayfile nothing text info title Printing Info file_basename uval nameps height n_elements info 24 END ELSE: ENDCASE we destroy the widget widget_control event top destroy if the file was originaly gzipped then we re gzip it and exit IF uval gzip THEN BEGIN spawn gzip uval nameps return ENDIF archiving IF uval name EQ print OR uval name EQ archive AND keyword_set archive_ps THEN BEGIN IF archive_ps NE 1 AND uval name EQ print then begin wesave report Shall we archive the postcript defaul_no question IF wesave EQ 0 THEN RETURN ENDIF if the name of the postscript is idl ps then we change it IF file_basename uval nameps EQ idl ps then BEGIN get the name of all the ps or ps gz files available in psdir allps file_search psdir ps ps gz pdf test_regular nosort allps file_basename file_basename allps gz ps allps file_basename allps pdf find which of these names corresponds to numbers get ascii codes of the names testnumb byte allps longest name maxstrlen size testnumb dimensions 0 ascii codes can be 0 or between byte 0 and byte 9 testnumb testnumb EQ 0 OR testnumb GE byte 0 0 AND testnumb LE byte 9 0 testnumb where total testnumb 1 EQ maxstrlen count IF count NE 0 THEN BEGIN get the largest number psnumber fix allps testnumb psnumber psnumber reverse sort psnumber 0 1 ENDIF ELSE psnumber 0 update uval nameps dirname file_dirname uval nameps mark_directory uval nameps dirname strtrim psnumber 2 ps change the name of the file file_move dirname idl ps uval nameps ENDIF spawn gzip uval nameps ENDIF return end pro printps psfilename this is working only with unix linux osX machines thisOS strupcase strmid version os_family 0 3 CASE thisOS OF MAC :return WIN :return ELSE: ENDCASE include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF we get the name of the latest created postscript psdir isadirectory psdir title Select psdir CASE N_PARAMS OF 0: BEGIN nameps file_search psdir ps test_regular nosort IF nameps 0 EQ THEN BEGIN ras report no postsrcipt file ending with ps found in : psdir RETURN ENDIF dates file_info nameps mtime lastdate reverse sort temporary dates 0 nameps nameps lastdate END 1: nameps psfilename ELSE: BEGIN ras report printps accept only one element: psfilename RETURN END ENDCASE we check if the file is exist in psdir if necessary we complete its name with ps and or gz nameps find nameps ps gz iodir psdir nopro IF nameps EQ NOT FOUND THEN BEGIN ng report file nameps ps gz does not exist return ENDIF gzipped strpos nameps gz if the file is gzipped we call gunzip et change its name IF gzipped NE 1 THEN BEGIN spawn gunzip nameps nameps strmid nameps 0 gzipped endif build the widget base widget_base row title Postscript file: file_basename nameps ps viewers grouped button psviewers no psviewers found IF file_which getenv PATH ghostview NE THEN psviewers psviewers Ghostview IF file_which getenv PATH gs NE THEN psviewers psviewers Ghostscript IF file_which getenv PATH kghostview NE THEN psviewers psviewers Kghostview if at least one of viewer was found we define these buttons IF n_elements psviewers GT 1 THEN BEGIN psviewers psviewers 1: notused cw_bgroup base psviewers frame label_top Visualize uvalue name: visualize nameps:nameps column return_name ENDIF printers list grouped buttons are the common variables printer_human_names and printer_human_names defined in a proper way CASE 1 OF n_elements printer_human_names eq 0: noting report the cm_4ps variable printer_human_names is not defined CWe could not propose any printer simple n_elements printer_human_names NE n_elements printer_machine_names : noting report the cm_4ps variables printer_human_names and Cprinter_machine_names do not have the same number of arguments CWe could not propose any printer simple printer_human_names 0 EQ : ELSE:notused cw_bgroup base printer_human_names frame column label_top Select printer uvalue name: print nameps:nameps gzip:gzipped NE 1 ENDCASE archive ps button can be created only if archive_ps ne 0 IF keyword_set archive_ps THEN notused widget_button base value archive ps uvalue name: archive nameps:nameps gzip:gzipped NE 1 quit button notused widget_button base value quit uvalue name: quit nameps:nameps gzip:gzipped NE 1 widget_control base realize xmanager printps base no_block return end "); 78 a[76] = new Array("./ReadWrite/idl-NetCDF/ncdf_listdims.html", "ncdf_listdims.pro", "", "FUNCTION ncdf_listdims ncid n ncdf_inquire ncid ndims names strarr n for i 0 n 1 do begin ncdf_diminq ncid i name size names i name endfor return names end"); 79 a[77] = new Array("./ReadWrite/idl-NetCDF/ncdf_listvars.html", "ncdf_listvars.pro", "", "FUNCTION ncdf_listvars ncid n ncdf_inquire ncid nvars names strarr n for i 0 n 1 do begin names i ncdf_varinq ncid i name endfor return names end"); 80 a[78] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickread/ncdf_quickread.html", "ncdf_quickread.pro", "", ""); 81 a[79] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickread/ncdf_quickread_helper.html", "ncdf_quickread_helper.pro", "", " ncdf_quickread_helper pro This file contains IDL functions to read netCDF data files into IDL variables Adapted from CDF2IDL pro This file contains the following functions and procedures: functions: ncdf_quickread_getfile strips the directory and optionally any suffixes from the path file ncdf_quickread_getdir returns the directory from the full path file ncdf_quickread_validatename validates the name that will be used as a netCDF variable procedures: ncdf_quickread_helper1 construct commands which when executed at the top level will read netCDF variables into IDL History: Date Name Action 06 Jun 97 S Rupert Created 09 Jun 97 S Rupert Fully tested 10 Jun 97 S Rupert Modified keyword usage 03 Feb 98 S Rupert Added additional error checking and warning to output script 17 Feb 98 S Rupert Corrected validation routine to handle instance of name strating with a number and containing a dash 05 Jul 00 A M Iwi Added keyword PREFIX on CDF2IDL Supplied string gets prepended to all variable names 19 Jun 01 A M Iwi Added keyword REFORM on CDF2IDL REFORM function is used to remove dimensions of size 1 02 Oct 03 A M Iwi Change into helper routine for ncdf_quickread 11 Aug 04 A M Iwi Add fields option to read only certain fields Also only stringify attributes of type CHAR function ncdf_quickread_getFile fullpath suffix suffix on_error 2 compile_opt hidden func_description This function returns the filename name from the full path Inputs: fullpath full directory file path Keyword: suffix: include inptu suffix in output file name Outputs: file filename Example Call: file ncdf_quickread_getfile fullpath Retrieve the postion at which the first character occurs from the end of the string dirlen rstrpos fullpath Retrieve the full length of the original string len strlen fullpath Retrieve the filename fullfile strmid fullpath dirlen 1 len Retrieve the position at which the first character occurs from the end of the string len 1 if not keyword_set suffix then len rstrpos fullfile if len EQ 1 then len strlen fullfile Retrieve the file file strmid fullfile 0 len Return the file name return file End function end function ncdf_quickread_getDir fullpath on_error 2 compile_opt hidden func_description This function returns the directory name from the full path Inputs: fullpath full directory file path Outputs: dir directory path Example Call: dir ncdf_quickread_getdir fullpath Retrieve the postion at which the first character occurs from the end of the string len rstrpos fullpath Retrieve the filename if len EQ 1 then dir else dir strmid fullpath 0 len 1 Return the file name return dir End function end function ncdf_quickread_validateName varname on_error 2 compile_opt hidden func_description This routine ensures that the given name does not start with a number nor contain a dash IDL cannot accept a variable starting with a number or containing a dash If the name starts with a number an underscore is prepended to the name and if it contains a dash the dash is replaced with an underscore Initialize the name name varname If the name starts with a number prepend it with an underscore if strpos varname 0 EQ 0 then name strcompress _ varname if strpos varname 1 EQ 0 then name strcompress _ varname if strpos varname 2 EQ 0 then name strcompress _ varname if strpos varname 3 EQ 0 then name strcompress _ varname if strpos varname 4 EQ 0 then name strcompress _ varname if strpos varname 5 EQ 0 then name strcompress _ varname if strpos varname 6 EQ 0 then name strcompress _ varname if strpos varname 7 EQ 0 then name strcompress _ varname if strpos varname 8 EQ 0 then name strcompress _ varname if strpos varname 9 EQ 0 then name strcompress _ varname If the name contains a dash replace it with an underscore if strpos name NE 1 then begin pieces str_sep name n_pieces n_elements pieces name pieces 0 for i 1 n_pieces 1 do begin name strcompress name _ pieces i endfor endif Return the file name return name End function end function ncdf_quickread_helper infile verbose verbose prefix prefix fields fields reform reform on_error 2 compile_opt hidden This procedure creates a script to read the data in a given netCDF file into IDL The default output file is the name of the netCDF file with idl replacing any existing suffix The default output is variable data only Inputs: infile full path to netCDF file of interest Optional Inputs: verbose includes extractions of all input file attributes in idl script prefix reform see changelog above Return value: array of commands to run at top level Ensure that the netCDF format is supported on the current platform if not ncdf_exists then message The Network Common Data Format is not supported on this platform Open the netcdf file for reading ncid NCDF_OPEN strcompress infile remove_all if ncid EQ 1 then message The file infile could not be opened please check the path Retrieve general information about this netCDF file ncidinfo NCDF_INQUIRE ncid command to write file header commands __ncid NCDF_OPEN infile subset 0 if n_elements fields ne 0 then begin if fields ne then begin subset 1 subfields strsplit fields extract endif endif Place the desired variables in local arrays for i 0 ncidinfo Nvars 1 do begin vardata NCDF_VARINQ ncid i if not subset then begin wanted 1 endif else begin match where subfields eq vardata Name nmatch wanted nmatch ne 0 endelse if wanted then begin varname ncdf_quickread_validatename vardata Name if keyword_set prefix then varname prefix varname commands commands NCDF_VARGET __ncid strcompress string i varname if keyword_set reform and vardata ndims ge 2 then commands commands varname reform varname if keyword_set verbose then begin for j 0 vardata Natts 1 do begin att NCDF_ATTNAME ncid i j attname strcompress varname _ strcompress att REMOVE_ALL commands commands NCDF_ATTGET __ncid strcompress string i att attname attinfo ncdf_attinq ncid i att if attinfo datatype eq CHAR then commands commands attname STRING attname endfor endif endif endfor if keyword_set verbose then begin for i 0 ncidinfo Ngatts 1 do begin name NCDF_ATTNAME ncid GLOBAL i attname ncdf_quickread_validatename name if keyword_set prefix then attname prefix attname commands commands NCDF_ATTGET __ncid GLOBAL name attname attinfo ncdf_attinq ncid global name if attinfo datatype eq CHAR then commands commands attname STRING attname endfor endif ncdf_close ncid commands commands NCDF_CLOSE __ncid Return commands to the caller return commands End procedure end"); 82 a[80] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite.html", "ncdf_quickwrite.pro", "", ""); 83 a[81] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper1.html", "ncdf_quickwrite_helper1.pro", "", "pro ncdf_quickwrite_helper1 ncvarstring ncdfstruct structname Parses the variable string so as to create the main structure on_error 2 compile_opt hidden ncdfstruct ncommands: 1 split string to extract IDL global attribute variable name bits strsplit ncvarstring extract case n_elements bits of 1: begin no attributes globattflag 0B globattnameidl end 2: begin globattflag 1B globattnameidl bits 1 end else: begin message Parse error: more than one sign in ncvarstring noname end endcase allvarspec bits 0 vars strsplit strcompress allvarspec remove_all extract nvar n_elements vars varnames strarr nvar varnamesidl strarr nvar nvardims intarr nvar vardims ptrarr nvar varattflags bytarr nvar varattnamesidl strarr nvar at start no dimensions known ndim 0 dimnames dimunlim 1 for ivar 0 nvar 1 do begin varandattspec vars ivar split into IDL attribute variable name and full variable specification bits strsplit varandattspec : extract case n_elements bits of 1: no variable attributes 2: begin varattflags ivar 1B varattnamesidl ivar bits 1 end else: begin message Parse error: more than one : sign in varandattspec noname end endcase fullvarspec bits 0 split full variable specification into variable specification and IDL variable name bits strsplit fullvarspec extract case n_elements bits of 1: varnameidl fill this in later 2: varnameidl bits 1 else: begin message Parse error: more than one sign in fullvarspec noname end endcase varspec bits 0 split variable specification into name and dimension specification bits strsplit varspec extract varname bits 0 case n_elements bits of 1: begin scalar nvardims ivar 0 end 2: begin dimspec bits 1 test for and strip trailing len strlen dimspec if strmid dimspec len 1 1 ne then begin message Parse error: dimension specification dimspec for variable varname should end with noname endif dimspec strmid dimspec 0 len 1 if dimspec eq then begin dimensions not specified assume 1d array with same name for dimension as for variable vardimnames varname endif else if dimspec eq then begin dimensions not specified but given as above again assume same name for dimension as for variable but with parsed below as meaning UNLIMITED vardimnames varname endif else begin vardimnames strsplit dimspec extract endelse now for each dimension name see if it already exists and if not then add it as a new name nvardim n_elements vardimnames nvardims ivar nvardim thisvardims intarr nvardim for i 0 nvardim 1 do begin dimname vardimnames i first see if dimname has leading if so strip it but record the fact that UNLIMITED is wanted unlimited strmid dimname 0 1 eq if unlimited then dimname strmid dimname 1 if ndim gt 0 then begin match where dimnames eq dimname nmatch case nmatch of 0: begin no match append to array dimnames dimnames dimname vardim ndim ndim ndim 1 end 1: begin match found point to it vardim match 0 end else: stop Duplicate match: BUG in NCDF_QUICK_HELPER1 endcase endif else begin no dimensions known this is the first ndim 1 dimnames dimname vardim 0 for completeness endelse if unlimited then begin if dimunlim ge 0 and dimunlim ne vardim then begin message NCDF dimensions dimnames dimunlim and dimnames vardim cannot both be of UNLIMITED size noname endif dimunlim vardim endif thisvardims i vardim endfor vardims ivar ptr_new thisvardims end else: message Parse error: variable specification varspec has stray noname endcase if varnameidl eq then varnameidl varname varnames ivar varname varnamesidl ivar varnameidl endfor now construct some commands which when executed at the top level will put IDL variable size information into the structure commands structname varsizes string indgen nvar ptr_new size varnamesidl now some more commands to tell the main level to copy the attributes into a heap location where the next helper routine will see them if globattflag then commands commands structname globatts ptr_new globattnameidl for ivar 0 nvar 1 do begin if varattflags ivar then begin commands commands structname varatts string ivar ptr_new varattnamesidl ivar endif endfor second argument comes back with a structure which contains all the information and also some variables to be used by next helper routine ncdfstruct ncommands: n_elements commands commands: ptr_new commands nvar: nvar varnames: varnames varids: intarr nvar nvardims: nvardims vardims: vardims varnamesidl: varnamesidl varsizes: ptrarr nvar varatts: ptrarr 1 nvar varattflags: varattflags varattnamesidl: varattnamesidl globatts: ptr_new globattflag: globattflag globattnameidl: globattnameidl ndim: ndim dimnames: dimnames dimids: intarr ndim 1 dimunlim: dimunlim fileid: 0 end"); 84 a[82] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper2.html", "ncdf_quickwrite_helper2.pro", "", " HELPER2 Constructs the commands which are actually needed to write the NetCDF file this file contains: STR ncdf_quickwrite_typename ncdf_quickwrite_helper2 compile_opt hidden _STR like STRING but with no whitespace we use this function enough to give it a short name but the underscore is to make it unlikely to conflict with a user s function function _str string return strcompress string remove_all end function ncdf_quickwrite_typename num name on_error 2 translate type number returned from size function into name usable by ncdf routines if not valid type throw an error and use name in informational message if set case num of usable types 1: type byte 2: type short 3: type long 4: type float 5: type double other types: set to something appropriate 7: type char string 12: type long unsigned 13: type long unsigned long 14: type float 64 bit integer 15: type float 64 bit integer else: begin if num eq 0 then gripe undefined else gripe not of valid type for a NetCDF file if n_params eq 1 then name Data item message name is gripe noname end endcase return type end pro ncdf_quickwrite_helper2 ncfilename s sname on_error 2 compile_opt hidden NB main structure is called s we use it so much that anything longer could get tedious start with no commands in fact 1 is an error condition s ncommands 1 free commands written by helper1 from heap ptr_free s commands dimsize lonarr s ndim 1 1 stops error if all fields scalar types strarr s nvar first of all work out dimension sizes for ivar 0 s nvar 1 do begin nvardim s nvardims ivar sizeinfo s varsizes ivar ntype sizeinfo sizeinfo 0 1 types ivar ncdf_quickwrite_typename ntype IDL expression s varnamesidl ivar for NCDF variable s varnames ivar if nvardim ne sizeinfo 0 then message NCDF variable s varnames ivar is defined with _str s nvardims ivar dimension s but corresponding IDL expression s varnamesidl ivar has _str sizeinfo 0 dimension s noname if nvardim ne 0 then begin not scalar for ivardim 0 nvardim 1 do begin idim s vardims ivar ivardim wanted sizeinfo 1 ivardim previous dimsize idim if previous ne 0 and previous ne wanted then message NCDF dimension s dimnames idim is multiply used but with conflicting sizes: _str previous and _str wanted noname dimsize idim wanted endfor endif endfor make commands to write the file to open the file if n_elements ncfilename eq 0 then ncfilename idl nc if strmid ncfilename 0 1 eq then begin ncfilename1 strmid ncfilename 1 clobstr clobber endif else begin ncfilename1 ncfilename clobstr endelse commands sname fileid ncdf_create ncfilename1 clobstr to do the dimensions for idim 0 s ndim 1 do begin if idim eq s dimunlim then sizestr unlimited else sizestr _str dimsize idim commands commands sname dimids _str idim ncdf_dimdef sname fileid s dimnames idim sizestr endfor to do the variables for ivar 0 s nvar 1 do begin if s nvardims ivar eq 0 then dimstr else dimstr sname dimids strjoin _str s vardims ivar commands commands sname varids _str ivar ncdf_vardef sname fileid s varnames ivar dimstr types ivar endfor to do the global attributes if s globattflag then begin tags tag_names s globatts ntags n_elements tags for itag 0 ntags 1 do begin sizeinfo size s globatts itag type ncdf_quickwrite_typename sizeinfo sizeinfo 0 1 commands commands ncdf_attput sname fileid global strlowcase tags itag s globattnameidl tags itag type endfor endif to do the variable attributes for ivar 0 s nvar 1 do begin if s varattflags ivar then begin tags tag_names s varatts ivar ntags n_elements tags for itag 0 ntags 1 do begin sizeinfo size s varatts ivar itag type ncdf_quickwrite_typename sizeinfo sizeinfo 0 1 commands commands ncdf_attput sname fileid sname varids _str ivar strlowcase tags itag s varattnamesidl ivar tags itag type endfor endif endfor to end the definition section commands commands ncdf_control sname fileid endef to write the data for ivar 0 s nvar 1 do begin commands commands ncdf_varput sname fileid sname varids _str ivar s varnamesidl ivar endfor close the file commands commands ncdf_close sname fileid make commands available to main level s ncommands n_elements commands s commands ptr_new commands end "); 85 a[83] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper3.html", "ncdf_quickwrite_helper3.pro", "", "pro ncdf_quickwrite_helper3 s Frees the variables in heap memory on_error 2 compile_opt hidden s is our ncdf structure ptr_free s globatts ptr_free s varatts ptr_free s commands ptr_free s vardims ptr_free s varsizes ptr_free s varatts end"); 86 a[84] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_verbose.html", "ncdf_quickwrite_verbose.pro", "", ""); 87 a[85] = new Array("./ReadWrite/idl-NetCDF/ncdf_read.html", "ncdf_read.pro", "", "PRO ncdf_read filename info dinfo vinfo gatts vatts data general info data dimension info variable attributes variable info global attributes read a NetCDF file NB The data is read into a rather nasty combination of structures arrays and pointers which is unfortunately necessary in order to cope with the full generality of the data format Here is the sort of syntax you might use to get at elements of the returned data cumbersome because IDL doesn t support C type a b shorthand for a b INFO NDIMS INFO NVARS INFO NGATTS INFO RECDIM DINFO idim NAME DINFO idim SIZE VINFO ivar NAME VINFO ivar NAME VINFO ivar DATATYPE VINFO ivar NDIMS VINFO ivar NATTS VINFO ivar DIM ivdim GATTS NAME GATTS DATATYPE GATTS LENGTH GATTS VALUES or maybe STRING GATTS VALUES VATTS ivar iatt NAME VATTS ivar iatt DATATYPE VATTS ivar iatt LENGTH VATTS ivar iatt VALUES or maybe STRING VATTS ivar iatt VALUES DATA ivar or maybe DATA ivar idim1 idim2 idim3 open file id ncdf_open filename info info ncdf_inquire id dimension info dinfo replicate name: size:0L info ndims for idim 0 info ndims 1 do begin ncdf_diminq id idim name size dinfo idim name name dinfo idim size size endfor variable info vinfo replicate name: datatype: ndims:0l natts:0l dim:lonarr info ndims info nvars for ivar 0 info nvars 1 do begin var ncdf_varinq id ivar vinfo ivar name var name vinfo ivar datatype var datatype vinfo ivar ndims var ndims vinfo ivar natts var natts vinfo ivar dim var dim endfor global attributes if info ngatts gt 0 then begin gatts replicate name: datatype: length:0L values:ptr_new info ngatts for iatt 0 info ngatts 1 do begin name ncdf_attname id iatt global gatts iatt name name att ncdf_attinq id name global gatts iatt length att length gatts iatt datatype att datatype ncdf_attget id name vals global gatts iatt values ptr_new vals endfor endif else begin arbitary scalar value an empty list would be sensible but IDL doesn t support it gatts 1 endelse variable attributes vatts replicate ptr_new info nvars for ivar 0 info nvars 1 do begin if vinfo ivar natts gt 0 then begin vatts ivar ptr_new replicate name: datatype: length:0L values:ptr_new vinfo ivar natts for iatt 0 vinfo ivar natts 1 do begin name ncdf_attname id ivar iatt vatts ivar iatt name name att ncdf_attinq id ivar name vatts ivar iatt length att length vatts ivar iatt datatype att datatype ncdf_attget id ivar name vals vatts ivar iatt values ptr_new vals endfor endif else begin vatts ivar ptr_new 1 Pointer to arbitrary scalar analogous to case of lack of global attributes above We could put a here instead but try to be friendlier to code that might try to dereference it endelse endfor data data replicate ptr_new info nvars for ivar 0 info nvars 1 do begin ncdf_varget id ivar val data ivar ptr_new val endfor end"); 88 a[86] = new Array("./ReadWrite/idl-NetCDF/ncdf_struct.html", "ncdf_struct.pro", "", "FUNCTION ncdf_struct filename nodata nodata noattributes noattributes Read entire netcdf file into a structure Structure contains metadata actual array contents are on heap with pointers contained in the structure Heap variables not created if nodata specified Use ncdf_struct_free to free heap memory Some data is duplicated for ease of access in particular if there is a variable name matching a dimension name then a pointer to the variable contents is accessible via the substructures corresponding to the dimension and every other variable that uses it Alan Iwi 27 6 02 id ncdf_open filename g ncdf_inquire id ndim g ndims nvar g nvars natt g ngatts if ndim gt 0 then begin dnames strarr ndim dsizes lonarr ndim for idim 0 ndim 1 do begin ncdf_diminq id idim dname dsize dnames idim dname dsizes idim dsize endfor endif if natt gt 0 and not keyword_set noattributes then begin anames strarr natt for iatt 0 natt 1 do begin aname ncdf_attname id global iatt ainq ncdf_attinq id global aname ncdf_attget id global aname aval if ainq datatype eq CHAR then aval string aval if iatt eq 0 then begin atts create_struct aname aval endif else begin atts create_struct atts aname aval endelse anames iatt aname endfor g create_struct g gatts atts gattnames anames endif if nvar gt 0 then begin vnames strarr nvar for ivar 0 nvar 1 do begin v ncdf_varinq id ivar vname v name vndim v ndims vnatt v natts vname v name if vnatt gt 0 and not keyword_set noattributes then begin vanames strarr vnatt for iatt 0 vnatt 1 do begin aname ncdf_attname id ivar iatt ainq ncdf_attinq id ivar aname ncdf_attget id ivar aname aval if ainq datatype eq CHAR then aval string aval if iatt eq 0 then begin atts create_struct aname aval endif else begin atts create_struct atts aname aval endelse vanames iatt aname endfor v create_struct v atts atts attnames anames endif vdnames dnames v dim vdsizes dsizes v dim v create_struct v dimnames vdnames dimsizes vdsizes if not keyword_set nodata then begin ncdf_varget id ivar vdata v create_struct v data ptr_new vdata dimdata replicate ptr_new vndim endif if ivar eq 0 then begin vars create_struct vname v endif else begin vars create_struct vars vname v endelse vnames ivar vname endfor endif if ndim gt 0 then begin for idim 0 ndim 1 do begin dname dnames idim d name:dname size:dsizes idim if not keyword_set nodata and nvar gt 0 then begin matchvar 1 for ivar 0 nvar 1 do begin if vnames ivar eq dname then matchvar ivar endfor if matchvar ne 1 then d create_struct d data vars matchvar data endif if idim eq 0 then begin dims create_struct dname d endif else begin dims create_struct dims dname d endelse endfor g create_struct g dims dims dimnames dnames dimsizes dsizes endif if nvar gt 0 then begin if not keyword_set nodata then begin for ivar 0 nvar 1 do begin for idim 0 vars ivar ndims 1 do begin vars ivar dimdata idim dims vars ivar dim idim data endfor endfor endif g create_struct g vars vars varnames vnames endif ncdf_close id return g end"); 89 a[87] = new Array("./ReadWrite/idl-NetCDF/ncdf_struct_free.html", "ncdf_struct_free.pro", "", "PRO ncdf_struct_free s free heap memory associated with struct returned by ncdf_struct for i 0 s nvars 1 do ptr_free s vars i data end"); 90 a[88] = new Array("./ReadWrite/ncdf_timeget.html", "ncdf_timeget.pro", "", " NAME: ncdf_timeget PURPOSE: get the time axis fom a netcdf_file and transforms it in julian days of IDL CATEGORY: reading ncdf_file CALLING SEQUENCE: time ncdf_timeget cdfid timeid INPUTS:cdfid: the ID of the ncdf_file which is already open timeid: the ID or the name of the variable which describe the calendar KEYWORD PARAMETERS: YYYYMMDD: active to obtain the date as a longinterger with the format YearYearYearYearMonthMonthDayDay the keyword parameters of ncdf_varget OUTPUTS:a long array of IDL julian days COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: the calendar variable must have the units attribute folowing the syntaxe bellow: time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2001 FUNCTION ncdf_timeget cdfid timeid YYYYMMDD yyyymmdd _extra ex insidetime ncdf_varinq cdfid timeid if insidetime natts NE 0 then begin attnames strarr insidetime natts for attiq 0 insidetime natts 1 do attnames attiq strlowcase ncdf_attname cdfid timeid attiq ENDIF ELSE return report the variable timeid must have the units attribut reading of the time axis ncdf_varget cdfid timeid time _extra ex time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 if where attnames EQ units 0 NE 1 then begin ncdf_attget cdfid timeid units value value strtrim strcompress string value 2 words str_sep value unite words 0 start str_sep words 2 case strlowcase unite of seconds :time julday start 1 start 2 start 0 time long 24 3600 hours :time julday start 1 start 2 start 0 time long 24 days :time julday start 1 start 2 start 0 time months :BEGIN for t 0 n_elements time 1 do begin time t julday start 1 time t start 2 start 0 endfor END years :BEGIN for t 0 n_elements time 1 do begin time t julday start 1 start 2 start 0 time t endfor END ELSE:return report bad syntax of the units attribut of the variable timeid ENDCASE ENDIF ELSE return report the variable timeid must have the units attribut if keyword_set yyyymmdd then time jul2date time return time end"); 91 a[89] = new Array("./ReadWrite/read_grads.html", "read_grads.pro", "", " NAME:read_grads PURPOSE:reading grads file except data type station or grib from the grads control file even if there is multiple data files CATEGORY:reading function CALLING SEQUENCE: res read_grads var date1 date2 FILENAME filename INPUTS: var: the variable name date1: date of the beginning yyyymmdd if TIMESTEP is not activate date2: last date Optionnal if not scpecified date2 date1 KEYWORD PARAMETERS: FILENAME: the grads control file name: xxxx ctl GLAMBOUNDARY via computegrid pro :a 2 elements vector lon1 lon2 giving the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 eq 360 key_shift will be automatically defined according to GLAMBOUNDARY TIMESTEP: to specify that the dates are time steps instead of true calendar IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir NOT yet available BOX: a 4 or 6 elements 1d array lon1 lon2 lat1 lat2 depth1 depth2 that specifies the area where data must be read EVERYTHING NOSTRUCTURE OUTPUTS: an array COMMON BLOCKS:common pro SIDE EFFECTS:define all the grid parameters defined in common pro associated to the data RESTRICTIONS: this function call the procedure scanfile that use the unix commands grep and sed EXAMPLE: IDL a read_grads sst 19900101 19900131 filename outputs ctl IDL plt a MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION read_grads var date1 date2 FILENAME filename BOX box TIMESTEP timestep EVERYTHING everything NOSTRUCT nostruct _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF we find the filename filename isafile FILENAME filename IODIRECTORY iodir _EXTRA ex if size filename type NE 7 then return report read_ncdf cancelled we scan the control file called filename scanctl filename filesname jpt1file varsname varslev swapbytes bigendian littleendian f77sequential fileheader theader xyheader VARFMT varfmt _EXTRA ex if n_elements varfmt EQ 0 then varfmt float check date1 and date2 and found the starting index t1 and the ending index t2 that corresponds to the time series specified by date1 and date2 for the time axis defined in the ctl file if n_elements date1 EQ 0 then begin t0 0 t1 0 ENDIF if n_elements date2 EQ 0 then date2 date1 if keyword_set timestep then BEGIN if date1 GT date2 then begin print date2 must be larger than date1 return 1 endif t1 0 long date1 long date2 date2jul date2 grads if jdate1 GT jdate2 then begin print date2 must be larger than date1 return 1 endif t1 where time GE jdate1 0 tmp where time LE jdate2 t2 t2 t2 1 ENDELSE if t2 LT t1 then begin print There is no date between date1 and date2 return 1 endif jpt2read t2 t1 1 index of the variable varid where strlowcase varsname EQ strlowcase var varid varid 0 if varid EQ 1 then begin print var not found in the variable liste of filename return 1 ENDIF varname var if varslev varid EQ 1 then res fltarr jpi jpj jpt2read nozero ELSE res fltarr jpi jpj varslev varid jpt2read nozero find the first file to be read according to the lile list the number of time step in each file and t1 and t2 indf2read t1 jpt1file startread t1 indf2read jpt1file alreadyread 0 readagain: jpt2read1file min jpt1file startread jpt2read f2read filesname indf2read opening check the existance of the file f2read isafile filename f2read iodirectory iodir _EXTRA ex if the file is stored on tape if version os_family EQ unix then spawn file f2read dev null open the file openr unit f2read get_lun error err swap_if_little_endian bigendian swap_if_big_endian littleendian swap_endian swapbytes if err ne 0 then begin print err_string return 1 endif case varfmt of byte :fmtsz 1l uint :fmtsz 2l int :fmtsz 2l long :fmtsz 4l float :fmtsz 4l endcase check its size addf77sec long 4 2 f77sequential xyblocsize xyheader addf77sec xyheader NE 0 jpi jpj fmtsz addf77sec nxybloc long total varslev filesize fileheader addf77sec fileheader NE 0 theader addf77sec theader NE 0 nxybloc xyblocsize jpt1file infof2read fstat unit if infof2read size NE filesize then begin print According to filename the file size must be strtrim filesize 1 instead of strtrim infof2read size 1 print jpi: strtrim jpi 2 print jpj: strtrim jpj 2 print jpt: strtrim jpt 2 print format size in byte: strtrim fmtsz 2 print number of xy arrays: strtrim nxybloc 2 return 1 endif reading loop on the time steps to be read in one file for i 0 jpt2read1file 1 do begin computing the offset offset fileheader addf77sec fileheader NE 0 theader addf77sec theader NE 0 nxybloc xyblocsize startread i theader addf77sec theader NE 0 if varid NE 0 THEN offset offset long total varslev 0:varid 1 xyblocsize if there is only one level IF varslev varid EQ 1 then begin case varfmt of byte :a assoc unit bytarr jpi jpj nozero offset 4 f77sequential uint :a assoc unit uintarr jpi jpj nozero offset 4 f77sequential int :a assoc unit intarr jpi jpj nozero offset 4 f77sequential long :a assoc unit lonarr jpi jpj nozero offset 4 f77sequential float :a assoc unit fltarr jpi jpj nozero offset 4 f77sequential endcase res i alreadyread a 0 ENDIF ELSE BEGIN more than 1 level to be read if f77sequential then BEGIN sequential access case varfmt of byte :a assoc unit bytarr jpi jpj 8 varslev varid nozero offset uint :a assoc unit uintarr jpi jpj 4 varslev varid nozero offset int :a assoc unit intarr jpi jpj 4 varslev varid nozero offset long :a assoc unit lonarr jpi jpj 2 varslev varid nozero offset float :a assoc unit fltarr jpi jpj 2 varslev varid nozero offset endcase tmp a 0 case varfmt OF we cut the headers and tailers of f77 write byte : tmp tmp 4:jpi jpj 3 uint : tmp tmp 2:jpi jpj 1 int : tmp tmp 2:jpi jpj 1 long : tmp tmp 1:jpi jpj 0 float :tmp tmp 1:jpi jpj 0 endcase if keyword_set key_zreverse then res i alreadyread reverse reform tmp jpi jpj varslev varid over 3 ELSE res i alreadyread reform tmp jpi jpj varslev varid over ENDIF ELSE BEGIN direct acces case varfmt of byte :a assoc unit bytarr jpi jpj varslev varid nozero offset uint :a assoc unit uintarr jpi jpj varslev varid nozero offset int :a assoc unit intarr jpi jpj varslev varid nozero offset long :a assoc unit lonarr jpi jpj varslev varid nozero offset float :a assoc unit fltarr jpi jpj varslev varid nozero offset endcase if keyword_set key_zreverse then res i alreadyread reverse a 0 3 ELSE res i alreadyread a 0 ENDELSE ENDELSE endfor close the file free_lun unit close unit do we need to read a new file to complete the time series if jpt2read1file NE jpt2read then BEGIN indf2read indf2read 1 startread 0 alreadyread alreadyread jpt2read1file jpt2read jpt2read jpt2read1file GOTO readagain ENDIF post processing if keyword_set key_yreverse then res reverse res 2 if keyword_set key_shift then begin case size res 0 of 2:res shift res key_shift 0 3:res shift res key_shift 0 0 4:res shift res key_shift 0 0 0 endcase endif mask IF varslev varid EQ 1 then begin if abs valmask LE 1e5 then notgood where res 0 EQ valmask ELSE notgood where abs res 0 GE abs valmask 10 if notgood 0 NE 1 then tmask notgood 0b ENDIF ELSE BEGIN if abs valmask LE 1e5 then notgood where res 0 EQ valmask ELSE notgood where abs res 0 GE abs valmask 10 if notgood 0 NE 1 then tmask notgood 0b ENDELSE if abs valmask LE 1e5 then notgood where res EQ valmask ELSE notgood where abs res GE abs valmask 10 if notgood 0 NE 1 THEN res notgood values f_nan valmask 1e20 if abs valmask LE 1e5 then notgood where res EQ valmask ELSE notgood where abs res GE abs valmask 10 if notgood 0 NE 1 THEN res notgood 1e20 valmask 1e20 triangles_list triangule subdomain extration time aguments time time t1:t2 jpt t2 t1 1 if keyword_set timestep then vardate strtrim time 0 2 ELSE vardate date2string vairdate time 0 updateold return res end"); 92 a[90] = new Array("./ReadWrite/read_oasis.html", "read_oasis.pro", "", " NAME:read_oasis PURPOSE:read the f77 unformated files used in Oasis version a read_oasis grids_orca_t106 a106 lon 320 160 IDL m read_oasis masks_orca_t106 or1t msk 182 149 i4 see also IDL scanoasis grids_orca_t106 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 FUNCTION read_oasis filename varname jpi jpj I2 I4 i4 I8 i8 R4 r4 openr unit filename f77_unformatted get_lun swap_if_little_endian error err if err ne 0 then begin print err_string return 1 endif char8 12345678 readu unit char8 print char8 found char8 EQ varname WHILE NOT EOF unit AND found NE 1 DO BEGIN readu unit if EOF unit then begin print varname not found in filename return 1 endif readu unit char8 print char8 found char8 EQ varname ENDWHILE case 1 of keyword_set i2 :res intarr jpi jpj keyword_set i4 :res lonarr jpi jpj keyword_set i8 :res lon64arr jpi jpj keyword_set r4 :res fltarr jpi jpj ELSE:res dblarr jpi jpj endcase readu unit res free_lun unit return res end"); 93 a[91] = new Array("./ReadWrite/readbat.html", "readbat.pro", "", " NAME: readbat PURPOSE: reading the bathymetry ASCII file of OPA CATEGORY: for OPA CALLING SEQUENCE: bat readbat filename INPUTS: filename: a string containing the filename KEYWORD PARAMETERS: ZERO: to put 0 on land instead of negatives values for the islands OUTPUTS: a 2d array COMMON BLOCKS:no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr May 31 2002 based on batlec2 pro written by Maurice Imbard March 17 1998 FUNCTION readbat filename ZERO zero lecture de la bathymetrie iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return 1 ENDIF ELSE iname_file iname_file 0 openr iunit iname_file get_lun readf iunit FORMAT 16x 2i8 iim ijm iim long iim ijm long ijm tmp readf iunit tmp tmp strsplit tmp extract iim long tmp n_elements tmp 2 ijm long tmp n_elements tmp 1 print iim ijm ifreq 40L ifin iim ifreq 1 irest iim ifin 1 ifreq print ifin irest ifreq zbati intarr ifreq zbati2 intarr irest zbat intarr iim ijm readf iunit FORMAT readf iunit FORMAT il1 0 FOR jn 1 ifin 1 DO BEGIN readf iunit FORMAT readf iunit FORMAT il2 min iim 1 il1 ifreq 1 readf iunit FORMAT readf iunit FORMAT readf iunit FORMAT il3 il2 jn 1 ifreq iformat string il3 2 i3 print jn il1 il2 il3 ifreq 1 FOR jj ijm 1 0 1 DO BEGIN readf iunit FORMAT iformat ij zbati zbat il1:il2 jj zbati ENDFOR il1 il1 ifreq ENDFOR readf iunit FORMAT readf iunit FORMAT il2 min iim 1 il1 ifreq 1 readf iunit FORMAT readf iunit FORMAT readf iunit FORMAT il3 il2 ifin 1 ifreq iformat string il3 2 i3 print irest 1 il1 il2 il3 FOR jj ijm 1 0 1 DO BEGIN readf iunit FORMAT iformat ij zbati2 zbat il1:il2 jj zbati2 ENDFOR close iunit free_lun iunit if keyword_set zero then zbat 0 zbat return zbat end"); 94 a[92] = new Array("./ReadWrite/readoldopadistcoast.html", "readoldopadistcoast.pro", "", " NAME:readoldopadistcoast PURPOSE: read the old binary direct access file that contains the distance to the coast in OPA based on the OPA subroutines dtacof and parctl CATEGORY:for OPA before NetCDF CALLING SEQUENCE:res readoldopadistcoast filename INPUTS: filename with the whole path if necessary jpiglo jpjglo jpk: dimensions of the opa grid KEYWORD PARAMETERS: IBLOC: ibloc size default: ibloc 4096L JPBYT: jpbyt size defalut: jpbyt 8L NUMREC: number of records in the file defalut: numrec 19L jpk OUTPUTS: a structure that contains two elements: tdistcoast the distance for the t points and fdiscoast the distance for the f points COMMON BLOCKS: no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2002 FUNCTION read3fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo params jpk nozero offset b a 0 return b end FUNCTION readoldopadistcoast filename jpiglo jpjglo jpk IBLOC ibloc JPBYT jpbyt NUMREC numrec iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return 1 ENDIF ELSE iname_file iname_file 0 open the file openr numcost iname_file get_lun swap_if_little_endian check the size of the file filepamameters fstat numcost defaut parameter definition for ORCA2 IF keyword_set ibloc THEN ibloc long ibloc ELSE ibloc 4096L jpiglo long jpiglo jpjglo long jpjglo jpk long jpk IF keyword_set jpbyt THEN jpbyt long jpbyt ELSE jpbyt 8L record length computation reclen ibloc jpiglo jpjglo jpbyt 1 ibloc 1 number of records IF keyword_set numrec THEN numrec long numrec ELSE numrec 3L jpk difference between the record length and the size of the contened array toomuch reclen jpiglo jpjglo jpbyt expected size computation size numrec reclen toomuch if size NE filepamameters size then begin print The size of the file is not the expected one print Check your file or the values of ibloc jpiglo print jpjglo jpk jpbyt numrec in this program return 1 endif first record: six 64 bit integer to read default definition iimlu long64 999 ijmlu long64 999 ikmlu long64 999 read readu numcost iimlu ijmlu ikmlu if iimlu NE jpiglo then begin print iimlu strtrim iimlu 1 differs from jpiglo strtrim jpiglo 1 return 1 endif if ijmlu NE jpjglo then begin print ijmlu strtrim ijmlu 1 differs from jpjglo strtrim jpjglo 1 return 1 endif if ikmlu NE jpk then begin print ikmlu strtrim ikmlu 1 differs from jpk strtrim jpk 1 return 1 endif other records params jpiglo:jpiglo jpjglo:jpjglo jpk:jpk reclen:reclen tdistcoast read3fromopa numcost params 2 fdistcoast read3fromopa numcost params 3 close numcost free_lun numcost return tdistcoast:tdistcoast fdistcoast:fdistcoast end"); 95 a[93] = new Array("./ReadWrite/readoldoparestart.html", "readoldoparestart.pro", "", " NAME:readoldoparestart based on the OPA subroutine dtrlec included at the end of the file PURPOSE:read the old restart files of OPA before NetCDF CATEGORY:for OPA before NetCDF CALLING SEQUENCE:readoldoparestart filename jpiglo jpjglo jpk INPUTS: filename: with the whole path if necessary jpiglo jpjglo jpk: dimensions of the opa grid KEYWORD PARAMETERS: IBLOC: ibloc size default: ibloc 4096L JPBYT: jpbyt size defalut: jpbyt 8L NUMREC: number of records in the file defalut: numrec 19L jpk UB VB TB SB ROTB HDIVB UN VN TN SN ROTN HDIVN GCX GCXB ETAB TAN BSFB BSFN BSFD EN: the variable we want to read OUTPUTS:according to the given keywords COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS:bug for etab and etan written on the same record EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2002 FUNCTION read2fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo nozero offset return a 0 end FUNCTION read3fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo params jpk nozero offset return a 0 end PRO readoldoparestart filename jpiglo jpjglo jpk IBLOC ibloc JPBYT jpbyt NUMREC numrec ub ub vb vb tb tb sb sb rotb rotb hdivb hdivb un un vn vn tn tn sn sn rotn rotn hdivn hdivn gcx gcx gcxb gcxb etab etab etan etan bsfb bsfb bsfn bsfn bsfd bsfd en en iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return ENDIF ELSE iname_file iname_file 0 open the file openr numrst iname_file get_lun swap_if_little_endian check the size of the file filepamameters fstat numrst parameter definition IF keyword_set ibloc THEN ibloc long ibloc ELSE ibloc 4096L jpiglo long jpiglo jpjglo long jpjglo jpk long jpk IF keyword_set jpbyt THEN jpbyt long jpbyt ELSE jpbyt 8L record length computation reclen ibloc jpiglo jpjglo jpbyt 1 ibloc 1 IF keyword_set numrec THEN numrec long numrec ELSE numrec 19L jpk toomuch reclen jpiglo jpjglo jpbyt expected size computation size numrec reclen toomuch if size NE filepamameters size then begin print The size of the file is not the expected one print Check your file or the values of ibloc jpiglo print jpjglo jpk jpbyt numrec in this program return endif first record: six 64 bit integer to read default definition ino1 long64 9999 it1 long64 9999 isor1 long64 9999 ipcg1 long64 9999 itke1 long64 9999 idast1 long64 9999 read readu numrst ino1 it1 isor1 ipcg1 itke1 idast1 print ino1 it1 isor1 ipcg1 itke1 idast1 other records params jpiglo:jpiglo jpjglo:jpjglo jpk:jpk reclen:reclen CALL read3 numrst ub 2 IF arg_present ub THEN ub read3fromopa numrst params 2 CALL read3 numrst vb 3 IF arg_present vb THEN vb read3fromopa numrst params 3 CALL read3 numrst tb 5 IF arg_present tb THEN tb read3fromopa numrst params 5 CALL read3 numrst sb 6 IF arg_present sb THEN sb read3fromopa numrst params 6 CALL read3 numrst rotb 7 IF arg_present rotb THEN rotb read3fromopa numrst params 7 CALL read3 numrst hdivb 8 IF arg_present hdivb THEN hdivb read3fromopa numrst params 8 CALL read3 numrst un 9 IF arg_present un THEN un read3fromopa numrst params 9 CALL read3 numrst vn 10 IF arg_present vn THEN vn read3fromopa numrst params 10 CALL read3 numrst tn 12 IF arg_present tn THEN tn read3fromopa numrst params 12 CALL read3 numrst sn 13 IF arg_present sn THEN sn read3fromopa numrst params 13 CALL read3 numrst rotn 14 IF arg_present rotn THEN rotn read3fromopa numrst params 14 CALL read3 numrst hdivn 15 IF arg_present hdivn THEN hdivn read3fromopa numrst params 15 C C Read elliptic solver arrays C CALL read2 numrst gcx jpk 17 IF arg_present gcx THEN gcx read2fromopa numrst params 17 CALL read2 numrst gcxb jpk 18 IF arg_present gcxb THEN gcxb read2fromopa numrst params 18 C ifdef key_freesurf_cstvol C C free surface formulation eta C CALL read2 numrst etab jpk 4 IF arg_present etab THEN etab read2fromopa numrst params 4 CALL read2 numrst etan jpk 4 IF arg_present etan THEN etan read2fromopa numrst params 4 else C C Rigid lid formulation bsf C CALL read2 numrst bsfb jpk 4 IF arg_present bsfb THEN bsfb read2fromopa numrst params 4 CALL read2 numrst bsfn jpk 11 IF arg_present bsfn THEN bsfn read2fromopa numrst params 11 CALL read2 numrst bsfd jpk 16 IF arg_present bsfd THEN bsfd read2fromopa numrst params 16 endif ifdef key_zdftke CALL read3 numrst en 19 IF arg_present en THEN en read3fromopa numrst params 19 close numrst free_lun numrst return end CDIR LIST SUBROUTINE dtrlec CCC CCC CCC ROUTINE dtrlec CCC CCC CCC Purpose : CCC CCC Read files for restart CCC CC Method : CC CC Read the previous fields on the file numrst CC the first record indicates previous characterics CC after control with the present run we read : CC prognostic variables on the second record CC elliptic solver arrays CC barotropic stream function arrays default option CC or free surface arrays key_freesurf_cstvol defined CC tke arrays key_zdftke defined CC for this last three records the previous characteristics CC could be different with those used in the present run CC CC Input : CC CC common CC comrst : restart parameter CC comctl : parameters for the control CC CC Output : CC CC common CC combef : previous fields before CC comnow : present fields now CC combsf : barotropic stream function CC comspg : surface pressure CC comsol : diagonal preconditioned conjugate CC CC Modifications : CC CC original : 91 03 CC additions : 92 01 M Imbard CC : 92 06 correction restart file M Imbard CC : 98 02 M Guyon FETI method CC addition : 98 05 G Roullet free surface CC CC parameters and commons CC CDIR NOLIST include parameter h include common h CDIR LIST CC CC local declarations CC INTEGER ji jj jk jl INTEGER ino0 it0 ipcg0 isor0 itke0 INTEGER ino1 it1 isor1 ipcg1 itke1 idast1 CC CC statement functions CC CDIR NOLIST include stafun h CDIR LIST CCC CCC OPA8 LODYC 1997 CCC C C C 0 Initialisations C C ino0 no it0 nit000 ipcg0 0 isor0 0 itke0 0 isor0 nsolv 1 ipcg0 2 nsolv ifdef key_zdftke itke0 1 endif C FETI method IF nsolv EQ 3 THEN isor0 2 ipcg0 2 ENDIF C IF lwp THEN WRITE numout WRITE numout dtrlec: beginning of restart WRITE numout WRITE numout the present run : WRITE numout job number : no WRITE numout with nit000 : nit000 WRITE numout with pcg option ipcg0 : ipcg0 WRITE numout with sor option isor0 : isor0 WRITE numout with FETI solver option ipcg0 isor0 : ipcg0 isor0 WRITE numout with tke option itke0 : itke0 ENDIF C C 1 Read numrst C C C First record C READ numrst REC 1 ino1 it1 isor1 ipcg1 itke1 idast1 C IF lwp THEN WRITE numout WRITE numout READ numrst with WRITE numout job number : ino1 WRITE numout with time step it : it1 WRITE numout with pcg option ipcg1 : ipcg1 WRITE numout with sor option isor1 : isor1 WRITE numout with tke option itke1 : itke1 WRITE numout with FETI solver option ipcg1 isor1 : ipcg1 isor1 WRITE numout ENDIF C C Control of date C IF it0 it1 NE 1 AND abs nrstdt EQ 1 THEN IF lwp THEN WRITE numout : problem with nit000 for the restart WRITE numout WRITE numout we stop verify the file WRITE numout or rerun with the value 0 for the WRITE numout control of time parameter nrstdt WRITE numout ENDIF STOP dtrlec ENDIF IF nrstdt EQ 1 ndate0 idast1 C C Read prognostic variables C CALL read3 numrst ub 2 CALL read3 numrst vb 3 CALL read3 numrst tb 5 CALL read3 numrst sb 6 CALL read3 numrst rotb 7 CALL read3 numrst hdivb 8 CALL read3 numrst un 9 CALL read3 numrst vn 10 CALL read3 numrst tn 12 CALL read3 numrst sn 13 CALL read3 numrst rotn 14 CALL read3 numrst hdivn 15 C C Read elliptic solver arrays C CALL read2 numrst gcx jpk 17 CALL read2 numrst gcxb jpk 18 C ifdef key_freesurf_cstvol C C free surface formulation eta C CALL read2 numrst etab jpk 4 CALL read2 numrst etan jpk 4 else C C Rigid lid formulation bsf C CALL read2 numrst bsfb jpk 4 CALL read2 numrst bsfn jpk 11 CALL read2 numrst bsfd jpk 16 endif C ifdef key_zdftke C C Read tke arrays C IF itke1 eq 1 THEN CALL read3 numrst en 19 ELSE IF lwp THEN WRITE numout : the previous restart file didnt used tke scheme WRITE numout ENDIF nrstdt 2 ENDIF endif C C RETURN END"); 96 a[94] = new Array("./ReadWrite/scanctl.html", "scanctl.pro", "", " GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be defined according to GLAMBOUNDARY PRO scanctl filename filesname jpt1file varsname varslev swapbytes bigendian littleendian f77sequential fileheader theader xyheader VARFMT varfmt _EXTRA ex common time1 systime 1 for key_performance DTYPE spawn grep i DTYPE filename notgood if keyword_set notgood then begin print This program is not adapted to data type station or grib Sorry stop endif UNDEF define valmask spawn grep i UNDEF filename valmask valmask strtrim valmask 2 valmask strsplit valmask 0 extract valmask float valmask 1 Headers spawn grep i FILEHEADER filename fileheader fileheader strtrim fileheader 2 if keyword_set fileheader then BEGIN fileheader strsplit fileheader 0 extract fileheader long fileheader 1 ENDIF ELSE fileheader 0L spawn grep i THEADER filename theader theader strtrim theader 2 if keyword_set theader then BEGIN theader strsplit theader 0 extract theader long theader 1 ENDIF ELSE theader 0L spawn grep i XYHEADER filename xyheader xyheader strtrim xyheader 2 if keyword_set xyheader then BEGIN xyheader strsplit xyheader 0 extract xyheader long xyheader 1 ENDIF ELSE xyheader 0L find the x axis spawn sed n e d e Xx Dd Ee Ff Yy Dd Ee Ff p filename xdef if xdef 0 EQ then BEGIN print Bad definition of xdef or ydef stop ENDIF xdef xdef 0:n_elements xdef 2 if n_elements xdef NE 1 then begin xdef byte xdef replicate byte 1 n_elements xdef xdef xdef where xdef NE 0 xdef string xdef endif xdef strtrim xdef 0 2 xdef strsplit xdef extract jpi long xdef 1 case strupcase xdef 2 of LINEAR :xaxis float xdef 3 findgen jpi float xdef 4 LEVELS :xaxis float xdef 3:n_elements xdef 1 ENDCASE find the y axis spawn sed n e d e Yy Dd Ee Ff Zz Dd Ee Ff p filename ydef if ydef 0 EQ then BEGIN print Bad definition of ydef or zdef stop ENDIF ydef ydef 0:n_elements ydef 2 if n_elements ydef NE 1 then begin ydef byte ydef replicate byte 1 n_elements ydef ydef ydef where ydef NE 0 ydef string ydef endif ydef strtrim ydef 0 2 ydef strsplit ydef extract jpj long ydef 1 case strupcase ydef 2 of LINEAR :yaxis float ydef 3 findgen jpj float ydef 4 LEVELS :yaxis float ydef 3:n_elements ydef 1 GAUST62 :BEGIN print Not yet coded stop END GAUSR15 :BEGIN print Not yet coded stop END GAUSR20 :BEGIN print Not yet coded stop END GAUSR30 :BEGIN print Not yet coded stop END GAUSR40 :BEGIN print Not yet coded stop END ELSE:BEGIN print Not yet coded stop END endcase find the z axis spawn sed n e d e Zz Dd Ee Ff Tt Dd Ee Ff p filename zdef if zdef 0 EQ then BEGIN print Bad definition of zdef or tdef stop ENDIF zdef zdef 0:n_elements zdef 2 if n_elements zdef NE 1 then begin zdef byte zdef replicate byte 1 n_elements zdef zdef zdef where zdef NE 0 zdef string zdef endif zdef strtrim zdef 0 2 zdef strsplit zdef extract jpk long zdef 1 case strupcase zdef 2 of LINEAR :zaxis float zdef 3 findgen jpk float zdef 4 LEVELS :zaxis float zdef 3:n_elements zdef 1 ENDCASE compute the grid computegrid xaxis xaxis yaxis yaxis zaxis zaxis _EXTRA ex domdef find the time axis spawn grep i TDEF filename timedef timedef strupcase strtrim timedef 2 timedef strsplit timedef 0 extract jpt long timedef 1 initial date: y0 m0 d0 h0 mn0 julian day of IDL: julady m0 d0 y0 h0 mn0 00 t0 timedef 3 monthsname string format C CMOA 31 indgen 12 case 1 OF h h :mmZd d mmmyy yy strpos t0 : NE 1:BEGIN pp strpos t0 : h0 long strmid t0 0 pp mn0 long strmid t0 pp 1 2 pp strpos t0 Z dd byte strmid t0 pp 2 1 LT byte A d0 long strmid t0 pp 1 1 dd m0 where monthsname EQ strmid t0 pp 2 dd 3 0 1 y0 long strmid t0 pp 5 dd END m m Zd d mmmyy yy strpos t0 Z NE 1:BEGIN h0 0 12 pp strpos t0 Z mn0 long strmid t0 0 pp dd byte strmid t0 pp 2 1 LT byte A d0 long strmid t0 pp 1 1 dd m0 where monthsname EQ strmid t0 pp 2 dd 3 0 1 y0 long strmid t0 pp 5 dd END d d mmmyy yy byte strmid t0 0 1 LT byte A 0 :BEGIN h0 0 12 mn0 0 dd byte strmid t0 1 1 LT byte A d0 long strmid t0 0 1 dd m0 where monthsname EQ strmid t0 1 dd 3 0 1 y0 long strmid t0 4 dd END mmmyy yy ELSE:BEGIN h0 0 12 mn0 0 d0 1 m0 where monthsname EQ strmid t0 0 3 0 1 y0 long strmid t0 3 END ENDCASE if y0 is a two digit integer between 1950 and 2049 case 1 of y0 LE 49:y0 2000 y0 y0 LE 99:y0 1900 y0 ELSE: ENDCASE increment date and definition of the calendar with IDL julian days tstep timedef 4 tsval long strmid tstep 0 strlen tstep 2 case strlowcase strmid tstep 1 reverse of mn :time julday m0 d0 y0 h0 mn0 lindgen jpt tsval 0 hr :time julday m0 d0 y0 h0 lindgen jpt tsval mn0 0 dy :time julday m0 d0 lindgen jpt tsval y0 h0 mn0 0 mo :time julday m0 lindgen jpt tsval d0 y0 h0 mn0 0 yr :time julday m0 d0 y0 lindgen jpt tsval h0 mn0 0 ENDCASE shit the calendar to correspond to the time step case strlowcase strmid tstep 1 reverse of dy :time long time mo :time long time 14L yr :time long time 365L 2 ELSE: endcase OPTIONS spawn grep i OPTIONS filename options options strtrim options 2 options strlowcase options 0 key_yreverse strpos options yrev NE 1 key_zreverse strpos options zrev EQ 1 multifiles strpos options template NE 1 f77sequential strpos options sequential NE 1 swapbytes strpos options byteswapped NE 1 bigendian strpos options big_endian NE 1 littleendian strpos options little_endian NE 1 cray strpos options cray_32bit_ieee NE 1 IF cray THEN BEGIN print cray_32bit_ieee Not yet coded stop ENDIF cal365 strpos options 365_day_calendar NE 1 IF cal365 THEN BEGIN print 365_day_calenda Not yet coded stop ENDIF building the filesname spawn grep i DSET filename files files strtrim files 0 2 files strsplit files extract if n_elements files NE 2 then begin print Bad definition of the filename There shoud be 2 elements: print DEST and 1 filename that may define many files stop endif files files 1 files strmid files 0 strpos files 0 reverse_search 1 filesname files if keyword_set multifiles then begin minutes if stregex files i n2 0 NE 1 then begin filetsep mn mnend long mn0 jpt 1 tmp strarr hend h0 1 for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i n2 extract regex string mn0 i format i2 2 filesname strjoin tmp endif hours if stregex files i hf 123 0 NE 1 then begin filetsep hr case strlowcase strmid tstep 1 reverse of mn :hend long h0 jpt mn0 1 1 60 hr :hend long h0 jpt 1 endcase tmp strarr hend h0 1 case 1 of stregex files i h1 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i h1 extract regex strtrim h0 i 1 stregex files i h2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i h2 extract regex string h0 i format i2 2 stregex files f2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname f2 extract regex string h0 i format i3 2 stregex files i hf 3 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i hf 3 extract regex string h0 i format i3 3 endcase filesname strjoin tmp endif days if stregex files i d 12 0 NE 1 then begin filetsep dy case strlowcase strmid tstep 1 reverse of mn :dend long d0 jpt mn0 1 1 1440 hr :dend long d0 jpt h0 1 1 24 dy :dend long d0 jpt 1 endcase tmp strarr dend d0 1 case 1 of stregex files i d1 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i d1 extract regex strtrim d0 i 1 stregex files i d2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i d2 extract regex string d0 i format i2 2 endcase filesname strjoin tmp endif months if stregex files i m 12c 0 NE 1 then begin filetsep mo tmp strarr 12 case 1 of stregex files i m1 NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i m1 extract regex strtrim i 1 stregex files i m2 NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i m2 extract regex string i format i2 2 stregex files i mc NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i mc extract regex monthsname i 1 endcase filesname strjoin tmp endif years if stregex files i y 24 0 NE 1 then begin case strlowcase strmid tstep 1 reverse of dy :yend long y0 jpt d0 1 1 365 mo :yend long y0 jpt m0 1 1 12 yr :yend long y0 jpt 1 ELSE:yend y0 endcase tmp strarr yend y0 1 case 1 of stregex files i y2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i y2 extract regex string y0 i 100 y0 i 100 format i2 2 stregex files i y4 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i y 4 extract regex string y0 i format i4 4 endcase filesname strjoin tmp endif filesname strsplit filesname extract time step unit of each file: case 1 of stregex files i n2 0 NE 1:filetsep mn stregex files i hf 123 0 NE 1:filetsep hr stregex files i d 12 0 NE 1:filetsep dy stregex files i m 12c 0 NE 1: filetsep mo stregex files i y 24 0 NE 1:filetsep yr ENDCASE number of time steps for each files case strlowcase strmid tstep 1 reverse of mn :BEGIN case filetsep of yr :jpt1file 60L 24L 365L mo :jpt1file 60L 24L 30L dy :jpt1file 60L 24L hr :jpt1file 60L mn :jpt1file 1L endcase END hr :BEGIN case filetsep of yr :jpt1file 24L 365L mo :jpt1file 24L 30L dy :jpt1file 24L hr :jpt1file 1L endcase END dy :BEGIN case filetsep of yr :jpt1file 365L mo :jpt1file 30L dy :jpt1file 1L endcase END mo :BEGIN case filetsep of yr :jpt1file 12L mo :jpt1file 1L endcase END yr :jpt1file 1L endcase number of files nof ceil jpt 1 jpt1file filesname filesname 0:nof 1 ENDIF ELSE BEGIN nof 1 jpt1file jpt ENDELSE first character if stregex files GE 0 THEN BEGIN iodir strmid filename 0 strpos filename reverse_search 1 for i 0 nof 1 do filesname i iodir strmid filesname i 1 ENDIF extracting the variables spawn grep i VARS filename nvars nvars strtrim nvars 2 nvars strsplit nvars 0 extract nvars long nvars 1 spawn sed n e d e Vv Aa Rr Ss Ee Nn Dd Vv Aa Rr Ss p filename varlist if n_elements varlist LE 2 then begin print No lines between vars and endvars stop endif varlist varlist 1:n_elements varlist 2 if n_elements varlist NE nvars then begin print Number of variables indicated by VARS strtrim nvars 1 differs from number of lines without at the beginning located between VARS and ENDVARS: strtrim n_elements varlist 1 stop ENDIF varsname strarr nvars varsdes strarr nvars varslev lonarr nvars for i 0 nvars 1 do BEGIN varlist i strtrim varlist i 2 tmp strsplit varlist i extract if strmid tmp 2 0 2 EQ 1 then BEGIN case long strmid tmp 2 3 2 of 10:BEGIN print Special data formats units 1 10 Not yet coded stop END 20:BEGIN print Special data formats units 1 20 Not yet coded stop END 30:BEGIN print Special data formats units 1 30 Not yet coded stop END 40:BEGIN case long strmid tmp 2 6 of 1:varfmt byte 2:varfmt uint 2:varfmt int 4:varfmt long ELSE:BEGIN print Bad definition of the special data formats: print long strmid tmp 2 6 should be equal to 1 2 2 or 4 stop END endcase END ELSE:BEGIN print Special data formats units 1 Not yet coded stop END endcase endif varsname i tmp 0 varsdes i strjoin tmp 3:n_elements tmp 1 varslev i long tmp 1 ENDFOR varslev 1 varslev ccmeshparameters filename filename ccmeshparameters filename Grads IF keyword_set key_performance EQ 1 THEN print time scanctl systime 1 time1 return end "); 97 a[95] = new Array("./ReadWrite/scanoasis.html", "scanoasis.pro", "", " NAME:scanoasis PURPOSE:scan an Oasis file version scanoasis grids_orca_t106 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 PRO scanoasis filename openr unit filename F77_UNFORMATTED GET_LUN SWAP_IF_LITTLE_ENDIAN error err if err ne 0 then begin print err_string return endif char8 12345678 WHILE NOT EOF unit DO BEGIN readu unit char8 print char8 readu unit ENDWHILE free_lun unit return end"); 98 a[96] = new Array("./ReadWrite/write_oasis.html", "write_oasis.pro", "", " NAME:write_oasis PURPOSE:write an Oasis file version 2 5 CATEGORY: CALLING SEQUENCE:write_oasis filename varname z2d INPUTS: filename:the filename varname: the name of the variable to be written z2d: the variable 2D array to be written KEYWORD PARAMETERS: I2 I4 I8 R4: to change the defaut format R8 of the data to be written APPEND: to open the file with the file pointer at the end of the file ready for data to be appended OUTPUTS: COMMON BLOCKS: SIDE EFFECTS:varname is automatically written as a charactere 8 by defaut z2d is written as an R8 array RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 PRO write_oasis filename varname z2d I2 I4 i4 I8 i8 R4 r4 APPEND append openw unit filename F77_UNFORMATTED GET_LUN SWAP_IF_LITTLE_ENDIAN error err APPEND append if err ne 0 then begin print err_string return endif writeu unit string varname format a8 case 1 of keyword_set i2 :writeu unit fix z2d keyword_set i4 :writeu unit long z2d keyword_set i8 :writeu unit long64 z2d keyword_set r4 :writeu unit float z2d ELSE:writeu unit double z2d endcase free_lun unit return end"); 99 a[97] = new Array("./ReadWrite/writebat.html", "writebat.pro", "", " NAME: writebat PURPOSE: write the bathymetry ASCII file of OPA CATEGORY: for OPA CALLING SEQUENCE: writebat bat filename INPUTS: bat: the bathymetry a 2d array filename: a string containing the filename KEYWORD PARAMETERS: OUTPUTS:no COMMON BLOCKS:no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr Sept 30 2003 based on batsav2 pro written by Maurice Imbard March 17 1998 PRO writebat zbat filename basic checks IF n_params NE 2 THEN BEGIN print bad number of aguments in the call of writebat return ENDIF IF size filename type NE 7 THEN BEGIN print the filename should be a string return ENDIF sbat size zbat IF sbat 0 NE 2 THEN BEGIN print bathymetry array should be 2d array return ENDIF jpi2 sbat 1 jpj2 sbat 2 parameters def ifreq 40 ifin jpi2 ifreq 1 irest jpi2 ifin 1 ifreq zbati intarr ifreq zbati2 intarr irest i0 intarr ifreq 5 i1 intarr max 1 irest 5 openw iunit filename get_lun fill the file printf iunit FORMAT 1x bathy IDL 2i8 jpi2 jpj2 printf iunit FORMAT il1 0 FOR jn 1 ifin 1 DO BEGIN printf iunit FORMAT il2 min jpi2 1 il1 ifreq 1 i0 0 il1 1 FOR jj 1 ifreq 5 1 DO BEGIN i0 jj i0 jj 1 5 END printf iunit FORMAT 3x 13 i3 12x i0 printf iunit FORMAT il3 il2 jn 1 ifreq iformat string il3 2 i3 FOR jj jpj2 1 0 1 DO BEGIN zbati 0:il3 zbat il1:il2 jj printf iunit FORMAT iformat jj 1 zbati END il1 il1 ifreq END printf iunit FORMAT il2 min jpi2 1 il1 ifreq 1 i1 0 il1 1 FOR jj 1 irest 5 1 DO BEGIN i1 jj i1 jj 1 5 END printf iunit FORMAT 3x 13 i3 12x i1 printf iunit FORMAT il3 il2 ifin 1 ifreq iformat string il3 2 i3 FOR jj jpj2 1 0 1 DO BEGIN zbati2 0:irest 1 0 zbati2 0:il3 zbat il1:il2 jj printf iunit FORMAT iformat jj 1 zbati2 END end close iunit free_lun iunit return end"); 100 a[98] = new Array("./Tests/TestsOld/tst_basic_old.html", "tst_basic_old.pro", "", "PRO tst_basic_old figure 1: basics plots 1 plot n 10 y findgen n basic plot splot y petit 2 2 1 portrait improved plot by using plot and graphic keywords splot y petit 2 2 2 noerase yrange 0 n 1 2 title x and x 2 oplot y 2 color 100 linestyle 2 thick 3 2 contour z dist n basic plot scontour z fill nlevels 15 petit 2 2 3 noerase improved plot by using contour and graphic keywords ind findgen 2 n 2 n scontour z levels n ind c_orientation 180 ind c_spacing 2 ind petit 2 2 4 noerase contour z overplot c_label rebin 1 0 2 n levels n ind c_charthick 2 c_charsize 1 5 c_colors 250 ind return end"); 101 a[99] = new Array("./Tests/TestsOld/tst_initlev_index_old.html", "tst_initlev_index_old.pro", "", ""); 102 a[100] = new Array("./Tests/TestsOld/tst_initlev_index_stride_old.html", "tst_initlev_index_stride_old.pro", "", ""); 103 a[101] = new Array("./Tests/TestsOld/tst_initlev_old.html", "tst_initlev_old.pro", "", ""); 104 a[102] = new Array("./Tests/TestsOld/tst_initlev_stride_old.html", "tst_initlev_stride_old.pro", "", ""); 105 a[103] = new Array("./Tests/TestsOld/tst_initorca05_index_old.html", "tst_initorca05_index_old.pro", "", ""); 106 a[104] = new Array("./Tests/TestsOld/tst_initorca05_index_stride_old.html", "tst_initorca05_index_stride_old.pro", "", ""); 107 a[105] = new Array("./Tests/TestsOld/tst_initorca05_old.html", "tst_initorca05_old.pro", "", ""); 108 a[106] = new Array("./Tests/TestsOld/tst_initorca05_short_old.html", "tst_initorca05_short_old.pro", "", ""); 109 a[107] = new Array("./Tests/TestsOld/tst_initorca05_short_stride_old.html", "tst_initorca05_short_stride_old.pro", "", ""); 110 a[108] = new Array("./Tests/TestsOld/tst_initorca05_stride_old.html", "tst_initorca05_stride_old.pro", "", ""); 111 a[109] = new Array("./Tests/TestsOld/tst_initorca2_index_old.html", "tst_initorca2_index_old.pro", "", ""); 112 a[110] = new Array("./Tests/TestsOld/tst_initorca2_index_stride_old.html", "tst_initorca2_index_stride_old.pro", "", ""); 113 a[111] = new Array("./Tests/TestsOld/tst_initorca2_old.html", "tst_initorca2_old.pro", "", ""); 114 a[112] = new Array("./Tests/TestsOld/tst_initorca2_short_old.html", "tst_initorca2_short_old.pro", "", ""); 115 a[113] = new Array("./Tests/TestsOld/tst_initorca2_short_stride_old.html", "tst_initorca2_short_stride_old.pro", "", ""); 116 a[114] = new Array("./Tests/TestsOld/tst_initorca2_stride_old.html", "tst_initorca2_stride_old.pro", "", ""); 117 a[115] = new Array("./Tests/TestsOld/tst_plt_old.html", "tst_plt_old.pro", "", "PRO tst_plt IMAGE image commons common figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 domdef domdef gdept 0 gdept 0 grille T temp read_ncdf votemper 00101 00131 file file plt temp landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 5 nocontour format i3 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 color_c if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 nocouleur c_thick 1 cont_thick 2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp cell_fill 1 jpi EQ 180 we must use cell_fill 2 for ORCA2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 zoom IF key_onearth THEN box 40 375 20 20 ELSE box jpi 4 3 jpi 4 jpj 4 3 jpj 4 plt temp boite box landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 projections IF key_onearth THEN BEGIN plt temp boite 20 380 60 90 stereo map 90 0 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp boite 20 380 90 50 ortho map 90 180 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp ortho map 0 0 21 portrait carte if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 ENDIF deep plot domdef 150 150 warning message domdef gdept jpk 2 gdept jpk 2 grille T temp read_ncdf votemper 00101 00131 file file plt temp carte 2 key_onearth land if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 118 a[116] = new Array("./Tests/TestsOld/tst_pltt_old.html", "tst_pltt_old.pro", "", "PRO tst_pltt IMAGE image commons common common figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 1 1 xt plot IF key_onearth THEN domdef 20 380 1 1 0 gdept 0 ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 gdept 0 temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab help jpt time pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocontour if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp color_c if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocouleur if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 equatorial plot IF key_onearth THEN BEGIN a abs gphit 0 yind where a EQ min a domdef 20 380 yind 0 yind n_elements yind 1 gdept 10 jpk 1 gdept 10 jpk 1 grille T yindex ENDIF ELSE BEGIN domdef min glamt max glamf jpj 2 jpj 2 gdept 10 jpk 1 gdept 10 jpk 1 grille T yindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 gdept 0 gdept 0 grille T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif gdept 0 gdept 0 grille T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 119 a[117] = new Array("./Tests/TestsOld/tst_pltz_old.html", "tst_pltz_old.pro", "", "PRO tst_pltz IMAGE image commons common IF jpk EQ 1 THEN return dummy cnt 1 CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return IF key_onearth THEN domdef 20 380 1 1 0 max gdept ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 max gdept temp read_ncdf votemper 00101 00131 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltz temp portrait if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocontour if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait color_c if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocouleur if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 ysurx 2 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 ysurx 2 hzsurht 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 0 max gdept grille T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif 0 max gdept grille T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file pltz temp boite 6000 zoom 1000 ysurx 2 hzsurht 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 oblique sections IF key_onearth THEN endpoints 110 45 290 45 ELSE endpoints jpi 6 jpj 3 5 jpi 6 2 jpj 3 domdef endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 false oblique sections IF key_onearth THEN endpoints 180 70 180 90 ELSE endpoints jpi 2 0 25 0 25 jpi 2 0 25 jpj domdef 6000 endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boite 6000 zoom 1000 ysurx 2 hzsurht 5 showbuild if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 comparison between real section and false oblique sections IF where gphit EQ 0 0 NE 1 THEN BEGIN IF key_onearth THEN box 20 380 0 0 0 6000 ELSE box 0 jpi 1 jpj 2 jpj 2 0 6000 domdef box grille T temp read_ncdf votemper 00101 00131 file file pltz temp boite 6000 portrait petit 1 2 1 zoom 500 hzsurht 5 IF key_onearth THEN endpoints 20 0 380 0 ELSE endpoints 0 jpj 2 jpi 1 jpj 2 domdef 6000 endpoints endpoints type pltz grille T temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boite 6000 zoom 500 hzsurht 5 petit 1 2 2 noerase if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png cnt cnt 1 ENDIF return end"); 120 a[118] = new Array("./Tests/tst_basic.html", "tst_basic.pro", "", "PRO tst_basic figure 1: basics plots 1 plot n 10 y findgen n basic plot splot y small 2 2 1 portrait improved plot by using plot and graphic keywords splot y small 2 2 2 noerase yrange 0 n 1 2 title x and x 2 oplot y 2 color 100 linestyle 2 thick 3 2 contour z dist n basic plot scontour z fill nlevels 15 small 2 2 3 noerase improved plot by using contour and graphic keywords ind findgen 2 n 2 n scontour z levels n ind c_orientation 180 ind c_spacing 2 ind small 2 2 4 noerase contour z overplot c_label rebin 1 0 2 n levels n ind c_charthick 2 c_charsize 1 5 c_colors 250 ind return end"); 121 a[119] = new Array("./Tests/tst_initlev.html", "tst_initlev.pro", "", ""); 122 a[120] = new Array("./Tests/tst_initlev_index.html", "tst_initlev_index.pro", "", ""); 123 a[121] = new Array("./Tests/tst_initlev_index_stride.html", "tst_initlev_index_stride.pro", "", ""); 124 a[122] = new Array("./Tests/tst_initlev_stride.html", "tst_initlev_stride.pro", "", ""); 125 a[123] = new Array("./Tests/tst_initorca05.html", "tst_initorca05.pro", "", ""); 126 a[124] = new Array("./Tests/tst_initorca05_index.html", "tst_initorca05_index.pro", "", ""); 127 a[125] = new Array("./Tests/tst_initorca05_index_stride.html", "tst_initorca05_index_stride.pro", "", ""); 128 a[126] = new Array("./Tests/tst_initorca05_short.html", "tst_initorca05_short.pro", "", ""); 129 a[127] = new Array("./Tests/tst_initorca05_short_stride.html", "tst_initorca05_short_stride.pro", "", ""); 130 a[128] = new Array("./Tests/tst_initorca05_stride.html", "tst_initorca05_stride.pro", "", ""); 131 a[129] = new Array("./Tests/tst_initorca2.html", "tst_initorca2.pro", "", ""); 132 a[130] = new Array("./Tests/tst_initorca2_index.html", "tst_initorca2_index.pro", "", ""); 133 a[131] = new Array("./Tests/tst_initorca2_index_stride.html", "tst_initorca2_index_stride.pro", "", ""); 134 a[132] = new Array("./Tests/tst_initorca2_short.html", "tst_initorca2_short.pro", "", ""); 135 a[133] = new Array("./Tests/tst_initorca2_short_stride.html", "tst_initorca2_short_stride.pro", "", ""); 136 a[134] = new Array("./Tests/tst_initorca2_stride.html", "tst_initorca2_stride.pro", "", ""); 137 a[135] = new Array("./Tests/tst_plt.html", "tst_plt.pro", "", "PRO tst_plt IMAGE image commons cm_4mesh figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 domdef domdef gdept 0 gdept 0 gridtype T temp read_ncdf votemper 00101 00131 file file plt temp landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 5 nocontour format i3 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 color_c if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 nofill c_thick 1 coast_thick 2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp cell_fill 1 jpi EQ 180 we must use cell_fill 2 for ORCA2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 zoom IF key_onearth THEN box 40 375 20 20 ELSE box jpi 4 3 jpi 4 jpj 4 3 jpj 4 plt temp boxzoom box landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 projections IF key_onearth THEN BEGIN plt temp boxzoom 20 380 60 90 stereo map 90 0 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp boxzoom 20 380 90 50 ortho map 90 180 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp ortho map 0 0 21 portrait realcont if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 ENDIF deep plot domdef 150 150 warning message domdef gdept jpk 2 gdept jpk 2 gridtype T temp read_ncdf votemper 00101 00131 file file plt temp realcont 2 key_onearth land if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 138 a[136] = new Array("./Tests/tst_pltt.html", "tst_pltt.pro", "", "PRO tst_pltt IMAGE image commons cm_4mesh cm_4cal figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 1 1 xt plot IF key_onearth THEN domdef 20 380 1 1 0 gdept 0 ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 gdept 0 temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab help jpt time pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocontour if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp color_c if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nofill if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 equatorial plot IF key_onearth THEN BEGIN a abs gphit 0 yind where a EQ min a domdef 20 380 yind 0 yind n_elements yind 1 gdept 10 jpk 1 gdept 10 jpk 1 gridtype T yindex ENDIF ELSE BEGIN domdef min glamt max glamf jpj 2 jpj 2 gdept 10 jpk 1 gdept 10 jpk 1 gridtype T yindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 gdept 0 gdept 0 gridtype T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif gdept 0 gdept 0 gridtype T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 139 a[137] = new Array("./Tests/tst_pltz.html", "tst_pltz.pro", "", "PRO tst_pltz IMAGE image commons cm_4mesh IF jpk EQ 1 THEN return dummy cnt 1 CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return IF key_onearth THEN domdef 20 380 1 1 0 max gdept ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 max gdept temp read_ncdf votemper 00101 00131 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltz temp portrait if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocontour if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait color_c if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nofill if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 yxaspect 2 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 0 max gdept gridtype T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif 0 max gdept gridtype T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file pltz temp boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 oblique sections IF key_onearth THEN endpoints 110 45 290 45 ELSE endpoints jpi 6 jpj 3 5 jpi 6 2 jpj 3 domdef endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 false oblique sections IF key_onearth THEN endpoints 180 70 180 90 ELSE endpoints jpi 2 0 25 0 25 jpi 2 0 25 jpj domdef 6000 endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 showbuild if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 comparison between real section and false oblique sections IF where gphit EQ 0 0 NE 1 THEN BEGIN IF key_onearth THEN box 20 380 0 0 0 6000 ELSE box 0 jpi 1 jpj 2 jpj 2 0 6000 domdef box gridtype T temp read_ncdf votemper 00101 00131 file file pltz temp boxzoom 6000 portrait small 1 2 1 zoom 500 zratio 5 IF key_onearth THEN endpoints 20 0 380 0 ELSE endpoints 0 jpj 2 jpi 1 jpj 2 domdef 6000 endpoints endpoints type pltz gridtype T temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boxzoom 6000 zoom 500 zratio 5 small 1 2 2 noerase if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png cnt cnt 1 ENDIF return end"); 140 a[138] = new Array("./Textoidl/matchdelim.html", "matchdelim.pro", "", " NAME: MATCHDELIM PURPOSE: Match open close delimiters in a string CATEGORY: text strings CALLING SEQUENCE: position matchdelim strn openpos INPUTS: strn a string containing an open in delimiter e g in which you want to find the matching closing delimiter e g KEYWORD PARAMETERS: OPEN_DELIM A single character containing the opening in delimiter e g Default is CLOSE_DELIM A single character containing the closing in delimiter e g Default is OUTPUTS: position returns the position in strn of the out closing delimiter 1 if no closing found openpos Set to a named variable to receive the out position of the first opening delimiter Optional COMMON BLOCKS: SIDE EFFECTS: NOTES: Any pair of nonidentical characters can be used as delimiters EXAMPLE: matchdelim one two three returns 9 the character just before three MODIFICATION HISTORY: Id: matchdelim pro 47 2006 05 09 09:13:01Z pinsard Log: matchdelim pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Removed restriction that open delim must be first char Added argument to allow for return of position of open delim Revision 1 1 1996 01 31 18:41:06 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Matchdelim InString OpenPos OPEN_DELIM OpenDelim CLOSE_DELIM CloseDelim HELP Help Return to caller if error On_error 2 IF n_params LT 1 OR keyword_set Help THEN BEGIN offset print offset Match open close delimiters in a string print offset position matchdelim strn openpos print offset Inputs: print offset offset strn a string containing an open in print offset offset delimiter e g in which you print offset offset want to find the matching closing print offset offset delimiter e g print offset Keywords: print offset offset OPEN_DELIM A single character containing the opening in print offset offset delimiter e g Default is print offset offset CLOSE_DELIM A single character containing the closing in print offset offset delimiter e g Default is print offset Outputs: print offset offset position returns the position in strn of the out print offset offset closing delimiter 1 if no closing found print offset offset openpos Set to a named variable to receive the out print offset offset position of the first opening delimiter print offset offset Optional print offset Example: print offset offset matchdelim a one two three returns 10 the character just print offset offset before three print offset offset a matchdelim aaa bbb ccc ddd eee f OP CL print offset offset returns a 12 just before ddd f 3 just before bbb return 1 ENDIF Set default delimiters IF n_elements OpenDelim EQ 0 THEN OpenDelim IF n_elements CloseDelim EQ 0 THEN CloseDelim Make sure InString has more than 1 character length strlen InString IF length LE 1 THEN return 1 Return if no open delimiter OpenPos strpos InString OpenDelim IF OpenPos EQ 1 THEN BEGIN print Error: No opening delimiter return 1 ENDIF Convert strings to array of integers to speed processing OpenDelim fix byte OpenDelim 0 CloseDelim fix byte CloseDelim 0 TmpStr fix byte strmid InString OpenPos length Leave the 1 in here This forces conversion from BYTE to INTEGER necessary because there are no negative BYTEs TmpStr TmpStr EQ OpenDelim 1 TmpStr EQ CloseDelim length n_elements TmpStr Initialize count of number of delimiters We ve found one the first opener BraceCnt 1 i 0 WHILE BraceCnt GT 0 AND i LT length 1 DO BEGIN i i 1 BraceCnt BraceCnt TmpStr i ENDWHILE i i OpenPos IF BraceCnt GT 0 THEN i 1 return i END "); 141 a[139] = new Array("./Textoidl/nexttok.html", "nexttok.pro", "", " NAME: NEXTTOK PURPOSE: Find the next occurance of any of a set of characters in a string and return the character which occurs next CATEGORY: text strings CALLING SEQUENCE: tok nexttok strn tokens INPUTS: strn string to be searched for sub superscripts in tokens string containing characters to be found in KEYWORD PARAMETERS: POSITION Set to a named variable to get position out of next token or 1 if none found HELP Print useful message and exit OUTPUTS: tok Contains the character among tokens which out occurs next in strn or null if none found COMMON BLOCKS: SIDE EFFECTS: NOTES: EXAMPLE: nexttok x 2 N_j 3 _ position pos returns and sets pos to 1 MODIFICATION HISTORY: Id: nexttok pro 47 2006 05 09 09:13:01Z pinsard Log: nexttok pro v Revision 1 4 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Generalized so that the next occurence of any of a set of characters will be returned Revision 1 1 1996 01 31 18:41:06 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION nexttok strn tokens POSITION position HELP Help Return to caller on error On_error 2 Help those in need of it IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Find the next occurance of any of a set of characters in a print offset string and return the character which occurs next CALLING SEQUENCE: print offset tok nexttok strn tokens INPUTS: print offset Inputs: print offset offset strn string to be searched for sub superscripts in print offset offset tokens string containing characters to be found in KEYWORD PARAMETERS: print offset Keywords: print offset offset POSITION Set to a named variable to get position out print offset offset of next token or 1 if none found print offset offset HELP Print useful message and exit OUTPUTS: print offset Outputs: print offset offset tok Contains the character among tokens which out print offset offset occurs next in strn or null if none found EXAMPLE: print offset Example: print offset offset nexttok x 2 N_j 3 _ position pos returns and sets print offset offset pos to 1 return ENDIF TmpStr byte strn TmpTok byte tokens NumToks n_elements TmpTok MatchIdx 0L Matches 0L FOR j 0 NumToks 1 DO BEGIN TmpMatch where TmpStr EQ TmpTok j TmpCnt IF TmpCnt GT 0 THEN BEGIN MatchIdx MatchIdx Replicate j TmpCnt Matches Matches TmpMatch ENDIF ENDFOR IF n_elements MatchIdx EQ 1 THEN BEGIN Position 1 return ENDIF MatchIdx MatchIdx 1: Matches Matches 1: SortInd sort Matches Position Matches SortInd 0 Tok string TmpTok MatchIdx SortInd 0 return Tok END "); 142 a[140] = new Array("./Textoidl/showtex.html", "showtex.pro", "", " NAME: SHOWTEX PURPOSE: Display TeX sequence translation table on current graphics device CATEGORY: text strings CALLING SEQUENCE: showtex INPUTS: KEYWORD PARAMETERS: HELP print out info on use of the function and exit FONT Set to 0 to use hardware font 1 to use vector Note that the only hardware font supported is Postscript OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: Plot is created NOTES: Hardware fonts are supported only for device PS PostScript EXAMPLE: MODIFICATION HISTORY: Id: showtex pro 47 2006 05 09 09:13:01Z pinsard Log: showtex pro v Revision 1 4 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added error handling and updated built in help Revision 1 1 1996 02 08 18:55:12 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details PRO Showtex FONT fnt HELP help Return to caller on error On_error 2 Print help if needed IF keyword_set help THEN BEGIN print Display TeX sequence translation table on current graphics device print showtex print Keywords: print HELP print this message and return print FONT set to 0 to use hardware fonts for current device print 1 to use vector fonts DEFAULT print NOTES: The only hardware font supported is PostScript print The FONT keyword overrides the font selected in p font return ENDIF We begin by deciding on the font PostScript 0 means use vector PostScript 0 PlotTitle Vector Fonts IF n_elements fnt EQ 0 THEN BEGIN get font from p font IF P font NE 1 THEN BEGIN User wants hardware font PostScript 1 PlotTitle PostScript Fonts ENDIF ENDIF ELSE BEGIN get font from FONT keyword IF fnt NE 1 THEN BEGIN PostScript 1 PlotTitle PostScript Fonts ENDIF ENDELSE Bomb out if user wants hardware font for non PostScript device IF PostScript EQ 1 AND strupcase D name NE PS THEN BEGIN Device isn t postscript and user wants hardware font Not good print Warning: No translation for device: D name return ENDIF Set P font to value indicated by FONT keyword saving surrent setting to reset at end OldPFont p font p font PostScript 1 erase seq textoidl tex DisplayString seq textoidl seq nseq n_elements seq nrows nseq 5 1 Five sequences per row dx 9 5 dy 9 nrows y 95 xyouts 5 y PlotTitle align 5 norm size 2 5 count 0 FOR i 1L nrows DO BEGIN y y dy x 1 FOR j 1 5 DO BEGIN IF count LT nseq THEN xyouts x y DisplayString count align 5 norm count count 1 x x dx ENDFOR ENDFOR Restore old P font p font OldPFont END"); 143 a[141] = new Array("./Textoidl/str_token.html", "str_token.pro", "", " NAME: STR_TOKEN PURPOSE: Retrieve portion of string up to token CATEGORY: text strings CALLING SEQUENCE: new str_token old token INPUTS: old String to be split Contains text after in out token on output token Token to use in splitting old in KEYWORD PARAMETERS: TRIM set to remove leading blanks from old before returning HELP print useful message and exit OUTPUTS: new portion of string up to token out old portion of old after token out in COMMON BLOCKS: SIDE EFFECTS: Input parameter old is modified NOTES: Token may be one or more characters If token is not found returns old and sets old to EXAMPLE: If old is foo44 bar then str_token old 44 would return foo and upon return old will be left with bar If TRIM were set old would be bar on return If old xyz then new str_token old a would return with new xyz and old THANKS: To D Linder who wrote GETTOK part of the goddard library upon which this is based MODIFICATION HISTORY: Id: str_token pro v 1 1 2000 06 14 19:09:22 mcraig Exp Log: str_token pro v Revision 1 1 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added built in help Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Str_token string token TRIM trim HELP Help Back to the caller if error occurs On_error 2 IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Retrieve portion of string up to token print offset new str_token old token print offset Inputs: print offset offset old String to be split Contains text after in out print offset offset token on output print offset offset token Token to use in splitting old in print offset Keywords: print offset offset TRIM set to remove leading blanks from old print offset offset before returning print offset offset HELP print useful message and exit print offset Outputs: print offset offset new portion of string up to token out print offset offset old portion of old after token out in print offset Side effects: print offset offset Input parameter old is modified print offset Notes: print offset offset Token may be one or more characters print offset offset If token is not found returns old and sets old to print offset Examples: print offset offset If old is foo44 bar then str_token old 44 would return print offset offset foo and upon return old will be left with bar If TRIM print offset offset were set old would be bar on return print offset offset If old xyz then new str_token old a would return with print offset offset new xyz and old return 1 ENDIF pos strpos string token IF pos GE 0 THEN BEGIN front strmid string 0 pos string strmid string pos strlen token strlen string IF keyword_set trim THEN string strtrim string 1 return front ENDIF front string string return front END "); 144 a[142] = new Array("./Textoidl/strcnt.html", "strcnt.pro", "", " NAME: STRCNT PURPOSE: Count number of occurrences of a substring in a string CATEGORY: text strings CALLING SEQUENCE: num strcnt strn substring pos INPUTS: string The string in which to count occurences in substring The substring to count occurrences of in pos the position at which to begin the search in If not supplied start at beginning of string KEYWORD PARAMETERS: HELP Print useful message and return OUTPUTS: num Number of occurances of substring in string out COMMON BLOCKS: SIDE EFFECTS: NOTES: Overlapping occurances are not counted separately For example counting occurances of bb in blah bbb returns one occurance EXAMPLE: MODIFICATION HISTORY: Id: strcnt pro v 1 3 1996 06 14 20:00:27 mcraig Exp Log: strcnt pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added fast processing using BYTE arrays if we are counting occurences of a single character Added error handling Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strcnt strn substrn startpos HELP Help Return to caller if error On_error 2 Help user if needed IF n_params LT 2 OR keyword_set Help THEN BEGIN offset print offset Count number of occurrences of a substring in a string print offset num strcnt strn substring pos print offset Inputs: print offset offset string The string in which to count occurences in print offset offset substring The substring to count occurrences of in print offset offset pos the position at which to begin the search in print offset offset If not supplied start at beginning of print offset offset string print offset Keywords: print offset offset HELP Print useful message and return print offset Outputs: print offset offset num Number of occurances of substring in string out return 1 ENDIF IF n_params EQ 2 THEN startpos 0 return if we weren t really given a substring to search for IF strlen substrn EQ 0 THEN BEGIN print Error: Can t count occurances of null string return 1 ENDIF or if we were told to start at the end of the string tmpstrn strmid strn startpos strlen strn IF strlen tmpstrn EQ 0 THEN return 0 If looking for occurences of single character process using BYTE array IF strlen substrn EQ 1 THEN BEGIN tmpstrn byte TmpStrn count n_elements where TmpStrn EQ byte substrn 0 ENDIF ELSE BEGIN count 0L pos rstrpos tmpstrn substrn WHILE pos GE 0 DO BEGIN count count 1 pos rstrpos tmpstrn substrn pos ENDWHILE ENDELSE return count END "); 145 a[143] = new Array("./Textoidl/strtrans.html", "strtrans.pro", "", " NAME: STRTRANS PURPOSE: Translate all occurences of one substring to another CATEGORY: text strings CALLING SEQUENCE: new strtrans oldstr from to ned INPUTS: oldstr string on which to operate in May be an array from substrings to be translated May be in an array to what strings in from should be in translated to May be an array KEYWORD PARAMETERS: HELP Set this to print useful message and exit OUTPUTS: new Translated string Array if oldstr is out an array ned number of substitutions performed in out oldstr Array if oldstr is an array COMMON BLOCKS: SIDE EFFECTS: NOTES: Any of old from and to can be arrays from and to must have the same number of elements EXAMPLE: inp Many bad chars in_here from _ to out strtrans inp from to ned Will produce out Many bad chars in here and set ned to 4 MODIFICATION HISTORY: Id: strtrans pro v 1 7 2004 06 15 17:25:54 mcraig Exp Log: strtrans pro v Revision 1 7 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 6 2004 01 11 01:49:00 mcraig Changed format of one array to newer style to avoidf conflict with function name in astro library Revision 1 5 2001 11 23 21:14:35 mcraig Added keywords EXTRACT PRESERVE_NULL REGEX to call to strsplit This comes very close to reproducing the behavior of the obsolete routine str_sep Revision 1 4 2001 11 21 19:13:23 mcraig Changed str_sep to strsplit The former is now considered obsolete by RSI Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Sped up significantly by using str_sep to handle the translation No longer relies on routines fromother user libraries Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION strtrans InputString from to ned HELP Help Bomb out to caller if error On_error 2 Offer help if we don t have at least InputString from and to or if the user asks for it IF n_params LT 3 OR keyword_set help THEN BEGIN offset print offset Translate all occurences of one substring to another print offset new strtrans oldstr from to ned print offset Inputs: print offset offset oldstr string on which to operate in print offset offset May be an array print offset offset from substrings to be translated May be in print offset offset an array print offset offset to what strings in from should be in print offset offset translated to May be an array print offset Outputs: print offset offset new Translated string Array if oldstr is out print offset offset an array print offset offset ned number of substitutions performed in out print offset offset oldstr Array if oldstr is an array print offset Notes: print offset offset Any of old from and to can be arrays print offset offset from and to must have the same number of elements return 1 ENDIF strn InputString Check that From To have same number of elements RETURN if they don t NFrom n_elements from NTo n_elements to IF NFrom EQ 0 OR NTo EQ 0 THEN return strn IF NFrom NE NTo THEN BEGIN print Error: Number of elements in from to unequal return 1 ENDIF Make sure there are no null strings in From RETURN if there are FromLen strlen From IF total FromLen EQ 0 GT 0 THEN BEGIN print Error: elements of From must have nonzero length return 1 ENDIF NStrings n_elements strn ned lonarr NStrings tmpned 0L Say strn a b c from and to Then the approach here is to first split strn at all occurances of then recombine the pieces with inserted instead Do this for all elements of strn and all elements of from FOR i 0L NStrings 1 DO BEGIN ned i 0L FOR j 0L NFrom 1 DO BEGIN SepStr strsplit strn i from j EXTRACT REGEX PRESERVE_NULL NSubs n_elements SepStr 1 strn i SepStr 0 FOR k 1L NSubs DO strn i strn i To j SepStr k ned i ned i NSubs ENDFOR ENDFOR return strn END "); 146 a[144] = new Array("./Textoidl/sub_sup_idl.html", "sub_sup_idl.pro", "", " NAME: SUB_SUP_IDL PURPOSE: Return the proper IDL font positioning command for TeX sub superscripts CATEGORY: CALLING SEQUENCE: fnt sub_sup_idl strn INPUTS: strn Either or _ the TeX super subscript in characters KEYWORD PARAMETERS: FORCE_UD Set this to use U D instead of E I for sub superscripts OUTPUTS: fnt Either U or E for superscripts out or D or I for subscripts COMMON BLOCKS: SIDE EFFECTS: NOTES: EXAMPLE: LIBRARY FUNCTIONS CALLED: MODIFICATION HISTORY: Id: sub_sup_idl pro v 1 1 1996 01 31 18:47:37 mcraig Exp Log: sub_sup_idl pro v Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 FUNCTION Sub_sup_idl token FORCE_UD force_ud IF keyword_set force_ud THEN BEGIN IF token EQ THEN return U IF token EQ _ THEN return D return ENDIF ELSE BEGIN IF token EQ THEN return E IF token EQ _ THEN return I return ENDELSE END "); 147 a[145] = new Array("./Textoidl/textable.html", "textable.pro", "", " NAME: TEXTABLE PURPOSE: Returns a translation table from TeX to IDL CATEGORY: text strings CALLING SEQUENCE: table textable INPUTS: None KEYWORD PARAMETERS: POSTSCRIPT If set return postscript translation table rather than vector fonts table Default is translations for vector fonts HELP Print help and exit OUTPUTS: table a 2D text array table 0 contains out the words to be translated away table 1 contains the words to translate them to COMMON BLOCKS: SIDE EFFECTS: NOTES: To find out what TeX sequences are available look at table 0 EXAMPLE: MODIFICATION HISTORY: Id: textable pro 47 2006 05 09 09:13:01Z pinsard Log: textable pro v Revision 1 8 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 7 1996 07 22 23:56:08 mcraig Added vartheta Revision 1 6 1996 07 12 21:31:42 mcraig Fixed varphi in vector font added circ Revision 1 5 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 4 1996 05 09 00:22:17 mcraig Added command to return to previous font after switching to Greek or symbol font Revision 1 3 1996 02 08 19:49:35 mcraig Removed control sequence perp because the postscript code for it is Revision 1 2 1996 02 08 18:53:38 mcraig Added translations for PostScript fonts and added several new TeX control sequences Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION textable POSTSCRIPT ps VECTOR vec HELP Help Return to caller if error On_error 2 Print help if necessary IF keyword_set Help THEN BEGIN offset print offset Returns a translation table from TeX to IDL print offset table textable print offset Keywords: print offset offset POSTSCRIPT If set return postscript translation print offset offset table rather than vector fonts table print offset offset Default is translations for vector print offset offset fonts print offset offset HELP Print help and exit print offset Outputs: print offset offset table a 2D text array table 0 contains out print offset offset the words to be translated away table 1 print offset offset contains the words to translate them to print offset Notes: print offset offset To find out what TeX sequences are available look at print offset offset table 0 ENDIF VECFONT 1 index of vector font in translation table PSFONT 2 index of postscript font in trans table IF keyword_set ps THEN FontSelection PSFONT ELSE FontSelection VECFONT Set IDL font sequence needed to switch to Greek letters GreekFont strarr 3 GreekFont VECFONT 7 GreekFont PSFONT M Set IDL font sequence needed to switch to special symbol font SymbolFont strarr 3 SymbolFont VECFONT M SymbolFont PSFONT M Set IDL font sequence needed to switch back to initial font PreviousFont strarr 3 PreviousFont VECFONT X PreviousFont PSFONT X lowercase Greek Note there is some trickery involved in getting varphi to work in the vector fonts because it is actually a member of the symbol font set not the Greek font set Go figure Solution is just to make the vector character a switch to symbol the proper character from that font and a switch back out of symbol Same comment holds for vartheta TeX SEQUENCE VECTOR POSTSCRIPT LowercaseGreek alpha a a beta b b gamma c g delta d d epsilon e e zeta f z eta g h theta h q iota i i kappa j k lambda k l mu l m nu m n xi n S Rx pi p p rho q r sigma r s tau s t upsilon t u phi u f chi v c psi w y omega x w varpi p v varepsilon e e varphi SymbolFont VECFONT P PreviousFont VECFONT j vartheta SymbolFont VECFONT t PreviousFont VECFONT J Uppercase Greek TeX SEQUENCE VECTOR POSTSCRIPT UppercaseGreek Gamma C G Delta D D Theta H Q Lambda K L Xi N S RX Pi P P Sigma R S Upsilon T string byte 161 Phi U F Psi W Y Omega X W Special symbols NOTES You must leave infty before in in the translatation table to avoid having the in part of infty translated away DO NOT blindly add the control sequence perp Its PostScript code is which leads to thing being interpreted as superscripts which shouldn t be TeX SEQUENCE VECTOR POSTSCRIPT Symbols aleph string byte 192 ast cap 3 string byte 199 cdot string byte 215 cup 1 string byte 200 exists E infty string byte 165 in e string byte 206 equiv : string byte 186 pm string byte 177 div string byte 184 subset 0 string byte 204 superset 2 string byte 201 leftarrow 4 string byte 172 downarrow 5 string byte 175 rightarrow 6 string byte 174 uparrow 7 string byte 173 neq string byte 185 propto string byte 181 sim A string byte 126 partial D string byte 182 nabla G string byte 209 angle a string byte 208 times X string byte 180 geq b string byte 179 leq l string byte 163 string byte 162 prime string byte 162 circ string byte 176 LowercaseGreek 1 GreekFont FontSelection LowercaseGreek FontSelection PreviousFont FontSelection UppercaseGreek 1 GreekFont FontSelection UppercaseGreek FontSelection PreviousFont FontSelection Symbols 1 SymbolFont FontSelection Symbols FontSelection PreviousFont FontSelection TranslationTable LowercaseGreek UppercaseGreek Symbols return TranslationTable 0:1 END "); 148 a[146] = new Array("./Textoidl/textoidl.html", "textoidl.pro", "", " NAME: TEXTOIDL PURPOSE: Convert a valid TeX string to a valid IDL string for plot labels CATEGORY: text strings CALLING SEQUENCE: new textoidl old INPUTS: old TeX string to be converted Will not be in modified old may be a string array KEYWORD PARAMETERS: FONT Set to 0 to use hardware font 1 to use vector Note that the only hardware font supported is PostScript TEX_SEQUENCES return the available TeX sequences HELP print out info on use of the function and exit OUTPUTS: new IDL string corresponding to old out COMMON BLOCKS: SIDE EFFECTS: NOTES: Use the procedure SHOWTEX to get a list of the available TeX control sequences The only hardware font for which translation is available is PostScript The only device for which hardware font translation is available is PostScript The FONT keyword overrides the font selected by p font EXAMPLE: out TeXtoIDL Gamma 2 5N_ ed The string out may be used in XYOUTS or other IDL text display routines It will be an uppercase Gamma with an exponent of 2 then a plus sign then an N with the subscript ed MODIFICATION HISTORY: Id: textoidl pro 47 2006 05 09 09:13:01Z pinsard Log: textoidl pro v Revision 1 7 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 6 2004 01 11 01:49:00 mcraig Changed format of one array to newer style to avoidf conflict with function name in astro library Revision 1 5 2001 11 23 21:10:55 mcraig Added backslash to tex sequences in translation table to protect them during regexp search in strsplit Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Added error handling cleaned up documentation Revision 1 2 1996 02 08 18:52:50 mcraig Added ability to use hardware fonts for PostScript device Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Textoidl InputString FONT fnt HELP hlp TEX_SEQUENCES tex_seq Return to caller if there is an error On_error 2 We begin by deciding on the font PostScript 0 means use vector PostScript 0 IF n_elements fnt EQ 0 THEN BEGIN get font from p font IF p font NE 1 THEN BEGIN User wants hardware font PostScript 1 ENDIF ENDIF ELSE BEGIN get font from FONT keyword IF fnt NE 1 THEN PostScript 1 ENDELSE Bomb out if user wants non PostScript hardware font IF PostScript EQ 1 AND d name NE PS THEN BEGIN Device isn t postscript and user wants hardware font Not good print Warning: No translation for device: d name return InputString ENDIF IF keyword_set tex_seq THEN BEGIN table textable return table 0 ENDIF IF keyword_set hlp OR n_params EQ 0 THEN BEGIN print Convert a TeX string to an IDL string print new TeXtoIDL old print old TeX string to translate in print new resulting IDL string out print Keywords: print FONT set to 1 to translate for vector fonts print DEFAULT Set to 0 to translate for print hardware font print TEX_SEQUENCES return the available TeX sequences print HELP print this message and exit print NOTES: print Use SHOWTEX to obtain a list of the available print TeX control sequences print old may be a string array If so new is too print The only device for which hardware font print translation is available is PostScript print The FONT keyword overrides the font selected print by p font return 1 ENDIF PostScript has been set to 1 if PostScript fonts are desired strn InputString table textable POSTSCRIPT PostScript Greek sub superscripts need to be protected by putting braces around them if they are unbraced This will have the result the it will be difficult to use as a sub superscript Get over it V2 11 Must include the in from of translation table TeX sequences to ensure that strsplit properly treats the in the TeX sequence Since strsplit is doing a regexp replace and is special in regexps need to escape it strn strtrans strn table 0 table 0 strn strtrans strn _ table 0 _ table 0 First we translate Greek letters and the like This makes guessing alignment of sub superscripts easier as all special characters will then be one character long V2 11 Must include the in from of translation table TeX sequences to ensure that strsplit properly treats the in the TeX sequence Since strsplit is doing a regexp replace and is special in regexps need to escape it strn strtrans strn table 0 table 1 FOR i 0L n_elements strn 1 DO BEGIN strn i translate_sub_super strn i Take care of sub superscripts ENDFOR return strn END "); 149 a[147] = new Array("./Textoidl/translate_sub_super.html", "translate_sub_super.pro", "", " NOTE to future maintainers: Make sure sub_sup_idl stays before translate_sub_super At least for now when IDL encounters a function and automatically compiles it it only compiles the functions in the file up to the named function So even if sub_sup_idl was declared with FORWARD_FUNCTION in translate_sub_super it would not properly compile SPECIAL NOTE: The file translate_sub_super pro contains two functions translate_sub_super and sub_sup_idl The former is the generic routine for processing TeX sub superscripts the latter is used only by translate_sub_super and has no general utility Hence it lives here You will see documentation for translate_sub_super second if you use DOC_LIBRARY NAME: SUB_SUP_IDL PURPOSE: Return the proper IDL font positioning command for TeX sub superscripts CATEGORY: TeXtoIDL CALLING SEQUENCE: fnt sub_sup_idl strn INPUTS: strn Either or _ the TeX super subscript in characters KEYWORD PARAMETERS: FORCE_UD Set this to use U D instead of E I for sub superscripts HELP Set to print useful message and exit OUTPUTS: fnt Either U or E for superscripts out or D or I for subscripts COMMON BLOCKS: SIDE EFFECTS: NOTES: Used only by translate_sub_super Should be kept in same file EXAMPLE: MODIFICATION HISTORY: Id: translate_sub_super pro 47 2006 05 09 09:13:01Z pinsard Log: translate_sub_super pro v Revision 1 5 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Changed some function calls to reflect changes in those functions moved some code out of the main loop that didn t need to be there added documentation Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Sub_sup_idl token FORCE_UD force_ud provide help if needed IF n_params NE 1 OR keyword_set Help THEN BEGIN offset print offset Return the proper IDL font positioning command for TeX print offset sub superscripts print offset fnt sub_sup_idl strn print offset Inputs: print offset offset strn Either or _ the TeX super subscript in print offset offset characters print offset Keywords: print offset offset FORCE_UD Set this to use U D instead of E I for print offset offset sub superscripts print offset offset HELP Set to print useful message and exit print offset Outputs: print offset offset fnt Either U or E for superscripts out print offset offset or D or I for subscripts return 1 ENDIF IF keyword_set force_ud THEN BEGIN IF token EQ THEN return U IF token EQ _ THEN return D return ENDIF ELSE BEGIN IF token EQ THEN return E IF token EQ _ THEN return I return ENDELSE END NAME: TRANSLATE_SUB_SUPER PURPOSE: Translate TeX sub superscripts to IDL sub superscripts CATEGORY: text strings CALLING SEQUENCE: new translate_sub_super old INPUTS: old string to be translated from TeX to IDL in KEYWORD PARAMETERS: RECURSED set if this function is being called recursively HELP Set to print useful message and exit OUTPUTS: new string old converted from TeX to IDL out COMMON BLOCKS: SIDE EFFECTS: NOTES: For best results when both a sub and superscript are used place the shorter of the two first e g N a _ bbbb is better than N_ bbbb a Single character sub super scripts do not need to be protected by braces Sub superscripts may be nested e g N N_1 N EXAMPLE: out translate_sub_super N 2_ big Then out N U2 N Dbig N which looks like it should on the display LIBRARY FUNCTIONS CALLED: str_token Text string mcraig sub_sup_idl contained in this file MODIFICATION HISTORY: Id: translate_sub_super pro 47 2006 05 09 09:13:01Z pinsard Log: translate_sub_super pro v Revision 1 5 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Changed some function calls to reflect changes in those functions moved some code out of the main loop that didn t need to be there added documentation Revision 1 2 1996 02 08 18:54:20 mcraig Changed default sub superscript size to be D U rather than I E to improve readability of plat annotations Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Translate_sub_super InputString RECURSED recursed HELP Help Return to caller if error On_error 2 Offer help if needed and or desired IF n_params NE 1 OR keyword_set help THEN BEGIN offset print offset Translate TeX sub superscripts to IDL sub superscripts print offset new translate_sub_super old print offset Inputs: print offset offset old string to be translated from TeX to IDL in print offset Keywords: print offset offset RECURSED set if this function is being called print offset offset recursively print offset offset HELP Set to print useful message and exit print offset Outputs: print offset offset new string old converted from TeX to IDL out print offset Notes: print offset offset For best results when both a sub and superscript are used print offset offset place the shorter of the two first e g N a _ bbbb is print offset offset better than N_ bbbb a print offset offset Single character sub super scripts do not need to be print offset offset protected by braces print offset offset Sub superscripts may be nested e g N N_1 N return 1 ENDIF To allow for nested scripts use E I instead of U D for scripts when called recursively IF NOT keyword_set recursed THEN ud 1 ELSE ud 0 Return to the normal level after making sub superscript unless we are recursed which indicates we are processing a nested script IF keyword_set recursed THEN fontRestore ELSE fontRestore N Initialize vars for processing scripts SpcByte byte 0 We need the BYTE value for a space below strn InputString pos 0 StorePos RecallPos OldToken LenLastScript 0 Grab next sub superscript Token will be either or _ RETURN if no scripts Token nexttok strn _ pos pos if pos EQ 1 then return InputString nothing to process FntChange sub_sup_idl Token Our approach will be to grab the input string up to the next or _ then process the script we ve found NewString str_token strn Token WHILE strlen strn GT 0 DO BEGIN Grab first char of sub superscript Script strmid strn 0 1 EndOfScript 0 Position of end of this script IF Script EQ THEN BEGIN Scripts of more than 1 char EndOfScript matchdelim strn Script translate_sub_super strmid strn 1 EndOfScript 1 recursed ENDIF Grab rest of string _after_ the end of the script strn strmid strn EndOfScript 1 strlen strn EndOfScript 1 Find the next script and prepare for processing it FntChange sub_sup_idl Token FORCE_UD ud OldToken Token Token nexttok strn _ POS pos If the input is n 2_j we want the 2 to be directly above the j rather than having the j below and to the right of the 2 In other words we want the first below not the second 2 2 N N J J To accomplish this we need to save the position at which we begin writing the 2 with a S and restore that position with a R after writing the 2 The first section in the IF block below handles the J above the thing after the first script We don t care if there is another script following We also padd the second script with spaces if it is shorter than the first to make sure that whatever comes out after the scripts starts in the proper place The worry is that without the spaces the input N looong _ s 1 will end up with the starting right the s ends IF StorePos EQ S THEN BEGIN StorePos RecallPos calculate the difference in length between this script and the previous stacked one removing font change commands crudely by guessing that the number of characters this takes is twice the number of exclamation points The 1 below is a kludge I don t know why but I need one extra space NumSpaces LenLastScript strlen script 2 strcnt Script NumSpaces NumSpaces 1 0 IF NumSpaces GT 0 THEN Script Script string replicate SpcByte NumSpaces ENDIF ELSE BEGIN IF Token NE OldToken AND pos EQ 0 THEN BEGIN The next script immediately folows this one Arrange to save the position of the current script so that both begin with the same horizontal position StorePos S RecallPos R LenLastScript strlen Script 2 strcnt Script ENDIF ENDELSE Continue building the IDL string adding on our just processed script NewString NewString StorePos FntChange Script RecallPos FontRestore IF pos NE 1 THEN BEGIN more left to process NewString NewString str_token strn Token ENDIF ELSE BEGIN we are done NewString NewString strn strn ENDELSE ENDWHILE return NewString END "); 150 a[148] = new Array("./ToBeReviewed/CALCULS/curl.html", "curl.pro", "", " NAME:curl PURPOSE:calcule la composante verticale du rotationnel d un champ de vecteur horizontaux CATEGORY:calcule sur les matrices CALLING SEQUENCE:res curl u v INPUTS: u et v deux matrices representant les coordonnes d un champ de vecteur KEYWORD PARAMETERS: OUTPUTS:res: une matrice 2d COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: les matrices u et v peuvent de 2 a 4 dimensions attention pour distinger les differents configurations de u et v xy xyz xyt xyzt on regarde la variable du common time qui contient le calendrier en jour julien d IDL auquel se rapportent u et v ansi que la variable jpt qui est le nombre de pas de temps a considerer ds time les tableaux u et v sont decoupes sur le meme domaine geographique A cause du decalage des grilles T U V et F il est possiible que ces 2 tableaux n aient pas la meme taille et se repportent a des indices differents Si tel est le cas les tableaux sont redecoupes sur les indices qu ils ont en commun et le dommaine est redefinit pour qu il colle a ces indices communs pour eviter ces redecoupes utiliser le mot cles memeindice ds domdef pro les points sur le bord du dessin sont mis a values f_nan EXAMPLE: MODIFICATION HISTORY:Guillaume Roullet grlod ipsl jussieu fr Sebastien Masson smasson lodyc jussieu fr adaptation pour marcher avec un domaine reduit 21 5 1999: valeurs manquantes a values f_nan periodicite FUNCTION curl uu vv common tempsun systime 1 pour key_performance IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of curl is based on Arakawa C grid U and V grids must therefore be defined u litchamp uu v litchamp vv date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 3 OR size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return 1 endcase calcul du rotationnel coefu e1u indice2d replicate 1 nzt coefu reform coefu nx ny nzt over coefu coefu umask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefv e2v indice2d replicate 1 nzt coefv reform coefv nx ny nzt over coefv coefv vmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan tabf fmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt div e1f indice2d e2f indice2d replicate 1 nzt div reform div nx ny nzt over tabf tabf div zu u temporary coefu zv v temporary coefv psi shift zv 1 0 0 zv zu shift zu 0 1 0 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask pour le trace graphique domdef glagmt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi moyenne psi direc nan END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:BEGIN print problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs return 1 end endcase calcul du rotationnel coefu e1u indice2d umask indice2d jpi jpj firstzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefu temporary coefu replicate 1 jpt coefu reform coefu nx ny jpt over coefv e2v indice2d vmask indice2d jpi jpj firstzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan coefv temporary coefv replicate 1 jpt coefv reform coefv nx ny jpt over tabf fmask indice2d jpi jpj firstzt e1f indice2d e2f indice2d tabf temporary tabf replicate 1 jpt tabf reform tabf nx ny jpt over calcul du rotationnel zu u temporary coefu zv v temporary coefv psi shift zv 1 0 0 zv zu shift zu 0 1 0 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi grossemoyenne psi direc nan END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN return report non code END xy ELSE:BEGIN xy indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return 1 endcase calcul du rotationnel coefu e1u indice2d umask indice2d jpi jpj firstzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefv e2v indice2d vmask indice2d jpi jpj firstzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan tabf fmask indice2d jpi jpj firstzt e1f indice2d e2f indice2d zu u temporary coefu zv v temporary coefv psi shift zv 1 0 zv zu shift zu 0 1 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask pour le trace graphique domdef glamt indice2d 0 0 glamf indice2d nx 1 0 gphit indice2d 0 0 gphif indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi moyenne psi direc nan END endcase if keyword_set key_performance THEN print temps curl systime 1 tempsun vargrid F varname vorticity return psi end"); 151 a[149] = new Array("./ToBeReviewed/CALCULS/depth2floatlevel.html", "depth2floatlevel.pro", "", " NAME:depth2floatlevel PURPOSE: assez comparable a depth2level mais ici le niveau calcule est en float Par ex le niveau 5 4 correspond a une profondeur egale a gdep 5 4 gdep 6 gdep 5 CATEGORY: SANS BOUCLE CALLING SEQUENCE:res depth2floatlevel depth2d INPUTS: depth2d tableau 2d de profondeur ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d de float contenant les valeurs des niveaux COMMON BLOCKS:common pro SIDE EFFECTS:accepte les vcaleurs a values f_nan et masque les points terres a valmask RESTRICTIONS: EXAMPLE: IDL a jpk 1 1 jpi jpj findgen jpi jpj IDL plt 1e6 a floatlevel2depth depth2floatlevel a nocontour champ nul a 1e 6 pres MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 06 2000 FUNCTION depth2floatlevel tab NOMASK nomask tempsun systime 1 pour key_performance common depthin litchamp tab levelup depth2level depthin UPPER nomask depthup level2depth levelup nomask levellow depth2level depthin lower nomask depthlow level2depth levellow nomask calcule de la distance depthlow depthup et gestion du cas ou cette distance est nulle ou egale a values f_nan divi depthlow depthup nan where finite divi EQ 0 if nan 0 NE 1 then divi nan 0 nan where divi EQ 0 if nan 0 NE 1 then divi nan values f_nan calcule du resultat res levelup depthin depthup divi on masque les points terre a valmask if NOT keyword_set nomask then begin grille mask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask endif if keyword_set key_performance THEN print temps depth2floatlevel systime 1 tempsun return res end"); 152 a[150] = new Array("./ToBeReviewed/CALCULS/depth2level.html", "depth2level.pro", "", " NAME: depth2level PURPOSE: permet de passer d un tableau 2d de profondeur au tableau 2d correspondant de niveaux CATEGORY: SANS BOUCLE CALLING SEQUENCE: res depth2level depth2d INPUTS: depth2d tableau 2d de profondeur ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: UPPER: active par defaut on selectionne le niveau directement au dessus de la profondeur LOWER: on selectionne le niveau directement au dessous de la profondeur CLOSER: on selectionne le niveau le plus proche de la profondeur NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant les valeurs des niveaux COMMON BLOCKS:common pro SIDE EFFECTS:pour les profondeurs hors des valeurs de gdep la valeur values f_nan est retournee Si la profondeur est superieur a celle du fond on retourne jpk 1dans le cas upper et values f_nan ds le cas lower RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 15 6 2000 accepte values f_nan FUNCTION depth2level tab LOWER lower UPPER upper CLOSER closer NOMASK nomask _extra ex tempsun systime 1 pour key_performance common upper 1 if keyword_set lower THEN upper 0 lecture du champ d entree et recuperation de la taille du sous domaine utilise in litchamp tab grille mask 1 1 gdep nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef IF ny EQ 1 THEN in reform in nx ny over taille size in if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:in in firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase vire les points a values f_nan notanumber where finite in nan EQ 1 if notanumber 0 NE 1 then in notanumber 0 on transforme le tableau 2d de profondeur en tableau 2d de niveaux correspondant aux profondeurs on passe en tableaux qui ont la taille des tableaux 3d prof replicate 1 nx ny gdep firstz:lastz in in replicate 1 nz mask01 prof LT in mask01 reform mask01 nx ny nz levels total mask01 3 notvalid where levels EQ nz if keyword_set upper then begin levels levels 1 notvalid where levels EQ 1 ENDIF ELSE notvalid where levels EQ nz IF notvalid 0 NE 1 THEN levels notvalid values f_nan si closer est active if keyword_set closer then begin test litchamp tab level2depth levels level2depth levels 1 jpk 1 litchamp tab test test 0 test 1 changer where test GE 0 if changer 0 NE 1 then levels changer levels changer 1 jpk 1 endif on replace les points a values f_nan if notanumber 0 NE 1 then levels notanumber values f_nan on masque les points terres a valmask if NOT keyword_set nomask then begin if n_elements valmask EQ 0 then valmask 1e20 terre where mask 0 EQ 0 if terre 0 NE 1 then levels terre valmask endif if keyword_set key_performance THEN print temps depth2level systime 1 tempsun return levels end"); 153 a[151] = new Array("./ToBeReviewed/CALCULS/depth2mask.html", "depth2mask.pro", "", " NAME: depth2mask PURPOSE: permet de passer d un tableau 2d de profondeur seuil au tableau 3d de mask avec des 1 ds les niveaux au dessus de la profondeur seuil et des 0 en dessous CATEGORY: SANS BOUCLE CALLING SEQUENCE: res depth2mask depht2d INPUTS: depht2d tableau 2d de profondeur seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: UPPER: active par defaut on selectionne le niveau directement au dessus de la profondeur LOWER: on selectionne le niveau directement au dessous de la profondeur CLOSER: on selectionne le niveau le plus proche de la profondeur OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de profondeurs seuil COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 FUNCTION depth2mask tab _extra ex tempsun systime 1 pour key_performance common on transforme le tableau 2d de profondeur en tableau 2d de niveaux correspondant aux profondeurs niveaux depth2level tab _extra ex IF niveaux 0 EQ 1 THEN return 1 on transforme le tableau 2d de niveaux en tableau 3d de mask mask level2mask niveaux if keyword_set key_performance NE 0 THEN print temps depth2mask systime 1 tempsun return mask end"); 154 a[152] = new Array("./ToBeReviewed/CALCULS/determ2.html", "determ2.pro", "", " NAME:determ2 PURPOSE: computes the determinant of n 2 by 2 arrays CATEGORY: no DO loops and better accuracy CALLING SEQUENCE: 2 cases: res determ2 z2ds res determ2 z1d00 z1d01 z1d10 z1d11 INPUTS: z2ds: an 2 2 n array or z1d00 z1d01 z1d10 z1d11: the four n elements arrays defined as: z2ds 0 0 z1d00 z2ds 0 1 z1d01 z2ds 1 0 z1d10 z2ds 1 1 z1d11 OUTPUTS: n elements array the determinent of each 2 2 arrrays EXAMPLE: a findgen 2 2 5 print determ2 a FOR i 0 4 DO print determ a i IDL solution MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 11th 2002 FUNCTION determ2 a b c d CASE n_params OF 1:res a 0 0 a 1 1 a 0 1 a 1 0 4:res a d c b ELSE:stop ENDCASE RETURN res END"); 155 a[153] = new Array("./ToBeReviewed/CALCULS/determ3.html", "determ3.pro", "", " NAME:determ3 PURPOSE: computes the determinant of n 3 by 3 arrays CATEGORY: no DO loops and better accuracy CALLING SEQUENCE:2 cases: res determ2 z2ds res determ2 in00 in01 in02 in10 in11 in12 in20 in21 in22 INPUTS: z2ds: an 3 3 n array or in00 in01 in02 in10 in11 in12 in20 in21 in22: the nine n elements arrays defined as: in00 z2ds 0 0 in01 z2ds 0 1 in02 z2ds 0 2 in10 z2ds 1 0 in11 z2ds 1 1 in12 z2ds 1 2 in20 z2ds 2 0 in21 z2ds 2 1 in22 z2ds 2 2 OUTPUTS: n elements array the determinent of each 3 3 arrrays EXAMPLE: a findgen 3 3 5 print determ3 a 2 FOR i 0 4 DO print determ a i 2 IDL solution MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 11th 2002 FUNCTION determ3 in00 in01 in02 in10 in11 in12 in20 in21 in22 IF n_params EQ 1 THEN BEGIN in00save temporary in00 in00 in00save 0 0 in01 in00save 0 1 in02 in00save 0 2 in10 in00save 1 0 in11 in00save 1 1 in12 in00save 1 2 in20 in00save 2 0 in21 in00save 2 1 in22 in00save 2 2 ENDIF a01 determ2 in10 in20 in12 in22 a11 determ2 in00 in20 in02 in22 a21 determ2 in00 in10 in02 in12 res in01 a01 in11 a11 in21 a21 IF n_params EQ 1 THEN in00 temporary in00save RETURN res END"); 156 a[154] = new Array("./ToBeReviewed/CALCULS/div.html", "div.pro", "", " NAME:div PURPOSE:calcule la divergence d un champ 2D CATEGORY:calcule sur les matrices CALLING SEQUENCE:res div u v INPUTS: u et v deux matrices representant les coordonnes d un champ de vecteur KEYWORD PARAMETERS: OUTPUTS:res: une matrice 2d COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: les matrices u et v peuvent de 2 a 4 dimensions attention pour distinger les differents configurations de u et v xy xyz xyt xyzt on regarde la variable du common time qui contient le calendrier en jour julien d IDL auquel se rapportent u et v ansi que la variable jpt qui est le nombre de pas de temps a considerer ds time les tableaux u et v sont decoupes sur le meme domaine geographique A cause du decalage des grilles T U V et F il est possiible que ces 2 tableaux n aient pas la meme taille et se repportent a des indices differents Si tel est le cas les tableaux sont redecoupes sur les indices qu ils ont en commun et le dommaine est redefinit pour qu il colle a ces indices communs pour eviter ces redecoupes utiliser le mot cles memeindice ds domdef pro les points sur le bord du dessin sont mis a values f_nan EXAMPLE: MODIFICATION HISTORY:Guillaume Roullet grlod ipsl jussieu fr Creation : printemps 1998 Sebastien Masson smasson lodyc jussieu fr adaptation pour marcher avec un domaine reduit 12 1 2000 FUNCTION div uu vv tempsun systime 1 pour key_performance common IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of div is based on Arakawa C grid U and V grids must therefore be defined u litchamp uu v litchamp vv date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN extraction de u et v sur le domaine qui convient case 1 of size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:BEGIN zdiv 1 GOTO sortie end endcase calcul de la divergence zu e2u indice2d replicate 1 nzt zu reform zu nx ny nzt over zu temporary u temporary zu umask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zv e1v indice2d replicate 1 nzt zv reform zv nx ny nzt over zv temporary v temporary zv vmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zdiv 1e6 e1t indice2d e2t indice2d zdiv zdiv replicate 1 nzt zdiv reform zdiv nx ny nzt over zdiv temporary zdiv zu shift zu 1 0 0 zv shift zv 0 1 0 tmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan zdiv temporary zdiv if n_elements valmask EQ 0 THEN valmask 1e20 terre where tmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt EQ 0 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv moyenne zdiv direc nan END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 3 OR size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return 1 endcase calcul de la divergence zu e2u indice2d umask indice2d jpi jpj firstzt terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zu zu replicate 1 jpt zu reform zu nx ny jpt over zu temporary u temporary zu zv e1v indice2d vmask indice2d jpi jpj firstzt terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zv zv replicate 1 jpt zv reform zv nx ny jpt over zv temporary v temporary zv zdiv 1e6 tmask indice2d jpi jpj firstzt e1t indice2d e2t indice2d zdiv zdiv replicate 1 jpt zdiv reform zdiv nx ny jpt over terre where zdiv EQ 0 zdiv temporary zdiv zu shift zu 1 0 0 zv shift zv 0 1 0 mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv grossemoyenne zdiv direc nan END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN return report non code END xy ELSE:BEGIN xy indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: BEGIN zdiv 1 GOTO sortie end size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return 1 endcase calcul de la divergence zu temporary u e2u indice2d umask indice3d terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zv temporary v e1v indice2d vmask indice3d terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zdiv zu shift zu 1 0 zv shift zv 0 1 zdiv temporary zdiv tmask indice3d e1t indice2d e2t indice2d mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan zdiv temporary zdiv 1e6 if n_elements valmask EQ 0 THEN valmask 1e20 terre where tmask indice3d EQ 0 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv moyenne zdiv direc nan END endcase sortie: if keyword_set key_performance THEN print temps div systime 1 tempsun return zdiv end"); 157 a[155] = new Array("./ToBeReviewed/CALCULS/floatlevel2depth.html", "floatlevel2depth.pro", "", " NAME:floatlevel2depth PURPOSE: assez comparable a level2depth C est la fonction inverse de depth2floatlevel CATEGORY:SANS BOUCLE CALLING SEQUENCE:res floatlevel2depth niveau INPUTS: tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant des profondeurs COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL a gdept jpk 1 1 jpi jpj findgen jpi jpj IDL plt 1e6 a floatlevel2depth depth2floatlevel a nocontour champ nul a 1e 6 pres MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 6 2000 FUNCTION floatlevel2depth tab NOMASK nomask tempsun systime 1 pour key_performance common flevelin litchamp tab on vire les points a values f_nan notanumber where finite flevelin nan EQ 1 if notanumber 0 NE 1 then flevelin notanumber 0 on seuil vire les points terres a valmask par ex flevelin 0 flevelin jpk 1 on calcule la profondeur depthup level2depth floor flevelin nomask depthlow level2depth ceil flevelin nomask weight flevelin floor flevelin res depthup weight depthlow depthup on replace les points a values f_nan if notanumber 0 NE 1 then res notanumber values f_nan on masque les points terres a valmask if NOT keyword_set nomask then begin grille mask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask endif if keyword_set key_performance THEN print temps floatlevel2depth systime 1 tempsun return res end"); 158 a[156] = new Array("./ToBeReviewed/CALCULS/fsfzpt.html", "fsfzpt.pro", "", "FUNCTION fsfzpt pfs pfp Ice freezing point fsfzpt: freezing point of seawater in degrees celsius units : salinity pfs ipss 78 pressure pfp decibars temperature fszfpt degrees celsius freezing pt reference : unesco tech papers in the marine science no 28 1978 eigth report jpots annex 6 freezing point of seawater F J Millero pp 29 35 checkvalue: fsfzpt 2 588567 deg c for s 40 0 p 500 decibars RETURN 0 0575 1 710523e 3 sqrt pfs 2 154996e 4 pfs pfs 7 53e 4 pfp END"); 159 a[157] = new Array("./ToBeReviewed/CALCULS/grad.html", "grad.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION grad field direc common IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of grad is based on Arakawa C grid U and V grids must therefore be defined res litchamp field taille size res grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz if n_elements valmask EQ 0 then valmask 1e20 case strupcase vargrid of T :BEGIN case direc of x :BEGIN divi e1u firstx:lastx firsty:lasty newmask umask firstx:lastx firsty:lasty firstz:lastz vargrid U domdef glamt firstx 0 glamu lastx 0 gphit 0 firsty gphiu 0 lasty gridtype T U END y :BEGIN divi e2v firstx:lastx firsty:lasty newmask vmask firstx:lastx firsty:lasty firstz:lastz vargrid V domdef glamt firstx 0 glamv lastx 0 gphit 0 firsty gphiv 0 lasty gridtype T V END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument ENDCASE END W :BEGIN case direc of x :divi e1u firstx:lastx firsty:lasty y :divi e2v firstx:lastx firsty:lasty z :BEGIN divi e3t firstz:lastz newmask mask vargrid T END ELSE:return report Bad definition of direction argument endcase END U :BEGIN case direc of x :BEGIN divi shift e1t 1 0 firstx:lastx firsty:lasty newmask tmask firstx:lastx firsty:lasty firstz:lastz vargrid T domdef glamt firstx 0 glamu lastx gphit 0 firsty gphiu 0 lasty gridtype T U END y :BEGIN divi e2f firstx:lastx firsty:lasty newmask fmask firstx:lastx firsty:lasty firstz:lastz vargrid F domdef glamu firstx 0 glamf lastx 0 gphiu 0 firsty gphif 0 lasty gridtype U F END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument endcase END V :BEGIN case direc of x :BEGIN divi e1f firstx:lastx firsty:lasty newmask fmask firstx:lastx firsty:lasty firstz:lastz vargrid F domdef glamv firstx 0 glamf lastx 0 gphiv 0 firsty gphif 0 lasty gridtype V F END y :BEGIN divi shift e2t 0 1 firstx:lastx firsty:lasty newmask tmask firstx:lastx firsty:lasty firstz:lastz vargrid T domdef glamt firstx 0 glamv lastx 0 gphit 0 firsty gphiv 0 lasty gridtype T V END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument endcase END F :BEGIN case direc of x :divi shift e1v 1 0 firstx:lastx firsty:lasty y :divi shift e2u 0 1 firstx:lastx firsty:lasty z :divi e3w firstz:lastz ELSE:return report Bad definition of direction argument endcase END ELSE:return report Bad definition of vargrid ENDCASE res fitintobox res case 1 of xy taille 0 EQ 2:BEGIN earth where mask firstz EQ 0 if earth 0 NE 1 then res earth values f_nan case direc of x :BEGIN res shift res 1 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 END y :BEGIN res shift res 0 1 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 END ELSE:return report Bad definition of direction argument for the type of array ENDCASE earth where newmask firstz EQ 0 if earth 0 NE 1 then res earth valmask END xyt taille 0 EQ 3 AND jpt NE 1:BEGIN earth where mask firstz EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate 1 n_elements earth nx ny lindgen jpt res earth values f_nan ENDIF divi divi replicate 1 jpt case direc of x :BEGIN res shift res 1 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 END y :BEGIN res shift res 0 1 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 END ELSE:return report Bad definition of direction argument for the type of array ENDCASE earth where newmask firstz EQ 0 if earth 0 NE 1 THEN res earth valmask END xyz taille 0 EQ 3 AND jpt EQ 1:BEGIN earth where mask EQ 0 if earth 0 NE 1 then res earth values f_nan case direc OF x :BEGIN divi divi replicate 1 nz res shift res 1 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 END y :BEGIN divi divi replicate 1 nz res shift res 0 1 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 END z :BEGIN divi reform replicate 1 nx ny divi nx ny nz if nx EQ 1 OR ny EQ 1 then res reform res nx ny nz if vargrid EQ W THEN BEGIN res shift res 0 0 1 res divi res 0 values f_nan ENDIF ELSE BEGIN res res shift res 0 0 1 divi res nz 1 values f_nan ENDELSE if earth 0 NE 1 then res earth valmask END ENDCASE END xyzt taille 0 EQ 4:BEGIN earth where mask replicate 1 jpt EQ 0 if earth 0 NE 1 then res earth values f_nan case direc OF x :BEGIN divi divi replicate 1 nz jpt res shift res 1 0 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 0 END y :BEGIN divi divi replicate 1 nz jpt res shift res 0 1 0 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 0 END z :BEGIN divi replicate 1 nx ny divi divi reform divi replicate 1 jpt nx ny nz jpt over if nx EQ 1 OR ny EQ 1 then res reform res nx ny nz jpt if vargrid EQ W THEN BEGIN res shift res 0 0 1 0 res divi res 0 values f_nan ENDIF ELSE BEGIN res res shift res 0 0 1 0 divi res nz 1 values f_nan ENDELSE END ENDCASE if earth 0 NE 1 then res earth valmask END endcase varname grad of varname varunit varunit m return res end "); 160 a[158] = new Array("./ToBeReviewed/CALCULS/grossemoyenne.html", "grossemoyenne.pro", "", " NAME: grossemoyenne PURPOSE: averages a 3 or 4 d time serie field over a selected geographical area or along the time axis For one ore more selected axes x y z t CATEGORY: CALLING SEQUENCE: result grossemoyenne tab direc BOXZOOM boxzoom INPUTS: tab 3 or 4d field direc x y z t xy xz yz xyz xt yt zt xyt xzt yzt or xyzt KEYWORD PARAMETERS: boxzoom xmin xmax ymin ymax zmin zmax pour plus de detail cf domdef boxzoom peut prendre 5 formes: vert2 vert1 vert2 lon1 lon2 lat1 lat2 lon1 lon2 lat1 lat2 vert2 lon1 lon2 lat1 lat2 vert1 vert2 NAN: not a number a activer si l on peut faire veut faire une moyenne sans tenir compte de certaines valeurs masques de tab si les valeurs masques de tab sont la valeur consacree par IDL values f_nan il suffit de mettre NAN si les valeurs masques de tab on pour valeur a a doit etre differente de 1 correspond a nan values f_nan et de 0 qui desactive nan Il faut mettre NAN a Rq: en sorties les points de result qui sont NAN auront pour valeur a ou values f_nan NODOMDEF: activer si l on ne veut pas passer ds domdef bien que le mot cle boxzoom soit present comme c est le cas qd grossemoyenne est appelee via checkfield INTEGRATION: pour faire une integrale plutot qu une moyenne SPATIALFIRST when performing at the same time spatial and temporal mean grossemoyenne is assuming that the mask is not changing with the time In consequence grossemoyenne performs temporal mean first and then call moyenne Activate SPATIALFIRST if you want to perform the spatial mean before the temporal mean Note that if NAN is activated then SPATIALFIRST is activated automatically TEMPORALFIRST: to force to perform first temporal mean even if nan is activated see SPATIALFIRST explanations WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: COMMON BLOCKS: result:un tableau common domdef SIDE EFFECTS: met les valeurs correspondants a la terre a 1e20 RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 Sebastien Masson smasson lodyc jussieu fr adaptation pour les tableaux comportants une dimension temporelle 14 8 98 15 1 98 12 3 99 adaptation pour NAN et utilisation de TEMPORARY PLAN DU PROGRAMME: I preliminaires I 1 determination des directions de moyennes d apres direc I 2 verification de la taille du tableau d entree I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne II moyennes pour les tableaux 3d x y t II 1 verification de la coherence de la taille du tableau a moyenner II 2 renvoie sur moyenne qd une moyenne sur t est demandee II 3 differents types de moyennes possibles III moyennes pour les tableaux 4d x y z t III 1 verification de la coherence de la taille du tableau a moyenner III 2 differents types de moyennes possibles IV finitions IV 1 on masque les terres par une valeur a 1e 20 IV 2 on remplace quand nan ne 1 values f_nan par nan IV 3 on revient au sous domaine initial function grossemoyenne tab direc BOXZOOM boxzoom INTEGRATION integration NAN nan NODOMDEF nodomdef WDEPTH wdepth SPATIALFIRST spatialfirst TEMPORALFIRST temporalfirst _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preliminaires dirt 0 dirx 0 diry 0 dirz 0 dim aa I 1 direction s suivants lesquelles on integre if strpos direc t ge 0 then dirt 1 if strpos direc x ge 0 then dirx 1 if strpos direc y ge 0 then diry 1 if strpos direc z ge 0 then dirz 1 IF keyword_set NAN AND dirx EQ 1 OR diry EQ 1 OR dirz EQ 1 THEN spatialfirst 1 IF keyword_set temporalfirst THEN spatialfirst 0 I 2 verification de la taille du tableau d entree taille size tab case 1 of taille 0 eq 1 :return report Le tableau n a qu une dimension cas non traite taille 0 eq 2 :return report Le tableau n a qu deux dimension cas non traite taille 0 eq 3 :BEGIN dim 3d if dirx eq 0 and diry eq 0 and dirt eq 0 then return tab END taille 0 eq 4 :BEGIN dim 4d if dirx eq 0 and diry eq 0 and dirz eq 0 and dirt eq 0 then return tab END else : return report Le tableau d entree doit etre a 3 ou 4 dimensions s il ne contient pas de dim temporelle utiliser moyenne endcase I 4 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne redefinition du domaine ajuste a boxzoom a 6 elements ceci va nous permetre de faire les calcules que sur le sous domaine comcerne par la moyenne domdef suivit de grille nous donne tous les tableaux de la grille sur le sous domaine if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1: bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2: bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4: bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5: bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6: bte Boxzoom Else: return report Wrong Definition of Boxzoom endcase if NOT keyword_set nodomdef then BEGIN savedbox 1b saveboxparam boxparam4grmoyenne dat domdef bte GRIDTYPE vargrid _extra ex ENDIF ENDIF attribution du mask et des tableaux de longitude et latitude grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 WDEPTH wdepth I 3 si dirt eq 1 on fait la moyenne temporelle et on envoie ds moyenne if dirt EQ 1 AND NOT keyword_set spatialfirst then begin if dim EQ 3d then BEGIN case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpt: res tab firstx:firstx nx 1 firsty:firsty ny 1 taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpt:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny jpt strtrim nx 1 strtrim ny 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 END ENDCASE if keyword_set integration then begin res total res 3 nan nan ENDIF ELSE BEGIN if keyword_set nan then BEGIN divi finite res divi total temporary divi 3 notanum where divi EQ 0 res total res 3 nan keyword_set nan 1 divi if notanum 0 NE 1 then res temporary notanum values f_nan ENDIF ELSE res total res 3 1 taille 3 ENDELSE ENDIF ELSE BEGIN case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk and taille 4 eq jpt: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz and taille 4 eq jpt: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz and taille 4 eq jpt:res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk and taille 4 eq jpt: res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz jpt strtrim nx 1 strtrim ny 1 strtrim nz 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 strtrim taille 4 1 END endcase if keyword_set integration then begin res total res 4 nan nan ENDIF ELSE BEGIN if keyword_set nan then begin divi finite res divi total temporary divi 4 notanum where divi EQ 0 res total res 4 nan 1 divi if notanum 0 NE 1 then res temporary notanum values f_nan ENDIF ELSE res total res 4 1 taille 4 ENDELSE ENDELSE if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return moyenne temporary res direc BOXZOOM boxzoom NAN nan INTEGRATION integration NODOMDEF nodomdef WDEPTH wdepth _extra ex ENDIF ELSE res tab IF jpt EQ 1 THEN BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return moyenne reform res over direc BOXZOOM boxzoom NAN nan INTEGRATION integration NODOMDEF nodomdef WDEPTH wdepth _extra ex END II Cas serie tableaux 2d tab3d if dim eq 3d then begin II 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpt soit celle du domaine reduit nx ny jpt case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpt: res tab firstx:firstx nx 1 firsty:firsty ny 1 taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpt:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny jpt strtrim nx 1 strtrim ny 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 enD endcase if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 then BEGIN res reform res nx ny jpt over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over II 3 differents types de moyennes if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 mask mask 0 case 1 of dirx eq 1 and diry eq 0 : begin e temporary e1 temporary mask echelle temporary e replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total echelle msknan 1 ELSE divi total echelle 1 ENDELSE res total temporary res echelle 1 nan nan divi 1 if msknan 0 NE 1 then BEGIN echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 1 total temporary echelle 1 EQ 0 endif end dirx eq 0 and diry eq 1 : begin e temporary e2 temporary mask if nx EQ 1 OR ny EQ 1 then e reform e nx ny over echelle temporary e replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total echelle msknan 2 ELSE divi total echelle 2 ENDELSE res total temporary res echelle 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 2 total temporary echelle 2 EQ 0 endif end dirx eq 1 and diry eq 1 : begin echelle temporary e1 temporary e2 temporary mask replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total total echelle msknan 1 1 ELSE divi total total echelle 1 1 ENDELSE res total temporary total temporary res echelle 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 1 total total temporary echelle 1 1 EQ 0 endif end endcase endif III Cas serie tableaux 3d tab4d if dim eq 4d then begin III 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpk jpt soit celle du domaine reduit nx ny ny jpt case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk and taille 4 eq jpt: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz and taille 4 eq jpt: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz and taille 4 eq jpt:res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk and taille 4 eq jpt: res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz jpt strtrim nx 1 strtrim ny 1 strtrim nz 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 strtrim taille 4 1 END endcase if nx EQ 1 OR ny EQ 1 OR nz EQ 1 OR jpt EQ 1 then res reform res nx ny nz jpt over if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN res reform res nx ny nz jpt over mask reform mask nx ny nz over ENDIF IF keyword_set key_partialstep THEN BEGIN the top of the ocean floor is IF vargrid EQ T OR vargrid EQ W THEN bottom total mask 3 ELSE bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 we suppress columns with only ocean or land good where bottom NE 0 AND bottom NE nz the bottom of the ocean in 3D index is: bottom lindgen nx ny temporary bottom 1L nx ny IF good 0 NE 1 THEN bottom bottom good ELSE bottom 1 ENDIF ELSE bottom 1 III 2 differents types de moyennes IF keyword_set nan NE 0 THEN msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 and dirz eq 0 : BEGIN e13 temporary e1 replicate 1 nz e13 reform e13 nx ny nz over echelle temporary e13 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz jpt nan 1 ENDIF bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 1 ELSE divi total echelle 1 endelse res temporary res echelle res total temporary res 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 1 total temporary echelle 1 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 0 : begin e23 temporary e2 replicate 1 nz e23 reform e23 nx ny nz over echelle temporary e23 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 2 ELSE divi total echelle 2 endelse res total temporary res echelle 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 2 total temporary echelle 2 EQ 0 endif end dirx eq 0 and diry eq 0 and dirz eq 1 : begin e33 replicate 1 1 nx ny e3 e33 reform e33 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e33 bottom e3w_ps firstx:lastx firsty:lasty temporary good ELSE e33 bottom e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e33 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 3 ELSE divi total echelle 3 endelse res total temporary res echelle 3 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 3 total temporary echelle 3 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 0 : begin e13 e1 replicate 1 nz e13 reform e13 nx ny nz over e23 e2 replicate 1 nz e23 reform e23 nx ny nz over echelle temporary e13 temporary e23 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 1 1 ELSE divi total total echelle 1 1 endelse res total total temporary res echelle 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 1 total total temporary echelle 1 1 EQ 0 endif end dirx eq 1 and diry eq 0 and dirz eq 1 : begin e133 e1 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e133 bottom e1 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e133 bottom e1 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e133 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 1 2 ELSE divi total total echelle 1 2 endelse res total total temporary res echelle 1 nan nan 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 2 total total temporary echelle 1 2 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 1 : begin e233 e2 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e233 bottom e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e233 bottom e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e233 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 2 2 ELSE divi total total echelle 2 2 endelse res total total temporary res echelle 2 nan nan 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 2 2 total total temporary echelle 2 2 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 1 : begin e1233 e1 e2 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e1233 bottom e1 e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e1233 bottom e1 e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e1233 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total total echelle msknan 1 1 1 ELSE divi total total total echelle 1 1 1 endelse res total total total temporary res echelle 1 nan nan 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total total temporary testnan 1 1 1 total total total temporary echelle 1 1 1 EQ 0 endif end endcase endif if dirt EQ 1 AND keyword_set spatialfirst then BEGIN IF reverse size res dimension 0 NE jpt THEN BEGIN print the last dimension of res is not equal to jpt: strtrim jpt 2 if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return 1 ENDIF tdim size res n_dimensions if keyword_set integration then res total res tdim nan nan ELSE BEGIN if keyword_set nan then BEGIN testnan testnan divi ENDELSE ENDIF IV finitions IV 1 on masque les terres par une valeur a 1e 20 valmask 1e 20 terre where divi EQ 0 IF terre 0 NE 1 THEN BEGIN res temporary terre 1e 20 ENDIF IV 2 on remplace quand nan ne 1 values f_nan par nan if keyword_set nan NE 0 then BEGIN puttonan where temporary testnan EQ 0 if puttonan 0 NE 1 then res temporary puttonan values f_nan if nan NE 1 then BEGIN notanumber where finite res eq 0 if notanumber 0 NE 1 then res temporary notanumber nan ENDIF ENDIF IV 3 on se remplace ds le sous domaine qui etait definit a l entree de moyenne if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat if keyword_set key_performance THEN print temps grossemoyenne systime 1 tempsun return res end"); 161 a[159] = new Array("./ToBeReviewed/CALCULS/hdyn.html", "hdyn.pro", "", " NAME:hdyn PURPOSE:calcule la hauteur dynamique par rapport a un etat de reference pour une profondeur de reference Cf les mots cles pour les differentes possibilites Par defaut l etat de reference est rho 1020 et la profondeur de reference est gdepw ka avec ka le premier niveau W directement au dessus de 1000 m CATEGORY: calculs de post traitement CALLING SEQUENCE:res hdyn sn tn INPUTS:sn et tn sont des tableaux de meme taille representant la salinite et la temperature KEYWORD PARAMETERS: GILL: activer cette cle si on veut faire le calcul de la hauteur dynamique comme ds le GILL page 215 cad par rapport a un etat de reference qui varie en profondeur et qui est determine par une temperature de reference tref a 0 degre et une salinite de reference sref a 35psu LEVEL: C est le niveau de reference a prendre Ce niveau est definit tel que gdepw level est la profondeur de reference SREF: donner une valeur a ce mot cle pour changer la salinite de reference utiliser ds le calcul lorsque GILL est active TREF: donner une valeur a ce mot cle pour changer la temperature de reference utiliser ds le calcul lorsque GILL est active PROFREF: donner a ce mot cle une profondeur qui sera prise comme la profondeur de reference ds ce cas LEVEL n a aucun effet le calcul sera alors effectue jusqu a cette profondeur en effectuant une interpolation entre le dernier niveau W au dessus de PROFREF et PROFREF SURFACE_LEVEL: C est le niveau auquel on veut calculer la hauteur dynamique Par defaut c est le niveau 0 OUTPUTS:un tableau de la meme taille que sn et tn representant la hauteur dynamique calculee a partir d une profondeur de reference et par rapport a un etat de reference COMMON BLOCKS: common pro SIDE EFFECTS: les points pour lesquels on nje peut calcule la hauteur dynamique dont la batymetrie est moins profonde que la profondeur de reference sont mis a la valeur values f_nan RESTRICTIONS:approximation: la pression en decibars est egale a la profondeur en metres la pression augmente de 1bar tous les 10m EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr FUNCTION hdyn tabsn tabtn TREF tref SREF sref PROFREF profref LEVEL level GILL gill SURFACE_LEVEL surface_level tempsun systime 1 pour key_performance common if NOT keyword_set surface_level then surface_level 0 utile si GILL est active if NOT keyword_set tref then tref 0 if NOT keyword_set sref then sref 35 on determine si besoin est la profondeur de reference et le niveau W situe directement au dessus if keyword_set profref then begin rien where gdepw LE profref level level level 1 za gdepw level ENDIF ELSE BEGIN if NOT keyword_set level then BEGIN rien where gdepw LE 1000 level level level 1 ENDIF profref gdepw level za profref ENDELSE tailles size tabsn taillet size tabtn if total tailles 0:tailles 0 NE taillet 0:taillet 0 NE 0 then return report Les tableaux sn et tn doivent avoir la meme taille if tailles 3 NE jpk then return report La dim verticale des tableaux sn et tn doit etre egalre a jpk nx nxt ny nyt case size tabsn 0 OF 3:BEGIN case 1 of tailles 1 eq jpi and tailles 2 eq jpj: BEGIN sn tabsn firstxt:lastxt firstyt:lastyt tn tabtn firstxt:lastxt firstyt:lastyt end tailles 1 eq nx and tailles 2 eq ny:BEGIN sn tabsn tn tabtn end else:return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if keyword_set gill then rhonref rhon replicate sref nx ny jpk replicate tref nx ny jpk insitu ELSE rhonref 1020 vol rhonref rhon sn tn insitu rhonref e33d replicate 1 nx ny e3t e33d reform e33d nx ny jpk over terre where tmask firstxt:lastxt firstyt:lastyt EQ 0 if terre 0 NE 1 then vol terre values f_nan case level of 0:hdyn 100 profref gdepw 0 vol 0 1:hdyn 100 vol e33d 0 profref gdepw 1 vol 1 ELSE:hdyn 100 total vol e33d surface_level: level 1 3 profref gdepw level vol level endcase END 4:BEGIN case 1 of tailles 1 eq jpi and tailles 2 eq jpj AND tailles 4 EQ jpt: BEGIN sn tabsn firstxt:lastxt firstyt:lastyt tn tabtn firstxt:lastxt firstyt:lastyt end tailles 1 eq nx and tailles 2 eq ny AND tailles 4 EQ jpt:BEGIN sn tabsn tn tabtn end else:return report Probleme d adequation entre les tailles du domaine et de la boite endcase if keyword_set gill then rhonref rhon replicate sref nx ny jpk jpt replicate tref nx ny jpk jpt insitu ELSE rhonref 1020 vol rhonref rhon sn tn insitu rhonref e33d replicate 1 nx ny e3t e33d e33d replicate 1 jpt e33d reform e33d nx ny jpk jpt over mask tmask firstxt:lastxt firstyt:lastyt mask mask replicate 1 jpt terre where mask EQ 0 if terre 0 NE 1 then vol terre values f_nan case level of 0:hdyn 100 profref gdepw 0 vol 0 1:hdyn 100 vol e33d 0 profref gdepw 1 vol 1 ELSE:hdyn 100 total vol e33d surface_level: level 1 3 profref gdepw level vol level endcase END ELSE: return report cas non code ENDCASE varunit cm varname Dynamic Height href strtrim round profref 1 m IF keyword_set key_performance THEN print temps hdyn systime 1 tempsun return hdyn end"); 162 a[160] = new Array("./ToBeReviewed/CALCULS/level2depth.html", "level2depth.pro", "", " NAME:level2depht PURPOSE: permet de passer d un tableau 2d de niveau au tableau 2d de profondeur correspondant a ces niveaux CATEGORY: SANS BOUCLE CALLING SEQUENCE: res level2depth niveau INPUTS: niveau tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant des profondeurs COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 14 6 2000 accepte values f_nan FUNCTION level2depth tab NOMASK nomask tempsun systime 1 pour key_performance common lecture du champ d entree et recuperation de la taille du sous domaine utilise niveaux litchamp tab grille mask 1 1 gdep nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef taille size niveaux if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:niveaux niveaux firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase wherenan where finite niveaux nan EQ 1 if wherenan 0 NE 1 then niveaux wherenan 0 niveaux 0 niveaux jpk 1 gdep replicate 1 nx ny gdep niveaux lindgen nx ny nx ny niveaux gdep reform gdep niveaux nx ny if wherenan 0 NE 1 then gdep wherenan values f_nan if NOT keyword_set nomask then begin if n_elements valmask EQ 0 then valmask 1e20 terre where mask 0 EQ 0 if terre 0 NE 1 then gdep terre valmask endif if keyword_set key_performance THEN print temps level2depth systime 1 tempsun return gdep end"); 163 a[161] = new Array("./ToBeReviewed/CALCULS/level2index.html", "level2index.pro", "", " NAME:level2index PURPOSE: on veut ds une matrice 3d extraire un tableau 2d x y dont chacun des elements a ete extrait a un niveau specifie par le tableau 2d level typiquement on veut obtenir la salinite le long d une isopycne que l on a reperee par son niveau level2index est une fonction qui donne en fonction de level un tableau 2d d indice qui permettra d extraire le tableau 2d du tableau 3d CATEGORY: SANS BOUCLE CALLING SEQUENCE: index level2index level INPUTS:level: un tableau 2d de niveaux KEYWORD PARAMETERS: OUTPUTS: untableau 2d d indices COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 24 11 1999 FUNCTION level2index level un elements de tableau 3d dont les 2 premieres dimensions sont nx et ny dont les coordonnes sont i j et k a pour indice ds le meme tableau 3d i j nx k nx ny level etant donne pour chaque points de level on connait i j et k on peut donc calculer l indice taille size level nx taille 1 ny taille 2 tableau k nx ny tabknxny nx ny long level return lindgen nx ny tabknxny end"); 164 a[162] = new Array("./ToBeReviewed/CALCULS/level2mask.html", "level2mask.pro", "", " NAME:level2mask PURPOSE: permet de passer d un tableau 2d de niveau seuil au tableau 3d de mask avec des 1 ds les niveaux au dessus du niveau seuil et des 0 en dessous et sur CATEGORY: SANS BOUCLE CALLING SEQUENCE: res level2mask niveau INPUTS: niveau tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de niveaux seuil COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 Setp 2004: boundary level have 0 values and not 1 as it was explained before in the header see: print array_equal niveau total level2mask niveau 3 FUNCTION level2mask tab tempsun systime 1 pour key_performance common lecture du champ d entree et recuperation de la taille du sous domaine utilise niveaux litchamp tab grille maskterre 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef IF ny EQ 1 THEN niveaux reform niveaux nx ny over taille size niveaux if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:niveaux niveaux firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase on transforme le tableau 2d de niveaux en tableau 3d de mask mask reform niveaux 1 indgen nz 1 nx ny nz mask floor temporary mask 1 mask temporary mask temporary maskterre if keyword_set key_performance THEN print temps level2mask systime 1 tempsun return mask end"); 165 a[163] = new Array("./ToBeReviewed/CALCULS/moyenne.html", "moyenne.pro", "", " NAME: moyenne PURPOSE: averages a 2 or 3 d field over a selected geographical area and along one ore more selected axes x y or z CATEGORY: CALLING SEQUENCE: result moyenne tab direc BOXZOOM boxzoom INPUTS: tab 2 or 3d field direc x y z xy xz yz or xyz KEYWORD PARAMETERS: BOXZOOM xmin xmax ymin ymax zmin zmax pour plus de detail cf domdef boxzoom peut prendre 5 formes: vert2 vert1 vert2 lon1 lon2 lat1 lat2 lon1 lon2 lat1 lat2 vert2 lon1 lon2 lat1 lat2 vert1 vert2 NAN: not a number a activer si l on peut faire veut faire une moyenne sans tenir compte de certaines valeurs masques de tab si les valeurs masques de tab sont la valeur consacree par IDL values f_nan il suffit de mettre NAN si les valeurs masques de tab on pour valeur a a doit etre differente de 1 correspond a nan values f_nan et de 0 qui desactive nan il faut mettre NAN a Rq: en sorties les points de result qui sont NAN auront pour valeur a ou values f_nan NODOMDEF: activer si l on ne veut pas passer ds domdef bien que le mot cle boxzoom soit present comme c est le cas qd moyenne est appelee via checkfield INTEGRATION: pour faire une integrale plutot qu une moyenne WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: result:un tableau COMMON BLOCKS: common domdef SIDE EFFECTS:met les valeurs correspondants a la terre a 1e20 RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 Sebastien Masson smasson lodyc jussieu fr mise au propre de certains truc les terres 14 8 98 15 1 98 11 3 99 adaptation pour NAN 28 7 99 moyennes tableaux 1d PLAN DU PROGRAMME: I preliminaires I 1 determination des directions de moyennes d apres direc I 2 verification de la taille du tableau d entree I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne moyennes pour les tableaux 1d x y II moyennes pour les tableaux 2d x y II 1 verification de la coherence de la taille du tableau a moyenner II 2 differents types de moyennes possibles III moyennes pour les tableaux 3d x y z III 1 verification de la coherence de la taille du tableau a moyenner III 2 differents types de moyennes possibles IV finitions IV 1 on masque les terres par une valeur a 1e 20 IV 2 on remplace quand nan ne 1 values f_nan par nan IV 3 on revient au sous domaine initial function moyenne tab direc BOXZOOM boxzoom INTEGRATION integration NAN nan NODOMDEF nodomdef WDEPTH wdepth _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preliminaires dirt 0 dirx 0 diry 0 dirz 0 I 1 direction s suivants lesquelles on integre if strpos direc t ge 0 then dirt 1 if strpos direc x ge 0 then dirx 1 if strpos direc y ge 0 then diry 1 if strpos direc z ge 0 then dirz 1 if dirx eq 0 and diry eq 0 and dirz eq 0 then return tab I 2 verification de la taille du tableau d entree taille size tab case 1 of taille 0 eq 1 :dim 1d taille 0 eq 2 :BEGIN dim 2d if dirx eq 0 and diry eq 0 then return tab END taille 0 eq 3 :BEGIN dim 3d if dirx eq 0 and diry eq 0 and dirz eq 0 then return tab END else : return report Le tableau d entree doit etre a 2 ou 3 dimensions s il contient une dim temporelle utiliser grossemoyenne endcase I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne redefinition du domaine ajuste a boxzoom a 6 elements ceci va nous permetre de faire les calcules que sur le sous domaine comcerne par la moyenne domdef suivit de grille nous donne tous les tableaux de la grille sur le sous domaine if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: return report Mauvaise Definition de Boxzoom endcase if NOT keyword_set nodomdef then BEGIN savedbox 1b saveboxparam boxparam4moyenne dat domdef bte GRIDTYPE vargrid _extra ex ENDIF ENDIF attribution du mask et des tableaux de longitude et latitude IF vargrid EQ W THEN wdepth 1 grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 WDEPTH wdepth II Cas du tableau 1d if dim EQ 1d then BEGIN if n_elements tab NE nx ny AND n_elements tab NE nx ny nz then BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom ENDIF case 1 of nx EQ 1 AND ny EQ 1:BEGIN vecteur suivant z case n_elements tab of jpk:res tab firstz:lastz nz:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if dirz EQ 1 then BEGIN dim 3d taille size reform res nx ny nz ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END ny EQ 1:BEGIN vecteur suivant x case n_elements tab of jpi:res tab firstx:lastx nx:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if dirx EQ 1 then BEGIN dim 2d taille size reform res nx ny ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END nx EQ 1:BEGIN vecteur suivant y case n_elements tab of jpj:res tab firsty:lasty ny:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if diry EQ 1 then BEGIN dim 2d taille size reform res nx ny ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END endcase endif II Cas du tableau 2d if dim eq 2d then begin II 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj soit celle du domaine reduit nx ny case 1 of taille 1 eq jpi and taille 2 eq jpj: res tab firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine nx ny strtrim nx 1 strtrim ny 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 END ENDCASE if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 then BEGIN res reform res nx ny over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over II 3 differents types de moyennes mask mask 0 if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 : begin e e1 mask if keyword_set integration then divi 1 else begin divi e IF msknan 0 NE 1 THEN divi temporary divi msknan if ny EQ 1 then divi reform divi nx ny over divi total divi 1 endelse res res e if ny EQ 1 then res reform res nx ny over res total res 1 nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask if ny EQ 1 then testnan reform testnan nx ny over testnan total testnan 1 total mask 1 EQ 0 endif end dirx eq 0 and diry eq 1 : begin e e2 mask if keyword_set integration then divi 1 else begin divi e IF msknan 0 NE 1 THEN divi temporary divi msknan if ny EQ 1 then divi reform divi nx ny over divi total divi 2 endelse res res e if ny EQ 1 then res reform res nx ny over res total res 2 nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask if ny EQ 1 then testnan reform testnan nx ny over testnan total testnan 2 total mask 2 EQ 0 endif end dirx eq 1 and diry eq 1 : begin if keyword_set integration then divi 1 else BEGIN IF msknan 0 NE 1 THEN divi total e1 e2 mask msknan ELSE divi total e1 e2 mask ENDELSE res total res e1 e2 mask nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask testnan total testnan total mask EQ 0 endif end endcase endif III Cas du tableau 3d if dim eq 3d then begin III 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpk soit celle du domaine reduit nx ny ny case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz :res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk : res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz strtrim nx 1 strtrim ny 1 strtrim nz 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 END endcase if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN res reform res nx ny nz over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over IF keyword_set key_partialstep THEN BEGIN the top of the ocean floor is IF vargrid EQ T OR vargrid EQ W THEN bottom total mask 3 ELSE bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 we suppress columns with only ocean or land good where bottom NE 0 AND bottom NE nz the bottom of the ocean in 3D index is: bottom lindgen nx ny temporary bottom 1L nx ny IF good 0 NE 1 THEN bottom bottom good ELSE bottom 1 ENDIF ELSE bottom 1 III 2 differents types de moyennes if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 and dirz eq 0 : begin e13 e1 replicate 1 nz e13 reform e13 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else begin divi e13 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 1 ENDELSE res res e13 mask if nz EQ 1 then res reform res nx ny nz over res total res 1 nan nan divi 1 e13 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 1 total mask 1 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 0 : begin e23 e2 replicate 1 nz e23 reform e23 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else begin divi e23 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 2 ENDELSE res res e23 mask if nz EQ 1 then res reform res nx ny nz over res total res 2 nan nan divi 1 e23 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 2 total mask 2 EQ 0 endif end dirx eq 0 and diry eq 0 and dirz eq 1 : begin e33 replicate 1 1 nx ny e3 e33 reform e33 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e33 bottom e3w_ps firstx:lastx firsty:lasty temporary good ELSE e33 bottom e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else begin divi e33 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 3 ENDELSE res res e33 mask if nz EQ 1 then res reform res nx ny nz over res total res 3 nan nan divi 1 e33 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 3 total mask 3 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 0 : begin e123 e1 e2 replicate 1 nz e123 reform e123 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else BEGIN divi e123 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 1 1 ENDELSE res res e123 mask if nz EQ 1 then res reform res nx ny nz over res total total res 1 nan nan 1 nan nan divi 1 e123 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 1 1 total total mask 1 1 EQ 0 endif end dirx eq 1 and diry eq 0 and dirz eq 1 : begin e133 e1 e3 e133 reform e133 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e133 bottom e1 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e133 bottom e1 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN divi e133 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 1 2 ENDELSE res res e133 mask if nz EQ 1 then res reform res nx ny nz over res total total res 1 nan nan 2 nan nan divi 1 e133 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 1 2 total total mask 1 2 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 1 : begin e233 e2 e3 e233 reform e233 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e233 bottom e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e233 bottom e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN divi e233 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 2 2 ENDELSE res res e233 mask if nz EQ 1 then res reform res nx ny nz over res total total res 2 nan nan 2 nan nan divi 1 e233 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 2 2 total total mask 2 2 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 1 : begin e1233 e1 e2 e3 e1233 reform e1233 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e1233 bottom e1 e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e1233 bottom e1 e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN if msknan 0 NE 1 then divi total e1233 mask msknan ELSE divi total e1233 mask ENDELSE res total res e1233 mask nan nan divi 1 e1233 1 if msknan 0 NE 1 then begin testnan msknan mask testnan total testnan total mask EQ 0 endif end endcase endif IV finitions IV 1 on masque les terres par une valeur a 1e 20 valmask 1e 20 terre where divi EQ 0 IF terre 0 NE 1 THEN BEGIN res terre 1e 20 ENDIF IV 2 on remplace quand nan ne 1 values f_nan par nan if keyword_set nan NE 0 then BEGIN puttonan where testnan EQ 0 if puttonan 0 NE 1 then res puttonan values f_nan if nan NE 1 then BEGIN notanumber where finite res eq 0 if notanumber 0 NE 1 then res notanumber nan ENDIF ENDIF IV 3 on se remplace ds le sous domaine qui etait definit a l entree de moyenne if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat if keyword_set key_performance THEN print temps moyenne systime 1 tempsun return res end"); 166 a[164] = new Array("./ToBeReviewed/CALCULS/norme.html", "norme.pro", "", " NAME:norme PURPOSE: calcule la norme d un champ de vecteurs puis fait une moyenne eventuelle Rq1: le champ de vecteur peut etre 2d:xy 3d: xyz ou xyt 4d: xyzt Rq2: le calcul de la norme est fait avant l eventuelle moyenne spatiale ou temporelle car la moyenne de la norme n est pas egale a la norme des moyennes CATEGORY: calcul de post traitement CALLING SEQUENCE:res norme champ_de_vecteurs INPUTS:un tableau 2d 3d ou 4d KEYWORD PARAMETERS: BOXZOOM: boxzoom sur laquelle moyenner par defaut le domaine selectionner par le dernier domdef effectue DIREC: t x y z xy xz yz xyz xt yt zt xyt xzt yzt xyzt directions selon lesquelles effectuer les moyennes OUTPUTS:tableau a tracer avec plt pltz ou pltt COMMON BLOCKS: common pro SIDE EFFECTS: La norme est calculee aux points T Pour faire ce calcul on moyenne les champs U et V aux points T avant de calculer la norme Au bord des cotes et du domaine on ne peut pas calculer les champs U et V aux points T ces points sont donc a la valeur values f_nan lorsqu on fait le calcul sur un domaine geographique reduit les champs U et V ne comprennent pas forcement le meme nombre de points Dans ce cas on redecoupe U et V pour ne garder que les points en commun Au passage on refait un domdef qui redefinit un domaine geographique sur lequel les champs U et V sont extraits sur les meme points RESTRICTIONS: pour savoir a quel type de tableau on a a faire on teste la taille de celui ci et les dates donnees par time 0 et time jpt 1 pour savoir si il y a une dimension temporelle Avant de lancer norme s assurer que time et jpt sont bien definis comme il faut EXAMPLE: pour calculer la moyenne de la norme des courants sur tout le dommaine entre 0 et 50: IDL res norme un vn boxzoom 0 50 dir xyz MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 9 6 1999 FUNCTION norme composanteu composantev BOXZOOM boxzoom DIREC direc _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of norme is based on Arakawa C grid U and V grids must therefore be defined if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: return report Mauvaise Definition de Boxzoom ENDCASE domdef boxzoom ENDIF if NOT keyword_set direc then direc 0 construction de u et v aux pts T u litchamp composanteu v litchamp composantev date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 vargrid T varname norme valmask 1e20 grilleu litchamp composanteu grid if grilleu EQ then grilleu U grillev litchamp composantev grid if grillev EQ then grillev V IF grilleu EQ V AND grillev EQ U THEN inverse 1 IF grilleu EQ T AND grillev EQ T THEN BEGIN interpolle 0 return report cas non code mais facile a faire ENDIF ELSE interpolle 1 if keyword_set inverse then begin rien u u v v rien endif on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case size u 3 OF nzt:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny end jpk:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 firstzt:lastzt ELSE u u 1: nx firstzt:lastzt IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 firstzt:lastzt ELSE v v 1: nx firstzt:lastzt IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 firstzt:lastzt ELSE u u 1: ny firstzt:lastzt IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 firstzt:lastzt ELSE v v 1: ny firstzt:lastzt end ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size u 3 EQ jpk AND size v 1 EQ jpi AND size v 2 EQ jpj AND size u 3 EQ jpk :BEGIN u u indice3d v v indice3d END ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if nzt EQ 1 then begin u reform u nx ny nzt over v reform v nx ny nzt over endif construction de u et v aux pts T a u 0 u u shift u 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude mask tmask indice3d if nzt EQ 1 then mask reform mask nx ny nzt over if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN res mask valmask moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res moyenne res direc nan boxzoom boxzoom nodomdef END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase construction de u et v aux pts T a u 0 u u shift u 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin mask tmask indice2d jpi jpj firstzt if ny EQ 1 then mask reform mask nx ny over construction de terre qui contient tous les point a masquer if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN BEGIN coeftps lindgen jpt nx ny coeftps replicate 1 n_elements mask coeftps mask temporary mask replicate 1 jpt mask temporary mask temporary coeftps res temporary mask valmask ENDIF moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res grossemoyenne res direc nan boxzoom boxzoom nodomdef END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case size u 3 OF nzt:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny end jpk:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 firstzt:lastzt ELSE u u 1: nx firstzt:lastzt IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 firstzt:lastzt ELSE v v 1: nx firstzt:lastzt IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 firstzt:lastzt ELSE u u 1: ny firstzt:lastzt IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 firstzt:lastzt ELSE v v 1: ny firstzt:lastzt end ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size u 3 EQ jpk AND size v 1 EQ jpi AND size v 2 EQ jpj AND size u 3 EQ jpk :BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt END ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase construction de u et v aux pts T a u 0 u u shift u 1 0 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude mask tmask indice3d if nzt EQ 1 then mask reform mask nx ny nzt over if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN BEGIN coeftps lindgen jpt nx ny nzt coeftps replicate 1 n_elements mask coeftps mask temporary mask replicate 1 jpt mask temporary mask temporary coeftps res temporary mask valmask ENDIF moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res grossemoyenne res direc nan boxzoom boxzoom nodomdef END xy ELSE:BEGIN xy indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if ny EQ 1 then begin u reform u nx ny over v reform v nx ny over endif construction de u et v aux pts T a u 0 u u shift u 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin mask tmask indice2d jpi jpj firstzt if nyt EQ 1 THEN mask reform mask nx ny over construction de terre qui contient tous les point a masquer if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN res mask valmask moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res moyenne res direc nan boxzoom boxzoom nodomdef END endcase if keyword_set key_performance THEN print temps norme systime 1 tempsun return res end"); 167 a[165] = new Array("./ToBeReviewed/CALCULS/projectondepth.html", "projectondepth.pro", "", " NAME:projectondepth PURPOSE: routine permettant de projeter un champ 3d suivant un tableau de profondeurs CATEGORY: sans boucles CALLING SEQUENCE:res projectondepth arrayin depthin INPUTS: arrayin: un tableau 3d dont la 3eme dimension doit etre egale a jpk depthin: un tableau 2d indiquant n chaque point a quel profondeur projeter KEYWORD PARAMETERS:none OUTPUTS:res: un tableau 2d projection du tableau 3d suivant les profondeurs indiquees par depthin COMMON BLOCKS:common pro SIDE EFFECTS: points a values f_nan qd calcul impossible points terres masques a Valmask RESTRICTIONS: EXAMPLE: on contruit un tableau de profondeurs possibles IDL a gdept jpk 1 1 jpi jpj findgen jpi jpj on contruit un tableau a projeter sur ces profondeurs pour le test on construit un tableau 3d dont chaque vecteur suivant z est la profondeur IDL arraytest replicate 1 jpi jpj gdept IDL arraytest reform arraytest jpi jpj jpk over on test la projection du tabeau profondeur sur la profondeur IDL plt 1e6 a projectondepth arraytest a nocontour champ nul a 1e 6 pres verifcation en projettant la temperature sur la profondeur de la 20 degres par exemple MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 6 2000 FUNCTION projectondepth arrayin depthin tempsun systime 1 pour key_performance common depth litchamp depthin array litchamp arrayin petites verifications tailledepth size depth taillearray size array if tailledepth 0 NE 2 THEN return report Depth array must have 2 dimensions if taillearray 0 NE 3 THEN return report Array in must have 3 dimensions verification de la coherence entre la taille du tableau et le domaine grille mask 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz case 1 of tailledepth 1 eq jpi and tailledepth 2 eq jpj:depth depth firstx:lastx firsty:lasty tailledepth 1 eq nx and tailledepth 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du tableau de profondeur endcase case 1 OF taillearray 3 NE jpk:return report Le tableau 3d doit avoir sa 3eme dimension egale a jpk taillearray 1 eq jpi and taillearray 2 eq jpj:array array firstx:lastx firsty:lasty taillearray 1 eq nx and taillearray 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du tableau de profondeur endcase c est parti flevel depth2floatlevel depth on vire les points a values f_nan notanumber where finite flevel nan EQ 1 if notanumber 0 NE 1 then flevel notanumber 0 on seuil vire les points terres a valmask par ex flevel 0 flevel jpk 1 indexup level2index floor flevel indexlow nx ny indexup out where indexlow GE nx ny jpk 1 if out 0 NE 1 then indexlow out indexlow out nx ny weight flevel floor flevel res array indexup res res weight array indexlow res on replace les points a values f_nan if notanumber 0 NE 1 then res notanumber values f_nan if out 0 NE 1 then res out values f_nan on masque les points terres a valmask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask if keyword_set key_performance THEN print temps projectondepth systime 1 tempsun return res end"); 168 a[166] = new Array("./ToBeReviewed/CALCULS/remplit.html", "remplit.pro", "", "FUNCTION remplit zinput NAN nan NITER niter BASIQUE basique mask mask FILLXDIR fillxdir FILLYDIR fillydir FILLVAL fillval _extra ex common tempsun systime 1 pour key_performance Extrapole zinout jpi jpj sur les continents en utilisant les 4 plus proches voisins masques oceaniquement et construit un nouveau masque contenant l ancien masque oceanique PLUSles points extrapoles Reitere le processus niter fois C est pas clair essayez Nan: to fill the point which have the value values f_nan Whitout this keyword these point are not filling and stays at values f_nan les points non remplis sont masques a valmask IF n_elements niter EQ 0 THEN niter 1 IF niter EQ 0 THEN return zinput z zinput if n_elements key_gridtype EQ 0 then key_gridtype c if keyword_set basique then begin oldkey_gridtype key_gridtype key_gridtype c nx size zinput 1 ny size zinput 2 if NOT keyword_set mask then mmmask basique ELSE mmmask mask if key_gridtype eq e then begin case vargrid of T :glam glamt firstxt:lastxt firstyt:lastyt U :glam glamu firstxu:lastxu firstyu:lastyu endcase endif ENDIF ELSE grille mmmask glam gphi gdep nx ny nz _extra ex if keyword_set mask then mmmask mask if size mmmask 0 EQ 3 THEN mmmask mmmask 0 if n_elements mmmask EQ 1 then mmmask replicate 1b nx ny if keyword_set nan then begin nanpoint where finite z EQ 0 if nanpoint 0 NE 1 then begin mmmask nanpoint 0b z nanpoint 0 endif ENDIF mmmask byte mmmask on ajoute un cadre de zero a z mask e1 e2 comme ca apres on peut faire des shifts ds tous les sens sans se soucier des bords du domaine tempdeux systime 1 pour key_performance 2 nx2 nx 2 case key_gridtype of c :BEGIN ztmp bytarr nx 2 ny 2 ztmp 1:nx 1:ny mmmask mmmask temporary ztmp ztmp fltarr nx 2 ny 2 ztmp 1:nx 1:ny z if keyword_set key_periodic AND nx EQ jpi then begin ztmp 0 1:ny z jpi 1 ztmp nx 1 1:ny z 0 endif z temporary ztmp END e :BEGIN ztmp bytarr nx 2 ny 4 ztmp 1:nx 2:ny 1 mmmask mmmask temporary ztmp ztmp fltarr nx 2 ny 4 ztmp 1:nx 2:ny 1 z if keyword_set key_periodic AND nx EQ jpi then begin ztmp 0 2:ny 1 z jpi 1 ztmp nx 1 2:ny 1 z 0 endif z temporary ztmp END endcase IF testvar var key_performance EQ 2 THEN print temps remplit: on ajoute un cadre de zero systime 1 tempdeux iteration FOR n 1 niter DO BEGIN on trouve les points coast tempdeux systime 1 pour key_performance 2 les points du bord du cadre ne doivent pas etre selectionnes comme la coast case key_gridtype of c :BEGIN mmmask 0 1b mmmask nx 1 1b mmmask 0 1b mmmask ny 1 1b END e :BEGIN mmmask 0 1b mmmask nx 1 1b mmmask 0:1 1b mmmask ny 2:ny 3 1b END endcase liste des points terre restant IF keyword_set fillxdir THEN BEGIN we stop if all the lines that contains data have been filled test total mmmask 1:nx 1 IF total test EQ 0 test EQ nx EQ ny 2 THEN GOTO fini ENDIF IF keyword_set fillydir THEN BEGIN we stop if all the columns that contains data have been filled test total mmmask 1:ny 2 IF total test EQ 0 test EQ ny EQ nx 2 THEN GOTO fini ENDIF land where mmmask EQ 0 if land 0 EQ 1 then GOTO fini les points du bord du cadre doivent maintenant etre dans la terre case key_gridtype of c :BEGIN mmmask 0 0b mmmask nx 1 0b mmmask 0 0b mmmask ny 1 0b END e :BEGIN mmmask 0 0b mmmask nx 1 0b mmmask 0:1 0b mmmask ny 2:ny 3 0b END endcase if keyword_set key_periodic AND nx EQ jpi then begin mmmask 0 mmmask nx mmmask nx 1 mmmask 1 endif liste des voisins mer case key_gridtype of c :BEGIN CASE 1 OF keyword_set fillxdir :weight mmmask 1 land mmmask 1 land keyword_set fillydir :weight mmmask nx2 land mmmask nx2 land ELSE:weight mmmask 1 land mmmask 1 land mmmask nx2 land mmmask nx2 land 1 sqrt 2 mmmask nx2 1 land mmmask nx2 1 land mmmask nx2 1 land mmmask nx2 1 land ENDCASE END e :BEGIN shifted glam 0 0 LT glam 0 1 oddeven land nx2 1 shifted MOD 2 weight mmmask 1 land mmmask 1 land mmmask 2 nx2 land mmmask 2 nx2 land sqrt 2 mmmask nx2 oddeven land mmmask nx2 1 oddeven land mmmask nx2 oddeven land mmmask nx2 1 oddeven land END endcase ok where weight GT 0 weight weight ok coast land temporary ok IF testvar var key_performance EQ 2 THEN print temps remplit: trouver la coast systime 1 tempdeux remplissage des points coast tempdeux systime 1 pour key_performance 2 on masque z z temporary z mmmask case key_gridtype of c :BEGIN CASE 1 OF keyword_set fillxdir :zcoast z 1 coast z 1 coast keyword_set fillydir :zcoast z nx2 coast z nx2 coast ELSE:zcoast z 1 coast z 1 coast z nx2 coast z nx2 coast 1 sqrt 2 z nx2 1 coast z nx2 1 coast z nx2 1 coast z nx2 1 coast ENDCASE END e :BEGIN oddeven coast nx2 1 shifted MOD 2 zcoast z 1 coast z 1 coast z 2 nx2 coast z 2 nx2 coast sqrt 2 z nx2 oddeven coast z nx2 1 oddeven coast z nx2 oddeven coast z nx2 1 oddeven coast END endcase z coast temporary zcoast temporary weight we update the the boundary conditions of z if keyword_set key_periodic AND nx EQ jpi then begin z 0 z nx z nx 1 z 1 endif IV on reduit le masque mmmask temporary coast 1 IF testvar var key_performance EQ 2 THEN print temps remplit: une iteration systime 1 tempdeux ENDFOR fini: on masque les valeurs sur les lands restantes IF n_elements valmask EQ 0 then valmask 1e20 IF n_elements fillval EQ 0 THEN fillval valmask z temporary z mmmask fillval 1b mmmask on redecoupe le tableau pour retirer le cadre case key_gridtype of c :BEGIN z z 1:nx 1:ny END e :BEGIN z z 1:nx 2:ny 1 END endcase if keyword_set basique then key_gridtype oldkey_gridtype if keyword_set key_performance THEN print temps remplit systime 1 tempsun return z END "); 169 a[167] = new Array("./ToBeReviewed/CALCULS/rhon.html", "rhon.pro", "", "FUNCTION rhon sn tn INSITU insitu SIGMA_N sigma_n common tempsun systime 1 pour key_performance Calcul de la fonction d etat issue de eos F Creation : 1997 G Roullet adaptation pour les tableaux z zt xyz xyzt par seb sn 1e5 double sn double tn 1e5 IF keyword_set sigma_n then insitu 1 taille size sn case taille 0 of 0:BEGIN z zrhop 0d jkmax 1 END 1:BEGIN z zrhop dblarr taille 1 jkmax taille 1 END 2:BEGIN xy jpt 1 ou zt zrhop dblarr taille 1 taille 2 if jpt EQ 1 then jkmax 1 ELSE jkmax taille 1 END 3:BEGIN xyz jpt 1 ou xyt zrhop dblarr taille 1 taille 2 taille 3 if jpt EQ 1 then jkmax taille 3 ELSE jkmax 1 END 4:BEGIN xyzt zrhop dblarr taille 1 taille 2 taille 3 taille 4 jkmax taille 3 END endcase FOR jk 0 jkmax 1 DO BEGIN case taille 0 of 0:BEGIN z ztt tn zs sn END 1:BEGIN z ztt tn jk zs sn jk END 2:BEGIN xy jpt 1 ou zt if jpt EQ 1 then begin ztt tn zs sn ENDIF ELSE BEGIN ztt tn jk zs sn jk ENDELSE END 3:BEGIN xyz jpt 1 ou xyt if jpt EQ 1 then begin ztt tn jk zs sn jk endif ELSE BEGIN ztt tn zs sn ENDELSE END 4:BEGIN xyzt ztt tn jk zs sn jk END endcase if n_elements sigma_n NE 0 then zh 1000 sigma_n ELSE zh gdept jk square root salinity zsr sqrt abs zs compute density pure water at atm pressure zr1 6 536332e 9 ztt 1 120083e 6 ztt 1 001685e 4 ztt 9 095290e 3 ztt 6 793952e 2 ztt 999 842594 seawater density atm pressure zr2 5 3875e 9 ztt 8 2467e 7 ztt 7 6438e 5 ztt 4 0899e 3 ztt 0 824493 zr3 1 6546e 6 ztt 1 0227e 4 ztt 5 72466e 3 zr4 4 8314e 4 potential density reference to the surface case taille 0 of 0: zrhop zr4 zs zr3 zsr zr2 zs zr1 1: zrhop jk zr4 zs zr3 zsr zr2 zs zr1 2:BEGIN if jpt EQ 1 then zrhop zr4 zs zr3 zsr zr2 zs zr1 ELSE zrhop jk zr4 zs zr3 zsr zr2 zs zr1 END 3:BEGIN if jpt EQ 1 then zrhop jk zr4 zs zr3 zsr zr2 zs zr1 ELSE zrhop zr4 zs zr3 zsr zr2 zs zr1 END 4: zrhop jk zr4 zs zr3 zsr zr2 zs zr1 endcase IF n_elements insitu EQ 1 THEN BEGIN add the compression terms ze 3 508914e 8 ztt 1 248266e 8 ztt 2 595994e 6 zbw 1 296821e 6 ztt 5 782165e 9 ztt 1 045941e 4 zb zbw ze zs zd 2 042967e 2 zc 7 267926e 5 ztt 2 598241e 3 ztt 0 1571896 zaw 5 939910e 6 ztt 2 512549e 3 ztt 0 1028859 ztt 4 721788 za zd zsr zc zs zaw zb1 0 1909078 ztt 7 390729 ztt 55 87545 za1 2 326469e 3 ztt 1 553190 ztt 65 00517 ztt 1044 077 zkw 1 361629e 4 ztt 1 852732e 2 ztt 30 41638 ztt 2098 925 ztt 190925 6 zk0 zb1 zsr za1 zs zkw masked in situ density case taille 0 of 0: zrhop zrhop 1 0 zh zk0 zh za zh zb 1: zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb 2:BEGIN if jpt EQ 1 then zrhop zrhop 1 0 zh zk0 zh za zh zb ELSE zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb END 3:BEGIN if jpt EQ 1 then zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb ELSE zrhop zrhop 1 0 zh zk0 zh za zh zb END 4: zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb endcase ENDIF ENDFOR terre where tn GE 1e6 if terre 0 NE 1 then zrhop terre valmask if keyword_set key_performance THEN print temps rhon systime 1 tempsun return zrhop END "); 170 a[168] = new Array("./ToBeReviewed/CALENDRIER/caldat.html", "caldat.pro", "", " Id: caldat pro 69 2006 05 11 10:35:53Z smasson Copyright c 1992 2003 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: CALDAT PURPOSE: Return the calendar date and time given julian date This is the inverse of the function JULDAY CATEGORY: Misc CALLING SEQUENCE: CALDAT Julian Month Day Year Hour Minute Second See also: julday the inverse of this function INPUTS: JULIAN contains the Julian Day Number which begins at noon of the specified calendar date It should be a long integer OUTPUTS: Trailing parameters may be omitted if not required MONTH: Number of the desired month 1 January 12 December DAY: Number of day of the month YEAR: Number of the desired year HOUR: Hour of the day Minute: Minute of the day Second: Second and fractions of the day KEYWORD PARAMETERS: NDAYSPM: for using a calendar with fixed number of days per months defaut value of NDAYSPM 30 COMMON BLOCKS: cm_4cal SIDE EFFECTS: None RESTRICTIONS: Accuracy using IEEE double precision numbers is approximately 1 10000th of a second MODIFICATION HISTORY: Translated from Numerical Recipies in C by William H Press Brian P Flannery Saul A Teukolsky and William T Vetterling Cambridge University Press 1988 second printing DMS July 1992 DMS April 1996 Added HOUR MINUTE and SECOND keyword AB 7 December 1997 Generalized to handle array input Eric Guilyardi June 1999 Added key_work ndayspm for fixed number of days per months AB 3 January 2000 Make seconds output as DOUBLE in array output pro CALDAT julian month day year hour minute second NDAYSPM ndayspm cm_4cal COMPILE_OPT idl2 ON_ERROR 2 Return to caller if errors IF n_elements key_caltype EQ 0 THEN key_caltype greg if keyword_set ndayspm then key_caltype 360d CASE key_caltype OF greg :BEGIN nParam N_PARAMS IF nParam LT 1 THEN MESSAGE Incorrect number of arguments min_julian 1095 max_julian 1827933925 minn MIN julian MAX maxx IF minn LT min_julian OR maxx GT max_julian THEN MESSAGE Value of Julian date is out of allowed range igreg 2299161L Beginning of Gregorian calendar julLong FLOOR julian 0 5d Better be long minJul MIN julLong IF minJul GE igreg THEN BEGIN all are Gregorian jalpha LONG julLong 1867216L 0 25d 36524 25d ja julLong 1L jalpha long 0 25d jalpha ENDIF ELSE BEGIN ja julLong gregChange WHERE julLong ge igreg ngreg IF ngreg GT 0 THEN BEGIN jalpha long julLong gregChange 1867216L 0 25d 36524 25d ja gregChange julLong gregChange 1L jalpha long 0 25d jalpha ENDIF ENDELSE jalpha 1 clear memory jb TEMPORARY ja 1524L jc long 6680d jb 2439870L 122 1d0 365 25d jd long 365d jc 0 25d jc je long jb jd 30 6001d day TEMPORARY jb TEMPORARY jd long 30 6001d je month TEMPORARY je 1L month TEMPORARY month 1L MOD 12L 1L year TEMPORARY jc 4715L year TEMPORARY year month GT 2 year year year LE 0 see if we need to do hours minutes seconds IF nParam GT 4 THEN BEGIN fraction julian 0 5d TEMPORARY julLong hour floor fraction 24d fraction TEMPORARY fraction hour 24d minute floor fraction 1440d second TEMPORARY fraction minute 1440d 86400d ENDIF if julian is an array reform all output to correct dimensions IF SIZE julian N_DIMENSION GT 0 THEN BEGIN dimensions SIZE julian DIMENSION month REFORM month dimensions day REFORM day dimensions year REFORM year dimensions IF nParam GT 4 THEN BEGIN hour REFORM hour dimensions minute REFORM minute dimensions second REFORM second dimensions ENDIF ENDIF END 360d :BEGIN jul long julian f jul floor jul IF total f NE 0 0 GT 0 THEN BEGIN Get hours minutes seconds hour floor f 24 f f hour 24 d minute floor f 1440 second f minute 1440 d0 86400 0d0 ENDIF ELSE BEGIN hour replicate 0L n_elements julian minute replicate 0L n_elements julian second replicate 0L n_elements julian ENDELSE IF keyword_set ndayspm THEN BEGIN IF ndayspm EQ 1 THEN ndayspm 30 ENDIF ELSE ndayspm 30 ndayspm long ndayspm Z floor julian year z 12 ndayspm 1 month z 12 ndayspm year 1 ndayspm 1 day z 12 ndayspm year 1 ndayspm month 1 WHILE total day LT 1 GT 0 DO BEGIN tochange where day LT 1 month tochange month tochange 1 day tochange day tochange ndayspm ENDWHILE WHILE total month LT 1 GT 0 DO BEGIN tochange where month LT 1 year tochange year tochange 1 month tochange month tochange 12 ENDWHILE year 0 does not exist neg where year LT 0 IF neg 0 NE 1 THEN year neg year neg 1 END noleap :BEGIN jul long julian year jul 365 1 day jul MOD 365L zero where day EQ 0 month 1 day GT 31 day GT 59 day GT 90 day GT 120 day GT 151 day GT 181 day GT 212 day GT 243 day GT 273 day GT 304 day GT 334 month long month day day 31L day GT 31 28L day GT 59 31L day GT 90 30L day GT 120 31L day GT 151 30L day GT 181 31L day GT 212 31L day GT 243 30L day GT 273 31L day GT 304 30L day GT 334 IF zero 0 NE 1 THEN BEGIN year zero year zero 1 month zero 12L day zero 31L ENDIF END ELSE:BEGIN ng report only 3 types of calendar are accepted: greg 360d and noleap return END ENDCASE zero where year ge 600000L cnt IF cnt NE 0 THEN year zero year zero 654321L return END"); 171 a[169] = new Array("./ToBeReviewed/CALENDRIER/def_month.html", "def_month.pro", "", "FUNCTION def_month timave date translate month number in string IF strpos date _ GT 1 THEN date strmid date 0 strpos date _ CASE strmid timave 0 2 OF 1m : BEGIN CASE strmid date strlen date 2 2 OF 01 : mn January 02 : mn February 03 : mn March 04 : mn April 05 : mn May 06 : mn June 07 : mn July 08 : mn August 09 : mn September 10 : mn October 11 : mn November 12 : mn December ELSE: mn ENDCASE END 3m : BEGIN CASE strmid date strlen date 2 2 OF 01 : mn DJF 02 : mn MMA 03 : mn JJA 04 : mn SON ELSE: mn ENDCASE END ELSE: ENDCASE return mn END "); 172 a[170] = new Array("./ToBeReviewed/CALENDRIER/julday.html", "julday.pro", "", " Id: julday pro 69 2006 05 11 10:35:53Z smasson Copyright c 1988 2003 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: JULDAY PURPOSE: Calculate the Julian Day Number for a given month day and year This is the inverse of the library function CALDAT See also caldat the inverse of this function CATEGORY: Misc CALLING SEQUENCE: Result JULDAY Month Day Year Hour Minute Second INPUTS: MONTH: Number of the desired month 1 January 12 December DAY: Number of day of the month YEAR: Number of the desired year Year parameters must be valid values from the civil calendar Years B C E are represented as negative integers Years in the common era are represented as positive integers In particular note that there is no year 0 in the civil calendar 1 B C E 1 is followed by 1 C E 1 HOUR: Number of the hour of the day MINUTE: Number of the minute of the hour SECOND: Number of the second of the minute Note: Month Day Year Hour Minute and Second can all be arrays The Result will have the same dimensions as the smallest array or will be a scalar if all arguments are scalars OPTIONAL INPUT PARAMETERS: Hour Minute Second optional time of day KEYWORD PARAMETERS: NDAYSPM: for using a calendar with fixed number of days per months defaut value of NDAYSPM 30 OUTPUTS: JULDAY returns the Julian Day Number which begins at noon of the specified calendar date If Hour Minute and Second are not specified then the result will be a long integer otherwise the result is a double precision floating point number COMMON BLOCKS: cm_4cal SIDE EFFECTS: None RESTRICTIONS: Accuracy using IEEE double precision numbers is approximately 1 10000th of a second with higher accuracy for smaller earlier Julian dates MODIFICATION HISTORY: Translated from Numerical Recipies in C by William H Press Brian P Flannery Saul A Teukolsky and William T Vetterling Cambridge University Press 1988 second printing AB September 1988 DMS April 1995 Added time of day Eric Guilyardi June 1999 Added key_work ndayspm for fixed number of days per months change to accept year 0 Sebastien Masson Aug 2003 fix bug for negative and large values of month values eg julday 349 1 1970 CT April 2000 Now accepts vectors or scalars function JULDAY MONTH DAY YEARin Hour Minute Second NDAYSPM ndayspm cm_4cal COMPILE_OPT idl2 ON_ERROR 2 Return to caller if errors IF n_elements key_caltype EQ 0 THEN key_caltype greg if keyword_set ndayspm then key_caltype 360d YEAR long yearin zero where year EQ 0 cnt IF cnt NE 0 THEN YEAR zero 654321L CASE key_caltype OF greg :BEGIN Gregorian Calander was adopted on Oct 15 1582 skipping from Oct 4 1582 to Oct 15 1582 GREG 2299171L incorrect Julian day for Oct 25 1582 Process the input if all are missing use todays date NP n_params IF np EQ 0 THEN RETURN SYSTIME JULIAN IF np LT 3 THEN MESSAGE Incorrect number of arguments Find the dimensions of the Result: 1 Find all of the input arguments that are arrays ignore scalars 2 Out of the arrays find the smallest number of elements 3 Find the dimensions of the smallest array Step 1: find all array arguments nDims SIZE month N_DIMENSIONS SIZE day N_DIMENSIONS SIZE year N_DIMENSIONS SIZE hour N_DIMENSIONS SIZE minute N_DIMENSIONS SIZE second N_DIMENSIONS arrays WHERE nDims GE 1 nJulian 1L assume everything is a scalar IF arrays 0 GE 0 THEN BEGIN Step 2: find the smallest number of elements nElement N_ELEMENTS month N_ELEMENTS day N_ELEMENTS year N_ELEMENTS hour N_ELEMENTS minute N_ELEMENTS second nJulian MIN nElement arrays whichVar step 3: find dimensions of the smallest array CASE arrays whichVar OF 0: julianDims SIZE month DIMENSIONS 1: julianDims SIZE day DIMENSIONS 2: julianDims SIZE year DIMENSIONS 3: julianDims SIZE hour DIMENSIONS 4: julianDims SIZE minute DIMENSIONS 5: julianDims SIZE second DIMENSIONS ENDCASE ENDIF d_Second 0d defaults d_Minute 0d d_Hour 0d convert all Arguments to appropriate array size type SWITCH np OF use switch so we fall thru all arguments 6: d_Second SIZE second N_DIMENSIONS GT 0 second 0:nJulian 1 : second 5: d_Minute SIZE minute N_DIMENSIONS GT 0 minute 0:nJulian 1 : minute 4: d_Hour SIZE hour N_DIMENSIONS GT 0 hour 0:nJulian 1 : hour 3: BEGIN convert m d y to type LONG L_MONTH SIZE month N_DIMENSIONS GT 0 LONG month 0:nJulian 1 : LONG month L_DAY SIZE day N_DIMENSIONS GT 0 LONG day 0:nJulian 1 : LONG day L_YEAR SIZE year N_DIMENSIONS GT 0 LONG year 0:nJulian 1 : LONG year END ENDSWITCH min_calendar 4716 max_calendar 5000000 minn MIN l_year MAX maxx IF minn LT min_calendar OR maxx GT max_calendar THEN MESSAGE Value of Julian date is out of allowed range change to accept year 0 if MAX L_YEAR eq 0 NE 0 then message There is no year zero in the civil calendar by seb Aug 2003 tochange where L_MONTH LT 0 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 1 L_MONTH tochange 12 L_MONTH tochange MOD 12 ENDIF tochange where L_MONTH GT 12 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 L_MONTH tochange L_MONTH tochange MOD 12 ENDIF by seb Aug 2003 end bc L_YEAR LT 0 L_YEAR TEMPORARY L_YEAR TEMPORARY bc inJanFeb L_MONTH LE 2 JY L_YEAR inJanFeb JM L_MONTH 1b 12b TEMPORARY inJanFeb JUL floor 365 25d JY floor 30 6001d TEMPORARY JM L_DAY 1720995L Test whether to change to Gregorian Calandar IF MIN JUL GE GREG THEN BEGIN change all dates JA long 0 01d TEMPORARY JY JUL TEMPORARY JUL 2L JA long 0 25d JA ENDIF ELSE BEGIN gregChange WHERE JUL ge GREG ngreg IF ngreg GT 0 THEN BEGIN JA long 0 01d JY gregChange JUL gregChange JUL gregChange 2L JA long 0 25d JA ENDIF ENDELSE hour minute second IF np GT 3 THEN BEGIN yes compute the fractional Julian date Add a small offset so we get the hours minutes seconds back correctly if we convert the Julian dates back This offset is proportional to the Julian date so small dates a long long time ago will be more accurate eps MACHAR DOUBLE eps eps eps ABS jul eps For Hours divide by 24 then subtract 0 5 in case we have unsigned ints jul TEMPORARY JUL TEMPORARY d_Hour 24d 0 5d TEMPORARY d_Minute 1440d TEMPORARY d_Second 86400d eps ENDIF check to see if we need to reform vector to array of correct dimensions IF N_ELEMENTS julianDims GT 1 THEN JUL REFORM TEMPORARY JUL julianDims RETURN jul END 360d :BEGIN Fixed number of days per month default 30 : IF keyword_set ndayspm THEN BEGIN IF ndayspm EQ 1 THEN ndayspm 30 ENDIF ELSE ndayspm 30 L_MONTH LONG MONTH L_DAY LONG DAY L_YEAR LONG YEAR neg where L_YEAR LT 0 IF neg 0 NE 1 THEN L_YEAR neg L_YEAR neg 1 JUL L_YEAR 1 12 L_MONTH 1 ndayspm L_DAY if n_elements Hour n_elements Minute n_elements Second eq 0 then return JUL if n_elements Hour eq 0 then Hour 0 if n_elements Minute eq 0 then Minute 0 if n_elements Second eq 0 then Second 0 IF Hour Minute Second EQ 0 THEN return JUL ELSE return JUL Hour 24 0d0 Minute 1440 0d0 Second 86400 0d0 END noleap :BEGIN L_MONTH LONG MONTH L_DAY LONG DAY L_YEAR LONG YEAR tochange where L_MONTH LT 0 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 1 L_MONTH tochange 12 L_MONTH tochange MOD 12 ENDIF tochange where L_MONTH GT 12 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 L_MONTH tochange L_MONTH tochange MOD 12 ENDIF L_YEAR L_YEAR 1 daysyear long total 0 0 31 28 31 30 31 30 31 31 30 31 30 cumulative return 365 L_YEAR daysyear L_MONTH L_DAY END ELSE:return report only 3 types of calendar are accepted: greg 360d and noleap ENDCASE END"); 173 a[171] = new Array("./ToBeReviewed/COULEURS/color24.html", "color24.pro", "", " NAME: COLOR24 PURPOSE: The purpose of this function is to convert a RGB color triple into the equivalent 24 big long integer CATEGORY: Graphics Color Specification CALLING SEQUENCE: color COLOR24 rgb_triple INPUTS: RGB_TRIPLE: A three element column or row array representing a color triple The values of the elements must be between 0 and 255 KEYWORD PARAMETERS: None COMMON BLOCKS: None SIDE EFFECTS: None RESTRICTIONS: None EXAMPLE: To convert the color triple for the color YELLOW 255 255 0 to the hexadecimal value 00FFFF x or the decimal number 65535 type: color COLOR24 255 255 0 This routine was written to be used with routines like COLORS or GETCOLOR MODIFICATION HISTORY: Written by: David Fanning 3 February 96 FUNCTION COLOR24 number This FUNCTION accepts a red green blue triple that describes a particular color and returns a 24 bit long integer that is equivalent to that color The color is described in terms of a hexidecimal number e g FF206A where the left two digits represent the blue color the middle two digits represent the green color and the right two digits represent the red color The triple can be either a row or column vector of 3 elements ON_ERROR 1 IF N_ELEMENTS number NE 3 THEN MESSAGE Augument must be a three element vector IF MAX number GT 255 OR MIN number LT 0 THEN MESSAGE Argument values must be in range of 0 255 base16 1L 16L 256L 4096L 65536L 1048576L num24bit 0L FOR j 0 2 DO num24bit num24bit number j MOD 16 base16 0 j Fix number j 16 base16 1 j RETURN num24bit END "); 174 a[172] = new Array("./ToBeReviewed/COULEURS/colorbar.html", "colorbar.pro", "", " NAME: COLORBAR PURPOSE: The purpose of this routine is to add a color bar to the current graphics window CATEGORY: Graphics Widgets CALLING SEQUENCE: COLORBAR INPUTS: None KEYWORD PARAMETERS: BOTTOM: The lowest color index of the colors to be loaded in the bar CB_CHARSIZE: The character size of the color bar annotations Default is 1 0 CB_CHARTICK: The character thick of the color bar annotations Default is 1 0 CB_COLOR: The color index of the bar outline and characters Default is ncolors 1 bottom CB_LOG: to get logarithmic scale for the colorbar CB_TITLE: This is title for the color bar The default is to have no title DISCRET: Vecteur contenant les incices des couleurs a tracer en barre de couleur On obtient ainsi une barre de couleur discrete ne comportant que les couleurs specifiees ds l ordre ou elles apparaissent ds le vecteur DIVISIONS: The number of divisions to divide the bar into There will be divisions 1 annotations The default is 2 FORMAT: The format of the bar annotations Default is F6 2 CB_LABEL: C est un vecteur qui specifie la valeur des sticks presents dans la barre de couleur Il permet qd on utilise DISCRET d avoir des couleurs qui ne s incrementent pas de facon regulieres MAX: The maximum data value for the bar annotation Default is NCOLORS 1 MIN: The minimum data value for the bar annotation Default is 0 NCOLORS: This is the number of colors in the color bar NOTITLE: oblige a ne pas mettre de titre meme si cb_title est declare POSITION: A four element array of normalized coordinates in the same form as the POSITION keyword on a plot Default is 0 88 0 15 0 95 0 95 for a vertical bar and 0 15 0 88 0 95 0 95 for a horizontal bar PSCOLOR: This keyword is only applied if the output is being sent to a PostScript file It indicates that the PostScript device is configured for color output If this keyword is set then the annotation is drawn in the color specified by the COLOR keyword If the keyword is not set the annotation is drawn in the color specified by the P COLOR system variable usually this will be the color black In general this gives better looking output on non color or gray scale printers If you are not specifically setting the annotation color with the COLOR keyword it will probably be better NOT to set this keyword either even if you are outputting to a color PostScript printer RIGHT: This puts the labels on the right hand side of a vertical color bar It applies only to vertical color bars TOP: This puts the labels on top of the bar rather than under it The keyword only applies if a horizontal color bar is rendered VERTICAL: Setting this keyword give a vertical color bar The default is a horizontal color bar COMMON BLOCKS: None SIDE EFFECTS: Color bar is drawn in the current graphics window RESTRICTIONS: The number of colors available on the display device not the PostScript device is used unless the NCOLORS keyword is used EXAMPLE: To display a horizontal color bar above a contour plot type: LOADCT 5 NCOLORS 100 CONTOUR DIST 31 41 POSITION 0 15 0 15 0 95 0 75 C_COLORS INDGEN 25 4 NLEVELS 25 COLORBAR NCOLORS 100 MODIFICATION HISTORY: Written by: David Fanning 10 JUNE 96 10 27 96: Added the ability to send output to PostScript DWF 11 4 96: Substantially rewritten to go to screen or PostScript file without having to know much about the PostScript device or even what the current graphics device is DWF 1 27 97: Added the RIGHT and TOP keywords Also modified the way the TITLE keyword works DWF 7 15 97: Fixed a problem some machines have with plots that have no valid data range in them DWF 3 3 98: ajout du keyword discret par sebastien smasson lodyc jussieu fr PRO COLORBAR BOTTOM bottom CB_CHARSIZE cb_charsize CB_CHARTHICK cb_charthick CB_COLOR cb_color DIVISIONS divisions DISCRET discret CB_LABEL cb_label FORMAT format POSITION position MAX max MIN min NCOLORS ncolors PSCOLOR pscolor CB_TITLE cb_title VERTICAL vertical TOP top RIGHT right CB_LOG CB_log _extra ex Is the PostScript device selected postScriptDevice D NAME EQ PS Check and define keywords IF N_ELEMENTS ncolors EQ 0 THEN BEGIN Most display devices to not use the 256 colors available to the PostScript device This presents a problem when writing general purpose programs that can be output to the display or to the PostScript device This problem is especially bothersome if you don t specify the number of colors you are using in the program One way to work around this problem is to make the default number of colors the same for the display device and for the PostScript device Then the colors you see in PostScript are identical to the colors you see on your display Here is one way to do it IF postScriptDevice THEN BEGIN oldDevice D NAME What kind of computer are we using SET_PLOT to appropriate display device thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x Open a window to make sure D N_COLORS is accurate WINDOW FREE PIXMAP XSIZE 10 YSIZE 10 WDELETE D WINDOW Here is how many colors we should use ncolors D N_COLORS SET_PLOT oldDevice IF oldDevice EQ X OR oldDevice EQ MAC OR oldDevice EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF ENDIF ELSE ncolors D N_COLORS ENDIF IF N_ELEMENTS bottom EQ 0 THEN bottom 0B IF N_ELEMENTS cb_charsize EQ 0 THEN cb_charsize 1 0 IF N_ELEMENTS cb_charthick EQ 0 THEN cb_charthick 1 0 IF N_ELEMENTS format EQ 0 THEN format F6 2 IF N_ELEMENTS cb_color EQ 0 THEN cb_color ncolors 1 bottom IF N_ELEMENTS min EQ 0 THEN min 0 0 IF N_ELEMENTS max EQ 0 THEN max FLOAT ncolors 1 IF N_ELEMENTS divisions EQ 0 THEN divisions 2 IF N_ELEMENTS cb_title EQ 0 THEN cb_title IF N_ELEMENTS notitle EQ 1 THEN cb_title pscolor KEYWORD_SET pscolor IF KEYWORD_SET vertical THEN BEGIN IF KEYWORD_SET discret THEN begin facteur 256 n_elements discret discret reform replicate 1 facteur discret facteur n_elements discret overwrite bar REPLICATE 1B 10 discret endif else bar REPLICATE 1B 10 BINDGEN 256 IF N_ELEMENTS position EQ 0 THEN position 0 88 0 15 0 95 0 95 ENDIF ELSE BEGIN IF KEYWORD_SET discret THEN begin facteur 256 n_elements discret discret reform replicate 1 facteur discret facteur n_elements discret overwrite bar discret REPLICATE 1B 10 endif else bar BINDGEN 256 REPLICATE 1B 10 IF N_ELEMENTS position EQ 0 THEN position 0 15 0 88 0 95 0 95 ENDELSE Scale the color bar IF NOT KEYWORD_SET discret THEN bar BYTSCL bar TOP ncolors 1 bottom Get starting locations in DEVICE coordinates xstart position 0 D X_VSIZE ystart position 1 D Y_VSIZE Get the size of the bar in DEVICE coordinates xsize position 2 position 0 D X_VSIZE ysize position 3 position 1 D Y_VSIZE For PostScript output only draw the annotation in P COLOR unless pscolor is set This makes better output on grayscale printers IF postScriptDevice AND pscolor NE 1 THEN BEGIN oldcolor cb_color cb_color P COLOR ENDIF Display the color bar in the window Sizing is different for PostScript and regular display IF postScriptDevice THEN BEGIN TV bar xstart ystart XSIZE xsize YSIZE ysize ENDIF ELSE BEGIN bar CONGRID bar CEIL xsize CEIL ysize INTERP TV bar xstart ystart ENDELSE Annotate the color bar if keyword_set cb_label then begin divisions n_elements cb_label 1 for i 0 divisions DO cb_label string cb_label FORMAT format format ENDIF ELSE cb_label IF KEYWORD_SET vertical THEN BEGIN IF KEYWORD_SET right THEN BEGIN PLOT min max min max NODATA XTICKS 1 YTICKS divisions XSTYLE 1 YSTYLE 9 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT A1 YTICKLEN 0 1 YRANGE min max YTITLE cb_title AXIS YAXIS 1 YRANGE min max YTICKFORMAT format YTICKS divisions YTICKLEN 0 1 YSTYLE 1 COLOR cb_color CHARTHICK cb_charthick CHARSIZE cb_charsize xtickname cb_label ylog cb_log ENDIF ELSE BEGIN PLOT min max min max NODATA XTICKS 1 YTICKS divisions XSTYLE 1 YSTYLE 9 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT format XTICKFORMAT A1 YTICKLEN 0 1 YRANGE min max xtickname cb_label AXIS YAXIS 1 YRANGE min max YTICKFORMAT A1 YTICKS divisions YTICKLEN 0 1 YTITLE cb_title YSTYLE 1 COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick ylog cb_log ENDELSE ENDIF ELSE BEGIN IF KEYWORD_SET top THEN BEGIN PLOT min max min max NODATA XTICKS divisions YTICKS 1 XSTYLE 9 YSTYLE 1 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT A1 XTICKLEN 0 1 XRANGE min max XTITLE cb_title AXIS XTICKS divisions XSTYLE 1 COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick XTICKFORMAT format XTICKLEN 0 1 XRANGE min max XAXIS 1 xtickname cb_label xlog cb_log ENDIF ELSE BEGIN PLOT min max min max NODATA XTICKS divisions YTICKS 1 XSTYLE 1 YSTYLE 1 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT format XTICKLEN 0 1 XRANGE min max TITLE cb_title xtickname cb_label xlog cb_log ENDELSE ENDELSE Restore color variable if changed for PostScript IF postScriptDevice AND pscolor NE 1 THEN cb_color oldcolor return END"); 175 a[173] = new Array("./ToBeReviewed/COULEURS/getcolor.html", "getcolor.pro", "", " NAME: GETCOLOR PURPOSE: The original purpose of this function was to enable the user to specify one of the 16 colors supported by the McIDAS color map by name Over time however the function has become a general purpose function for handling and supporting drawing colors in a device independent way In particular I have been looking for ways to write color handling code that will work transparently on both 8 bit and 24 bit machines On 24 bit machines the code should work the same where color decomposition is turned on or off The 16 supported colors in GETCOLOR come from the McIDAS color table offered on the IDL newsgroup by Liam Gumley CATEGORY: Graphics Color Specification CALLING SEQUENCE: result GETCOLOR color OPTIONAL INPUT PARAMETERS: COLOR: A string with the name of the color Valid names are: black magenta cyan yellow green red blue navy gold pink aqua orchid gray sky beige white The color YELLOW is returned if the color name can t be resolved Case is unimportant If the function is called with just this single input parameter the return value is either a 1 by 3 array containing the RGB values of that particular color or a 24 bit integer that can be decomposed into that particular color depending upon the state of the TRUE keyword and upon whether color decomposition is turned on or off The state of color decomposition can ONLY be determined if the program is being run in IDL 5 2 or higher INDEX: The color table index where the specified color should be loaded If this parameter is passed then the return value of the function is the index number and not the color triple If color decomposition is turned on AND the user specifies an index parameter the color is loaded in the color table at the proper index but a 24 bit value is returned to the user in IDL 5 2 and higher If no positional parameter is present then the return value is either a 16 by 3 byte array containing the RGB values of all 16 colors or it is a 16 element long integer array containing color values that can be decomposed into colors The 16 by 3 array is appropriate for loading color tables with the TVLCT command: Device Decomposed 0 colors GetColor TVLCT colors 100 INPUT KEYWORD PARAMETERS: NAMES: If this keyword is set the return value of the function is a 16 element string array containing the names of the colors These names would be appropriate for example in building a list widget with the names of the colors If the NAMES keyword is set the COLOR and INDEX parameters are ignored listID Widget_List baseID Value GetColor Names YSize 16 LOAD: If this keyword is set all 16 colors are automatically loaded starting at the color index specified by the START keyword Note that setting this keyword means that the return value of the function will be a structure with each field of the structure corresponding to a color name The value of each field will be an index number set by the START keyword corresponding to the associated color or a 24 bit long integer value that creates the color on a true color device What you have as the field values is determined by the TRUE keyword or whether color decomposition is on or off in the absense of the TRUE keyword It will either be a 1 by 3 byte array or a long integer value START: The starting color index number if the LOAD keyword is set This keyword value is ignored unless the LOAD keyword is also set The keyword is also ignored if the TRUE keyword is set or if color decomposition in on in IDL 5 2 and higher The default value for the START keyword is D TABLE_SIZE 17 TRUE: If this keyword is set the specified color triple is returned as a 24 bit integer equivalent The lowest 8 bits correspond to the red value the middle 8 bits to the green value and the highest 8 bits correspond to the blue value In IDL 5 2 and higher if color decomposition is turned on it is as though this keyword were set COMMON BLOCKS: None SIDE EFFECTS: None RESTRICTIONS: The TRUE keyword causes the START keyword to be ignored The NAMES keyword causes the COLOR INDEX START and TRUE parameters to be ignored The COLOR parameter is ignored if the LOAD keyword is used On systems where it is possible to tell the state of color decomposition i e IDL 5 2 and higher a 24 bit value or values is automatically returned if color decomposition is ON EXAMPLE: To load a yellow color in color index 100 and plot in yellow type: yellow GETCOLOR yellow 100 PLOT data COLOR yellow or PLOT data COLOR GETCOLOR yellow 100 To do the same thing on a 24 bit color system with decomposed color on type: PLOT data COLOR GETCOLOR yellow TRUE or in IDL 5 2 and higher DEVICE Decomposed 1 PLOT data COLOR GETCOLOR yellow To load all 16 colors into the current color table starting at color index 200 type: TVLCT GETCOLOR 200 To add the color names to a list widget: listID Widget_List baseID Value GetColor Names YSize 16 To load all 16 colors and have the color indices returned in a structure: DEVICE Decomposed 0 colors GetColor Load Start 1 HELP colors Structure PLOT data COLOR colors yellow To get the direct color values as 24 bit integers in color structure fields: DEVICE Decomposed 1 colors GetColor Load PLOT data COLOR colors yellow Note that the START keyword value is ignored if on a 24 bit device so it is possible to write completely device independent code by writing code like this: colors GetColor Load PLOT data Color colors yellow MODIFICATION HISTORY: Written by: David Fanning 10 February 96 Fixed a bug in which N_ELEMENTS was spelled wrong 7 Dec 96 DWF Added the McIDAS colors to the program 24 Feb 99 DWF Added the INDEX parameter to the program 8 Mar 99 DWF Added the NAMES keyword at insistence of Martin Schultz 10 Mar 99 DWF Reorderd the colors so black is first and white is last 7 June 99 DWF Added automatic recognition of DECOMPOSED 1 state 7 June 99 DWF Added LOAD AND START keywords 7 June 99 DWF FUNCTION COLOR24 number This FUNCTION accepts a red green blue triple that describes a particular color and returns a 24 bit long integer that is equivalent to that color The color is described in terms of a hexidecimal number e g FF206A where the left two digits represent the blue color the middle two digits represent the green color and the right two digits represent the red color The triple can be either a row or column vector of 3 elements ON_ERROR 1 IF N_ELEMENTS number NE 3 THEN MESSAGE Augument must be a three element vector IF MAX number GT 255 OR MIN number LT 0 THEN MESSAGE Argument values must be in range of 0 255 base16 1L 16L 256L 4096L 65536L 1048576L num24bit 0L FOR j 0 2 DO num24bit num24bit number j MOD 16 base16 0 j Fix number j 16 base16 1 j RETURN num24bit END of COLOR24 FUNCTION GETCOLOR thisColor index TRUE truecolor NAMES colornames LOAD load START start Set up the color vectors names Black Magenta Cyan Yellow Green rvalue 0 255 0 255 0 gvalue 0 0 255 255 255 bvalue 0 255 255 0 0 names names Red Blue Navy Gold Pink rvalue rvalue 255 0 0 255 255 gvalue gvalue 0 0 0 187 127 bvalue bvalue 0 255 115 0 127 names names Aqua Orchid Gray Sky Beige White rvalue rvalue 112 219 127 0 255 255 gvalue gvalue 219 112 127 163 171 255 bvalue bvalue 147 219 127 255 127 255 Did the user ask for a specific color If not return all the colors If the user asked for a specific color find out if a 24 bit value is required Return to main IDL level if an error occurs ON_Error 1 np N_Params IF Keyword_Set start EQ 0 THEN start D TABLE_SIZE 17 User ask for the color names IF Keyword_Set colornames THEN RETURN names ELSE names StrUpCase names If no positional parameter return all colors IF np EQ 0 THEN BEGIN Did the user want a 24 bit value If so call COLOR24 IF Keyword_Set trueColor THEN BEGIN returnColor LonArr 16 FOR j 0 15 DO returnColor j Color24 rvalue j gvalue j bvalue j If LOAD keyword set return a color structure IF Keyword_Set load THEN BEGIN returnValue Create_Struct black returnColor 0 FOR j 1 15 DO returnValue Create_Struct returnValue names j returnColor j returnColor returnValue ENDIF RETURN returnColor ENDIF If color decomposition is ON return 24 bit values IF Float Version Release GE 5 2 THEN BEGIN IF D Name EQ X OR D Name EQ WIN OR D Name EQ MAC THEN BEGIN Device Get_Decomposed decomposedState ENDIF ELSE decomposedState 0 IF decomposedState EQ 1 THEN BEGIN returnColor LonArr 16 FOR j 0 15 DO returnColor j Color24 rvalue j gvalue j bvalue j IF Keyword_Set load THEN BEGIN returnValue Create_Struct black returnColor 0 FOR j 1 15 DO returnValue Create_Struct returnValue names j returnColor j RETURN returnValue ENDIF RETURN returnColor ENDIF IF Keyword_Set load THEN BEGIN TVLCT Reform rvalue gvalue bvalue 16 3 start returnValue Create_Struct black start FOR j 1 15 DO returnValue Create_Struct returnValue names j start j RETURN returnValue ENDIF returnColor REFORM rvalue gvalue bvalue 16 3 RETURN returnColor ENDIF IF Keyword_Set load THEN BEGIN TVLCT Reform rvalue gvalue bvalue 16 3 start returnValue Create_Struct black start FOR j 1 15 DO returnValue Create_Struct returnValue names j start j RETURN returnValue ENDIF returnColor REFORM rvalue gvalue bvalue 16 3 RETURN returnColor ENDIF Check synonyms of colors IF StrUpCase thisColor EQ GREY THEN thisColor GRAY IF StrUpCase thisColor EQ CHARCOAL THEN thisColor GRAY IF StrUpCase thisColor EQ AQUAMARINE THEN thisColor AQUA IF StrUpCase thisColor EQ SKYBLUE THEN thisColor SKY Make sure the parameter is an uppercase string varInfo SIZE thisColor IF varInfo varInfo 0 1 NE 7 THEN MESSAGE The color name must be a string thisColor STRUPCASE thisColor Get the color triple for this color colorIndex WHERE names EQ thisColor If you can t find it Issue an infomational message set the index to a YELLOW color and continue IF colorIndex 0 LT 0 THEN BEGIN MESSAGE Can t find color Returning YELLOW INFORMATIONAL colorIndex 3 ENDIF Get the color triple r rvalue colorIndex g gvalue colorIndex b bvalue colorIndex returnColor REFORM r g b 1 3 Did the user want a 24 bit value If so call COLOR24 IF KEYWORD_SET trueColor THEN BEGIN returnColor COLOR24 returnColor RETURN returnColor ENDIF If color decomposition is ON return 24 bit value IF Float Version Release GE 5 2 THEN BEGIN IF D Name EQ X OR D Name EQ WIN OR D Name EQ MAC THEN BEGIN Device Get_Decomposed decomposedState ENDIF ELSE decomposedState 0 IF decomposedState EQ 1 THEN BEGIN Before you change return color load index if requested IF N_Elements index NE 0 THEN BEGIN index 0 index index D Table_Size 1 TVLCT returnColor index returnColor index ENDIF RETURN returnColor END"); 176 a[174] = new Array("./ToBeReviewed/COULEURS/lct.html", "lct.pro", "", " NAME:lct PURPOSE:plus court que de taper loadct file palette tbl CATEGORY:flemme CALLING SEQUENCE:lct numerp_couleur INPUTS:optionnel: numero de la couleur que l on veut ds palette tbl KEYWORD PARAMETERS: ceux de loadct LIGHTNESS: a scalar used to change the Lightness of the color palette to be abble to adjust according to the printer we use the media paper or slide lightness 1 to get darker colors rq: si le mot cle file n est pas specifie on cherche un fichier contenant les palette du nom de palette tbl Ce fichier peut etre dans n importe quel repertoire du path MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 30 3 1999 ajout de _extra de la recherche du nom complet et pour que ca marche aussi en mode PS et Z 6 7 1999: compatibilite mac et windows PRO lct numero GET_NAME get_name LIGHTNESS Lightness _EXTRA ex common le mot cle file est passe par l intermediere de EXTRA definition du mon du fichier qui contient les palettes de couleur if n_elements ex NE 0 then BEGIN if where tag_names ex EQ FILE 0 NE 1 then nompal ex FILE ELSE nompal palette tbl ENDIF ELSE nompal palette tbl quelle est l adresse complete de nompal thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos nompal sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep for i 0 n_elements multipath 1 do if rstrpos multipath i sep NE strlen multipath i 1 then multipath i multipath i sep nompal current multipath nompal ENDIF on test tous les noms possibles pour trouver ou est le fichier nfile n_elements nompal n 0 repeat begin res findfile nompal n n n 1 endrep until res 0 NE OR n EQ n_elements nompal if res 0 NE then BEGIN nompal nompal n 1 if n_elements ex NE 0 then if where tag_names ex EQ FILE 0 NE 1 then ex FILE nompal si on est en mode POSTSCRIPT il faut repasser en mode X pour changer la palette de couleur oldname d name if d name EQ PS OR d name EQ Z then BEGIN thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF if arg_present get_name then begin if n_elements numero EQ 0 then loadct file nompal GET_NAME get_name _EXTRA ex ELSE loadct numero file nompal silent GET_NAME get_name _EXTRA ex ENDIF ELSE BEGIN if n_elements numero EQ 0 then loadct file nompal _EXTRA ex ELSE loadct numero file nompal silent _EXTRA ex ENDELSE if oldname EQ PS AND keyword_set lightness then palit lightness set_plot oldname IF oldname EQ X OR oldname EQ MAC OR oldname EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF ENDIF ELSE ras report le fichier de palettes demande n existe pas return end"); 177 a[175] = new Array("./ToBeReviewed/COULEURS/newpalette.html", "newpalette.pro", "", " NAME:newpalette PURPOSE:permet de stocker la palette qui est a l ecran dans un fichier du meme type que celui fournit par defaut dans IDL: colors1 tbl CATEGORY:pour garder ses jolies palettes perso CALLING SEQUENCE:newpalette nom_de_palette INPUTS:nom_de_palette: c est un string qui contient le nom de la nouvelle palette que l on veut ecrire KEYWORD PARAMETERS: OVER: c est un entier qui designe le numero de la palette que l on veut remplacer par la palette a l ecran ceux de modifyct rq: si le mot cle file n est pas specifie on cherche un fichier contenant les palettes du nom de palette tbl Ce fichier peut etre dans n importe quel repertoire du path Par contre il doit etre en droit d ecriture MODIFICATION HISTORY: Guillaume Roulet gr lodyc jussieu fr 30 3 1999 s masson ajout de _extra de le recherche du nom complet de OVER et du blabla 5 5 1999 s masson va copie eventuelle du fichier contenant les palettes pro newpalette nom OVER over _extra ex le mot cle file est passe par l intermediere de EXTRA definition du mon du fichier qui contient les palettes de couleur if n_elements ex NE 0 then BEGIN if where tag_names ex EQ FILE 0 NE 1 then nompal ex FILE ELSE nompal palette tbl ENDIF ELSE nompal palette tbl nomcourt nompal quelle est l adresse complete de nompal nompal find nompal if nompal 0 NE NOT FOUND then begin nompal nompal 0 nompal nous appartient spawn whoami login appartient strpos nompal login 0 if appartient EQ 1 then begin ouinon report Le fichier nompal ne vous appartient pas Voulez vous copier le fichier nomcourt dans le repertoire courant: current default_no question if ouinon then return ELSE BEGIN spawn cp nompal nomcourt on copie nompal nomcourt spawn chmod u w nompal on se donne les droits d ecriture ENDELSE endif ENDIF ELSE BEGIN aucun fichier nompal a ete trouve nompal nomcourt on recupe le nompal d origine ouinon report le fichier de palettes demande nompal n existe pas ds les repertoires path Voulez vous cree un fichier nompal dans le repertoire courant default_no question if NOT ouinon then return nomfichsource filepath colors1 tbl subdir resource colors spawn cp nomfichsource nompal on copie spawn chmod u w nompal on se donne les droits d ecriture ENDELSE if n_elements ex NE 0 then if where tag_names ex EQ FILE 0 NE 1 then ex FILE nompal tvlct r g b get r congrid r 256 g congrid g 256 b congrid b 256 IF n_elements over EQ 0 then over 255 modifyct over nom r g b file nompal _extra ex return end"); 178 a[176] = new Array("./ToBeReviewed/COULEURS/palit.html", "palit.pro", "", "PRO palit coef red green blue Eclaircit la palette courante en jouant sur la luminosite coef regle l attenuation des couleurs par defaut divise par 2 la luminosite coef 0 1 pour la QMS papier de l IPSL convient tres bien IF n_elements coef EQ 0 THEN coef 0 5 IF n_elements red EQ 0 THEN tvlct red green blue get color_convert red green blue h l s rgb_hls l 1 coef 1 l Le noir doit rester bien noir toutes mes palettes commencent par du noir et finissent par du blanc l 0 0 tvlct h l s hls return END"); 179 a[177] = new Array("./ToBeReviewed/COULEURS/xlct.html", "xlct.pro", "", " Id: xlct pro 19 2006 05 02 09:40:19Z pinsard Copyright c 1991 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited PRO XLCT_PSAVE Save Restore our plotting state Swaps our state with the current state each time its called COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback updt_cb_data tmp xlct_psave win: d window x: x s y: y s xtype: x type ytype: y type clip: p clip wset psave win x type psave xtype y type psave ytype x s psave x y s psave y p clip psave clip psave tmp end pro xlct_alert_caller COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data ErrorStatus 0 CATCH ErrorStatus if ErrorStatus NE 0 then begin CATCH CANCEL v DIALOG_MESSAGE Unexpected error in XLCT: ERR_STRING ERR_STRING ERROR return endif if STRLEN updt_callback gt 0 then begin if PTR_VALID p_updt_cb_data then begin CALL_PROCEDURE updt_callback DATA p_updt_cb_data endif else begin CALL_PROCEDURE updt_callback endelse endif end Redraw the ramp image PRO xlct_show COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data cur_win D WINDOW WSET show_win TV BYTE FLOAT ncolors FINDGEN siz FLOAT siz 1 REPLICATE 1 w_height BYTE cbot WSET cur_win Let the caller of XLCT know that the color table was modified xlct_alert_caller END PRO xlct_draw_cps i c COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot tc color if n_elements c gt 0 then begin tc c if c ne 0 then color c endif if i 0 eq 1 then j indgen n_elements cps else j i plots cps j tfun j noclip color tc plots cps j tfun j noclip psym 6 color tc end PRO xlct_transfer UPDATE update COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot l lonarr ncolors Subscripts m n_elements cps for i 0 m 2 do begin n cps i 1 cps i Interval b tfun i 1 tfun i float n l cps i findgen n b tfun i cbot endfor l ncolors 1 tfun m 1 Last point if use_values then begin r_curr cbot r l r_orig g_curr cbot g l g_orig b_curr cbot b l b_orig endif else begin r_curr cbot r r_orig l g_curr cbot g g_orig l b_curr cbot b b_orig l endelse tvlct r g b cbot if keyword_set update then xlct_show end PRO xlct_event event COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data IF event id eq state draw THEN BEGIN PROCESS DRAWABLE EVENTS if event press ne 0 then begin Pressed button dmin 1 0e8 Find closest control pnt xlct_psave Remove old p convert_coord event x event y TO_DATA DEVICE xlct_psave Restore old x fix p 0 y fix p 1 for i 0 n_elements cps 1 do begin d p 0 cps i 2 p 1 tfun i 2 dist 2 if d lt dmin then begin dmin d pnt i endif endfor return endif if event release ne 0 then begin Released button pnt 1 xlct_transfer update return endif if pnt lt 0 then return Don t care here xlct_psave Remove old For visuals with static colormaps erase plot before drawing new if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin ERASE color 0 endif p convert_coord event x event y TO_DATA DEVICE Coord of mouse n ncolors 1 Into range m n_elements cps 1 x fix p 0 0 cps pnt 1 1 0 0 0 0 0 else s findgen nc s nc int nc 0 0 gamma nc if chop ne 0 then begin too_high where s ge nc n if n gt 0 then s too_high 0L endif if use_values then begin s s 1 cps cps keep tfun tfun keep goto interp_cps ENDIF ENDCASE ADDCP : BEGIN xlct_psave xlct_draw_cps 1 0 igap 0 Find largest gap for i 0 n_elements cps 2 do if cps i 1 cps i gt cps igap 1 cps igap then igap i cps cps 0:igap cps igap cps igap 1 2 cps igap 1: tfun tfun 0:igap tfun igap tfun igap 1 2 tfun igap 1: interp_cps: xlct_draw_cps 1 Redraw new xlct_transfer update xlct_psave Restore old points if n_elements reset_all then goto reset_all ENDCASE ENDCASE END NAME: XLCT PURPOSE: comme xloadct mais plus cour a ecrire et appelle par defaut la palette palette tbl qui peut etre situee dans n importe quel repertoire de path CATEGORY: Widgets CALLING SEQUENCE: XLCT INPUTS: None KEYWORDS: FILE: If this keyword is set the file by the given name is used instead of the file colors1 tbl in the IDL directory This allows multiple IDL users to have their own color table file GROUP The widget ID of the widget that calls Xlct When this ID is specified a death of the caller results in a death of Xlct NCOLORS number of colors to use Use color indices from BOTTOM to the smaller of D TABLE_SIZE 1 and NCOLORS 1 Default D TABLE_SIZE all available colors BOTTOM first color index to use Use color indices from BOTTOM to BOTTOM NCOLORS 1 Default 0 SILENT Normally no informational message is printed when a color map is loaded If this keyword is present and zero this message is printed USE_CURRENT: If set use the current color tables regardless of the contents of the COMMON block COLORS MODAL: If set then XLCT runs in modal mode meaning that all other widgets are blocked until the user quits XLCT A group leader must be specified via the GROUP keyword for the MODAL keyword to have any effect The default is to not run in modal mode BLOCK: Set this keyword to have XMANAGER block when this application is registered By default the Xmanager keyword NO_BLOCK is set to 1 to provide access to the command line if active command line processing is available Note that setting BLOCK for this application will cause all widget applications to block not only this application For more information see the NO_BLOCK keyword to XMANAGER UPDATECALLBACK: Set this keyword to a string containing the name of a user supplied procedure that will be called when the color table is updated by XLCT The procedure may optionally accept a keyword called DATA which will be automatically set to the value specified by the optional UPDATECBDATA keyword UPDATECBDATA: Set this keyword to a value of any type It will be passed via the DATA keyword to the user supplied procedure specified via the UPDATECALLBACK keyword if any If the UPDATECBDATA keyword is not set the value accepted by the DATA keyword to the procedure specified by UPDATECALLBACK will be undefined OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: One of the predefined color maps may be loaded RESTRICTIONS: This routine uses the LOADCT user library procedure to do the actual work MODIFICATION HISTORY: 5 5 1999 copie de xloadct par Sebastien Masson smlod ipsl jussieu fr PRO XLct SILENT silent_f GROUP group FILE file USE_CURRENT use_current NCOLORS nc BOTTOM bottom MODAL modal BLOCK block UPDATECALLBACK updt_cb_name UPDATECBDATA updt_cb_data COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data IF XRegistered xlct NE 0 THEN return IF N_ELEMENTS block EQ 0 THEN block 0 IF N_ELEMENTS updt_cb_name EQ 0 THEN updt_callback ELSE updt_callback updt_cb_name IF N_ELEMENTS updt_cb_data GT 0 THEN p_updt_cb_data PTR_NEW updt_cb_data ELSE p_updt_cb_data PTR_NEW values_button lonarr 2 IF KEYWORD_SET SILENT_f THEN silent SILENT_F ELSE silent 1 changements effectues par S Masson IF N_ELEMENTS file GT 0 THEN filename file ELSE BEGIN filename find palette tbl filename filename 0 if filename EQ NOT FOUND then filename filepath colors1 tbl subdir resource colors ENDELSE file filename siz 256 Basic width of tool names 0 LOADCT GET_NAMES names FILE file Get table names w_height 50 Height of ramp cur_win D WINDOW lock 0 chop 0 vbot 0 vtop 100 gamma 1 0 use_values 0 Bases: 0 slider base stretch bottom stretch top gamma 1 transfer function drawable buttons 2 color table list 3 options base sliders top stretch state bases: lonarr 4 draw: 0L name_list: 0L DJC Added modal keyword Moved group_leader keyword from XMANAGER to WIDGET_BASE Ignore modal keyword if a group leader is not supplied if N_ELEMENTS group GT 0L then base WIDGET_BASE TITLE Xlct COLUMN GROUP_LEADER group MODAL KEYWORD_SET modal else base WIDGET_BASE TITLE Xlct COLUMN Setting the managed attribute indicates our intention to put this app under the control of XMANAGER and prevents our draw widgets from becoming candidates for becoming the default window on WSET 1 XMANAGER sets this but doing it here prevents our own WSETs at startup from having that problem WIDGET_CONTROL MANAGED base show WIDGET_DRAW base YSIZE w_height XSIZE siz FRAME RETAIN 2 junk WIDGET_BASE base ROW done WIDGET_BUTTON junk VALUE Done UVALUE DONE junk1 WIDGET_BUTTON junk VALUE Help UVALUE HELP junk CW_BGROUP base ROW EXCLUSIVE NO_REL Tables Options Function UVALUE NEWBASE SET_VALUE 0 junk widget_base base for i 0 1 do state bases i WIDGET_BASE junk COLUMN sbase WIDGET_BASE state bases 0 COLUMN bot WIDGET_SLIDER sbase TITLE Stretch Bottom MINIMUM 0 MAXIMUM 100 VALUE 0 DRAG UVALUE BOTTOM xsize siz top WIDGET_SLIDER sbase TITLE Stretch Top MINIMUM 0 MAXIMUM 100 VALUE 100 DRAG UVALUE TOP xsize siz g_lbl WIDGET_LABEL sbase VALUE STRING 1 0 g_slider WIDGET_slider sbase TITLE Gamma Correction MINIMUM 0 MAXIMUM 100 VALUE 50 UVALUE GAMMA SUPPRESS_VALUE DRAG xsize siz junk WIDGET_BASE sbase for i 2 3 do state bases i WIDGET_BASE junk COLUMN DEVICE GET_SCREEN junk if junk 1 le 768 then junk 8 else junk 16 state name_list WIDGET_LIST state bases 2 VALUE names ysize junk Drawable for transfer function junk WIDGET_BASE state bases 1 COLUMN FRAME junk1 WIDGET_BUTTON junk VALUE Reset Transfer Function UVALUE TFUNR junk1 WIDGET_BUTTON junk VALUE Add Control Point UVALUE ADDCP junk1 WIDGET_BUTTON junk VALUE Remove Control Point UVALUE REMCP state draw WIDGET_DRAW state bases 1 xsize siz ysize siz BUTTON_EVENTS MOTION_EVENTS opt_id state bases 3 junk CW_BGROUP opt_id ROW LABEL_LEFT Sliders: EXCLUSIVE NO_REL Independent Gang UVALUE GANG SET_VALUE lock junk CW_BGROUP opt_id ROW LABEL_LEFT Top: EXCLUSIVE NO_REL Clip Chop SET_VALUE chop UVALUE CHOP junk CW_BGROUP opt_id ROW LABEL_LEFT Stretch: EXCLUSIVE NO_REL Indices Intensity UVALUE VALUES SET_VALUE use_values junk WIDGET_BUTTON opt_id VALUE Reverse Table UVALUE REVERSE NO_REL junk WIDGET_BUTTON opt_id VALUE REPLACE Original Table UVALUE OVERWRITE NO_REL junk WIDGET_BUTTON opt_id VALUE RESTORE Original Table UVALUE RESTORE NO_REL WIDGET_CONTROL state bases 1 MAP 0 Tfun is not visible WIDGET_CONTROL state bases 3 MAP 0 options are not visible WIDGET_CONTROL base REALIZE WIDGET_CONTROL state draw GET_VALUE tmp if n_elements bottom gt 0 then cbot bottom else cbot 0 ncolors d table_size cbot if n_elements nc gt 0 then ncolors ncolors nc if ncolors le 0 then message Number of colors is 0 or negative psave xlct_psave win: d window x: x s y: y s xtype: x type ytype: y type clip: p clip Our initial state wset tmp Initial graph xlct_psave Save original scaling window plot 0 ncolors 1 0 ncolors 1 xstyle 3 ystyle 3 xmargin 1 1 ymargin 1 1 ticklen 0 03 NODATA xlct_psave Restore original scaling window If no common use current colors IF KEYWORD_SET use_current or N_ELEMENTS r_orig LE 0 THEN BEGIN TVLCT r_orig g_orig b_orig GET r_curr r_orig b_curr b_orig g_curr g_orig ENDIF r0 r_curr Save original colors g0 g_curr b0 b_curr color ncolors cbot 1 cps 0 ncolors 1 tfun cps pnt 1 WIDGET_CONTROL show GET_VALUE show_win WSET show_win DJC fixed color bar display bug TVSCL BYTSCL INDGEN siz REPLICATE 1 w_height top ncolors 1 TV BYTE FLOAT ncolors FINDGEN siz FLOAT siz 1 REPLICATE 1 w_height BYTE cbot WSET cur_win DJC moved GROUP_LEADER keyword to WIDGET_BASE XManager xlct base NO_BLOCK NOT FLOAT block MODAL KEYWORD_SET modal END"); 180 a[178] = new Array("./ToBeReviewed/COULEURS/xpal.html", "xpal.pro", "", " Id: xpal pro 19 2006 05 02 09:40:19Z pinsard Copyright c 1992 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: XPAL PURPOSE: comme xpalette mais plus court a ecrire et possede en plus une touche save qui grace a la routine newpalette permet de sauver la routine que l on vient de faire Rq qd on appuie sur la touche predefined appelle xlct plutot que xloadct CATEGORY: Color tables widgets CALLING SEQUENCE: XPAL INPUTS: No explicit inputs The current color table is used as a starting point KEYWORD PARAMETERS: BLOCK: Set this keyword to have XMANAGER block when this application is registered By default the Xmanager keyword NO_BLOCK is set to 1 to provide access to the command line if active command line processing is available Note that setting BLOCK for this application will cause all widget applications to block not only this application For more information see the NO_BLOCK keyword to XMANAGER UPDATECALLBACK: Set this keyword to a string containing the name of a user supplied procedure that will be called when the color table is updated by XLOADCT The procedure may optionally accept a keyword called DATA which will be automatically set to the value specified by the optional UPDATECBDATA keyword UPDATECBDATA: Set this keyword to a value of any type It will be passed via the DATA keyword to the user supplied procedure specified via the UPDATECALLBACK keyword if any If the UPDATECBDATA keyword is not set the value accepted by the DATA keyword to the procedure specified by UPDATECALLBACK will be undefined OUTPUTS: None COMMON BLOCKS: COLORS: Contains the current RGB color tables XP_COM: Private to this module SIDE EFFECTS: XPAL uses two colors from the current color table as drawing foreground and background colors These are used for the RGB plots on the left and the current index marker on the right This means that if the user set these two colors to the same value the XPAL display could become unreadable like writing on black paper with black ink XPAL minimizes this possibility by noting changes to the color map and always using the brightest available color for the foreground color and the darkest for the background Thus the only way to make XPAL s display unreadable is to set the entire color map to a single color which is highly unlikely The only side effect of this policy is that you may notice XPAL redrawing the entire display after you ve modified the current color This simply means that the change has made XPAL pick new drawing colors The new color tables are saved in the COLORS common and loaded to the display PROCEDURE: The XPAL widget has the following controls: Left: Three plots showing the current Red Green and Blue vectors Center: A status region containing: 1 The total number of colors 2 The current color XPAL allows changing one color at a time This color is known as the current color and is indicated in the color spectrum display with a special marker 3 The current mark index The mark is used to remember a color index It is established by pressing the Set Mark Button while the current color index is the desired mark index 4 The current color The special marker used in color spectrum display prevents the user from seeing the color of the current index but it is visible here A panel of control buttons which do the following when pressed: Done: Exits XPAL Predefined: Starts XLOADCT to allow selection of one of the predefined color tables Help: Supplies help information similar to this header Redraw: Completely redraws the display using the current state of the color map Set Mark: Set the value of the mark index to the current index Switch Mark: Exchange the mark and the current index Copy Current: Every color lying between the current index and the mark index inclusive is given the current color Interpolate: The colors lying between the current index and the mark index are interpolated linearly to lie between the colors of two endpoints save: permet de sauver la palette qui est actuellement a l ecran Qd on appuie sur ce bouton un widget apparait qui demande: 1 le nom a donner a la palette que l on veut sauver 2 le numero de la palette que l on veut eventuellement ecrase par la nouvelle palette Si aucun numero n est specifie la nouvelle palette estajoutee aux anciennes 3 le nom du fichier qui contient les palettes Rq: suivre eventuellement les indications fournis au prompteur Three sliders R G and B that allow the user to modify the current color Right: A display which shows the current color map as a series of squares Color index 0 is at the upper left The color index increases monotonically by rows going left to right and top to bottom The current color index is indicated by a special marker symbol There are 4 ways to change the current color: 1 Press any mouse button while the mouse pointer is over the color map display 2 Use the By Index slider to move to the desired color index 3 Use the Row Slider to move the marker vertically 4 Use the Column Slider to move the marker horizontally MODIFICATION HISTORY: addaptation de xpalette pour ajouter un bouton save par Gima Nicolas nglod ipsl jussieu fr et par Masson Sebastien smlod ipsl jussieu fr function XP_NEW_COLORS Choose the best foreground and background colors for the current color maps and set P appropriately Returns 1 if the colors changed 0 otherwise common xp_com xpw state res 0 junk CT_LUMINANCE dark dark_col bright bright_col if bright_col ne p color then begin p color bright_col res 1 endif if dark_col ne p background then begin p background dark_col res 1 endif return res end pro XP_ALERT_CALLER common xp_com xpw state ErrorStatus 0 CATCH ErrorStatus if ErrorStatus NE 0 then begin CATCH CANCEL v DIALOG_MESSAGE Unexpected error in XPAL: ERR_STRING ERR_STRING ERROR return endif if STRLEN state updt_callback gt 0 then begin if PTR_VALID state p_updt_cb_data then begin CALL_PROCEDURE state updt_callback DATA state p_updt_cb_data endif else begin CALL_PROCEDURE state updt_callback endelse endif end pro XP_XLCTCALLBACK For visuals with static colormaps update the graphics after a change by XLOADCT if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin XP_REDRAW endif end pro XP_REDRAW common xp_com xpw state junk XP_NEW_COLORS WIDGET_CONTROL xpw colorsel set_value 1 XP_REPLOT p color F Update the plots of RGB Let the caller of XPAL know that the color table was modified XP_ALERT_CALLER end pro XP_REPLOT color_index type Re draw the RGB plots Type has the following possible values D : Draw the data part of all three plots F : draw all three plots R : Draw the data part of the Red plot G : Draw the data part of the Green plot B : Draw the data part of the Blue plot common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr common pscale r_x_s r_y_s g_x_s g_y_s b_x_s b_y_s Update the plots of RGB save_win D WINDOW wset state plot_win save_p_region p region save_x_margin x margin save_y_margin y margin save_x_s x s save_y_s y s save_x_type x type save_y_type y type y margin 2 2 x margin 6 2 if type eq F then begin p region 0 6667 1 1 plot xstyle 2 ystyle 3 yrange 0 260 r_curr title Red r_x_s x s r_y_s y s p region 0 333 1 6667 plot noerase xstyle 2 ystyle 3 yrange 0 260 g_curr title Green g_x_s x s g_y_s y s p region 0 0 1 333 plot noerase xstyle 2 ystyle 3 yrange 0 260 b_curr title Blue b_x_s x s b_y_s y s endif else begin if type eq D or type eq R then begin p region 0 6667 1 1 x s r_x_s y s r_y_s oplot r_curr color color_index endif if type eq D or type eq G then begin p region 0 333 1 6667 x s g_x_s y s g_y_s oplot g_curr color color_index endif if type eq D or type eq B then begin p region 0 0 1 333 x s b_x_s y s b_y_s oplot b_curr color color_index endif endelse empty WSET save_win p region save_p_region x margin save_x_margin y margin save_y_margin x s save_x_s y s save_y_s x type save_x_type y type save_y_type end pro XP_CHANGE_COLOR type value Change current color Type has the following possible values R : Change the R part of the current color G : B : common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr cur_idx state cur_idx XP_REPLOT p background type if type eq R then r_curr cur_idx value if type eq G then g_curr cur_idx value if type eq B then b_curr cur_idx value tvlct r_curr cur_idx g_curr cur_idx b_curr cur_idx cur_idx if XP_NEW_COLORS then begin Highlight the current position using the marker WIDGET_CONTROL xpw colorsel set_value 1 Re initialize XP_REPLOT p color F endif else begin XP_REPLOT p color type endelse For visuals with static colormaps update the graphics of the current color if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin Mark new square tmp D WINDOW wset state cur_color_win erase color state cur_idx wset tmp endif Let the caller of XPAL know that the color table was modified xp_alert_caller end pro XP_BUTTON_EVENT event common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr NOTE: The value of these tags depend on the order of the buttons in the base case event value of DONE 0: begin empty r_orig r_curr g_orig g_curr b_orig b_curr new orig color tbl WIDGET_CONTROL DESTROY event top p state old_p end PREDEFINED 1: xlct silent group xpw base UPDATECALLBACK XP_XLCTCALLBACK HELP 2: XDisplayFile FILEPATH xpal txt subdir help widget TITLE Xpal Help GROUP event top WIDTH 55 HEIGHT 16 REDRAW 3: XP_REDRAW SET MARK 4: begin state mark_idx state cur_idx WIDGET_CONTROL xpw mark_label set_value strcompress state mark_idx REMOVE end SWITCH MARK 5 : if state mark_idx ne state cur_idx then begin tmp state mark_idx state mark_idx state cur_idx state cur_idx tmp WIDGET_CONTROL xpw colorsel set_value tmp WIDGET_CONTROL xpw idx_label set_value strcompress state cur_idx REMOVE WIDGET_CONTROL xpw mark_label set_value strcompress state mark_idx REMOVE endif COPY CURRENT 6 : begin do_copy: cur_idx state cur_idx if state mark_idx le cur_idx then begin s state mark_idx e cur_idx endif else begin s cur_idx e state mark_idx endelse n e s 1 XP_REPLOT p background D if event value eq 6 then begin r_curr s:e r_curr cur_idx g_curr s:e g_curr cur_idx b_curr s:e b_curr cur_idx endif else begin Interpolate scale findgen n float n 1 r_curr s:e r_curr s fix r_curr e fix r_curr s scale g_curr s:e g_curr s fix g_curr e fix g_curr s scale b_curr s:e b_curr s fix b_curr e fix b_curr s scale endelse tvlct r_curr s:e g_curr s:e b_curr s:e s if XP_NEW_COLORS then begin WIDGET_CONTROL xpw colorsel SET_VALUE 1 XP_REPLOT p color F endif else begin XP_REPLOT p color D endelse Let the caller of XPAL know that the color table was modified xp_alert_caller end 7: goto do_copy 8: BEGIN COMMON basecommon bas212 bas222 bas232 base WIDGET_BASE COLUMN FRAME bas1 WIDGET_LABEL base value Save bas2 WIDGET_BASE base COLUMN bas21 WIDGET_BASE bas2 COLUMN bas211 WIDGET_LABEL bas21 value Palette Name : bas212 WIDGET_TEXT bas21 value Noname editable bas22 WIDGET_BASE bas2 COLUMN bas221 WIDGET_LABEL bas22 value Overwrite palette number : bas222 WIDGET_TEXT bas22 value editable bas23 WIDGET_BASE bas2 COLUMN bas231 WIDGET_LABEL bas23 value file name : bas232 WIDGET_TEXT bas23 value palette tbl editable bas3 WIDGET_BASE base ROW ok WIDGET_BUTTON bas3 value OK ALIGN_LEFT FRAME UVALUE ok cancel WIDGET_BUTTON bas3 value CANCEL ALIGN_RIGHT FRAME UVALUE cancel WIDGET_CONTROL base REALIZE WIDGET_CONTROL base SET_UVALUE drawID XMANAGER xp_button_event base END else: endcase end PRO xp_button_event_event ev COMMON basecommon bas212 bas222 bas232 WIDGET_CONTROL ev id GET_UVALUE uval IF TAG_NAMES ev STRUCTURE_NAME EQ WIDGET_BUTTON THEN BEGIN CASE uval OF ok :BEGIN WIDGET_CONTROL bas212 GET_VALUE palname WIDGET_CONTROL bas222 GET_VALUE over WIDGET_CONTROL bas232 GET_VALUE fichname if over 0 EQ then over 255 ELSE over long over newpalette palname 0 OVER over 0 file fichname 0 WIDGET_CONTROL ev top DESTROY END cancel : WIDGET_CONTROL ev top DESTROY ENDCASE ENDIF END pro XP_EVENT event common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr case event id of xpw button_base: XP_BUTTON_EVENT event xpw rgb_base: begin cur_idx state cur_idx if event r ne r_curr cur_idx then XP_CHANGE_COLOR R event r if event g ne g_curr cur_idx then XP_CHANGE_COLOR G event g if event b ne b_curr cur_idx then XP_CHANGE_COLOR B event b end xpw colorsel: begin cur_idx state cur_idx new_pos event value ne cur_idx Update the RBG sliders if event value ne cur_idx then begin state cur_idx cur_idx event value WIDGET_CONTROL xpw idx_label set_value strcompress cur_idx REMOVE_ALL Mark new square tmp D WINDOW wset state cur_color_win erase color cur_idx wset tmp WIDGET_CONTROL xpw rgb_base set_value r_curr cur_idx g_curr cur_idx b_curr cur_idx endif end else: endcase end pro XPAL group group BLOCK block UPDATECALLBACK updt_cb_name UPDATECBDATA updt_cb_data common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr IF N_ELEMENTS updt_cb_name EQ 0 THEN updt_callback ELSE updt_callback updt_cb_name IF N_ELEMENTS updt_cb_data GT 0 THEN p_updt_cb_data PTR_NEW updt_cb_data ELSE p_updt_cb_data PTR_NEW xpw xp_widgets base:0L colorsel:0L mark_label:0L idx_label:0L button_base:0L rgb_base:0L state old_p: p Original value of P mark_idx:0 Current mark index cur_idx:0 Current index cur_color_win:0 Current Color draw window index plot_win:0 RGB plot draw window index updt_callback: updt_callback user defined callback optional p_updt_cb_data:p_updt_cb_data data for callback optional if XREGISTERED XPAL then return Only one copy at a time IF N_ELEMENTS block EQ 0 THEN block 0 on_error 2 Return to caller if an error occurs nc d table_size of colors avail if nc eq 0 then message Device has static color tables Can t modify if nc eq 2 then message Unable to work with monochrome system state old_p p Save p p noclip 1 No clipping p color nc 1 Foreground color p font 0 Hdw font save_win d window Previous window IF N_ELEMENTS r_orig LE 0 THEN BEGIN If no common use current colors TVLCT r_orig g_orig b_orig GET r_curr r_orig b_curr b_orig g_curr g_orig ENDIF Create widgets xpw base WIDGET_BASE title Xpal ROW space 30 This is a little tricky Setting the managed attribute indicates our intention to put this app under the control of XMANAGER and prevents our draw widgets from becoming candidates for becoming the default window on WSET 1 XMANAGER sets this but doing it here prevents our own WSETs at startup from having that problem WIDGET_CONTROL MANAGED xpw base version WIDGET_INFO VERSION if version style Motif then junk 510 else junk 580 plot_frame WIDGET_DRAW xpw base xsize 200 ysize junk c1 WIDGET_BASE xpw base COLUMN space 20 status WIDGET_BASE c1 COLUMN FRAME ncw WIDGET_LABEL WIDGET_BASE status DYNAMIC_RESIZE xpw idx_label CW_FIELD status title Current Index: value 0 xsize 20 STRING xpw mark_label CW_FIELD status title Mark Index: value 0 xsize 20 STRING c1_1 widget_base status ROW junk WIDGET_LABEL c1_1 value Current Color: cur_color WIDGET_DRAW c1_1 xsize 125 ysize 50 frame names Done Predefined Help Redraw Set Mark Switch Mark Copy Current Interpolate save xpw button_base CW_BGROUP c1 names COLUMN 3 FRAME xpw rgb_base CW_RGBSLIDER c1 FRAME DRAG junk WIDGET_BASE xpw base Responds to YOFFSET if version style Motif then junk2 30 else junk2 50 xpw colorsel CW_COLORSEL junk yoffset junk2 state cur_idx 0 state mark_idx 0 Position RGB slider appropriately WIDGET_CONTROL xpw rgb_base SET_VALUE r_curr 0 g_curr 0 b_curr 0 WIDGET_CONTROL REALIZE xpw base WIDGET_CONTROL ncw set_value Number Of Colors: strcompress d n_colors REMOVE_ALL WIDGET_CONTROL get_value tmp cur_color state cur_color_win tmp WIDGET_CONTROL get_value tmp plot_frame state plot_win tmp Update the plots of RGB junk XP_NEW_COLORS XP_REPLOT p color F WSET save_win XMANAGER Xpal xpw base event_handler XP_EVENT group group NO_BLOCK NOT FLOAT block end "); 181 a[179] = new Array("./ToBeReviewed/GRILLE/changegrid.html", "changegrid.pro", "", "function changegrid newgrid cm_4mesh if cmpgrid newgrid EQ 0 then return 0 update the common paramaters ccmeshparameters newgrid ixminmesh newgrid ixminmesh ixmaxmesh newgrid ixmaxmesh iyminmesh newgrid iyminmesh iymaxmesh newgrid iymaxmesh izminmesh newgrid izminmesh izmaxmesh newgrid izmaxmesh read the new file loadgrid newgrid filename IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return 1 end"); 182 a[180] = new Array("./ToBeReviewed/GRILLE/cmpgrid.html", "cmpgrid.pro", "", "FUNCTION cmpgrid newgrid common newgrid must be a structure if size newgrid type NE 8 then return 0 does ccmeshparameters exist if n_elements ccmeshparameters EQ 0 then return 1 we compare the structure which caracterise the grid whith ccmeshparameters case 1 of ccmeshparameters jpiglo NE newgrid jpiglo: ccmeshparameters jpjglo NE newgrid jpjglo: ccmeshparameters jpkglo NE newgrid jpkglo: ccmeshparameters jpi NE newgrid jpi: ccmeshparameters jpj NE newgrid jpj: ccmeshparameters jpk NE newgrid jpk: total ccmeshparameters glaminfo newgrid glaminfo NE 0: total ccmeshparameters gphiinfo newgrid gphiinfo NE 0: ccmeshparameters ixminmesh NE newgrid ixminmesh: ccmeshparameters ixmaxmesh NE newgrid ixmaxmesh: ccmeshparameters iyminmesh NE newgrid iyminmesh: ccmeshparameters iymaxmesh NE newgrid iymaxmesh: ccmeshparameters izminmesh NE newgrid izminmesh: ccmeshparameters izmaxmesh NE newgrid izmaxmesh: ccmeshparameters key_shift NE newgrid key_shift: ccmeshparameters key_periodic NE newgrid key_periodic: array_equal ccmeshparameters key_stride newgrid key_stride EQ 0: ccmeshparameters key_gridtype NE newgrid key_gridtype: ccmeshparameters key_yreverse NE newgrid key_yreverse: ccmeshparameters key_zreverse NE newgrid key_zreverse: ccmeshparameters key_partialstep NE newgrid key_partialstep: ccmeshparameters key_onearth NE newgrid key_onearth: ELSE:return 0 endcase return 1 end"); 183 a[181] = new Array("./ToBeReviewed/GRILLE/decoupeterre.html", "decoupeterre.pro", "", " NAME:decoupeterre PURPOSE:tres semblable a grille Ici qd vargrid ne T ou W alors pour le trace il faut recuperer Tmask glamt gphit et le tableau de triangulation sur le sous domaine considere La specificite de decoupeterre par rapport a grille c est que l on prend ds la mesure du possible un sous domaine juste un peu plus grand que celui definit par domdef de facon a etre sur que le masque que l on trace recouvrira bien tout le dessin CATEGORY:pour plt CALLING SEQUENCE:decoupeterre mask glam gphi z nx ny nz TRI tri INPUTS: KEYWORD PARAMETERS: TRI si ce mot clef sert a obtenir grace a grille la triangulation qui se rapporte a la grille mais uniquement sur la partie du zoom ce tableau de triangulation reduit est passe ds la variable que l on a egalee a tri par ex: grille tri triangulation_reduite ne mot clef est utilise dans plt pro WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS:le masque et ses coordonnees COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 24 2 99 PRO decoupeterre mask glam gphi gdep TYPE type TRI tri INDICEZOOM indicezoom COINMONTE coinmonte COINDESCEND coindescend WDEPTH wdepth REALSECTION realsection USETRI usetri _extra ex cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance if vargrid EQ W then wdepth 1 horizontal parameters if possible extent the domain according to the grid type default case case vargrid of U :BEGIN firstx 0 min firstxt firstxu 1 lastx max lastxt lastxu 1 min firstyt firstyu 1 lasty max lastyt lastyu 1 min firstxt firstxv 1 lastx max lastxt lastxv 1 min firstyt firstyv 1 lasty max lastyt lastyv 1 min firstxt firstxf 1 lastx max lastxt lastxf 1 min firstyt firstyf 1 lasty max lastyt lastyf 1 firstx 1 :lastx firsty:lasty ELSE glam glamu 0 firstx 1 :lastx firsty:lasty ENDELSE END yz :BEGIN if keyword_set realsection EQ 0 then begin if vargrid EQ U OR vargrid EQ F then gphi gphiu firstx:lastx firsty:lasty ENDIF ELSE BEGIN to drawsectionbottom if vargrid EQ U OR vargrid EQ F OR finite gphiv 0 EQ 0 then gphi gphif firstx:lastx 0 firsty 1 :lasty ELSE gphi gphiv firstx:lastx 0 firsty 1 :lasty ENDELSE END ELSE: ENDCASE vertical boundaries if keyword_set wdepth then begin firstz 0 min firstzt firstzw 1 lastz max lastzt lastzw 1 jpk 1 ENDIF ELSE BEGIN firstz firstzt lastz lastzt ENDELSE nz lastz firstz 1 mask case type of xy :BEGIN mask tmask firstx:lastx firsty:lasty firstz profond firstz NE 0 END for the verical section we have to choose the right mask according to the grid point and to the direction of the section xz :BEGIN if vargrid EQ V OR vargrid EQ F then begin mask vmask firstx:lastx firstyv:lastyv firstz:lastz ENDIF ELSE mask tmask firstx:lastx firsty:lasty firstz:lastz END yz :BEGIN if vargrid EQ U OR vargrid EQ F then begin mask umask firstxu:lastxu firsty:lasty firstz:lastz ENDIF ELSE mask tmask firstx:lastx firsty:lasty firstz:lastz END ELSE:mask tmask firstx:lastx firsty:lasty firstz:lastz endcase vertical axis when we do a real section we directly plot the gdepw in drawsectionbottom pro instead of contouring the mask at 0 5 at gdept IF keyword_set realsection EQ 0 then gdep gdept firstz:lastz ELSE BEGIN if lastz EQ jpk 1 then we add some fictive very deep level that will not be used but that is necessary to avoid array size bugs in draw bottom section gdep gdepw firstz 1:lastz 2 gdept jpk 1 ELSE gdep gdepw firstz 1:lastz 1 gdep gdepw firstz:lastz special case when we are using the partial steps in the vertical section that are only 1 point wide in that case the z axis is a 2d array and we modify the depth of the last level ocean with hdepw that is the real depth of the bottom CASE 1 OF keyword_set key_partialstep and type EQ xz AND ny EQ 1 AND keyword_set realsection :BEGIN bottom total mask 3 good where bottom NE 0 AND bottom NE nz 1 bottom lindgen nx bottom nx IF good 0 NE 1 THEN BEGIN bottom bottom good gdep replicate 1 nx gdep truegdep hdepw firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END keyword_set key_partialstep and type EQ yz AND nx EQ 1 AND keyword_set realsection :BEGIN bottom total mask 3 good where bottom NE 0 AND bottom NE nz 1 bottom lindgen ny bottom ny IF good 0 NE 1 THEN BEGIN bottom bottom good gdep replicate 1 ny gdep truegdep hdepw firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ELSE: ENDCASE ENDELSE vecteur triangulation Qd TRI est active IF arg_present TRI then if triangles_list 0 EQ 1 OR usetri LT 1 then tri 1 ELSE BEGIN si on est en train de tracer un niveau profond on refait la triangulation if keyword_set profond then begin tri triangule mask coinmonte coinmonte coindescend coindescend _extra ex indicezoom lindgen jpi jpj firstx:lastx firsty:lasty ENDIF ELSE BEGIN sinon on recupere la partie de triangulation qui nous interesse et on la numerote convenablement if nx EQ jpi AND ny EQ jpj then tri triangles_list ELSE BEGIN msk bytarr jpi jpj msk firstx:lastx firsty:lasty 1 ind where msk triangles_list 0 EQ 1 AND msk triangles_list 1 EQ 1 AND msk triangles_list 2 EQ 1 tri triangles_list ind firstx firsty jpi y tri jpi x tri y jpi tri x y nx ENDELSE ENDELSE ENDELSE if keyword_set key_performance THEN print temps decoupeterre systime 1 tempsun return end "); 184 a[182] = new Array("./ToBeReviewed/GRILLE/domdef.html", "domdef.pro", "", " NAME: DOMDEF PURPOSE:permet d extraire un sous domaine d etude en fournissant les parametres necessaires pour les traces cf outputs CATEGORY: CALLING SEQUENCE:domdef lon1 lon2 lat1 lat2 vert1 vert2 ou bien domdef vecteur INPUTS: facultatif vecteur a 2 4 ou 6 elements: sans l utilisation des mots cles index xindex yindex zindex: vert1 vert2: pour un domaine 3D dont la partie horizontale couvre tout glam et gphi lon1 lon2 lat1 lat2: definissant les longitudes min max et les latitudes min max du domaine a etudier tous les niveaux sont selectiones lon1 lon2 lat1 lat2 vert1 vert2 pour specifier les profondeurs KEYWORD PARAMETERS: ENDPOINTS: a four elements vector x1 y1 x2 y2 used to specify that domdef must define the box used to make a plot pltz pltt plt1d done strictly along the line that can have any direction starting at x1 y1 ending at x2 y2 When defining endpoints you must also define TYPE which define the type of plots pltz xt yt zt x y z t will used ENDPOINTS keywords FINDALWAYS:oblige a redefinir une boite meme qd auqun point n est trouve ds la boite dans ce cas on selectionne toute la grille GRIDTYPE:un string ou un vecteur de string contennant le nom des grilles determinees uniquement par : T U V W F pour lesquelles le calcul doit etre fait par ex : T ou T U MEMEINDICES: il se peut que les points t u v et F correspondant a une meme boite geographique ne concernent pas les memes indices des tableaux Ceci pose parfois de pb ou du moins de serieuses complications ds les programmes ou plusieurs types de grilles interviennent cf : norme curl Activer MEMEINDICES pour forcer domdef a prendre les memes indices ceux de la grille T pour toutes les autres grilles INDEX: activer si on veut specifier que tous les elements passes en entree de domdef se rapportent aux indices des tableaux glam gphi et gdep plutot qu aux valeurs de ces tableaux xindex: activer si on veut que les elements passes en entrre de domdef et concernant la dimension en x se rapportent aux indices des tableaux glam qu aux valeurs de ces tableaux yindex: cf xindex mais pour y et les gphi zindex: cf xindex mais pour z et les gdep OUTPUTS:on recupere pour les 4 grilles t u v f nxt u v:entier qui contient le nombre de pts en longitude de la grille reduite au domaine nyt u v:entier qui contient le nombre de pts en latitude de la grille reduite au domaine nzt w:entier qui contient le nombre de pts en profondeur de la grille reduite au domaine 3D firstxt u v f: le first indice qui delimite le sous domaine suivant x firstyt u v f: le first indice qui delimite le sous domaine suivant y firstzt w: le first indice qui delimite le sous domaine suivant z lastxt u v f: le last indice qui delimite le sous domaine suivant x lastyt u v f: le last indice qui delimite le sous domaine suivant y lastzt w: le last indice qui delimite le sous domaine suivant z COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 8 2 98 rewrite everything debug and spee up Sebastien Masson April 2005 pro domdef x1 x2 y1 y2 z1 z2 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex ENDPOINTS endpoints TYPE type INDEX index _extra ex include commons cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance CASE N_PARAMS OF 0: 1: 2: 4: 6: ELSE:BEGIN ras report Bad number of parameter in the call of domdef RETURN END ENDCASE IF keyword_set endpoints THEN BEGIN IF NOT keyword_set type THEN BEGIN dummy report If domdef is used do find the box associated to endpoints you must also specify type keyword return ENDIF CASE N_PARAMS OF 0: 1:boxzoom x1 2:boxzoom x1 x2 4:boxzoom x1 x2 y1 y2 6:boxzoom x1 x2 y1 y2 z1 z2 ENDCASE section BOXZOOM boxzoom ENDPOINTS endpoints TYPE type ONLYBOX return ENDIF recall domdef when there is only one input parameter IF N_PARAMS EQ 1 THEN BEGIN CASE n_elements x1 OF 2:domdef x1 0 x1 1 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex 4:domdef x1 0 x1 1 x1 2 x1 3 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex 6:domdef x1 0 x1 1 x1 2 x1 3 x1 4 x1 5 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex ELSE:BEGIN ras report Bad number of elements in x1 RETURN END ENDCASE RETURN ENDIF default definitions and checks IF NOT keyword_set gridtype THEN gridtype T U V W F ELSE gridtype strupcase gridtype IF keyword_set memeindices THEN gridtype T gridtype default definitions lon1t 99999 lon2t 99999 lat1t 99999 lat2t 99999 lon1u 99999 lon2u 99999 lat1u 99999 lat2u 99999 lon1v 99999 lon2v 99999 lat1v 99999 lat2v 99999 lon1f 99999 lon2f 99999 lat1f 99999 lat2f 99999 vert1t 99999 vert2t 99999 vert1w 99999 vert2w 99999 IF jpj EQ 1 THEN BEGIN IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over ENDIF IF where gridtype eq U 0 NE 1 THEN BEGIN glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over ENDIF IF where gridtype eq V 0 NE 1 THEN BEGIN glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over ENDIF IF where gridtype eq F 0 NE 1 THEN BEGIN glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over ENDIF ENDIF IF N_PARAMS EQ 2 THEN GOTO vertical define all horizontal parameters lon1 et lon2 lat1 et lat2 firstx tuvf lastx tuvf nx tuvf check if the grid is defined for U and V points If not take care of the cases gridtype eq U or V errstatus 0 IF finite glamu 0 gphiu 0 EQ 0 OR n_elements glamu EQ 0 OR n_elements gphiu EQ 0 AND where gridtype eq U 0 NE 1 THEN BEGIN firstxu values f_nan lastxu values f_nan nxu values f_nan okgrid where gridtype NE U count IF count NE 0 THEN gridtype gridtype okgrid ELSE errstatus report U grid is undefined Impossible to call domdef with vargid U ENDIF IF finite glamv 0 gphiv 0 EQ 0 OR n_elements glamv EQ 0 OR n_elements gphiv EQ 0 AND where gridtype eq V 0 NE 1 THEN BEGIN firstxv values f_nan lastxv values f_nan nxv values f_nan okgrid where gridtype NE V count IF count NE 0 THEN gridtype gridtype okgrid ELSE errstatus report V grid is undefined Impossible to call domdef with vargid V ENDIF IF errstatus EQ 1 THEN return horizontal domain defined with lon1 lon2 lat1 and lat2 IF N_PARAMS EQ 0 OR N_PARAMS EQ 4 OR N_PARAMS EQ 6 AND NOT keyword_set xindex AND NOT keyword_set yindex AND NOT keyword_set index THEN BEGIN IF N_PARAMS EQ 0 THEN BEGIN find lon1 and lon2 the longitudinal boudaries of the full domain IF where gridtype eq T 0 NE 1 THEN lon1t min glamt max lon2t IF where gridtype eq W 0 NE 1 AND where gridtype eq T 0 EQ 1 THEN lon1t min glamt max lon2t IF where gridtype eq U 0 NE 1 THEN lon1u min glamu max lon2u IF where gridtype eq V 0 NE 1 THEN lon1v min glamv max lon2v IF where gridtype eq F 0 NE 1 THEN lon1f min glamf max lon2f lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f find lat1 and lat2 the latitudinal boudaries of the full domain IF where gridtype eq T 0 NE 1 THEN lat1t min gphit max lat2t IF where gridtype eq W 0 NE 1 AND where gridtype eq T 0 EQ 1 THEN lat1t min gphit max lat2t IF where gridtype eq U 0 NE 1 THEN lat1u min gphiu max lat2u IF where gridtype eq V 0 NE 1 THEN lat1v min gphiv max lat2v IF where gridtype eq F 0 NE 1 THEN lat1f min gphif max lat2f lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f ENDIF ELSE BEGIN lon1 min x1 x2 max lon2 lat1 min y1 y2 max lat2 ENDELSE find firstxt firstxt nxt and nyt according to lon1 lon2 lat1 and lat2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN dom where glamt GE lon1 AND glamt LE lon2 AND gphit GE lat1 AND gphit LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt gphit sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt gphit sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamt neig1 max glamt neig2 min gphit neig1 max gphit neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamt neig1 max glamt neig2 min gphit neig1 max gphit neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstxt 1 lastxt 1 nxt 0 firstyt 1 lastyt 1 nyt 0 ENDELSE ENDIF ELSE BEGIN jyt dom jpi ixt temporary dom MOD jpi firstxt min temporary ixt max lastxt firstyt min temporary jyt max lastyt nxt lastxt firstxt 1 nyt lastyt firstyt 1 ENDELSE ENDIF find firstxu firstxu firstyu firstyu nxu and nyu according to lon1 lon2 lat1 and lat2 IF where gridtype eq U 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxu firstxt lastxu lastxt nxu nxt firstyu firstyt lastyu lastyt nyu nyt ENDIF ELSE BEGIN dom where glamu GE lon1 AND glamu LE lon2 AND gphiu GE lat1 AND gphiu LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN if t grid parameters alreday defined we use them CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstxu firstxt lastxu lastxt nxu nxt firstyu firstyt lastyu lastyt nyu nyt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu gphiu sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu gphiu sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamu neig1 max glamu neig2 min gphiu neig1 max gphiu neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamu neig1 max glamu neig2 min gphiu neig1 max gphiu neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstxu 1 lastxu 1 nxu 0 firstyu 1 lastyu 1 nyu 0 ENDELSE ENDIF ELSE BEGIN jyu dom jpi ixu temporary dom MOD jpi firstxu min temporary ixu max lastxu firstyu min temporary jyu max lastyu nxu lastxu firstxu 1 nyu lastyu firstyu 1 ENDELSE ENDELSE ENDIF find firstxv firstxv firstyv firstyv nxv and nyv according to lon1 lon2 lat1 and lat2 IF where gridtype eq V 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxv firstxt lastxv lastxt nxv nxt firstyv firstyt lastyv lastyt nyv nyt ENDIF ELSE BEGIN dom where glamv GE lon1 AND glamv LE lon2 AND gphiv GE lat1 AND gphiv LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstxv firstxt lastxv lastxt nxv nxt firstyv firstyt lastyv lastyt nyv nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstxv firstxu lastxv lastxu nxv nxu firstyv firstyu lastyv lastyu nyv nyu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv gphiv sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv gphiv sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamv neig1 max glamv neig2 min gphiv neig1 max gphiv neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamv neig1 max glamv neig2 min gphiv neig1 max gphiv neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstxv 1 lastxv 1 nxv 0 firstyv 1 lastyv 1 nyv 0 ENDELSE ENDIF ELSE BEGIN jyv dom jpi ixv temporary dom MOD jpi firstxv min temporary ixv max lastxv firstyv min temporary jyv max lastyv nxv lastxv firstxv 1 nyv lastyv firstyv 1 ENDELSE ENDELSE ENDIF find firstxf firstxf firstyf firstyf nxf and nyf according to lon1 lon2 lat1 and lat2 IF where gridtype eq F 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxf firstxt lastxf lastxt nxf nxt firstyf firstyt lastyf lastyt nyf nyt ENDIF ELSE BEGIN dom where glamf GE lon1 AND glamf LE lon2 AND gphif GE lat1 AND gphif LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstxf firstxt lastxf lastxt nxf nxt firstyf firstyt lastyf lastyt nyf nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstxf firstxu lastxf lastxu nxf nxu firstyf firstyu lastyf lastyu nyf nyu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstxf firstxv lastxf lastxv nxf nxv firstyf firstyv lastyf lastyv nyf nyv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf gphif sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf gphif sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamf neig1 max glamf neig2 min gphif neig1 max gphif neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamf neig1 max glamf neig2 min gphif neig1 max gphif neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstxf 1 lastxf 1 nxf 0 firstyf 1 lastyf 1 nyf 0 ENDELSE ENDIF ELSE BEGIN jyf dom jpi ixf temporary dom MOD jpi firstxf min temporary ixf max lastxf firstyf min temporary jyf max lastyf nxf lastxf firstxf 1 nyf lastyf firstyf 1 ENDELSE ENDELSE ENDIF ENDIF ELSE BEGIN CASE 1 OF horizontal domain defined with the X and Y indexes keyword_set xindex AND keyword_set yindex OR keyword_set index :BEGIN fstx min x1 x2 max lstx fsty min y1 y2 max lsty IF fstx LT 0 OR lstx GE jpi THEN BEGIN ras report Bad definition of X1 or X2 return ENDIF IF fsty LT 0 OR lsty GE jpj THEN BEGIN ras report Bad definition of Y1 or Y2 return ENDIF nx lstx fstx 1 ny lsty fsty 1 find lon1t lon2t lat1t lat2t firstxt firstxt nxt and nyt according to x1 x2 y1 y2 IF where gridtype eq T 0 NE 1 OR where gridtype eq W 0 NE 1 THEN BEGIN lon1t min glamt fstx:lstx fsty:lsty max lon2t lat1t min gphit fstx:lstx fsty:lsty max lat2t firstxt fstx lastxt lstx firstyt fsty lastyt lsty nxt nx nyt ny ENDIF find lon1u lon2u lat1u lat2u firstxu firstxu nxu and nyu according to x1 x2 y1 y2 IF where gridtype eq U 0 NE 1 THEN BEGIN lon1u min glamu fstx:lstx fsty:lsty max lon2u lat1u min gphiu fstx:lstx fsty:lsty max lat2u firstxu fstx lastxu lstx firstyu fsty lastyu lsty nxu nx nyu ny ENDIF find lon1v lon2v lat1v lat2v firstxv firstxv nxv and nyv according to x1 x2 y1 y2 IF where gridtype eq V 0 NE 1 THEN BEGIN lon1v min glamv fstx:lstx fsty:lsty max lon2v lat1v min gphiv fstx:lstx fsty:lsty max lat2v firstxv fstx lastxv lstx firstyv fsty lastyv lsty nxv nx nyv ny ENDIF find lon1f lon2f lat1f lat2f firstxf firstxf nxf and nyf according to x1 x2 y1 y2 IF where gridtype eq F 0 NE 1 THEN BEGIN lon1f min glamf fstx:lstx fsty:lsty max lon2f lat1f min gphif fstx:lstx fsty:lsty max lat2f firstxf fstx lastxf lstx firstyf fsty lastyf lsty nxf nx nyf ny ENDIF lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f END horizontal domain defined with the X index and lat1 lat2 keyword_set xindex :BEGIN fstx min x1 x2 max lstx IF fstx LT 0 OR lstx GE jpi THEN BEGIN ras report Bad definition of X1 or X2 return ENDIF nx lstx fstx 1 lat1 min y1 y2 max lat2 find lon1t lon2t firstxt firstxt firstyt firstyt nxt and nyt according to x1 x2 lat1 and lat2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN firstxt fstx lastxt lstx nxt nx dom where gphit fstx:lstx GE lat1 AND gphit fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt fstx:lstx gphit fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt fstx:lstx gphit fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphit fstx:lstx neig1 max gphit fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphit fstx:lstx neig1 max gphit fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstyt 1 lastyt 1 nyt 0 ENDELSE ENDIF ELSE BEGIN jyt temporary dom nx firstyt min temporary jyt max lastyt nyt lastyt firstyt 1 ENDELSE IF nyt NE 0 THEN lon1t min glamt firstxt:lastxt firstyt:lastyt max lon2t ENDIF find lon1u lon2u firstxu firstxu firstyu firstyu nxu and nyu according to x1 x2 lat1 and lat2 IF where gridtype eq U 0 NE 1 THEN BEGIN firstxu fstx lastxu lstx nxu nx IF keyword_set memeindices THEN BEGIN firstyu firstyt lastyu lastyt nyu nyt ENDIF ELSE BEGIN dom where gphiu fstx:lstx GE lat1 AND gphiu fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstyu firstyt lastyu lastyt nyu nyt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu fstx:lstx gphiu fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu fstx:lstx gphiu fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphiu fstx:lstx neig1 max gphiu fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphiu fstx:lstx neig1 max gphiu fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstyu 1 lastyu 1 nyu 0 ENDELSE ENDIF ELSE BEGIN jyu temporary dom nx firstyu min temporary jyu max lastyu nyu lastyu firstyu 1 ENDELSE ENDELSE IF nyu NE 0 THEN lon1u min glamu firstxu:lastxu firstyu:lastyu max lon2u ENDIF find lon1v lon2v firstxv firstxv firstyv firstyv nxv and nyv according to x1 x2 lat1 and lat2 IF where gridtype eq V 0 NE 1 THEN BEGIN firstxv fstx lastxv lstx nxv nx IF keyword_set memeindices THEN BEGIN firstyv firstyt lastyv lastyt nyv nyt ENDIF ELSE BEGIN dom where gphiv fstx:lstx GE lat1 AND gphiv fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstyv firstyt lastyv lastyt nyv nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstyv firstyu lastyv lastyu nyv nyu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv fstx:lstx gphiv fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv fstx:lstx gphiv fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphiv fstx:lstx neig1 max gphiv fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphiv fstx:lstx neig1 max gphiv fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstyv 1 lastyv 1 nyv 0 ENDELSE ENDIF ELSE BEGIN jyv temporary dom nx firstyv min temporary jyv max lastyv nyv lastyv firstyv 1 ENDELSE ENDELSE IF nyv NE 0 THEN lon1v min glamv firstxv:lastxv firstyv:lastyv max lon2v ENDIF find lon1f lon2f firstxf firstxf firstyf firstyf nxf and nyf according to x1 x2 lat1 and lat2 IF where gridtype eq F 0 NE 1 THEN BEGIN firstxf fstx lastxf lstx nxf nx IF keyword_set memeindices THEN BEGIN firstyf firstyt lastyf lastyt nyf nyt ENDIF ELSE BEGIN dom where gphif fstx:lstx GE lat1 AND gphif fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstyf firstyt lastyf lastyt nyf nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstyf firstyu lastyf lastyu nyf nyu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstyf firstyv lastyf lastyv nyf nyv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf fstx:lstx gphif fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf fstx:lstx gphif fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphif fstx:lstx neig1 max gphif fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphif fstx:lstx neig1 max gphif fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstyf 1 lastyf 1 nyf 0 ENDELSE ENDIF ELSE BEGIN jyf temporary dom nx firstyf min temporary jyf max lastyf nyf lastyf firstyf 1 ENDELSE ENDELSE IF nyf NE 0 THEN lon1f min glamf firstxf:lastxf firstyf:lastyf max lon2f ENDIF lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f END horizontal domain defined with the Y index and lon1 lon2 keyword_set yindex :BEGIN fsty min y1 y2 max lsty IF fsty LT 0 OR lsty GE jpj THEN BEGIN ras report Bad definition of Y1 or Y2 return ENDIF ny lsty fsty 1 lon1 min x1 x2 max lon2 find lat1t lat2t firstxt firstxt firstyt firstyt nxt and nyt according to x1 x2 lon1 and lon2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN firstyt fsty lastyt lsty nyt ny dom where glamt fsty:lsty GE lon1 AND glamt fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt fsty:lsty gphit fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt fsty:lsty gphit fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamt fsty:lsty neig1 max glamt fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamt fsty:lsty neig1 max glamt fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstxt 1 lastxt 1 nxt 0 ENDELSE ENDIF ELSE BEGIN jxt temporary dom MOD jpi firstxt min temporary jxt max lastxt nxt lastxt firstxt 1 ENDELSE IF nxt NE 0 THEN lat1t min gphit firstxt:lastxt firstyt:lastyt max lat2t ENDIF find lat1u lat2u firstxu firstxu firstyu firstyu nxu and nyu according to x1 x2 lon1 and lon2 IF where gridtype eq U 0 NE 1 THEN BEGIN firstyu fsty lastyu lsty nyu ny IF keyword_set memeindices THEN BEGIN firstxu firstyt lastxu lastyt nxu nxt ENDIF ELSE BEGIN dom where glamu fsty:lsty GE lon1 AND glamu fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstxu firstxt lastxu lastxt nxu nxt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu fsty:lsty gphiu fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu fsty:lsty gphiu fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamu fsty:lsty neig1 max glamu fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamu fsty:lsty neig1 max glamu fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstxu 1 lastxu 1 nxu 0 ENDELSE ENDIF ELSE BEGIN jxu temporary dom MOD jpi firstxu min temporary jxu max lastxu nxu lastxu firstxu 1 ENDELSE ENDELSE IF nxu NE 0 THEN lat1u min gphiu firstxu:lastxu firstyu:lastyu max lat2u ENDIF find lat1v lat2v firstxv firstxv firstyv firstyv nxv and nyv according to x1 x2 lon1 and lon2 IF where gridtype eq V 0 NE 1 THEN BEGIN firstyv fsty lastyv lsty nyv ny IF keyword_set memeindices THEN BEGIN firstxv firstyt lastxv lastyt nxv nxt ENDIF ELSE BEGIN dom where glamv fsty:lsty GE lon1 AND glamv fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstxv firstxt lastxv lastxt nxv nxt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstxv firstxu lastxv lastxu nxv nxu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv fsty:lsty gphiv fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv fsty:lsty gphiv fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamv fsty:lsty neig1 max glamv fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamv fsty:lsty neig1 max glamv fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstxv 1 lastxv 1 nxv 0 ENDELSE ENDIF ELSE BEGIN jxv temporary dom MOD jpi firstxv min temporary jxv max lastxv nxv lastxv firstxv 1 ENDELSE ENDELSE IF nxv NE 0 THEN lat1v min gphiv firstxv:lastxv firstyv:lastyv max lat2v ENDIF find lat1f lat2f firstxf firstxf firstyf firstyf nxf and nyf according to x1 x2 lon1 and lon2 IF where gridtype eq F 0 NE 1 THEN BEGIN firstyf fsty lastyf lsty nyf ny IF keyword_set memeindices THEN BEGIN firstxf firstyt lastxf lastyt nxf nxt ENDIF ELSE BEGIN dom where glamf fsty:lsty GE lon1 AND glamf fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstxf firstxt lastxf lastxt nxf nxt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstxf firstxu lastxf lastxu nxf nxu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstxf firstxv lastxf lastxv nxf nxv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf fsty:lsty gphif fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf fsty:lsty gphif fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamf fsty:lsty neig1 max glamf fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamf fsty:lsty neig1 max glamf fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstxf 1 lastyf 1 nxf 0 ENDELSE ENDIF ELSE BEGIN jxf temporary dom MOD jpi firstxf min temporary jxf max lastxf nxf lastxf firstxf 1 ENDELSE ENDELSE IF nxf NE 0 THEN lat1f min gphif firstxf:lastxf firstyf:lastyf max lat2f ENDIF lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f END ENDCASE ENDELSE The extracted domain is it regular or not CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype eq W 0 NE 1 AND nxt NE 0 AND nyt NE 0:BEGIN to get faster we first test the most basic cases befor testing the full array CASE 0 OF array_equal glamt firstxt:lastxt firstyt glamt firstxt:lastxt lastyt :key_irregular 1b array_equal gphit firstxt firstyt:lastyt gphit lastxt firstyt:lastyt :key_irregular 1b array_equal glamt firstxt:lastxt firstyt:lastyt glamt firstxt:lastxt firstyt replicate 1 nyt :key_irregular 1b array_equal gphit firstxt:lastxt firstyt:lastyt replicate 1 nxt gphit firstxt firstyt:lastyt :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq U 0 NE 1 AND nxu NE 0 AND nyu NE 0:BEGIN CASE 0 OF array_equal glamu firstxu:lastxu firstyu glamu firstxu:lastxu lastyu :key_irregular 1b array_equal gphiu firstxu firstyu:lastyu gphiu lastxu firstyu:lastyu :key_irregular 1b array_equal glamu firstxu:lastxu firstyu:lastyu glamu firstxu:lastxu firstyu replicate 1 nyu :key_irregular 1b array_equal gphiu firstxu:lastxu firstyu:lastyu replicate 1 nxu gphiu firstxu firstyu:lastyu :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq V 0 NE 1 AND nxv NE 0 AND nyv NE 0:BEGIN CASE 0 OF array_equal glamv firstxv:lastxv firstyv glamv firstxv:lastxv lastyv :key_irregular 1b array_equal gphiv firstxv firstyv:lastyv gphiv lastxv firstyv:lastyv :key_irregular 1b array_equal glamv firstxv:lastxv firstyv:lastyv glamv firstxv:lastxv firstyv replicate 1 nyv :key_irregular 1b array_equal gphiv firstxv:lastxv firstyv:lastyv replicate 1 nxv gphiv firstxv firstyv:lastyv :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq F 0 NE 1 AND nxf NE 0 AND nyf NE 0:BEGIN CASE 0 OF array_equal glamf firstxf:lastxf firstyf glamf firstxf:lastxf lastyf :key_irregular 1b array_equal gphif firstxf firstyf:lastyf gphif lastxf firstyf:lastyf :key_irregular 1b array_equal glamf firstxf:lastxf firstyf:lastyf glamf firstxf:lastxf firstyf replicate 1 nyf :key_irregular 1b array_equal gphif firstxf:lastxf firstyf:lastyf replicate 1 nxf gphif firstxf firstyf:lastyf :key_irregular 1b ELSE:key_irregular 0b ENDCASE END ELSE: ENDCASE define all vertical parameters vert1 vert2 firstz tw lastz tw nz tw vertical: vertical domain defined with vert1 vert2 IF NOT keyword_set zindex OR keyword_set index THEN BEGIN define vert1 et vert2 CASE N_PARAMS OF 2:vert1 min x1 x2 max vert2 6:vert1 min z1 z2 max vert2 ELSE:BEGIN IF inter byte gridtype byte T U V F 0 NE 1 THEN vert1t min gdept max vert2t IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN vert1w min gdepw max vert2w vert1 min vert1t vert1w vert2 max vert2t vert2w END ENDCASE define firstzt firstzt nzt IF inter byte gridtype byte T U V F 0 NE 1 THEN BEGIN domz where gdept ge vert1 and gdept le vert2 nzt IF nzt NE 0 THEN BEGIN firstzt domz 0 lastzt domz nzt 1 ENDIF ELSE BEGIN ras report WARNING The box does not contain any T level firstzt 1 lastzt 1 ENDELSE ENDIF define firstzw firstzw nzw IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstzw firstzt lastzw lastzt nzw nzt ENDIF ELSE BEGIN domz where gdepw ge vert1 and gdepw le vert2 nzw IF nzw NE 0 THEN BEGIN firstzw domz 0 lastzw domz nzw 1 ENDIF ELSE BEGIN ras report WARNING The box does not contain any W level firstzw 1 lastzw 1 ENDELSE ENDELSE ENDIF vertical domain defined with the Z index ENDIF ELSE BEGIN CASE N_PARAMS OF 2:fstz min x1 x2 max lstz 4:return 6:fstz min z1 z2 max lstz ENDCASE IF fstz LT 0 OR lstz GE jpk THEN BEGIN ras report Bad definition of X1 X2 Z1 or Z2 return ENDIF nz lstz fstz 1 find vert1t vert2t firstzt firstzt nzt according to x1 x2 or z1 z2 IF where gridtype eq T 0 NE 1 THEN BEGIN vert1t min gdept fstz:lstz max vert2t firstzt fstz lastzt lstz nzt nz ENDIF find vert1w vert2w firstzw firstzw nzw according to x1 x2 or z1 z2 IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN BEGIN vert1w min gdepw fstz:lstz max vert2w firstzw fstz lastzw lstz nzw nz ENDIF vert1 min vert1t vert1w vert2 max vert2t vert2w ENDELSE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF if keyword_set key_performance THEN print temps domdef systime 1 tempsun return end"); 185 a[183] = new Array("./ToBeReviewed/GRILLE/f2v.html", "f2v.pro", "", " NAME:f2v PURPOSE:permet de passer un champs se rapportant a la grille F sur la grille V grace a la moyenne: res 0 5 res shift res 1 0 CATEGORY:grille CALLING SEQUENCE:res f2v tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION f2v temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxf etc firstxv firstxf lastxv lastxf firstyv firstyf lastyv lastyf nxv nxf nyv nyf vargrid V if NOT keyword_set valmask then valmask 1e20 lon1 glamv firstxv 0 lon2 glamf lastxf 0 cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf: taille 1 eq jpi and taille 2 eq jpj: res res firstxf:lastxf firstyf:lastyf else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask fmask firstxf:lastxf firstyf:lastyf 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 1 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan mask vmask firstxf:lastxf firstyf:lastyf 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ nzt: taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxf:lastxf firstyf:lastyf firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxf:lastxf firstyf:lastyf else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask fmask firstxf:lastxf firstyf:lastyf lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxf nyf jpt over ENDIF ELSE mask fmask firstxf:lastxf firstyf:lastyf firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxf:lastxf firstyf:lastyf lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxf nyf jpt over ENDIF ELSE mask vmask firstxf:lastxf firstyf:lastyf firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxf:lastxf firstyf:lastyf firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask fmask firstxf:lastxf firstyf:lastyf firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxf nyf nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan mask vmask firstxf:lastxf firstyf:lastyf firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxf nyf nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 186 a[184] = new Array("./ToBeReviewed/GRILLE/fmask.html", "fmask.pro", "", " NAME:fmask PURPOSE:calcule fmask CATEGORY:fonction economisatrice de memoire plus besion de garder fmask CALLING SEQUENCE:res fmask OUTPUTS:un tableau 3d correspondant a fmask EXAMPLE:s utilise comme si fmask etait un tableau connu en replacant ds la syntaxe fmask par fmask par ex: au lieu de taper fmask domainef il faut taper fmask domainef MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 FUNCTION fmask cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 1 0 shift tmask 0 1 shift tmask 1 1 3:res tmask shift tmask 1 0 0 shift tmask 0 1 0 shift tmask 1 1 0 ENDCASE if NOT keyword_set key_periodic then res jpi 1 fmaskredy res jpj 1 fmaskredx if keyword_set key_performance THEN print temps fmask systime 1 tempsun return res end"); 187 a[185] = new Array("./ToBeReviewed/GRILLE/grille.html", "grille.pro", "", " NAME:grille PURPOSE: choisit la grille qui doit etre utilisee pour faire le graphe en fonction de vargrid et renvoie les parametres correspondants calcules ds domdef pro et reduit au domaine definit par domdef contrairement a grandegrille pro CATEGORY: CALLING SEQUENCE: grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 INPUTS:rien ATTENTION les choix de la grille se fait a partir de la valeur de la variable globale vargrid qui peut etre egale a T U V W ou F KEYWORD PARAMETERS: TRI si ce mot clef sert a obtenir grace a grille la triangulation qui se rapporte a la grille mais uniquement sur la partie du zoom ce tableau de triangulation reduit est passe ds la variable que l on a egalee a tri par ex: grille tri triangulation_reduite ne mot clef est utilise dans plt pro FORPLT: ds plt on veut que sur les points terres glam et gphi soit egale a glamt et gphit quelle que soit la grille NOTRI: utile seulement qd TRI est active dans ce cas grille retourne 1 ds la variable tri meme si la variable du common triangles_list est definie et differente de 1 WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS:mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 pour leur definition cf domdef et la gestion des sous domaines sur le web Rq: ces outputs sont optionnels si je veux recuperer que mask glam et gphi il suffit de taper grille mask glam gphi COMMON BLOCKS: cm_4mesh and cm_4data SIDE EFFECTS: utilise la variable globale vargird RESTRICTIONS: vargrid doit etre T W U V ou F EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 12 2 1999 10 11 1999 forplt pro grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 TRI tri NOTRI notri TOUT tout FORPLT forplt IFPLTZ ifpltz WDEPTH wdepth _EXTRA ex include commons cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance vargrid strupcase strmid vargrid 0 reverse_offset if vargrid eq W then wdepth 1 if keyword_set tout then begin savedbox 1b saveboxparam boxparam4grille dat domdef gridtype vargrid _EXTRA ex endif tempdeux systime 1 pour key_performance 2 IF keyword_set wdepth THEN BEGIN firstz firstzw lastz lastzw nz nzw ENDIF ELSE BEGIN firstz firstzt lastz lastzt nz nzt ENDELSE CASE 1 OF grille T and W vargrid eq T OR vargrid eq W : begin scalaires nx nxt ny nyt firstx firstxt firsty firstyt lastx lastxt lasty lastyt vecteurs 2d IF arg_present glam THEN glam glamt firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphit firstx:lastx firsty:lasty IF arg_present e1 THEN e1 e1t firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2t firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask tmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask tmask firstx:lastx firsty:lasty firstz:lastz end grille U vargrid eq U : begin scalaires nx nxu ny nyu firstx firstxu firsty firstyu lastx lastxu lasty lastyu vecteurs 2d IF arg_present glam THEN glam glamu firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphiu firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz eastboarder mask shift mask 1 0 mask westboarder mask shift mask 1 0 mask if key_periodic NE 1 OR nx NE jpi then westboarder nx 1 0b tmp1 shift eastboarder 0 1 tmp1 0 0b tmp2 shift eastboarder 0 1 tmp2 ny 1 0b add temporary tmp1 temporary tmp2 1b eastboarder 1b temporary westboarder eastboarder temporary eastboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 1b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 0b endif no1 temporary tmp1 temporary tmp2 tmp temporary eastboarder temporary no1 mask mask 0:nx 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1u firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2u firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask umask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask umask firstx:lastx firsty:lasty firstz:lastz end grille V vargrid eq OPAPTDHV or vargrid eq OPAPT3DV or vargrid eq V : begin scalaires nx nxv ny nyv firstx firstxv firsty firstyv lastx lastxv lasty lastyv vecteurs 2d IF arg_present glam THEN glam glamv firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphiv firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz northboarder mask shift mask 0 1 mask southboarder mask shift mask 0 1 mask southboarder ny 1 0b tmp1 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp1 nx 1 0b tmp2 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp2 0 0b add temporary tmp1 temporary tmp2 1b northboarder 1b southboarder northboarder temporary northboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 0b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 1b endif no1 temporary tmp1 temporary tmp2 tmp temporary northboarder mask temporary no1 mask 0:ny 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1v firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2v firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask vmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask vmask firstx:lastx firsty:lasty firstz:lastz end grille F vargrid eq OPAPTDHF or vargrid eq OPAPT3DF or vargrid eq F : begin scalaires nx nxf ny nyf firstx firstxf firsty firstyf lastx lastxf lasty lastyf vecteurs 2d IF arg_present glam THEN glam glamf firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphif firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz eastboarder mask shift mask 1 0 mask westboarder mask shift mask 1 0 mask westboarder nx 1 0b northboarder mask shift mask 0 1 mask southboarder mask shift mask 0 1 mask southboarder ny 1 0b tmp1 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp1 nx 1 0b tmp2 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp2 0 0b add temporary tmp1 temporary tmp2 1b northboarder 1b southboarder northboarder temporary northboarder temporary add tmp1 shift eastboarder 0 1 tmp1 0 0b tmp2 shift eastboarder 0 1 tmp2 ny 1 0b add temporary tmp1 temporary tmp2 1b eastboarder 1b temporary westboarder eastboarder temporary eastboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 1b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 1b endif no1 temporary tmp1 temporary tmp2 tmp temporary northboarder temporary eastboarder mask temporary no1 mask 0:nx 2 0b mask 0:ny 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1f firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2f firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask fmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask fmask firstx:lastx firsty:lasty firstz:lastz END ELSE:BEGIN ras report Wrong definition of vargrid vargrid Only T U V W or F are acceptable stop END ENDCASE IF testvar var key_performance EQ 2 THEN print temps grille: attribution des scalaires vecteurs et tableaux systime 1 tempdeux Variables se rapportant a la dimension verticale tempdeux systime 1 pour key_performance 2 if keyword_set wdepth then begin gdep gdepw firstz:lastz e3 e3w firstz:lastz endif else begin gdep gdept firstz:lastz e3 e3t firstz:lastz ENDELSE for the vertical sections with partial steps IF keyword_set ifpltz AND keyword_set key_partialstep THEN BEGIN CASE 1 OF ifpltz EQ xz AND ny EQ 1:BEGIN bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 good where bottom NE 0 AND bottom NE nz keyword_set wdepth bottom lindgen nx bottom 1l keyword_set wdepth nx IF good 0 NE 1 THEN BEGIN bottom bottom good IF lastz EQ jpk 1 THEN gdep nz 1 max hdepw gdep replicate 1 nx gdep if keyword_set wdepth THEN truegdep hdepw firstx:lastx firsty:lasty ELSE truegdep hdept firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ifpltz EQ yz AND nx EQ 1:BEGIN bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 good where bottom NE 0 AND bottom NE nz keyword_set wdepth bottom lindgen ny bottom 1l keyword_set wdepth ny IF good 0 NE 1 THEN BEGIN bottom bottom good IF lastz EQ jpk 1 THEN gdep nz 1 max hdepw gdep replicate 1 ny gdep if keyword_set wdepth THEN truegdep hdepw firstx:lastx firsty:lasty ELSE truegdep hdept firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ELSE: ENDCASE ENDIF IF testvar var key_performance EQ 2 THEN print temps grille: Variables se rapportant a la dimension verticale systime 1 tempdeux vecteur triangulation Qd TRI est active if arg_present TRI then if triangles_list 0 EQ 1 OR keyword_set notri then tri 1 ELSE BEGIN tempdeux systime 1 pour key_performance 2 msk bytarr jpi jpj msk firstx:lastx firsty:lasty 1 ind where msk triangles_list 0 msk triangles_list 1 msk triangles_list 2 EQ 1 tri triangles_list ind firstx firsty jpi y tri jpi x tri y jpi tri x y nx IF testvar var key_performance EQ 2 THEN print temps grille: decoupage de la triangulation systime 1 tempdeux ENDELSE pour s assurer qu il n y a pas de dimension degenerees 1 mask reform mask over glam reform glam over gphi reform gphi over gdep reform gdep over e1 reform e1 over e2 reform e2 over e3 reform e3 over if keyword_set savedbox THEN restoreboxparam boxparam4grille dat if keyword_set key_performance THEN print temps grille systime 1 tempsun IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end "); 188 a[186] = new Array("./ToBeReviewed/GRILLE/t2v.html", "t2v.pro", "", " NAME:t2v PURPOSE:permet de passer un champs se rapportant a la grille T sur la grille V grace a la moyenne: res 0 5 res shift res 0 1 CATEGORY:grille CALLING SEQUENCE:res t2v tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION t2v temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxv etc firstxv firstxt lastxv lastxt firstyv firstyt lastyv lastyt nxv nxt nyv nyt vargrid V if NOT keyword_set valmask then valmask 1e20 lat1 gphit 0 firstyt lat2 gphiv 0 lastyv cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt: taille 1 eq jpi and taille 2 eq jpj: res res firstxt:lastxt firstyt:lastyt else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask tmask firstxt:lastxt firstyt:lastyt 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 0 1 res nyt 1 values f_nan mask vmask firstxt:lastxt firstyt:lastyt 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ nzt: taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxt:lastxt firstyt:lastyt firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxt:lastxt firstyt:lastyt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask tmask firstxt:lastxt firstyt:lastyt lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxt nyt jpt over ENDIF ELSE mask tmask firstxt:lastxt firstyt:lastyt firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 res nyt 1 values f_nan if taille 3 EQ jpt then BEGIN mask vmask firstxt:lastxt firstyt:lastyt lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxt nyt jpt over ENDIF ELSE mask vmask firstxt:lastxt firstyt:lastyt firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxt:lastxt firstyt:lastyt firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask tmask firstxt:lastxt firstyt:lastyt firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxt nyt nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 0 res nyt 1 values f_nan mask vmask firstxt:lastxt firstyt:lastyt firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxt nyt nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END ENDCASE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 189 a[187] = new Array("./ToBeReviewed/GRILLE/tracegrille.html", "tracegrille.pro", "", " NAME:tracegrille PURPOSE:dessine la grille CATEGORY: CALLING SEQUENCE:tracegrille INPUTS:glam et gphi les tableaux 1d ou 2d des position en longitude latitude des points de la grille Si glam et gphi ne sont pas specifies trace la grille specifiee par vargrid sur le domaine definit par le dernier domdef KEYWORD PARAMETERS: XSTRIDE un entier pour specifier qu on ne veut tracer qu une ligne de i constant tout les xstride points YSTRIDE un entier pour specifier qu on ne veut tracer qu une ligne de j constant tout les ystride points OCEAN: pour ne tracer la grille que sur les points oceans EARTH: pour ne tracer la grille que sur les points terre RMOUT:select to remove all cell having one corner out of the plot boundaries x range y range tous les mots clefs de la procedure PLOTS OUTPUTS:none COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL plt indgen jpi jpj nocontour nofill IDL vargrid T IDL tracegrille ocean color 20 IDL tracegrille earth color 80 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO tracegrille glamin gphiin OCEAN ocean EARTH earth XSTRIDE xstride YSTRIDE ystride RMOUT rmout _extra extra cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance to avoid warning message oldexcept except except 0 if n_elements key_gridtype EQ 0 then key_gridtype c if n_elements glamin n_elements gphiin EQ 0 then BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz IF keyword_set ocean AND key_gridtype EQ c THEN BEGIN we reduce the mask to take into account the point located ON the coastline CASE vargrid OF U :BEGIN mask tmask firstx:lastx firsty:lasty IF NOT keyword_set key_periodic OR nx NE jpi THEN tmpx mask nx 1 mask mask shift mask 1 0 1 IF NOT keyword_set key_periodic OR nx NE jpi THEN mask nx 1 temporary tmpx END V :BEGIN mask tmask firstx:lastx firsty:lasty tmpy mask ny 1 mask mask shift mask 0 1 1 mask ny 1 temporary tmpy END F :BEGIN mask tmask firstx:lastx firsty:lasty IF NOT keyword_set key_periodic OR nx NE jpi THEN tmpx mask nx 1 tmpy mask ny 1 mask mask shift mask 1 0 shift mask 0 1 shift mask 1 1 1 mask ny 1 temporary tmpy IF NOT keyword_set key_periodic OR nx NE jpi THEN mask nx 1 temporary tmpx END ELSE: ENDCASE ENDIF ENDIF ELSE BEGIN glam glamin gphi gphiin IF size glam 0 EQ 1 AND size gphi 0 EQ 1 THEN BEGIN nx n_elements glam ny n_elements gphi glam glam replicate 1 ny gphi replicate 1 nx gphi ENDIF ELSE BEGIN nx size glam 1 ny size glam 2 ENDELSE ENDELSE if n_elements mask EQ 0 then mask replicate 1b nx ny if size mask 0 EQ 3 then mask mask 0 IF keyword_set RMOUT THEN BEGIN out where glam GT max x range OR glam LT min x range OR gphi GT max y range OR gphi LT min y range IF out 0 NE 1 THEN BEGIN glam out values f_nan gphi out values f_nan ENDIF ENDIF IF keyword_set ocean then BEGIN earth where mask EQ 0 if earth 0 NE 1 then begin glam earth values f_nan gphi earth values f_nan ENDIF earth 0 ENDIF IF keyword_set earth THEN BEGIN ocean where mask EQ 1 if ocean 0 NE 1 then begin glam ocean values f_nan gphi ocean values f_nan ENDIF ocean 0 ENDIF if NOT keyword_set xstride then xstride 1 if NOT keyword_set ystride then ystride 1 case key_gridtype of c :BEGIN for i 0 ny 1 ystride do begin plots glam i gphi i _extra extra endfor for i 0 nx 1 xstride do begin plots glam i gphi i _extra extra endfor END e :BEGIN shifted glam 0 0 LT glam 0 1 glam2 glam glam 1 glam 0 2 if shifted then begin for i 0 ny 2 do BEGIN xx transpose glam i glam2 i yy transpose gphi i gphi i 1 plots xx 0:2 nx 2 yy 0:2 nx 2 _extra extra ENDFOR ENDIF ELSE BEGIN for i 1 ny 1 do BEGIN xx transpose glam i glam2 i yy transpose gphi i gphi i 1 plots xx 0:2 nx 2 yy 0:2 nx 2 _extra extra ENDFOR ENDELSE for i 1 ny 1 2 do plots glam 0 2 i 1 glam 0 2 i gphi 0 2 i 1 gphi 0 2 i _extra extra for i 0 ny 2 2 do plots glam nx 1 2 i glam nx 1 2 i 1 gphi nx 1 2 i gphi nx 1 2 i 1 _extra extra END endcase if keyword_set key_performance THEN print temps trace grille systime 1 tempsun except oldexcept return end"); 190 a[188] = new Array("./ToBeReviewed/GRILLE/u2t.html", "u2t.pro", "", " NAME:u2t PURPOSE:permet de passer un champs se rapportant a la grille U sur la grille T grace a la moyenne: res 0 5 res shift res 1 0 CATEGORY:grille CALLING SEQUENCE:res u2t tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION u2t temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxu etc firstxt firstxu lastxt lastxu firstyt firstyu lastyt lastyu nxt nxu nyt nyu vargrid T if NOT keyword_set valmask then valmask 1e20 lon1 glamt firstxt 0 lon2 glamu lastxu 0 cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu: taille 1 eq jpi and taille 2 eq jpj: res res firstxu:lastxu firstyu:lastyu else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask umask firstxu:lastxu firstyu:lastyu 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 1 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan mask tmask firstxu:lastxu firstyu:lastyu 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ nzt: taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxu:lastxu firstyu:lastyu firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxu:lastxu firstyu:lastyu else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask umask firstxu:lastxu firstyu:lastyu lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxu nyu jpt over ENDIF ELSE mask umask firstxu:lastxu firstyu:lastyu firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxu:lastxu firstyu:lastyu lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxu nyu jpt over ENDIF ELSE mask tmask firstxu:lastxu firstyu:lastyu firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxu:lastxu firstyu:lastyu firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask umask firstxu:lastxu firstyu:lastyu firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxu nyu nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan mask tmask firstxu:lastxu firstyu:lastyu firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxu nyu nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 191 a[189] = new Array("./ToBeReviewed/GRILLE/umask.html", "umask.pro", "", " NAME:umask PURPOSE:calcule umask CATEGORY:fonction economisatrice de memoire plus besion de garder umask CALLING SEQUENCE:res umask INPUTS: KEYWORD PARAMETERS: OUTPUTS:un tableau 3d correspondant a umask COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE:s utilise comme si umask etait un tableau connu en replacant ds la syntaxe umask par umask par ex: au lieu de taper umask domaineu il faut taper umask domaineu MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 6 99 introduction du key_shift 20 9 99 cas jpk 1 merci jpblod ipsl jussieu fr FUNCTION umask cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 1 0 3:res tmask shift tmask 1 0 0 ENDCASE if NOT keyword_set key_periodic then res jpi 1 umaskred if keyword_set key_performance THEN print temps umask systime 1 tempsun return res end"); 192 a[190] = new Array("./ToBeReviewed/GRILLE/v2t.html", "v2t.pro", "", " NAME:v2t PURPOSE:permet de passer un champs se rapportant a la grille V sur la grille T grace a la moyenne: res 0 5 res shift res 0 1 CATEGORY:grille CALLING SEQUENCE:res v2t tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION v2t temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxv etc firstxt firstxv lastxt lastxv firstyt firstyv lastyt lastyv nxt nxv nyt nyv vargrid T if NOT keyword_set valmask then valmask 1e20 lat1 gphit 0 firstyt lat2 gphiv 0 lastyv cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv: taille 1 eq jpi and taille 2 eq jpj: res res firstxv:lastxv firstyv:lastyv else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask vmask firstxv:lastxv firstyv:lastyv 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 0 1 res 0 values f_nan mask tmask firstxv:lastxv firstyv:lastyv 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ nzt: taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxv:lastxv firstyv:lastyv firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxv:lastxv firstyv:lastyv else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask vmask firstxv:lastxv firstyv:lastyv lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxv nyv jpt over ENDIF ELSE mask vmask firstxv:lastxv firstyv:lastyv firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxv:lastxv firstyv:lastyv lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxv nyv jpt over ENDIF ELSE mask tmask firstxv:lastxv firstyv:lastyv firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxv:lastxv firstyv:lastyv firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask vmask firstxv:lastxv firstyv:lastyv firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxv nyv nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 0 res 0 values f_nan mask tmask firstxv:lastxv firstyv:lastyv firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxv nyv nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 193 a[191] = new Array("./ToBeReviewed/GRILLE/vmask.html", "vmask.pro", "", " NAME:vmask PURPOSE:calcule vmask CATEGORY:fonction economisatrice de memoire plus besion de garder vmask CALLING SEQUENCE:res vmask OUTPUTS:un tableau 3d correspondant a vmask EXAMPLE:s utilise comme si vmask etait un tableau connu en replacant ds la syntaxe vmask par vmask par ex: au lieu de taper vmask domainef il faut taper vmask domainef MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 20 9 99 cas jpk 1 merci jpblod ipsl jussieu fr FUNCTION vmask common tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 0 1 3:res tmask shift tmask 0 1 0 ENDCASE res jpj 1 vmaskred if keyword_set key_performance THEN print temps vmask systime 1 tempsun return res end"); 194 a[192] = new Array("./ToBeReviewed/HOPE/completetype.html", "completetype.pro", "", " function completetype typein type typein case type of x :type type yzt y :type type xzt z :type type zyt t :type type xyz xy :type type zt xz :type type yt yz :type type xt xt :type type yz yt :type type xz zt :type type xy xyz :type type t xyt :type type z yzt :type type x xyzt : endcase return type end "); 195 a[193] = new Array("./ToBeReviewed/HOPE/computehopegrid.html", "computehopegrid.pro", "", " NAME:computehopegrid PURPOSE: CATEGORY:grille CALLING SEQUENCE:computehopegrid INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2001 06 PRO computehopegrid xaxis yaxis zaxis linetype FORTHEMASK forthemask WPOINT wpoint FIRSTS firsts LASTS lasts PTTYPE pttype cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF if not keyword_set scalar keyword_set vector then scalar 1 jpiglo n_elements xaxis jpjglo n_elements yaxis jpkglo n_elements zaxis jpi jpiglo jpj jpjglo jpk jpkglo if NOT keyword_set firsts then firsts 0 0 0 if NOT keyword_set lasts then lasts jpi 1 jpj 1 jpk 1 depermination of the grid type and of the point type if keyword_set pttype then vargrid pttype if linetype EQ odd even then key_gridtype e ELSE key_gridtype c computation of the horizontal grid if key_gridtype EQ e then begin if vargrid EQ T then begin glamt xaxis glamt glamt replicate 1 jpj xstep glamt 1 0 glamt 0 0 2 glamt 2 lindgen jpj 2 glamt 2 lindgen jpj 2 xstep glamu glamt xstep ENDIF ELSE BEGIN glamu xaxis glamu glamu replicate 1 jpj xstep glamu 1 0 glamu 0 0 2 glamu 2 lindgen jpj 2 glamu 2 lindgen jpj 2 xstep glamt glamu xstep ENDELSE zoom glamt glamt firsts 0 :lasts 0 firsts 1 :lasts 1 glamu glamu firsts 0 :lasts 0 firsts 1 :lasts 1 jpiglo lasts 0 firsts 0 1 jpi jpiglo jpjglo lasts 1 firsts 1 1 jpj jpjglo glamv glamu glamf glamu gphit yaxis firsts 1 :lasts 1 gphit replicate 1 jpi gphit gphif gphit gphiu gphit gphiv gphif ENDIF ELSE BEGIN if vargrid eq T then begin glamt xaxis glamt glamt replicate 1 jpj glamu glamt glamt 1 0 glamt 0 0 2 ENDIF ELSE BEGIN glamu xaxis glamu glamu replicate 1 jpj xstep glamu 1 0 glamu 0 0 2 glamt glamu glamu 1 0 glamu 0 0 2 ENDELSE zoom glamt glamt firsts 0 :lasts 0 firsts 1 :lasts 1 glamu glamu firsts 0 :lasts 0 firsts 1 :lasts 1 jpiglo lasts 0 firsts 0 1 jpi jpiglo jpjglo lasts 1 firsts 1 1 jpj jpjglo glamv glamt glamf glamu gphit yaxis firsts 1 :lasts 1 gphit replicate 1 jpi gphit gphiu gphit if jpj GT 1 then begin gphiv gphit gphit 0 1 gphit 0 0 2 gphif gphit gphit 0 1 gphit 0 0 2 ENDIF ELSE BEGIN gphiv gphit gphif gphit ENDELSE ENDELSE computation of the vertical grid if keyword_set wpoint then begin gdepw zaxis if jpk ne 1 then begin gdept shift gdepw 1 gdepw 2 gdept jpk 1 gdepw jpk 1 5 gdepw jpk 1 gdepw jpk 2 endif else gdept zaxis endif else begin gdept zaxis if jpk ne 1 then begin gdepw shift gdept 1 gdept 2 gdepw 0 0 endif else gdepw zaxis endelse computation of the vertical scale factors if jpk ne 1 then begin e3t abs shift gdepw 1 gdepw e3t jpk 1 abs gdept jpk 1 gdepw jpk 1 e3w abs gdept shift gdept 1 e3w 0 abs gdept 0 gdepw 0 endif else begin e3t 1 e3w 1 endelse zoom gdept gdept firsts 2 :lasts 2 gdepw gdepw firsts 2 :lasts 2 e3t e3t firsts 2 :lasts 2 e3w e3w firsts 2 :lasts 2 jpkglo lasts 2 firsts 2 1 jpk jpkglo computation of the horizontal scale factors e1t replicate 1b jpi jpj e2t replicate 1b jpi jpj e1u e1t e2u e2t e1v e1t e2v e2t e1f e1t e2f e2t mask tmask replicate 1b jpi jpj jpk if keyword_set forthemask then BEGIN land where forthemask ge valmask 10 if land 0 ne 1 then tmask land 0b endif umaskred replicate 1 jpj jpk vmaskred replicate 1 jpi jpk fmaskredy replicate 1 jpj jpk fmaskredx replicate 1 jpi jpk updateold domdef if keyword_set firsts AND keyword_set lasts then BEGIN if vargrid EQ T then BEGIN if jpj GT 1 then begin lon1 min glamt 0 0 1 lon2 max glamt jpi 1 0 1 endif ELSE BEGIN lon1 min glamt 0 0 lon2 max glamt jpi 1 0 ENDELSE ENDIF ELSE BEGIN if jpj GT 1 then begin lon1 min glamu 0 0 1 lon2 max glamu jpi 1 0 1 endif ELSE BEGIN lon1 min glamu 0 0 lon2 max glamu jpi 1 0 ENDELSE ENDELSE lat1 min gphit 0 0 gphit 0 jpj 1 lat2 max gphit 0 0 gphit 0 jpj 1 domdef lon1 lon2 lat1 lat2 gdepw 0 gdept jpk 1 gridtype vargrid ENDIF ixminmesh 0l ixmaxmesh long jpi 1 iyminmesh 0l iymaxmesh long jpj 1 izminmesh 0l izmaxmesh long jpk 1 for the triangulation key_periodic glamt 0 EQ glamt jpi 1 glamt 1 glamt 0 MOD 360 if jpi gt 4 AND jpj GT 4 then begin triangles_list triangule shifted glamt 0 0 LT glamt 0 1 twin_corners_up 1 twin_corners_dn 1 ENDIF ELSE BEGIN triangles_list 1 twin_corners_up 1 twin_corners_dn 1 ENDELSE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end "); 196 a[194] = new Array("./ToBeReviewed/HOPE/createhopestruct.html", "createhopestruct.pro", "", "FUNCTION createhopestruct event widget_control event top get_uvalue top_uvalue find the selected variable selected top_uvalue 1 findline top_uvalue selected get the variable id varid top_uvalue 1 findline top_uvalue datavarid selected get the section type type top_uvalue 1 findline top_uvalue sectype selected get its dimension dimsvar top_uvalue 1 findline top_uvalue dimvar selected tosort sortdim completetype type dimsvar dimsvar tosort get the specified spatial domain and build reading parameters linetype top_uvalue 1 findline top_uvalue linetype selected case linetype of odd :domainid widget_info event top find_by_uname basedomainodd even :domainid widget_info event top find_by_uname basedomaineven odd even :domainid widget_info event top find_by_uname basedomainodd even endcase allaxes top_uvalue 1 findline top_uvalue dimlist xaxis allaxes dimsvar 0 xlimits top_uvalue 1 findline top_uvalue xlimits if NOT keyword_set xlimits then begin xid widget_info domainid find_by_uname xinterval widget_control xid get_value xint endif ELSE xint xaxis where xaxis GE xlimits 0 AND xaxis LE xlimits 1 yaxis allaxes dimsvar 1 yaxis reverse yaxis latitudes from the south to the north ylimits top_uvalue 1 findline top_uvalue ylimits if NOT keyword_set ylimits then begin yid widget_info domainid find_by_uname yinterval widget_control yid get_value yint endif ELSE yint yaxis where yaxis GE ylimits 0 AND yaxis LE ylimits 1 zaxis allaxes dimsvar 2 zlimits top_uvalue 1 findline top_uvalue zlimits if NOT keyword_set zlimits then begin zid widget_info domainid find_by_uname zinterval widget_control zid get_value zint endif ELSE zint zaxis where zaxis GE zlimits 0 AND zaxis LE zlimits 1 time axis and time interval time allaxes dimsvar 3 yyyymmdd vairdate time tlimits top_uvalue 1 findline top_uvalue tlimits if NOT keyword_set tlimits then BEGIN date1id widget_info event top find_by_uname date1 widget_control date1id get_value date1 date2id widget_info event top find_by_uname date2 widget_control date2id get_value date2 tlimits date1 date2 ENDIF tint time where yyyymmdd GE tlimits 0 AND yyyymmdd LE tlimits 1 limits of the domain nxt n_elements xint nyt n_elements yint nzt n_elements zint jpt n_elements tint firstx where xaxis GE xint 0 0 firsty where yaxis GE yint 0 0 lasty firsty nyt 1 firstz where zaxis GE zint 0 0 firstt where time GE tint 0 0 read the array cdfid ncdf_open top_uvalue 1 findline top_uvalue filename offset firstx n_elements yaxis lasty 1 firstz firstt count nxt nyt nzt jpt tosortinv sortdim completetype type inv sort the offset and count for the case of the array is not written as a xyzt array but for example as a yzxt array offset offset tosortinv count count tosortinv call to ncdf_varget ncdf_varget cdfid varid array offset offset count count force to keep the dimension equal to 1 if count 3 eq 1 then array reform array count 0 count 1 count 2 count 3 over if not array_equal tosort lindgen 4 then array transpose temporary array tosort count nxt nyt nzt jpt if jpt eq 1 then array reform array count 0 count 1 count 2 count 3 over array reverse array 2 over if there is no longitude zoom shift the array to obtain longitude between 20 and 380 if nxt EQ 128 OR nxt EQ 256 then begin key_shift where xaxis GE 20 0 xaxis shift temporary xaxis key_shift xaxis where xaxis LT 20 xaxis where xaxis LT 20 360 array shift temporary array key_shift 0 0 0 ENDIF ELSE key_shift 0 get some informations about the array insidevar ncdf_varinq cdfid varid if insidevar natts NE 0 then begin attnames strarr insidevar natts for attiq 0 insidevar natts 1 do attnames attiq strlowcase ncdf_attname cdfid varid attiq get the name if where attnames EQ long_name 0 EQ 1 then value ELSE ncdf_attget cdfid varid long_name value varname strtrim string value 2 get the units if where attnames EQ units 0 EQ 1 then value ELSE ncdf_attget cdfid varid units value varunit strtrim string value 2 get the missing_value if where attnames EQ missing_value 0 EQ 1 then valmask 1e20 ELSE ncdf_attget cdfid varid missing_value valmask ENDIF ELSE BEGIN varunit valmask 1e20 varname ENDELSE varexp build arguments to use computehopegrid and put it together in a structure firsts firstx firsty firstz lasts firstx nxt 1 firsty nyt 1 firstz nzt 1 vargrid top_uvalue 1 findline top_uvalue pointtype selected hopegrid xaxis:xaxis yaxis:yaxis zaxis:zaxis firsts:firsts lasts:lasts type:type linetype:linetype pttype:vargrid hopestru array:array unit:varunit name:varname date:time firstt:firstt jpt 1 grid:vargrid hopegrid:hopegrid we close the netcdf file before living ncdf_close cdfid return hopestru end"); 197 a[195] = new Array("./ToBeReviewed/HOPE/cw_selectinterval.html", "cw_selectinterval.pro", "", " PRO testwid_event event widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy get :BEGIN id widget_info event top find_by_uname discret widget_control id get_value value1 help value1 print value1 value1 id widget_info event top find_by_uname continus widget_control id get_value value2 help value2 print value2 value2 END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN nothing widget_label base value beginning of the test nothing cw_selectinterval base 10 indgen 5 _extra ex uname discret uvalue discret print nothing nothing cw_selectinterval base indgen 20 _extra ex uname continus uvalue continus print nothing nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base no_block return end function cw_selectinterval_get_value id bgroupid widget_info id find_by_uname bgroup the widget is a set of button if bgroupid ne 0 then begin widget_control bgroupid get_value selected widget_control bgroupid get_uvalue vecteur vecteur vecteur vecteur endif else begin the widget is 2 sliders Minid Widget_Info Id Find_by_uname min widget_control minid get_value minval minval minval value maxid widget_info id find_by_uname max widget_control maxid get_value maxval maxval maxval value widget_control minid get_uvalue vecteur vecteur vecteur vecteur selected where vecteur ge minval and vecteur le maxval ENDELSE if selected 0 eq 1 then return 1 else return vecteur selected END function cw_selectinterval_event event widget_control event id get_uvalue uval case uval name of min :begin change the value if the minimum for the slider called max maxid widget_info event handler find_by_uname max widget_control maxid set_value SLIDER_MIN:event value 1 end max :begin change the value if the maximum for the slider called min minid widget_info event handler find_by_uname min widget_control minid set_value SLIDER_MAX:event value 1 end bgroup : endcase return ID:event handler TOP:event top HANDLER:0L END function cw_selectinterval parent vecteur _extra ex base widget_base parent EVENT_FUNC cw_selectinterval_event FUNC_GET_VALUE cw_selectinterval_get_value PRO_SET_VALUE cw_selectinterval_set_value ROW _extra ex if n_elements vecteur le 10 then begin nothing CW_BGROUP base strtrim vecteur 1 nonexclusive row uvalue name: bgroup vecteur:vecteur uname bgroup buttvalue bytarr n_elements nothing buttvalue 0 1 widget_control nothing set_value buttvalue endif else begin min min floor vecteur max max ceil vecteur nothing cw_slider_pm base value min min min max max 1 uvalue name: min vecteur:vecteur uname min nothing cw_slider_pm base value max min min 1 max max uvalue name: max uname max endelse return base end"); 198 a[196] = new Array("./ToBeReviewed/HOPE/domainpart.html", "domainpart.pro", "", "pro domainpart top_uvalue basedomain selected DESTROY destroy if keyword_set destroy then BEGIN id widget_info basedomain find_by_uname title IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname oddsecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname evensecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname odd evensecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basex IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basey IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basez IF id NE 0 THEN widget_control id destroy return endif we get the size of the dimenstion id of this section dimvar top_uvalue 1 findline top_uvalue dimvar selecteddim dimvar selected typedim top_uvalue 1 findline top_uvalue typedim sorteddim selecteddim sortdim typedim selecteddim dimlist top_uvalue 1 findline top_uvalue dimlist longitude part basex widget_info basedomain find_by_uname basex IF basex NE 0 THEN widget_control basex destroy basex widget_base basedomain row uname basex nothing widget_text basex value longitude xsize 10 nothing cw_selectinterval basex dimlist sorteddim 0 uname xinterval uvalue name: xinterval latitude part basey widget_info basedomain find_by_uname basey IF basey NE 0 THEN widget_control basey destroy basey widget_base basedomain row uname basey nothing widget_text basey value latitude xsize 10 nothing cw_selectinterval basey reverse dimlist sorteddim 1 uname yinterval uvalue name: yinterval depth part basez widget_info basedomain find_by_uname basez IF basez NE 0 THEN widget_control basez destroy basez widget_base basedomain row uname basez nothing widget_text basez value depth xsize 10 nothing cw_selectinterval basez dimlist sorteddim 2 uname zinterval uvalue name: zinterval end "); 199 a[197] = new Array("./ToBeReviewed/HOPE/findlineandpointtype.html", "findlineandpointtype.pro", "", "FUNCTION findlineandpointtype sectype xaxis yaxis iodir the file HOPE_lonlat nc is used in this function This file must be localized in iodir netcdf HOPE_lonlat dimensions: latTlow 242 lonTlowodd 128 latThigh 390 lonThighodd 256 variables: float latTlow latTlow latTlow:units degrees_north float lonTlowodd lonTlowodd lonTlowodd:units degrees_east lonTlowodd:point_spacing even lonTlowodd:modulo float latThigh latThigh latThigh:units degrees_north float lonThighodd lonThighodd lonThighodd:units degrees_east lonThighodd:point_spacing even lonThighodd:modulo jpi n_elements xaxis jpj n_elements yaxis depermination of the grid type and of the point type low resolution grid: jpi 128 jpj 121 x 2 jpk 20 0 1 4 2 8 4 2 5 6 odd T u T u 93 3 even T u T u 92 2 odd T u T u 91 1 even T u T u 90 0 high resolution grid: jpi 256 jpj 195 x 2 jpk 29 0 0 7 1 4 2 1 2 8 odd T u T u 91 6 even T u T u 91 0 odd T u T u 90 5 even T u T u 90 0 x0 floor xaxis 0 10 10 y0 floor yaxis 0 10 10 case sectype of xy :BEGIN if jpi NE 128 and jpi NE 256 OR jpj NE 121 AND jpj NE 121 2 AND jpj NE 195 AND jpj NE 195 2 then begin print CASE NOT coded stop ENDIF case 1 of jpj EQ 195: BEGIN case X0 OF 0:BEGIN line even vargrid T END 0 7:BEGIN case y0 OF 91 6:BEGIN line odd vargrid T END 91 0:BEGIN line even vargrid U END ELSE:BEGIN print CASE NOT coded stop END endcase END 1 4:BEGIN line odd vargrid U END endcase END jpj EQ 121:BEGIN case x0 OF 0:BEGIN line even vargrid T END 1 4:BEGIN case y0 OF 93 3:BEGIN line odd vargrid T END 92 2:BEGIN line even vargrid U END ELSE:BEGIN print CASE NOT coded stop END endcase END 2 8:BEGIN line odd vargrid U END endcase END jpj EQ 195 2:BEGIN line odd even case x0 OF 0 7:vargrid T 1 4:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END jpj EQ 121 2:BEGIN line odd even case x0 OF 1 4:vargrid T 2 8:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END ELSE:BEGIN print CASE NOT coded stop END endcase END xz :BEGIN if jpi NE 128 and jpi NE 256 then begin print CASE NOT coded stop ENDIF case X0 OF 0:BEGIN line even vargrid T END 0 7:BEGIN id ncdf_open iodir HOPE_lonlat nc ncdf_varget id latThigh lat test where lat EQ yaxis 0 0 if test EQ 1 then begin print CASE NOT coded stop endif IF test MOD 2 EQ 1 THEN BEGIN line even vargrid U ENDIF ELSE BEGIN line odd vargrid T ENDELSE ncdf_close id END 1 4:BEGIN if jpi EQ 128 then begin id ncdf_open iodir HOPE_lonlat nc ncdf_varget id latTlow lat test where lat EQ yaxis 0 0 if test EQ 1 then begin print CASE NOT coded stop endif IF test MOD 2 EQ 1 THEN BEGIN line even vargrid U ENDIF ELSE BEGIN line odd vargrid T ENDELSE ncdf_close id ENDIF ELSE BEGIN line odd vargrid U ENDELSE END 2 8:BEGIN line odd vargrid U END endcase END yz :BEGIN if jpj NE 121 AND jpj NE 195 then begin print CASE NOT coded stop ENDIF id ncdf_open iodir HOPE_lonlat nc case y0 of 93 3:BEGIN line odd ncdf_varget id lonTlowodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid T where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END 92 2:BEGIN line even ncdf_varget id lonTlowodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid U where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid T ELSE:BEGIN print CASE NOT coded stop END endcase END 91 6:BEGIN line odd ncdf_varget id lonThighodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid T where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END 91 0:BEGIN line even ncdf_varget id lonThighodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid U where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid T ELSE:BEGIN print CASE NOT coded stop END endcase END ELSE:BEGIN print CASE NOT coded stop END endcase ncdf_close id END else:BEGIN print case not coded stop END endcase return linetype:line pointtype:vargrid end"); 200 a[198] = new Array("./ToBeReviewed/HOPE/read_hope.html", "read_hope.pro", "", " NAME: read_hope PURPOSE: read the Hope grid file converted in NetCdf by xconv CATEGORY: reading CALLING SEQUENCE: a read_hope typein varnamein INPUTS: typein: a string specifing from which type of section the 4D array based: xy xz yz varnamein: a string the name of the cariable to be read in lower or upper case KEYWORD PARAMETERS: FILENAME the name of the file to be read XLIMITS a two elements vertor lonmin lonmax the bondary of the longitudes from 0 to 360 YLIMITS a two elements vertor latmin latmax the bondary of the latitudes from 90 to 90 ZLIMITS a two elements vertor depthmin depthmax the bondary of the depth TLIMITS a two elements vertor date1 date2 the bondary of the calendar with date1 and date2 folowing the syntaxe yyyymmdd ODDPT: activate to read only the sections located on ODD points EVENPT: activate to read only the sections located on even points ODDEVENPT: activate to read only the sections located on both even and odd points horizontal sections OUTPUTS: 1 if typein and varnamein are undefine this is the widget version a structure which but be read by litchamp pro and is necessary to complute the grid associated to the data see the example COMMON BLOCKS: common pro usefull only for the definition of iodir SIDE EFFECTS: x y z t xt yt and zt section not coded xconv must be able to works with this kind of fonction The grib file has no zoom possibilities on horizontal dimensions RESTRICTIONS: When typein and varnamein are defined the methode to find the godd variable is: 1 find the variables which are available on this type of sections woth this name 2 if ODDPT EVENPT or ODDEVENPT are specified consider only these types of sections 3 for an XY section the chosen variable is the one which has the most level in the vertical domain specified by ZLIMITS for an XZ section the chosen variable is the one which has the most points in the latitude domain specified by YLIMITS for an YZ section the chosen variable is the one which has the most points in the longitude domain specified by XLIMITS EXAMPLE: IDL a read_hope xy ocpt filename CLIM_CNT_1993 1998 nc IDL help a struct Structure 6 tags length 1860176 refs 1: ARRAY FLOAT Array 128 242 15 UNIT STRING deg C NAME STRING Ocean potential temperature DATE FLOAT Array 1 GRID STRING T HOPEGRID STRUCT Array 1 IDL help a hopegrid struct Structure 8 tags length 1588 refs 2: XAXIS FLOAT Array 128 YAXIS FLOAT Array 242 ZAXIS FLOAT Array 15 FIRSTS LONG Array 3 LASTS LONG Array 3 TYPE STRING xy LINETYPE STRING odd even PTTYPE STRING T IDL help litchamp a FLOAT Array 128 242 15 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2001 pro read_hope_event event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue case uval name OF cancel :begin close the file cdfid top_uvalue 1 findline top_uvalue cdfid ncdf_close cdfid clear the pointer for i 0 n_elements top_uvalue 1 do ptr_free top_uvalue i kill the widget widget_control event top destroy end type choice :begin find the new type of selected section typeindex widget_info event id droplist_select selectedtype top_uvalue 1 findline top_uvalue type choice typeindex find the available variables for this type of section sectype top_uvalue 1 findline top_uvalue sectype goodvar where sectype EQ selectedtype namevar top_uvalue 1 findline top_uvalue namevar goodnamevar namevar goodvar find the selected var name varchoiceid widget_info event top find_by_uname var choice varindex widget_info varchoiceid droplist_select varchoice top_uvalue 1 findline top_uvalue var choice selectedvarname varchoice varindex do we change the variable if where goodnamevar EQ selectedvarname 0 EQ 1 then begin selectedvarname goodnamevar 0 varindex where varchoice EQ selectedvarname 0 widget_control varchoiceid set_droplist_select varindex ENDIF displays the different domains selected goodvar where goodnamevar EQ selectedvarname rh_alldomains event top selected end var choice :BEGIN find the new variable varindex widget_info event id droplist_select selectedvar top_uvalue 1 findline top_uvalue var choice varindex find the available variables for this type of section namevar top_uvalue 1 findline top_uvalue namevar goodvar where namevar EQ selectedvar sectype top_uvalue 1 findline top_uvalue sectype goodtype sectype goodvar find the selected type of section typechoiceid widget_info event top find_by_uname type choice typeindex widget_info typechoiceid droplist_select typechoice top_uvalue 1 findline top_uvalue type choice selectedtype typechoice typeindex do we change the type of section if where goodtype EQ selectedtype 0 EQ 1 then begin selectedtype goodtype 0 typeindex where typechoice EQ selectedtype 0 widget_control typechoiceid set_droplist_select typeindex ENDIF displays the different domains selected goodvar where goodtype EQ selectedtype rh_alldomains event top selected END plot :BEGIN plot the array res createhopestruct event type of section selected top_uvalue 1 findline top_uvalue selected type top_uvalue 1 findline top_uvalue sectype selected get the informations of cw_specifie specifieid widget_info event top find_by_uname specifie widget_control specifieid get_value specifie specifie struct2string specifie direct2string case type of x :command plt1d res x specifie y :command plt1d res y specifie z :command plt1d res z specifie t :command pltt res t specifie xy :command plt res specifie xz :command pltz res xz specifie yz :command pltz res yz specifie xt :command pltt res xt specifie yt :command pltt res yt specifie zt :command pltt res zt specifie xyz : xyt : yzt : xyzt : ENDCASE test execute command if test EQ 0 then stop end linechoice :BEGIN if event select EQ 1 then begin sensitive bytarr 3 sensitive where odd even odd even eq event value 1 basedomainodd widget_info event top find_by_uname basedomainodd widget_control basedomainodd sensitive sensitive 0 basedomaineven widget_info event top find_by_uname basedomaineven widget_control basedomaineven sensitive sensitive 1 basedomainoddeven widget_info event top find_by_uname basedomainodd even widget_control basedomainoddeven sensitive sensitive 2 case where sensitive EQ 1 0 of 0:BEGIN widget_control basedomainodd get_uvalue oddsecchoice oddsecchoiceid widget_info event top find_by_uname oddsecchoice if oddsecchoiceid NE 0 then index widget_info oddsecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected oddsecchoice index END 1:BEGIN widget_control basedomaineven get_uvalue evensecchoice evensecchoiceid widget_info event top find_by_uname evensecchoice if evensecchoiceid NE 0 then index widget_info evensecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected evensecchoice index END 2:BEGIN widget_control basedomainodd get_uvalue oddevensecchoice oddevensecchoiceid widget_info event top find_by_uname odd evensecchoice if oddevensecchoiceid NE 0 then index widget_info oddevensecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected oddevensecchoice index END endcase endif END oddsecchoice :BEGIN widget_control event top update 0 basedomainodd widget_info event top find_by_uname basedomainodd widget_control basedomainodd get_uvalue oddsecchoice domainpart top_uvalue basedomainodd oddsecchoice event index top_uvalue 1 findline top_uvalue selected oddsecchoice event index widget_control event top update 1 END evensecchoice :BEGIN widget_control event top update 0 basedomaineven widget_info event top find_by_uname basedomaineven widget_control basedomaineven get_uvalue evensecchoice domainpart top_uvalue basedomaineven evensecchoice event index top_uvalue 1 findline top_uvalue selected evensecchoice event index widget_control event top update 1 END odd evensecchoice :BEGIN widget_control event top update 0 basedomainoddeven widget_info event top find_by_uname basedomainodd even widget_control basedomainoddeven get_uvalue oddevensecchoice domainpart top_uvalue basedomainoddeven oddevensecchoice event index top_uvalue 1 findline top_uvalue selected oddevensecchoice event index widget_control event top update 1 END date1 :BEGIN date2id widget_info event top find_by_uname date2 widget_control date2id get_value date2 if event value GT date2 then widget_control date2id set_value event value END date2 :BEGIN date1id widget_info event top find_by_uname date1 widget_control date1id get_value date1 if event value LT date1 then widget_control date1id set_value event value END else: endcase return end FUNCTION read_hope typein varnamein FILENAME filename XLIMITS xlimits YLIMITS ylimits ZLIMITS zlimits TLIMITS tlimits ODDPT oddpt ODDEVENPT oddevenpt EVENPT evenpt _extra ex common usefull only for the definition of iodir if n_elements filename EQ 0 then filename isafile iodirectory iodir _extra ex IF size filename type NE 7 THEN return 1 filename isafile filename filename iodirectory iodir _extra ex cdfid ncdf_open filename id of the netcdf file wathinside ncdf_inquire cdfid structure with global informations dimensions namedim strarr wathinside ndims name of the dimensions typedim strarr wathinside ndims type of the dimensions x y z t sizedim lonarr wathinside ndims size of each dimension loop on the dimensions to get the names and sizes for dimiq 0 wathinside ndims 1 do begin ncdf_diminq cdfid dimiq name value namedim dimiq name case 1 of STRCMP name lon 3 FOLD_CASE :typedim dimiq x STRCMP name lat 3 FOLD_CASE :typedim dimiq y STRCMP name z 1 FOLD_CASE :typedim dimiq z STRCMP name t 1 FOLD_CASE :typedim dimiq t ELSE:BEGIN ncdf_close cdfid return report Unknown name of dimension END endcase sizedim dimiq value endfor dimlist: structure which contains the name and the value of each dimension we suppose that there is always a variable which has the same name that the dimension and which gives the values of this dimension ncdf_varget cdfid namedim 0 value dimlist create_struct namedim 0 value for dimiq 1 wathinside ndims 1 do begin ncdf_varget cdfid namedim dimiq value get the value dimlist create_struct dimlist namedim dimiq value endfor variables namevar strarr wathinside nvars names of the variables ndimsvar lonarr wathinside nvars number of dim for each variable dimvar replicate 1 wathinside ndims wathinside nvars dims of each variables loop over the variable ids to fill namevar ndimsvar and dimvar for varid 0 wathinside nvars 1 do begin res ncdf_varinq cdfid varid namevar varid res name namevar varid strjoin strsplit namevar varid _ 0 99 EXTRACT REGEX ndimsvar varid res ndims dimvar 0:res ndims 1 varid res dim ENDFOR we cut dimvar to select only the interessant part dimvar dimvar 0:max ndimsvar 1 selection of the data variables which are diffrent from the dimension variables we suppose that that data variables are 4D array with sometime dimensions equal to 1 they must be different from dimension variables which have only 1 dimension datavarid where ndimsvar eq 4 numberofvar n_elements datavarid namevar namevar datavarid ndimsvar ndimsvar datavarid dimvar dimvar datavarid sectype strarr numberofvar the type of section for each variable : xy xz yz linetype strarr numberofvar the line of the points : odd even or odd even pointtype strarr numberofvar the type of variable : scalar T or vector U for i 0 numberofvar 1 do begin dimofthevar dimvar i sectype i typedim dimofthevar 0 typedim dimofthevar 1 xaxisid dimofthevar where typedim dimofthevar EQ x yaxisid dimofthevar where typedim dimofthevar EQ y lineandpt findlineandpointtype sectype i dimlist xaxisid 0 dimlist yaxisid 0 iodir linetype i lineandpt linetype pointtype i lineandpt pointtype endfor definition of the widget base widget_base column first base: droplist to select the type of section droplist to select the variable button to select type of line : odd even or odd even base1 widget_base base row frame typechoice sectype uniq sectype sort sectype if n_elements typechoice GT 1 then typechoice typechoice sortdim typechoice base11 widget_droplist base1 title Type of section value typechoice uvalue name: type choice uname type choice if n_elements typein NE 0 then BEGIN selectedtype strmid typein 0 2 widget_control base11 set_droplist_select 0L where typechoice EQ selectedtype 0 ENDIF ELSE selectedtype typechoice 0 varchoice namevar uniq namevar sort namevar base12 widget_droplist base1 title Available data value varchoice uvalue name: var choice uname var choice if n_elements varnamein NE 0 THEN BEGIN selectedname varnamein widget_control base12 set_droplist_select 0L where strlowcase varchoice EQ strlowcase varnamein 0 ENDIF ELSE selectedname varchoice 0 base13 widget_base base1 row uname linechoicebase base 2: base to select the domain of the odd points base2 widget_base base column uname basedomainodd frame base 3: base to select the domain of the even points base3 widget_base base column uname basedomaineven frame base 4: base to select the domain of the odd even points base4 widget_base base column uname basedomainodd even frame base 5: calendar base5 widget_base base row uname baset frame timename strlowcase tag_names dimlist wathinside recdim read the time axis in julina days time ncdf_timeget cdfid timename update the dimlist structure dimlist wathinside recdim time base51 cw_calendar base5 time uname date1 uvalue name: date1 base52 cw_calendar base5 time uname date2 uvalue name: date2 base 6: base to select the min max and others keywords base6 cw_specifie base column uname specifie uvalue name: specifie base 7: last base with the action buttons base7 widget_base base row uname finalaction base71 widget_button base7 value Plot uvalue name: plot base72 widget_button base7 value Cancel uvalue name: cancel determination of the selected variable goodname 0 where strlowcase namevar EQ strlowcase selectedname goodtype 0 where sectype EQ selectedtype selected inter goodname goodtype if selected 0 EQ 1 then BEGIN widget_control base destroy ncdf_close cdfid return report impossible combinaison : type of section selectedtype variable name selectedname ENDIF if n_elements typein NE 0 then BEGIN if NOT keyword_set xlimits then xlimits 1e9 1e9 if NOT keyword_set ylimits then ylimits 1e9 1e9 if NOT keyword_set zlimits then zlimits 1e9 1e9 if NOT keyword_set tlimits then tlimits 1e9 1e9 ENDIF if n_elements typein NE 0 AND n_elements selected NE 1 then BEGIN if keyword_set oddpt then selected inter selected where linetype EQ odd if keyword_set evenpt then selected inter selected where linetype EQ even if keyword_set oddevenpt then selected inter selected where linetype EQ odd even if selected 0 EQ 1 then BEGIN widget_control base destroy ncdf_close cdfid return report impossible combinaison : type of section selectedtype variable name selectedname and line type endif if n_elements selected NE 1 then begin case selectedtype of xy :BEGIN choice on the vertical axis choice based on the variable which has the most available levels between the zlimits if NOT keyword_set zlimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin zdim dimvar 2 selected i zaxis dimlist zdim nothing where zaxis GE zlimits 0 AND zaxis LE zlimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END xz :BEGIN choice on the latitude axis if NOT keyword_set ylimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin ydim dimvar 2 selected i yaxis dimlist ydim nothing where yaxis GE ylimits 0 AND yaxis LE ylimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END yz :BEGIN choice on the longitude axis if NOT keyword_set xlimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin xdim dimvar 2 selected i xaxis dimlist xdim nothing where xaxis GE xlimits 0 AND xaxis LE xlimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END endcase endif ENDIF definition of the uvalue of the base which allows to share the variables between programs top_uvalue ptrarr 2 18 allocate_heap top_uvalue 0 0 type choice top_uvalue 1 0 temporary typechoice top_uvalue 0 1 var choice top_uvalue 1 1 temporary varchoice top_uvalue 0 2 namevar top_uvalue 1 2 temporary namevar top_uvalue 0 3 dimvar top_uvalue 1 3 temporary dimvar top_uvalue 0 4 sectype top_uvalue 1 4 temporary sectype top_uvalue 0 5 linetype top_uvalue 1 5 temporary linetype top_uvalue 0 6 pointtype top_uvalue 1 6 temporary pointtype top_uvalue 0 7 dimlist top_uvalue 1 7 temporary dimlist top_uvalue 0 8 typedim top_uvalue 1 8 temporary typedim top_uvalue 0 9 sizedim top_uvalue 1 9 temporary sizedim top_uvalue 0 10 cdfid top_uvalue 1 10 cdfid top_uvalue 0 11 datavarid top_uvalue 1 11 datavarid top_uvalue 0 12 selected top_uvalue 1 12 selected top_uvalue 0 13 filename top_uvalue 1 13 filename top_uvalue 0 14 xlimits top_uvalue 1 14 testvar var xlimits top_uvalue 0 15 ylimits top_uvalue 1 15 testvar var ylimits top_uvalue 0 16 zlimits top_uvalue 1 16 testvar var zlimits top_uvalue 0 17 tlimits top_uvalue 1 17 testvar var tlimits widget_control base set_uvalue top_uvalue rh_alldomains base selected if n_params EQ 0 then BEGIN we use the widget widget_control base REALIZE xmanager read_hope base no_block return 1 ENDIF get the output output createhopestruct top:base clear the pointer for i 0 n_elements top_uvalue 1 do ptr_free top_uvalue i close the file ncdf_close cdfid return output end"); 201 a[199] = new Array("./ToBeReviewed/HOPE/rh_alldomains.html", "rh_alldomains.pro", "", "PRO rh_alldomains topid selected widget_control topid get_uvalue top_uvalue widget_control topid update 0 selectedline top_uvalue 1 findline top_uvalue linetype selected we get the size of the dimenstion id of this section dimvar top_uvalue 1 findline top_uvalue dimvar typedim top_uvalue 1 findline top_uvalue typedim dimlist top_uvalue 1 findline top_uvalue dimlist sizedim top_uvalue 1 findline top_uvalue sizedim buttons to select type of line : odd even or odd even linechoicebase widget_info topid find_by_uname linechoicebase id widget_info linechoicebase find_by_uname linechoice IF id NE 0 THEN widget_control id destroy choice if where selectedline EQ odd 0 NE 1 then choice choice odd if where selectedline EQ even 0 NE 1 then choice choice even if where selectedline EQ odd even 0 NE 1 then choice choice odd even choice choice 1:n_elements choice 1 nothing cw_bgroup linechoicebase choice row exclusive return_name uname linechoice uvalue name: linechoice widget_control nothing set_value 0 sensitive bytarr 3 sensitive where odd even odd even eq choice 0 1 odd points domain basedomainodd widget_info topid find_by_uname basedomainodd id widget_info basedomainodd find_by_uname title IF id NE 0 THEN widget_control id destroy oddsecchoice where selectedline EQ odd if oddsecchoice 0 NE 1 then BEGIN oddsecchoice selected oddsecchoice nothing widget_label basedomainodd value Domain of the odd points uname title IF n_elements oddsecchoice GT 1 THEN BEGIN selecteddim dimvar oddsecchoice sorteddim selecteddim FOR i 0 n_elements oddsecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim oddsecchoice oddsecchoice sortedzdim nothing widget_droplist basedomainodd title number of levels value strtrim sizedims 2 uvalue name: oddsecchoice uname oddsecchoice ENDIF domainpart top_uvalue basedomainodd oddsecchoice 0 widget_control basedomainodd set_uvalue oddsecchoice ENDIF ELSE BEGIN nothing widget_label basedomainodd value uname title domainpart top_uvalue basedomainodd destroy widget_control basedomainodd set_uvalue 1 ENDELSE widget_control basedomainodd sensitive sensitive 0 even points domain basedomaineven widget_info topid find_by_uname basedomaineven id widget_info basedomaineven find_by_uname title IF id NE 0 THEN widget_control id destroy evensecchoice where selectedline EQ even if evensecchoice 0 NE 1 then BEGIN evensecchoice selected evensecchoice nothing widget_label basedomaineven value Domain of the even points uname title IF n_elements evensecchoice GT 1 THEN BEGIN selecteddim dimvar evensecchoice sorteddim selecteddim FOR i 0 n_elements evensecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim evensecchoice evensecchoice sortedzdim nothing widget_droplist basedomaineven title number of levels value strtrim sizedims 2 uvalue name: evensecchoice uname evensecchoice ENDIF domainpart top_uvalue basedomaineven evensecchoice 0 widget_control basedomaineven set_uvalue evensecchoice ENDIF ELSE BEGIN domainpart top_uvalue basedomaineven destroy nothing widget_label basedomaineven value uname title widget_control basedomaineven set_uvalue 1 ENDELSE widget_control basedomaineven sensitive sensitive 1 odd even points domain basedomainoddeven widget_info topid find_by_uname basedomainodd even id widget_info basedomainoddeven find_by_uname title IF id NE 0 THEN widget_control id destroy oddevensecchoice where selectedline EQ odd even if oddevensecchoice 0 NE 1 then BEGIN oddevensecchoice selected oddevensecchoice nothing widget_label basedomainoddeven value Domain of the odd even points uname title IF n_elements oddevensecchoice GT 1 THEN BEGIN selecteddim dimvar oddevensecchoice sorteddim selecteddim FOR i 0 n_elements oddevensecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim oddevensecchoice oddevensecchoice sortedzdim nothing widget_droplist basedomainoddeven title number of levels value strtrim sizedims 2 uvalue name: odd evensecchoice uname odd evensecchoice ENDIF domainpart top_uvalue basedomainoddeven oddevensecchoice 0 widget_control basedomainoddeven set_uvalue oddevensecchoice ENDIF ELSE BEGIN domainpart top_uvalue basedomainoddeven destroy nothing widget_label basedomainoddeven value uname title widget_control basedomainoddeven set_uvalue 1 ENDELSE widget_control basedomainoddeven sensitive sensitive 2 case where sensitive EQ 1 0 of 0: top_uvalue 1 findline top_uvalue selected oddsecchoice 0 1: top_uvalue 1 findline top_uvalue selected evensecchoice 0 2: top_uvalue 1 findline top_uvalue selected oddevensecchoice 0 endcase widget_control topid update 1 return end"); 202 a[200] = new Array("./ToBeReviewed/HOPE/sortdim.html", "sortdim.pro", "", " function sortdim dims inverse inverse IDL a x y t z IDL b a sortdim a IDL print a x y t z IDL print b x y z t IDL print b sortdim a inv x y t z IDL a xytz IDL print sortdim a 0 1 3 2 tosort dims if n_elements tosort eq 1 then tosort string reform byte tosort 1 strlen tosort 0 tosort strrepl tosort strwhere tosort x a tosort strrepl tosort strwhere tosort y b tosort strrepl tosort strwhere tosort z c tosort strrepl tosort strwhere tosort t d tosort uniq tosort sort tosort if keyword_set inverse then tosort sort tosort return tosort end "); 203 a[201] = new Array("./ToBeReviewed/HOPE/xrh.html", "xrh.pro", "", " procedure to call read_hope in the widget mode PRO xrh _extra ex a read_hope _extra ex return end"); 204 a[202] = new Array("./ToBeReviewed/IMAGE/animgif.html", "animgif.pro", "", " NAME:animgif PURPOSE:construire une animation gif CATEGORY:pour faire des dessins animes CALLING SEQUENCE:animgif toto gif INPUTS:toto gif: c est le nom du fichier gif contenant l animation Rq ce fichier est place dans le repertoire definit par iodir KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS:on utilise le Z buffer pour aller plus vite donc si on plante ds animgif il faut faire: IDL device close IDL set_plot x IDL retall RESTRICTIONS: si on veut supprimer le common il faut definir a la main la taille de l image les variables xsize et ysize ainsi que iodir EXAMPLE: MODIFICATION HISTORY: Guillaume Roullet grlod ipsl jussieu fr Sebastien Masson smasson lodyc jussieu fr 30 4 1999 PRO animgif nomfic common recupere la palette de couleur et la place dans rouge vert bleu tvlct rouge vert bleu get complete la palette courante sur 256 couleurs red rouge replicate 255 256 n_elements rouge green vert replicate 255 256 n_elements rouge blue bleu replicate 255 256 n_elements rouge bascule sur le z device permettant de creer l image sans l afficher thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS set_plot z taille de l image en nombre de pixel: xsize 30 min page_size max ma key_portrait ma 1 key_portrait ysize 30 min page_size max ma 1 key_portrait ma key_portrait device set_resolution xsize ysize commencement du fichier gif ecriture d une image vide reinitplt plot 0 0 nodata write_gif iodir nomfic tvrd red green blue multiple debut de la partie a changer boucle de creation de l image calen TIMEGEN 366 START JULDAY 1 1 2000 debut where calen EQ 19810105 debut where calen EQ 19790105 debut debut 0 if debut EQ 1 then begin device close CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE stop endif for i 0 73 15 1 do begin for i 0 3 2 1 do begin for i 0 73 2 1 do begin print Image numero : strtrim i 2 date calen debut i erase 255 plt nlec sst date ATF 19 29 int 5 noerase plt nlec sss date ATF label 2 noerase plt nlec htoth date RE3 nlec hpycn date RE3 10 60 int 5 inv noerase domdef 290 340 5 15 plt norme nlec unsurf date RE3 nlec vnsurf date RE3 0 1 2 int 1 noerase Ecriture de l image dans le fichier gif write_gif iodir nomfic tvrd red green blue multiple ENDFOR fin de la partie a changer fermeture du fichier write_gif iodir nomfic close rebascule en mode terminal X device close CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE return end"); 205 a[203] = new Array("./ToBeReviewed/IMAGE/image_viewer.html", "image_viewer.pro", "", " NAME: IMAGE_VIEWER PURPOSE: The purpose of this program is to provide an interactive tool that can be used to view JPEG BMP GIF PNG and TIFF picture files Images are loaded into memory so the initial file access may take a while but once each picture has been opened they can all be viewed in a very rapid fashion CATEGORY: Visualization Widgets CALLING SEQUENCE: image_viewer INPUT PARAMETERS: None KEYWORD PARAMETERS: None OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: While this program is running in an IDL session it will change the current working directory enables disables color decomposition and sets QUIET 1 ORDER 0 P BACKGROUND 0 These settings are returned to their initial settings before the program was initiated once it is terminated RESTRICTIONS: This program is supported in IDL version 5 5 and newer In order to open GIF files or TIFF files with LZW compression the copy of IDL being used must be licensed with these features IDL only supports BMP files in the standard Windows format and does not support OS2 bitmaps MODIFICATION HISTORY: Written by: AEB 1 02 PRO IMAGE_VIEWER_OPEN_FILES event THIS PROCEDURE IS CALLED WHEN A USER SELECTS File Open Picture Files FROM THE MAIN MENU error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR if status report dialog is still active destroy it: if SIZE tlb TYPE NE 0 then WIDGET_CONTROL tlb DESTROY RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState prompt user to select files with native file selection dialog: if pState gifFlag EQ 1 then filter JPG jpg JPEG jpeg JPE jpe JFIF jfif GIF gif BMP bmp TIF tif TIFF tiff PNG png else filter JPG jpg JPEG jpeg JPE jpe JFIF jfif BMP bmp TIF tif TIFF tiff PNG png files DIALOG_PICKFILE TITLE Select picture files to open MULTIPLE_FILES FILTER filter GET_PATH path if user hit Cancel then return to previous program level: if files 0 EQ then RETURN change current working directory to location of selected files: CD path nFiles N_ELEMENTS files pState nFiles nFiles pState increment 100 nFiles files files SORT files create status report dialog: xCenter pState screenSize 0 2 yCenter pState screenSize 1 2 tlb2 WIDGET_BASE TITLE Status Report COLUMN ALIGN_CENTER TLB_FRAME_ATTR 19 MODAL GROUP_LEADER pState tlb spacer WIDGET_LABEL tlb2 VALUE label1 WIDGET_LABEL tlb2 VALUE LOADING SELECTED IMAGE FILES INTO MEMORY spacer WIDGET_LABEL tlb2 VALUE label2 WIDGET_LABEL tlb2 VALUE PLEASE WAIT spacer WIDGET_LABEL tlb2 VALUE statusBase WIDGET_BASE tlb2 ROW FRAME BASE_ALIGN_CENTER ALIGN_CENTER EVENT_PRO image_viewer_timer cancelBut WIDGET_BUTTON statusBase VALUE Cancel EVENT_PRO image_viewer_cancel progressLabel WIDGET_LABEL statusBase Value Progress : 0 statusSlider WIDGET_SLIDER statusBase SENSITIVE 0 TITLE XSIZE 200 percentLabel WIDGET_LABEL statusBase VALUE 100 geom WIDGET_INFO tlb2 GEOMETRY xHalfSize geom Scr_XSize 2 yHalfSize geom Scr_YSize 2 WIDGET_CONTROL tlb2 XOFFSET xCenter xHalfSize YOFFSET yCenter yHalfSize WIDGET_CONTROL tlb2 REALIZE pState statusBase statusBase pState statusSlider statusSlider WIDGET_CONTROL tlb2 SET_UVALUE pState reset settings of GUI: WIDGET_CONTROL pState fileText SET_VALUE WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE re create thumbnails base with appropriate size for number of images selected: nRows CEIL nFiles 3 0 WIDGET_CONTROL pState thumbBase DESTROY pState thumbBase WIDGET_BASE pState controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE nRows 89 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 initialize pointer array to reference image data: numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images pState images PTRARR nFiles ALLOCATE_HEAP pState files files loop through each file: pState timer 1B WIDGET_CONTROL statusBase TIMER 0 01 END PRO IMAGE_VIEWER_OPEN_FOLDER event THIS PROCEDURE IS CALLED WHEN A USER SELECTS File Open All In Folder FROM THE MAIN MENU error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR if status report dialog is still active destroy it: if SIZE tlb TYPE NE 0 then WIDGET_CONTROL tlb DESTROY RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState prompt user to select files with native file selection dialog: folder DIALOG_PICKFILE TITLE Select folder that contains picture files DIRECTORY if user hit Cancel then return to previous program level: if folder EQ then RETURN change current working directory to location of selected files: CD folder if pState gifFlag EQ 1 then filter JPG JPEG JPE JFIF GIF BMP TIF TIFF PNG else filter JPG JPEG JPE JFIF BMP TIF TIFF PNG files FILE_SEARCH filter COUNT nFiles FOLD_CASE FULLY_QUALIFY_PATH NOSORT if nFiles EQ 0 then begin dummy DIALOG_MESSAGE No valid picture files were found in the selected folder INFO RETURN endif pState nFiles nFiles pState increment 100 nFiles files files SORT files create status report dialog: xCenter pState screenSize 0 2 yCenter pState screenSize 1 2 tlb2 WIDGET_BASE TITLE Status Report COLUMN ALIGN_CENTER TLB_FRAME_ATTR 19 MODAL GROUP_LEADER pState tlb spacer WIDGET_LABEL tlb2 VALUE label1 WIDGET_LABEL tlb2 VALUE LOADING SELECTED IMAGE FILES INTO MEMORY spacer WIDGET_LABEL tlb2 VALUE label2 WIDGET_LABEL tlb2 VALUE PLEASE WAIT spacer WIDGET_LABEL tlb2 VALUE statusBase WIDGET_BASE tlb2 ROW FRAME BASE_ALIGN_CENTER ALIGN_CENTER EVENT_PRO image_viewer_timer cancelBut WIDGET_BUTTON statusBase VALUE Cancel EVENT_PRO image_viewer_cancel progressLabel WIDGET_LABEL statusBase Value Progress : 0 statusSlider WIDGET_SLIDER statusBase SENSITIVE 0 TITLE XSIZE 200 percentLabel WIDGET_LABEL statusBase VALUE 100 geom WIDGET_INFO tlb2 GEOMETRY xHalfSize geom Scr_XSize 2 yHalfSize geom Scr_YSize 2 WIDGET_CONTROL tlb2 XOFFSET xCenter xHalfSize YOFFSET yCenter yHalfSize WIDGET_CONTROL tlb2 REALIZE pState statusBase statusBase pState statusSlider statusSlider WIDGET_CONTROL tlb2 SET_UVALUE pState reset settings of GUI: WIDGET_CONTROL pState fileText SET_VALUE WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE re create thumbnails base with appropriate size for number of images selected: nRows CEIL nFiles 3 0 WIDGET_CONTROL pState thumbBase DESTROY pState thumbBase WIDGET_BASE pState controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE nRows 89 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 initialize pointer array to reference image data: numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images pState images PTRARR nFiles ALLOCATE_HEAP pState files files loop through each file: pState timer 1B WIDGET_CONTROL statusBase TIMER 0 01 END PRO IMAGE_VIEWER_CANCEL event obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState shut off timer: pState timer 0B END PRO IMAGE_VIEWER_TIMER event obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState if pState timer EQ 1 then begin continue processing files: if pState currFile LE pState nFiles 1 then begin i pState currFile extension STRUPCASE STRMID pState files i STRPOS pState files i REVERSE_SEARCH 1 if extension EQ JPG or extension EQ JPEG or extension EQ JPE or extension EQ JFIF then begin result QUERY_JPEG pState files i info if result NE 1 then begin dummy DIALOG_MESSAGE Selected file: pState files i does not appear to be a valid JPEG file ERROR if i MOD 3 EQ 0 then pState rowBase WIDGET_BASE pState thumbBase ROW ALIGN_LEFT if pState currFile EQ pState nFiles 1 then begin last file terminate timer: pState timer 0B pState currFile 0L WIDGET_CONTROL event top DESTROY endif else begin increment file number and update progress slider: pState currFile pState currFile 1 progressValue ROUND i 1 pState increment Exit FROM THE MAIN MENU terminate the program by destroying the top level base widgetID always stored in event top : WIDGET_CONTROL event top DESTROY END PRO IMAGE_VIEWER_HELP event THIS PROCEDURE IS CALLED WHEN A USER SELECTS Help Help on IMAGE_VIEWER FROM THE MAIN MENU display a simple message: messageStr IMAGE_VIEWER written by AEB 2002 The purpose of this program is to provide an interactive tool that can be used to view JPEG BMP GIF PNG and TIFF picture files In order to provide rapid viewing capabilities the images are loaded into memory which can cause the initial file access to take a bit of time while the pictures are opened and thumbnails are created dummy DIALOG_MESSAGE messageStr info END PRO IMAGE_VIEWER_THUMBS event THIS PROCEDURE IS CALLED WHEN A USER CLICKS ON ONE OF THE THUMBNAIL PICTURES error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR RETURN endif if event press EQ 1 then begin WIDGET_CONTROL HOURGLASS obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE obtain current image data: WIDGET_CONTROL event id GET_UVALUE fileID imageStruct pState images fileID 1 xOffset ROUND 710 imageStruct xSize 2 yOffset ROUND 650 imageStruct ySize 2 if pState colorMode EQ PSEUDO then begin TVLCT imageStruct red imageStruct green imageStruct blue TV TEMPORARY imageStruct image xOffset yOffset endif else begin pState colorMode EQ TRUE : if imageStruct imageColorMode EQ PSEUDO then begin DEVICE DECOMPOSED 0 TVLCT imageStruct red imageStruct green imageStruct blue TV TEMPORARY imageStruct image xOffset yOffset endif else begin imageStruct imageColorMode EQ TRUE : DEVICE DECOMPOSED 1 TV TEMPORARY imageStruct image xOffset yOffset TRUE 1 endelse endelse WIDGET_CONTROL pState fileText SET_VALUE pState files fileID 1 endif END PRO IMAGE_VIEWER_CLEANUP widgetID THIS PROCEDURE IS CALLED WHEN THE PROGRAM IS TERMINATED AND XMANAGER REGISTERS A CLEANUP: obtain state structure for top level base from its uvalue: WIDGET_CONTROL widgetID GET_UVALUE pState test for validity of state structure pointer: if PTR_VALID pState then begin reset original settings: QUIET pState quietInit ORDER pState orderInit P BACKGROUND pState backInit CD pState currentDir DEVICE DECOMPOSED pState dc TVLCT pState r pState g pState b cleanup heap memory: PTR_FREE TEMPORARY pState files numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images PTR_FREE TEMPORARY pState images PTR_FREE TEMPORARY pState endif END PRO IMAGE_VIEWER_EVENT event THIS PROCEDURE IS CALLED WHEN A USER RESIZES THE TOP LEVEL BASE error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState reset widget size: WIDGET_CONTROL event top XSIZE pState tlbWidth YSIZE pState tlbHeight XOFFSET 0 YOFFSET 0 END PRO IMAGE_VIEWER error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR QUIET quietInit ORDER orderInit P BACKGROUND backInit CD currentDir RETURN endif ignore beta and development build versions of IDL because string to float conversion will fail: betaTest STRPOS STRLOWCASE VERSION RELEASE beta buildTest STRPOS STRLOWCASE VERSION RELEASE build check to make sure the version of IDL running is 5 5 or newer: if betaTest EQ 1 and buildTest EQ 1 then begin if FLOAT VERSION RELEASE LT 5 5 then begin dummy dialog_message IMAGE_VIEWER is only supported in IDL version 5 5 or newer ERROR RETURN endif endif check to make sure there is adequate real estate: DEVICE GET_SCREEN_SIZE screenSize if LONG screenSize 0 screenSize 1 LT 786432 then begin messageStr IMAGE_VIEWER requires the computer monitor Display to be configured in 1024 x 768 mode or better dummy DIALOG_MESSAGE messageStr RETURN endif check in auxiliary license: result LMGR idl_tifflzw VERSION 1 0 result LMGR idl_gif VERSION 1 0 gifFlag 1B if result NE 1 then begin messageStr The ability to read GIF and TIFF LZW compressed images requires an auxiliary license in order to conform with the patent rights of the Unisys Corporation IMAGE_VIEWER was unable to find the required license in this installation Consequently the ability to read GIF files will be disabled dummy DIALOG_MESSAGE messageStr gifFlag 0B endif warn users of color flashing if monitor in PseudoColor mode: if D N_COLORS LE 256 then begin messageStr The computer monitor Display is currently configured in 8 bit 256 Colors PseudoColor mode Due to the dynamic read write nature of the colormap system for this visual when a colortable is loaded for an image it affects all visible graphics windows including the thumbnails of other images This can lead to a phenomenon known as color flashing If possible it is recommended that you exit this program reconfigure your monitor in 24 bit TrueColor mode or better and restart IMAGE_VIEWER dummy DIALOG_MESSAGE messageStr endif obtain the current working directory: CD CURRENT currentDir if STRUPCASE VERSION OS_FAMILY EQ WINDOWS then begin executeStr cd USERPROFILE My Documents My Pictures cd SPAWN executeStr pathInit HIDE pathInit pathInit 0 result FILE_TEST pathInit READ if result EQ 1 then begin CD pathInit endif else begin result FILE_TEST C: My Documents My Pictures READ if result EQ 1 then begin CD C: My Documents My Pictures endif else begin result FILE_TEST C: READ if result EQ 1 then CD C: endelse endelse endif suppress informational messaging: quietInit QUIET QUIET 1 make sure color decomposition is disabled: DEVICE GET_DECOMPOSED dc if D N_COLORS GT 256 then colorMode TRUE else colorMode PSEUDO obtain the current color table: TVLCT r g b GET LOADCT 0 SILENT force ORDER 0: orderInit ORDER ORDER 0 force P BACKGROUND 0: backInit P BACKGROUND P BACKGROUND 0 create GUI: tlb WIDGET_BASE TITLE Image Viewer ROW MBAR menuBar TLB_SIZE_EVENTS XOFFSET 0 YOFFSET 0 fileMenu WIDGET_BUTTON menuBar VALUE File MENU fileBttn1 WIDGET_BUTTON fileMenu VALUE Open Picture Files EVENT_PRO image_viewer_open_files fileBttn2 WIDGET_BUTTON fileMenu VALUE Open All In Folder EVENT_PRO image_viewer_open_folder fileBttn3 WIDGET_BUTTON fileMenu VALUE Exit EVENT_PRO image_viewer_exit helpMenu WIDGET_BUTTON menuBar VALUE Help MENU helpBttn1 WIDGET_BUTTON helpMenu VALUE Help on IMAGE_VIEWER EVENT_PRO image_viewer_help controlsBase WIDGET_BASE tlb COLUMN FRAME ALIGN_TOP labelBase WIDGET_BASE controlsBase COLUMN SCR_XSIZE 280 thumbLabel WIDGET_LABEL labelBase ALIGN_CENTER VALUE CLICK ON THUMBNAIL TO VIEW IMAGE thumbBase WIDGET_BASE controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE 700 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 imageBase WIDGET_BASE tlb COLUMN FRAME ALIGN_TOP fileBase WIDGET_BASE imageBase ROW ALIGN_CENTER fileLabel WIDGET_LABEL fileBase VALUE Current Image File fileText WIDGET_TEXT fileBase XSIZE 75 YSIZE 1 imageDraw WIDGET_DRAW imageBase XSIZE 710 YSIZE 650 RETAIN 2 display the GUI on the computer monitor: WIDGET_CONTROL tlb REALIZE obtain the top level base geometry: tlbGeom WIDGET_INFO tlb GEOMETRY tlbWidth tlbGeom xsize tlbHeight tlbGeom ysize if tlbWidth EQ 0 or tlbHeight EQ 0 then begin WIDGET_CONTROL tlb TLB_GET_SIZE tlbSize tlbWidth tlbSize 0 tlbHeight tlbSize 1 endif create state structure to store information needed by the other event handling procedures: pState PTR_NEW files:PTR_NEW ALLOCATE_HEAP images:PTR_NEW ALLOCATE_HEAP screenSize:screenSize quietInit:quietInit orderInit:orderInit tlb:tlb statusBase:0L controlsBase:controlsBase thumbBase:thumbBase fileText:fileText timer:0B nFiles:0L currentDir:currentDir imageDraw:imageDraw dc:dc r:r g:g b:b gifFlag:gifFlag statusSlider:0L backInit:backInit colorMode:colorMode tlbWidth:tlbWidth tlbHeight:tlbHeight currFile:0L rowBase:0L increment:0 0 store this state structure in the uvalue of the top level base so it can be obtained by other program units: WIDGET_CONTROL tlb SET_UVALUE pState register the GUI with the XMANAGER event handler routine: XMANAGER image_viewer tlb CLEANUP image_viewer_cleanup END "); 206 a[204] = new Array("./ToBeReviewed/IMAGE/imdisp.html", "imdisp.pro", "", " FUNCTION IMDISP_GETPOS ASPECT POSITION POSITION MARGIN MARGIN Compute a position vector given an aspect ratio called by IMDISP_IMSIZE Check arguments if n_params ne 1 then message Usage: RESULT IMDISP_GETPOS ASPECT if n_elements aspect eq 0 then message ASPECT is undefined Check keywords if n_elements position eq 0 then position 0 0 0 0 1 0 1 0 if n_elements margin eq 0 then margin 0 1 Get range limited aspect ratio and margin input values aspect_val float aspect 0 0 01 0 0 0L y0 round position 1 d y_vsize 0L Compute size of image device units xsize round position 2 position 0 d x_vsize 2L ysize round position 3 position 1 d y_vsize 2L Recompute the image position based on actual image size position fltarr 4 position 0 x0 float d x_vsize position 1 y0 float d y_vsize position 2 x0 xsize float d x_vsize position 3 y0 ysize float d y_vsize END PRO IMDISP IMAGE RANGE RANGE BOTTOM BOTTOM NCOLORS NCOLORS MARGIN MARGIN INTERP INTERP DITHER DITHER ASPECT ASPECT POSITION POSITION OUT_POS OUT_POS NOSCALE NOSCALE NORESIZE NORESIZE ORDER ORDER USEPOS USEPOS CHANNEL CHANNEL BACKGROUND BACKGROUND ERASE ERASE AXIS AXIS NEGATIVE NEGATIVE _EXTRA EXTRA_KEYWORDS NAME: IMDISP PURPOSE: Display an image on the current graphics device IMDISP is an advanced replacement for TV and TVSCL Supports WIN MAC X CGM PCL PRINTER PS and Z graphics devices Image is automatically byte scaled can be disabled Custom byte scaling of Pseudo color images via the RANGE keyword Pseudo indexed color and True color images are handled automatically 8 bit and 24 bit graphics devices are handled automatically Decomposed color settings are handled automatically Image is automatically sized to fit the display can be disabled The P MULTI system variable is honored for multiple image display Image can be positioned via the POSITION keyword Color table splitting via the BOTTOM and NCOLORS keywords Image aspect ratio customization via the ASPECT keyword Resized images can be resampled default or interpolated Top down image display via the ORDER keyword ORDER is ignored Selectable display channel R G B via the CHANNEL keyword Background can be set to a specified color via the BACKGROUND keyword Screen can be erased prior to image display via the ERASE keyword Plot axes can be drawn on the image via the AXIS keyword Photographic negative images can be displayed via the NEGATIVE keyword CATEGORY: Image display CALLING SEQUENCE: IMDISP IMAGE INPUTS: IMAGE Array containing image data Pseudo indexed color images must have 2 dimensions True color images must have 3 dimensions in either 3 NX NY NX 3 NY or NX NY 3 form OPTIONAL INPUTS: None KEYWORD PARAMETERS: RANGE For Pseudo Color images only a vector with two elements specifying the minimum and maximum values of the image array to be considered when the image is byte scaled default is minimum and maximum array values This keyword is ignored for True Color images or if the NOSCALE keyword is set BOTTOM Bottom value in the color table to be used for the byte scaled image default is 0 This keyword is ignored if the NOSCALE keyword is set NCOLORS Number of colors in the color table to be used for the byte scaled image default is D TABLE_SIZE BOTTOM This keyword is ignored if the NOSCALE keyword is set MARGIN A scalar value specifying the margin to be maintained around the image in normal coordinates default is 0 1 or 0 025 if P MULTI is set to display multiple images INTERP If set the resized image will be interpolated using bilinear interpolation default is nearest neighbor sampling DITHER If set true color images will be dithered when displayed on an 8 bit graphics device default is no dithering ASPECT A scalar value specifying the aspect ratio height width for the displayed image default is to maintain native aspect ratio POSITION On input a 4 element vector specifying the position of the displayed image in the form X0 Y0 X1 Y1 in in normal coordinates default is 0 0 0 0 1 0 1 0 See the examples below to display an image where only the offset and size are known e g MAP_IMAGE output OUT_POS On output a 4 element vector specifying the position actually used to display the image NOSCALE If set the image will not be byte scaled default is to byte scale the image NORESIZE If set the image will not be resized default is to resize the image to fit the display ORDER If set the image is displayed from the top down default is to display the image from the bottom up Note that the system variable ORDER is always ignored USEPOS If set the image will be sized to exactly fit a supplied POSITION vector over riding ASPECT and MARGIN default is to honor ASPECT and MARGIN when a POSITION vector is supplied CHANNEL Display channel Red Green or Blue to be written 0 All channels the default 1 Red channel 2 Green channel 3 Blue channel This keyword is only recognized by graphics devices which support 24 bit decomposed color WIN MAC X It is ignored by all other graphics devices However True color RGB images can be displayed on any device supported by IMDISP BACKGROUND If set to a positive integer the background will be filled with the color defined by BACKGROUND ERASE If set the screen contents will be erased Note that if P MULTI is set to display multiple images the screen is always erased when the first image is displayed AXIS If set plot axes will be drawn on the image The default x and y axis ranges are determined by the size of the image When the AXIS keyword is set IMDISP accepts any keywords supported by PLOT e g TITLE COLOR CHARSIZE etc NEGATIVE If set a photographic negative of the image is displayed The values of BOTTOM and NCOLORS are honored This keyword allows True color images scanned from color negatives to be displayed It also allows Pseudo color images to be displayed as negatives without reversing the color table This keyword is ignored if the NOSCALE keyword is set OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The image is displayed on the current graphics device RESTRICTIONS: Requires IDL 5 0 or higher square bracket array syntax EXAMPLE: Load test data openr lun filepath ctscan dat subdir examples data get_lun ctscan bytarr 256 256 readu lun ctscan free_lun lun openr lun filepath hurric dat subdir examples data get_lun hurric bytarr 440 330 readu lun hurric free_lun lun read_jpeg filepath rose jpg subdir examples data rose help ctscan hurric rose Display single images p multi 0 loadct 0 imdisp hurric erase wait 3 0 imdisp rose interp erase wait 3 0 Display multiple images without color table splitting works on 24 bit displays only top 2 images are garbled on 8 bit displays p multi 0 1 3 0 0 loadct 0 imdisp ctscan margin 0 02 loadct 13 imdisp hurric margin 0 02 imdisp rose margin 0 02 wait 3 0 Display multiple images with color table splitting works on 8 bit or 24 bit displays p multi 0 1 3 0 0 loadct 0 ncolors 64 bottom 0 imdisp ctscan margin 0 02 ncolors 64 bottom 0 loadct 13 ncolors 64 bottom 64 imdisp hurric margin 0 02 ncolors 64 bottom 64 imdisp rose margin 0 02 ncolors 64 bottom 128 wait 3 0 Display an image at a specific position over riding aspect and margin p multi 0 loadct 0 imdisp hurric position 0 0 0 0 1 0 0 5 usepos erase wait 3 0 Display an image with axis overlay p multi 0 loadct 0 imdisp rose axis erase wait 3 0 Display an image with contour plot overlay p multi 0 loadct 0 imdisp hurric out_pos out_pos erase contour smooth hurric 10 edge noerase position out_pos xstyle 1 ystyle 1 levels findgen 5 40 0 follow wait 3 0 Display a small image with correct resizing p multi 0 loadct 0 data dist 8 1:7 1:7 imdisp data erase wait 3 0 imdisp data interp wait 3 0 Display a true color image without and with interpolation p multi 0 imdisp rose erase wait 3 0 imdisp rose interp wait 3 0 Display a true color image as a photographic negative imdisp rose negative erase wait 3 0 Display a true color image on PostScript output note that color table is handled automatically current_device d name set_plot PS device color bits_per_pixel 8 filename imdisp_true ps imdisp rose axis title PostScript True Color Output device close set_plot current_device Display a pseudo color image on PostScript output current_device d name set_plot PS device color bits_per_pixel 8 filename imdisp_pseudo ps loadct 0 imdisp hurric axis title PostScript Pseudo Color Output device close set_plot current_device Display an image where only the offset and size are known Read world elevation data file filepath worldelv dat subdir examples data openr lun file get_lun data bytarr 360 360 readu lun data free_lun lun Reorganize array so it spans 180W to 180E world data world 0:179 data 180: world 180: data 0:179 Create remapped image map_set orthographic isotropic noborder remap map_image world x0 y0 xsize ysize compress 1 Convert offset and size to position vector pos fltarr 4 pos 0 x0 float d x_vsize pos 1 y0 float d y_vsize pos 2 x0 xsize float d x_vsize pos 3 y0 ysize float d y_vsize Display the image loadct 0 imdisp remap pos pos usepos map_continents map_grid MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: imdisp pro v 1 47 2002 06 05 16:31:07 gumley Exp Copyright C 1999 2000 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: imdisp pro v 1 47 2002 06 05 16:31:07 gumley Exp CHECK INPUT Check arguments if n_params ne 1 then message Usage: IMDISP IMAGE if n_elements image eq 0 then message Argument IMAGE is undefined if max p multi eq 0 then begin if n_elements margin eq 0 then begin if n_elements position eq 4 then margin 0 0 else margin 0 1 endif endif else begin if n_elements margin eq 0 then margin 0 025 endelse if n_elements order eq 0 then order 0 if n_elements channel eq 0 then channel 0 Check position vector if n_elements position gt 0 then begin if n_elements position ne 4 then message POSITION must be a 4 element vector of the form X0 Y0 X1 Y1 if position 0 lt 0 0 then message POSITION 0 must be GE 0 0 if position 1 lt 0 0 then message POSITION 1 must be GE 0 0 if position 2 gt 1 0 then message POSITION 2 must be LE 1 0 if position 3 gt 1 0 then message POSITION 3 must be LE 1 0 if position 0 ge position 2 then message POSITION 0 must be LT POSITION 2 if position 1 ge position 3 then message POSITION 1 must be LT POSITION 3 endif Check the image dimensions result size image ndims result 0 if ndims lt 2 or ndims gt 3 then message IMAGE must be a Pseudo Color 2D or True Color 3D image array dims result 1:ndims Check that 3D image array is in valid true color format true 0 if ndims eq 3 then begin index where dims eq 3L count if count eq 0 then message True Color dimensions must be 3 NX NY NX 3 NY or NX NY 3 true 1 truedim index 0 endif Check scaling range for pseudo color images if true eq 0 then begin if n_elements range eq 0 then begin min_value min image max max_value range min_value max_value endif if n_elements range ne 2 then message RANGE keyword must be a 2 element vector endif else begin if n_elements range gt 0 then message RANGE keyword is not used for True Color images continue endelse Check for supported graphics devices names WIN MAC X CGM PCL PRINTER PS Z result where d name eq names count if count eq 0 then message Graphics device is not supported Get color table information if d flags and 256 ne 0 and d window lt 0 then begin window free pixmap wdelete d window endif if n_elements bottom eq 0 then bottom 0 if n_elements ncolors eq 0 then ncolors d table_size bottom Get IDL version number version float version release Check for IDL 5 2 or higher if printer device is selected if version lt 5 2 and d name eq PRINTER then message IDL 5 2 or higher is required for PRINTER device support GET RED GREEN AND BLUE COMPONENTS OF TRUE COLOR IMAGE if true eq 1 then begin case truedim of 0 : begin red image 0 grn image 1 blu image 2 end 1 : begin red image 0 grn image 1 blu image 2 end 2 : begin red image 0 grn image 1 blu image 2 end endcase red reform red overwrite grn reform grn overwrite blu reform blu overwrite endif COMPUTE POSITION FOR IMAGE Save first element of p multi multi_first p multi 0 Establish image position if not defined if n_elements position eq 0 then begin if max p multi eq 0 then begin position 0 0 0 0 1 0 1 0 endif else begin plot 0 nodata xstyle 4 ystyle 4 xmargin 0 0 ymargin 0 0 position x window 0 y window 0 x window 1 y window 1 endelse endif Erase and fill the background if required if multi_first eq 0 then begin if keyword_set erase then erase if n_elements background gt 0 then begin polyfill 0 01 1 01 1 01 0 01 0 01 0 01 0 01 1 01 1 01 0 01 normal color background 0 endif endif Compute image aspect ratio if not defined if n_elements aspect eq 0 then begin case true of 0 : result size image 1 : result size red endcase dims result 1:2 aspect float dims 1 float dims 0 endif Save image xrange and yrange for axis overlays xrange 0 dims 0 yrange 0 dims 1 if order eq 1 then yrange reverse yrange Set the aspect ratio and margin to fill the position window if requested if keyword_set usepos then begin xpos_size float d x_vsize position 2 position 0 ypos_size float d y_vsize position 3 position 1 aspect_value ypos_size xpos_size margin_value 0 0 endif else begin aspect_value aspect margin_value margin endelse Compute size of displayed image and save output position pos position case true of 0 : imdisp_imsize image x0 y0 xsize ysize position pos aspect aspect_value margin margin_value 1 : imdisp_imsize red x0 y0 xsize ysize position pos aspect aspect_value margin margin_value endcase out_pos pos BYTE SCALE THE IMAGE IF REQUIRED Choose whether to scale the image or not if keyword_set noscale eq 0 then begin Scale the image case true of 0 : scaled imdisp_imscale image bottom bottom ncolors ncolors range range negative keyword_set negative 1 : begin scaled_dims size red 1:2 scaled bytarr scaled_dims 0 scaled_dims 1 3 scaled 0 0 0 imdisp_imscale red bottom 0 ncolors 256 negative keyword_set negative scaled 0 0 1 imdisp_imscale grn bottom 0 ncolors 256 negative keyword_set negative scaled 0 0 2 imdisp_imscale blu bottom 0 ncolors 256 negative keyword_set negative end endcase endif else begin Don t scale the image case true of 0 : scaled image 1 : begin scaled_dims size red 1:2 scaled replicate red 0 scaled_dims 0 scaled_dims 1 3 scaled 0 0 0 red scaled 0 0 1 grn scaled 0 0 2 blu end endcase endelse DISPLAY IMAGE ON PRINTER DEVICE if d name eq PRINTER then begin Display the image case true of 0 : begin device index_color tv scaled x0 y0 xsize xsize ysize ysize order order end 1 : begin device true_color tv scaled x0 y0 xsize xsize ysize ysize order order true 3 end endcase Draw axes if required if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords Return to caller return endif DISPLAY IMAGE ON GRAPHICS DEVICES WHICH HAVE SCALEABLE PIXELS if d flags and 1 ne 0 then begin Display the image case true of 0 : tv scaled x0 y0 xsize xsize ysize ysize order order 1 : begin tvlct r g b get loadct 0 silent tv scaled x0 y0 xsize xsize ysize ysize order order true 3 tvlct r g b end endcase Draw axes if required if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords Return to caller return endif RESIZE THE IMAGE Resize the image if keyword_set noresize eq 0 then begin if true eq 0 then begin resized imdisp_imregrid scaled xsize ysize interp keyword_set interp endif else begin resized replicate scaled 0 xsize ysize 3 resized 0 0 0 imdisp_imregrid reform scaled 0 xsize ysize interp keyword_set interp resized 0 0 1 imdisp_imregrid reform scaled 1 xsize ysize interp keyword_set interp resized 0 0 2 imdisp_imregrid reform scaled 2 xsize ysize interp keyword_set interp endelse endif else begin resized temporary scaled x0 0 y0 0 endelse GET BIT DEPTH FOR THIS DISPLAY If this device supports windows make sure a window has been opened if d flags and 256 ne 0 then begin if d window lt 0 then begin window free pixmap wdelete d window endif endif Set default display depth depth 8 Get actual bit depth on supported displays if d name eq WIN or d name eq MAC or d name eq X then begin if version ge 5 1 then begin device get_visual_depth depth endif else begin if d n_colors gt 256 then depth 24 endelse endif SELECT DECOMPOSED COLOR MODE ON OR OFF FOR 24 BIT DISPLAYS if d name eq WIN or d name eq MAC or d name eq X then begin if depth gt 8 then begin if version ge 5 2 then device get_decomposed entry_decomposed else entry_decomposed 0 if true eq 1 or channel gt 0 then device decomposed 1 else device decomposed 0 endif endif DISPLAY THE IMAGE If the display is 8 bit and the image is true color convert image from true color to indexed color if depth le 8 and true eq 1 then begin resized color_quan temporary resized 3 r g b colors ncolors dither keyword_set dither byte bottom tvlct r g b bottom true 0 endif Set channel value for supported devices if d name eq WIN or d name eq MAC or d name eq X then begin channel_value channel endif else begin channel_value 0 endelse Display the image case true of 0 : tv resized x0 y0 order order channel channel_value 1 : tv resized x0 y0 order order true 3 endcase RESTORE THE DECOMPOSED COLOR MODE FOR 24 BIT DISPLAYS if d name eq WIN or d name eq MAC or d name eq X and depth gt 8 then begin device decomposed entry_decomposed if d name eq MAC then tv 0 1 1 endif DRAW AXES IF REQUIRED if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords END"); 207 a[205] = new Array("./ToBeReviewed/IMAGE/saveimage.html", "saveimage.pro", "", "PRO SAVEIMAGE FILE BMP BMP PNG PNG PICT PICT JPEG JPEG TIFF TIFF QUALITY QUALITY DITHER DITHER CUBE CUBE QUIET QUIET MULTIPLE multiple NAME: SAVEIMAGE PURPOSE: Save the current graphics window to an output file GIF by default The output formats supported are: GIF 8 bit with color table BMP 8 bit with color table PNG 8 bit with color table PICT 8 bit with color table JPEG 24 bit true color TIFF 24 bit true color Any conversions necessary to convert 8 bit or 24 bit images onscreen to 8 bit or 24 bit output files are done automatically CATEGORY: Input Output CALLING SEQUENCE: SAVEIMAGE FILE INPUTS: FILE Name of the output file GIF format by default OPTIONAL INPUTS: None KEYWORD PARAMETERS: BMP Set this keyword to create BMP format 8 bit with color table PNG Set this keyword to create PNG format 8 bit with color table PICT Set this keyword to create PICT format 8 bit with color table JPEG Set this keyword to create JPEG format 24 bit true color TIFF Set this keyword to create TIFF format 24 bit true color QUALITY If set to a named variable specifies the quality for JPEG output default 75 Ranges from 0 terrible to 100 excellent Smaller quality values yield higher compression ratios and smaller output files DITHER If set dither the output image when creating 8 bit output which is read from a 24 bit display default is no dithering CUBE If set use the color cube method to quantize colors when creating 8 bit output which is read from a 24 bit display default is to use the statistical method This may improve the accuracy of colors in the output image especially white QUIET Set this keyword to suppress the information message default is to print an information message MULTIPLE to write multiple gif image OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The output file is overwritten if it exists RESTRICTIONS: Requires IDL 5 0 or higher square bracket array syntax EXAMPLE: openr lun filepath hurric dat subdir examples data get_lun image bytarr 440 330 readu lun image free_lun lun loadct 13 tvscl image saveimage hurric gif MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: saveimage pro 69 2006 05 11 10:35:53Z smasson Copyright C 1999 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: saveimage pro 69 2006 05 11 10:35:53Z smasson CHECK INPUT Check arguments if n_params ne 1 then message Usage: SAVEIMAGE FILE if n_elements file eq 0 then message Argument FILE is undefined if n_elements file gt 1 then message Argument FILE must be a scalar string Check keywords output GIF if keyword_set bmp then output BMP if keyword_Set png then output PNG if keyword_set pict then output PICT if keyword_set jpeg then output JPEG if keyword_set tiff then output TIFF if n_elements quality eq 0 then quality 75 Check for TVRD capable device if d flags and 128 eq 0 then message Unsupported graphics device Check for open window if d flags and 256 ne 0 then begin if d window lt 0 then message No graphics windows are open endif Get display depth depth 8 if d n_colors gt 256 then depth 24 GET CONTENTS OF GRAPHICS WINDOW Handle window devices other than the Z buffer if d flags and 256 ne 0 then begin Copy the contents of the current display to a pixmap current_window d window xsize d x_size ysize d y_size window free pixmap xsize xsize ysize ysize retain 2 device copy 0 0 xsize ysize 0 0 current_window Set decomposed color mode for 24 bit displays version float version release if depth gt 8 then begin if version gt 5 1 then device get_decomposed entry_decomposed device decomposed 1 endif endif Read the pixmap contents into an array if depth gt 8 then begin image tvrd order 0 true 1 endif else begin image tvrd order 0 endelse Handle window devices other than the Z buffer if d flags and 256 ne 0 then begin Restore decomposed color mode for 24 bit displays if depth gt 8 then begin if version gt 5 1 then begin device decomposed entry_decomposed endif else begin device decomposed 0 if keyword_set quiet eq 0 then print Decomposed color was turned off endelse endif Delete the pixmap wdelete d window wset current_window endif Get the current color table tvlct r g b get If an 8 bit image was read reduce the number of colors if depth le 8 then begin reduce_colors image index r r index g g index b b index endif WRITE OUTPUT FILE case 1 of Save the image in 8 bit output format output eq GIF or output eq BMP or output eq PICT or output eq PNG : begin if depth gt 8 then begin Convert 24 bit image to 8 bit case keyword_set cube of 0 : image color_quan image 1 r g b colors 256 dither keyword_set dither 1 : image color_quan image 1 r g b cube 6 endcase Sort the color table from darkest to brightest table_sum total long r long g long b 2 table_index sort table_sum image_index sort table_index r r table_index g g table_index b b table_index oldimage image image image_index temporary oldimage endif Save the image case output of GIF : write_gif file image r g b MULTIPLE multiple BMP : write_bmp file image r g b PNG : write_png file image r g b PICT : write_pict file image r g b endcase end Save the image in 24 bit output format output eq JPEG or output eq TIFF : begin Convert 8 bit image to 24 bit if depth le 8 then begin info size image nx info 1 ny info 2 true bytarr 3 nx ny true 0 r image true 1 g image true 2 b image image temporary true endif If TIFF format output reverse image top to bottom if output eq TIFF then image reverse temporary image 3 Write the image case output of JPEG : write_jpeg file image true 1 quality quality TIFF : write_tiff file image 1 endcase end endcase Print information for the user if keyword_set quiet eq 0 then print file output format Created a in a format END"); 208 a[206] = new Array("./ToBeReviewed/IMAGE/showimage.html", "showimage.pro", "", "PRO SHOWIMAGE FILE DITHER DITHER CURRENT CURRENT NAME: SHOWIMAGE PURPOSE: Show the contents of a graphics file in the current window The input formats supported are: GIF 8 bit with color table BMP 8 bit with color table or 24 bit true color PICT 8 bit with color table TIFF 8 bit with color table or 24 bit true color JPEG 24 bit true color Any conversions necessary to translate 8 bit or 24 bit files to 8 bit or 24 bit images on screen are done automatically CATEGORY: Input Output CALLING SEQUENCE: SHOWIMAGE FILE INPUTS: FILE Name of the output file format is identified automatically OPTIONAL INPUTS: None KEYWORD PARAMETERS: DITHER Set this keyword to dither the input image when displaying 24 bit images on an 8 bit display default is no dithering CURRENT Set this keyword to display the image in the current window default is to create a new window sized to fit the image OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The color table is modified RESTRICTIONS: Requires IDL 5 2 or higher image QUERY functions EXAMPLE: showimage filepath rose jpg subdir examples data MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: showimage pro 69 2006 05 11 10:35:53Z smasson Copyright C 1999 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: showimage pro 69 2006 05 11 10:35:53Z smasson CHECK INPUT Check IDL version if float version release lt 5 2 then begin message IDL 5 2 or higher is required continue return endif Check input arguments case 1 of n_params ne 1 : error Usage: SHOWIMAGE FILE n_elements file eq 0 : error Argument FILE is undefined n_elements file gt 1 : error Argument FILE must be a scalar string findfile file 0 eq : error Argument FILE was not found else : error endcase if error ne then begin message error continue return endif CHECK THE GRAPHICS DEVICE Check for device supporting windows and tvrd if d flags and 256 eq 0 or d flags and 128 eq 0 then begin error string d name format Graphics device a is not supported message error continue return endif Make sure a window has been opened in this session and get visual depth if d window lt 0 then begin window free pixmap xsize 20 ysize 20 wdelete d window endif device get_visual_depth depth If 8 bit display is low on colors print a message if depth eq 8 and d table_size lt 64 then message Display has less than 64 colors image quality may degrade continue IDENTIFY FILE AND READ IMAGE Identify the file format result query_gif file info if result eq 0 then result query_bmp file info if result eq 0 then result query_pict file info if result eq 0 then result query_tiff file info if result eq 0 then result query_jpeg file info if result eq 0 then begin message File format not recognized continue return endif Fix the channel information for GIF images if info type eq GIF then info channels 1 Read the image case info type of GIF : read_gif file image r g b BMP : begin if info channels eq 1 then begin image read_bmp file r g b endif else begin image read_bmp file image reverse temporary image 1 endelse end PICT : read_pict file image r g b TIFF : begin if info channels eq 1 then begin image read_tiff file r g b order order image reverse temporary image 2 endif else begin image read_tiff file order order image reverse temporary image 3 endelse end JPEG : read_jpeg file image endcase If an 8 bit image was read reduce the number of colors if info channels eq 1 then begin reduce_colors image index r r index g g index b b index endif Get image size dims size image dimensions if n_elements dims eq 2 then begin nx dims 0 ny dims 1 endif else begin nx dims 1 ny dims 2 endelse CREATE A WINDOW Create a draw widget sized to fit the image if not keyword_set current then begin Set default window size scroll 0 xsize nx ysize ny draw_xsize nx draw_ysize ny Adjust the window size if the image is too large device get_screen_size screen screen_xsize screen 0 screen_ysize screen 1 if nx gt screen_xsize then begin xsize 0 9 screen_xsize scroll 1 endif if ny gt screen_ysize then begin ysize 0 9 screen_ysize scroll 1 endif Create the draw widget base widget_base title file draw widget_draw base scroll scroll widget_control draw xsize xsize ysize ysize draw_xsize draw_xsize draw_ysize draw_ysize endif HANDLE IDL 8 BIT MODE if depth eq 8 then begin If the color table of an 8 bit image is larger than the current display table convert the image to 24 bit if info channels eq 1 and n_elements r gt d table_size then begin Convert to 24 bit dims size image dimensions nx dims 0 ny dims 1 true bytarr 3 nx ny true 0 r image true 1 g image true 2 b image image temporary true Reset the number of channels info channels 3 endif If image is 24 bit convert to 8 bit if info channels eq 3 then begin Convert 24 bit image to 8 bit image color_quan image 1 r g b colors d table_size dither keyword_set dither Sort the color table from darkest to brightest table_sum total long r long g long b 2 table_index sort table_sum image_index sort table_index r r table_index g g table_index b b table_index oldimage image image image_index temporary oldimage Reset the number of channels info channels 1 endif endif DISPLAY THE IMAGE Realize the draw widget if not keyword_set current then widget_control base realize Save current decomposed mode and display order device get_decomposed current_decomposed current_order order Set image to display from bottom up order 0 Display the image if info channels eq 1 then begin device decomposed 0 tvlct r g b tv image endif else begin device decomposed 1 tv image true 1 endelse Restore decomposed mode and display order device decomposed current_decomposed order current_order END"); 209 a[207] = new Array("./ToBeReviewed/INIT/initncdf.html", "initncdf.pro", "", " NAME:initncdf PURPOSE:initfile for Netcdf file define all the grid parameters CATEGORY: CALLING SEQUENCE:initncdf ncfilename INPUTS:ncfilename: a string giving the name of the NetCdf file KEYWORD PARAMETERS: GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be defined according to GLAMBOUNDARY INVMASK: to inverse the mask: mask 1 mask IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir MASKNAME: a string giving the name of the variable in the file that contains the land sea mask MISSING_VALUE: to define or redifine if the attribute is already existing the missing values used with USEASMASK keyword start1: index the axis from 1 instead of 0 when using xyindex and or zindex USEASMASK: a string giving the name of the variable in the file that will be used to build the land sea mask In this case the mask is based on the first record if record dimension exists The mask is build according to : 1 the keyword missing_value if existing 2 the attribute missing_value if existing 3 NaN values if existing XYZ AXISNAME a string giving the name of the variable in the file that contains the xyz axis for X axis default name must be x longitude nav_lon or lon for Y axis default name must be y latitude nav_lat or lat for Z axis default name must be z level lev depth XYZ MINMESH: to define the common variables i xyz minmesh used to define the grid only in a zoomed part of the original grid Defaut values are 0L XYZ MAXMESH: to define the common variables i xyz maxmesh used to define the grid only in a zoomed part of the original grid Defaut values are jp ijk glo 1 xyindex: to define the x y axis with index instead of using the values contained in X YAXISNAME x yaxis keyword_set start1 findgen jpi jpj this forces key_onearth 0 zindex: to define the z axis with index instead of using the values contained in ZAXISNAME zaxis keyword_set start1 findgen jpk OUTPUTS:none except the grid parameters of the common pro COMMON BLOCKS:common pro SIDE EFFECTS:change the grid parameters of the common pro RESTRICTIONS: the file must contain an x and an y axis 1 ou 2 dimentional array EXAMPLE: IDL initncdf toto nc glam 180 180 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 May 2002 PRO initncdf ncfilein XAXISNAME xaxisname YAXISNAME yaxisname ZAXISNAME zaxisname MASKNAME maskname INVMASK invmask USEASMASK useasmask MISSING_VALUE missing_value START1 start1 XYINDEX xyindex ZINDEX zindex _EXTRA ex common check the name of the file ncfile isafile FILENAME ncfilein IODIRECTORY iodir _extra ex if size ncfile type NE 7 then BEGIN print initncdf cancelled return endif if the file is stored on tape if version os_family EQ unix then spawn file ncfile dev null open the file cdfid ncdf_open ncfile what is inside the file inside ncdf_inquire cdfid name of the variables namevar strarr inside nvars for varid 0 inside nvars 1 do begin invar ncdf_varinq cdfid varid namevar varid strlowcase invar name ENDFOR find the xaxis if keyword_set xaxisname then xaxisname strlowcase xaxisname ELSE xaxisname x xvarid where namevar EQ xaxisname OR namevar EQ longitude OR namevar EQ nav_lon OR namevar EQ lon xvarid xvarid 0 if xvarid EQ 1 then begin print the xaxis was not found check the use of XAXISNAME keyword stop endif get the size of xaxis xinq ncdf_varinq cdfid xvarid ncdf_diminq cdfid xinq dim 0 blabla jpifromx should we read or compute the xaxis IF NOT keyword_set xyindex THEN BEGIN read the xaxis ncdf_varget cdfid xvarid xaxis make sure of the shape of xaxis IF xinq ndims GE 2 THEN BEGIN ncdf_diminq cdfid xinq dim 1 blabla jpjfromx xaxis reform xaxis jpifromx jpjfromx over ENDIF ENDIF ELSE xaxis keyword_set start1 findgen jpifromx find the yaxis if keyword_set yaxisname then yaxisname strlowcase yaxisname ELSE yaxisname y yvarid where namevar EQ yaxisname OR namevar EQ latitude OR namevar EQ nav_lat OR namevar EQ lat yvarid yvarid 0 if yvarid EQ 1 then begin print the yaxis was not found check the use of YAXISNAME keyword stop endif get the size of yaxis and check it is ok with the values found for x yinq ncdf_varinq cdfid yvarid IF xinq ndims GE 2 THEN BEGIN ncdf_diminq cdfid yinq dim 0 blabla jpifromy ncdf_diminq cdfid yinq dim 1 blabla jpjfromy IF jpifromy NE jpifromx THEN BEGIN print xaxis and y axis do not have the same x dimension ENDIF ENDIF ELSE ncdf_diminq cdfid yinq dim 0 blabla jpjfromy IF n_elements jpjfromx NE 0 THEN BEGIN IF jpjfromy NE jpjfromx THEN BEGIN print xaxis and y axis do not have the same y dimension ENDIF ENDIF should we read or compute the xaxis IF NOT keyword_set xyindex THEN BEGIN read the yaxis ncdf_varget cdfid yvarid yaxis make sure of the shape of xaxis IF xinq ndims GE 2 THEN yaxis reform yaxis jpifromy jpjfromy over ENDIF ELSE yaxis keyword_set start1 findgen jpjfromy find the zaxis if keyword_set zaxisname then zaxisname strlowcase zaxisname ELSE zaxisname z zvarid where namevar EQ nav_lev or namevar EQ zaxisname OR namevar EQ level OR namevar EQ lev OR strmid namevar 0 5 EQ depth zvarid zvarid 0 if zvarid EQ 1 AND inside ndims GT 3 then begin print initncdf: the zaxis was not found check the the use of ZAXISNAME keyword if you whant to find one stop endif read the zaxis if zvarid NE 1 THEN ncdf_varget cdfid zvarid zaxis IF keyword_set zindex THEN zaxis keyword_set start1 findgen n_elements zaxis mask CASE 1 OF keyword_set maskname :BEGIN mskid where namevar EQ strlowcase maskname 0 if mskid NE 1 THEN BEGIN mskinq ncdf_varinq cdfid mskid is the mask variable containing the record dimension withrcd where mskinq dim EQ inside recdim 0 IF withrcd NE 1 THEN BEGIN in order to read only the first record we need to get the size of each dimension count replicate 1L mskinq ndims FOR d 0 mskinq ndims 1 DO BEGIN IF d NE withrcd THEN BEGIN ncdf_diminq cdfid mskinq dim d name size count d size ENDIF ENDFOR read the variable for the first record ncdf_varget cdfid mskid tmask count count ENDIF ELSE ncdf_varget cdfid mskid tmask check if we need to applay add_offset and scale factor FOR a 0 mskinq natts 1 DO BEGIN attname ncdf_attname cdfid mskid a CASE strlowcase attname OF add_offset :ncdf_attget cdfid mskid attname add_offset scale_factor :ncdf_attget cdfid mskid attname scale_factor ELSE: ENDCASE ENDFOR IF n_elements scale_factor NE 0 THEN tmask tmask scale_factor IF n_elements add_offset NE 0 THEN tmask tmask add_offset if keyword_set invmask then tmask 1 tmask tmask byte round tmask ENDIF ELSE tmask 1 END keyword_set useasmask :BEGIN mskid where namevar EQ strlowcase useasmask 0 if mskid NE 1 THEN BEGIN mskinq ncdf_varinq cdfid mskid is the mask variable containing the record dimension withrcd where mskinq dim EQ inside recdim 0 IF withrcd NE 1 THEN BEGIN in order to read only the first record we need to get the size of each dimension count replicate 1L mskinq ndims FOR d 0 mskinq ndims 1 DO BEGIN IF d NE withrcd THEN BEGIN ncdf_diminq cdfid mskinq dim d name size count d size ENDIF ENDFOR read the variable for the first record ncdf_varget cdfid mskid tmask count count ENDIF ELSE ncdf_varget cdfid mskid tmask check if we need to applay add_offset and scale factor FOR a 0 mskinq natts 1 DO BEGIN attname ncdf_attname cdfid mskid a CASE strlowcase attname OF add_offset :ncdf_attget cdfid mskid attname add_offset scale_factor :ncdf_attget cdfid mskid attname scale_factor missing_value :IF n_elements missing_value EQ 0 THEN ncdf_attget cdfid mskid attname missing_value ELSE: ENDCASE ENDFOR IF n_elements scale_factor NE 0 THEN tmask tmask scale_factor IF n_elements add_offset NE 0 THEN tmask tmask add_offset IF n_elements missing_value NE 0 THEN BEGIN we have to take care of the float accuracy CASE 1 OF missing_value GE 1 e6:tmask tmask LT missing_value 10 missing_value LE 1 e6:tmask tmask GT missing_value 10 abs missing_value LE 1 e 6:tmask abs tmask GT 1 e 6 ELSE:tmask tmask NE missing_value ENDCASE if keyword_set invmask then tmask 1 tmask ENDIF ELSE BEGIN tmask finite tmask IF min tmask EQ 1 THEN BEGIN print missing or nan values not found tmask 1 ENDIF ENDELSE ENDIF ELSE tmask 1 END ELSE:tmask 1 ENDCASE ncdf_close cdfid compute the grid if zvarid EQ 1 then BEGIN computegrid xaxis xaxis yaxis yaxis mask tmask onearth 1b keyword_set xyindex _EXTRA ex ENDIF ELSE BEGIN computegrid xaxis xaxis yaxis yaxis zaxis zaxis mask tmask onearth 1b keyword_set xyindex _EXTRA ex ENDELSE IF n_elements time EQ 0 THEN time 0 jpt n_elements time return end"); 210 a[208] = new Array("./ToBeReviewed/INIT/initncdfxxx.html", "initncdfxxx.pro", "", ""); 211 a[209] = new Array("./ToBeReviewed/INIT/initorca05.html", "initorca05.pro", "", ""); 212 a[210] = new Array("./ToBeReviewed/INIT/initorca2.html", "initorca2.pro", "", ""); 213 a[211] = new Array("./ToBeReviewed/INIT/initorca2full.html", "initorca2full.pro", "", ""); 214 a[212] = new Array("./ToBeReviewed/LECTURE/GRIB/bit2int.html", "bit2int.pro", "", "FUNCTION bit2int bitin checkneg checkneg res 0L n n_elements bitin 1 IF keyword_set checkneg THEN BEGIN IF bitin 0 EQ 1 THEN BEGIN bitin 0 0 neg 1 ENDIF ELSE neg 1 ENDIF ELSE neg 1 FOR i 0 n DO res res 2L i bitin n i RETURN neg res END"); 215 a[213] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib.html", "read_grib.pro", "", "function read_grib varcode date1 date2 file file common http: www wmo ch web www WDM Guides Guide binary 2 html gribfile d1fes2 raid6 SINTEX common ES10 d 00 atm 5d ES10 d 00_5d_00911201_00911230 grib IF keyword_set file THEN gribfile isafile file file iodir iodir ELSE gribfile d1fes2 raid6 SINTEX common ES10 atm 5d ZOOM_IND ES10_5d_00210101_00301230 grib openr num gribfile GET_LUN ERROR err SWAP_IF_LITTLE_ENDIAN if err ne 0 then begin print err_string return 1 ENDIF recstart scan_grib_recstart num messize scan_grib_messize num recstart addoff lonarr n_elements recstart FOR i 1L n_elements recstart 1 DO addoff i recstart i recstart i 1 messize i 1 nbits scan_grib_nbits num recstart print nbits uniq nbits sort nbits codes scan_grib_code num recstart nbcodes uniq codes sort codes dates scan_grib_date num recstart nbdates uniq dates sort dates goodvar where codes EQ varcode IF goodvar 0 EQ 1 THEN BEGIN print no var code strtrim varcode 2 in the file return 1 ENDIF recstart recstart goodvar dates dates goodvar gooddate where dates GE date1 AND dates LE date2 IF gooddate 0 EQ 1 THEN BEGIN print no dates between strtrim date1 2 and strtrim date2 2 in the file return 1 ENDIF recstart recstart gooddate dates dates gooddate key_caltype 360d time date2jul dates jpt n_elements time IF jpt EQ 1 THEN vardate strtrim dates 0 2 ELSE vardate strtrim dates 0 2 strtrim dates jpt 1 2 varname vargrid T varexp varunit grib_pds read_grib_pds num recstart 0 grid parameters IF grib_pds gdsnotomitted THEN BEGIN grib_gds read_grib_gds num recstart 0 min max of the latitude with a precision of 10 2 lat1 fix 100 grib_gds la1 100 lat2 fix 100 grib_gds la2 100 CASE grib_gds gridtype OF Latitude Longitude Grid 0:BEGIN computegrid grib_gds lo1 grib_gds la1 grib_gds di grib_gds dj grib_gds ni grib_gds nj END Gaussian Latitude Longitude Grid 4:BEGIN find the latitude axis CASE 1 OF n48 grib_gds n EQ 48 AND lat1 EQ 88 57 AND lat2 EQ 88 57: gphit n48gaussian n80 grib_gds n EQ 80 AND lat1 EQ 89 14 AND lat2 EQ 89 14: gphit n80gaussian n128 grib_gds n EQ 128 AND lat1 EQ 89 46 AND lat2 EQ 89 46: gphit n128gaussian n160 grib_gds n EQ 160 AND lat1 EQ 89 57 AND lat2 EQ 89 57: gphit n160gaussian n256 grib_gds n EQ 256 AND lat1 EQ 89 73 AND lat2 EQ 89 73: gphit n256gaussian part of one of the gaussian grids defined above ELSE:BEGIN cnt 0 REPEAT BEGIN CASE cnt OF 0:gphit n48gaussian 1:gphit n80gaussian 2:gphit n128gaussian 3:gphit n160gaussian 4:gphit n256gaussian 5:BEGIN gphit n80gaussian lat1 29 71 lat2 19 62 END ELSE:stop ENDCASE nfix fix gphit 100 100 nlat1 where nfix EQ lat1 0 nlat2 where nfix EQ lat2 0 IF nlat1 NE 1 AND nlat2 NE 1 AND nlat2 nlat1 1 EQ grib_gds nj THEN gphit gphit nlat1:nlat2 ELSE gphit 1 cnt cnt 1 ENDREP UNTIL gphit 0 NE 1 END ENDCASE computegrid grib_gds lo1 1 grib_gds di 1 grib_gds ni 1 YAXIS gphit END Mercator Projection Grid gridtype EQ 1: Gnomonic Projection Grid gridtype EQ 2: Lambert Conformal secant or tangent conical or bipolar normal or oblique Projection Grid gridtype EQ 3: Polar Stereographic Projection Grid gridtype EQ 5: Oblique Lambert conformal secant or tangent conical or bipolar projection gridtype EQ 13: Spherical Harmonic Coefficients gridtype EQ 50: Space view perspective or orthographic grid gridtype EQ 90: reserved see Manual on Codes ELSE: ENDCASE ENDIF ELSE stop res fltarr grib_gds ni grib_gds nj n_elements recstart FOR i 0 n_elements recstart 1 DO BEGIN res i read_grib_bds num recstart i grib_gds ni grib_gds nj ENDFOR free_lun num IF keyword_set key_yreverse THEN res reverse res 2 RETURN res END"); 216 a[214] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_bds.html", "read_grib_bds.pro", "", "FUNCTION read_grib_bds num recstart ni nj offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 ddd bit2int binary a 27 binary a 28 checkneg offset offset sizepds IF gdsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizedds bit2int binary a 1 binary a 2 binary a 3 offset offset sizedds ENDIF IF bmsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizebms bit2int binary a 1 binary a 2 binary a 3 offset offset sizebms ENDIF a assoc num bytarr 1 nozero offset 1 sizebds bit2int binary a 1 binary a 2 binary a 3 flags binary a 4 BIT VALUE MEANING 1 0 Grid point data 1 Spherical Harmonic Coefficients 2 0 Simple packing 1 Second order Complex Packing 3 0 Original data were floating point values 1 Original data were integer values 4 0 No additional flags at octet 14 1 Octet 14 contains flag bits 5 12 5 Reserved set to 0 6 0 Single datum at each grid point 1 Matrix of values at each grid point 7 0 No secondary bit maps 1 Secondary bit maps present 8 0 Second order values have constant width 1 Second order values have different widths 9 12 Reserved set to 0 eee bit2int binary a 5 binary a 6 checkneg aaa bit2int binary a 7 checkneg bbb bit2int binary a 8 binary a 9 binary a 10 IF aaa LT 0 THEN rrr 2 24 bbb 16 aaa 64 ELSE rrr 2 24 bbb 16 aaa 64 nbits a 11 0 CASE 1 OF flags 0 EQ 0 AND flags 1 EQ 0:BEGIN CASE nbits OF 8 :a assoc num bytarr ni nj nozero offset 1 12 16:a assoc num uintarr ni nj nozero offset 1 12 32:a assoc num ulonarr ni nj nozero offset 1 12 64:a assoc num ulon64arr ni nj nozero offset 1 12 ELSE: ENDCASE END ENDCASE RETURN rrr a 0 2 eee 10 ddd END"); 217 a[215] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_end.html", "read_grib_end.pro", "", "PRO read_grib_end num offset a assoc num bytarr 4 nozero offset endcode string a 0 IF endcode NE 7777 THEN stop RETURN END"); 218 a[216] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_gds.html", "read_grib_gds.pro", "", "FUNCTION read_grib_gds num recstart offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 offset recstart 8 sizepds a assoc num bytarr 1 nozero offset 1 sizegds bit2int binary a 1 binary a 2 binary a 3 nv a 4 0 pv a 5 0 gridtype a 6 0 CASE 1 OF Latitude Longitude Grid Gaussian Latitude Longitude Grid gridtype EQ 0 OR gridtype EQ 4:BEGIN ni bit2int binary a 7 binary a 8 nj bit2int binary a 9 binary a 10 la1 bit2int binary a 11 binary a 12 binary a 13 checkneg 1000 lo1 bit2int binary a 14 binary a 15 binary a 16 checkneg 1000 resflags binary a 17 la2 bit2int binary a 18 binary a 19 binary a 20 checkneg 1000 lo2 bit2int binary a 21 binary a 22 binary a 23 checkneg 1000 di bit2int binary a 24 binary a 25 1000 IF di EQ 65 5350 THEN di 1 IF gridtype EQ 0 THEN BEGIN dj bit2int binary a 26 binary a 27 1000 IF dj EQ 65 5350 THEN dj 1 ENDIF ELSE BEGIN n bit2int binary a 26 binary a 27 ENDELSE scanflags binary a 28 res size:sizegds gridtype:gridtype ni:ni nj:nj la1:la1 la2:la2 lo1:lo1 lo2:lo2 di:di IF gridtype EQ 0 THEN res create_struct res dj dj ELSE res create_struct res n n RETURN res END Mercator Projection Grid gridtype EQ 1: Gnomonic Projection Grid gridtype EQ 2: Lambert Conformal secant or tangent conical or bipolar normal or oblique Projection Grid gridtype EQ 3: Polar Stereographic Projection Grid gridtype EQ 5: Oblique Lambert conformal secant or tangent conical or bipolar projection gridtype EQ 13: Spherical Harmonic Coefficients gridtype EQ 50: Space view perspective or orthographic grid gridtype EQ 90: reserved see Manual on Codes ELSE: ENDCASE RETURN 1 END"); 219 a[217] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_is.html", "read_grib_is.pro", "", "FUNCTION read_grib_is num offset infofile fstat num a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN stop a assoc num bytarr 1 nozero offset 4 sizerecord bit2int binary a 0 binary a 1 binary a 2 a assoc num bytarr 1 nozero offset 7 gribed a 0 IF gribed NE 1 THEN stop RETURN typefile:typefile sizerecord:sizerecord gribed:gribed 0 END"); 220 a[218] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_pds.html", "read_grib_pds.pro", "", "FUNCTION read_grib_pds num recstart offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 paramtableversion a 4 0 centerid a 5 0 procid a 6 0 gridid a 7 0 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 paramunitid a 9 0 levtype a 10 0 levalue1 a 11 0 levalue2 a 12 0 year a 13 0 month a 14 0 day a 15 0 hour a 16 0 minute a 17 0 timeunit a 18 0 p1 a 19 0 p2 a 20 0 timerange a 21 0 n1 a 22 0 n2 a 23 0 nbmiss a 24 0 century a 25 0 subcenterid a 26 0 d bit2int binary a 27 binary a 28 checkneg RETURN size:sizepds gdsnotomitted:gdsnotomitted bmsnotomitted:bmsnotomitted d:d END"); 221 a[219] = new Array("./ToBeReviewed/LECTURE/GRIB/read_gribtable.html", "read_gribtable.pro", "", " NAME: read_gribtable PURPOSE: Read contents of a gribtable Gribtables are located in the gribtables subdirectory of HIPHOP CATEGORY: HIPHOP GRIB ECMWF CALLING SEQUENCE: read_gribtable tablename parmtabl parmtabl EXAMPLE: tablename ectab_128 INPUTS: tablename : the full path name of a gribtable file OPTIONAL INPUT PARAMETERS: KEYWORD INPUT PARAMETERS: OUTPUTS: parmtable : the parameter table COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: MODIFICATION HISTORY: Dominik Brunner Apr 2000 PRO read_gribtable tablename parmtabl parmtabl center center subcenter subcenter tablnum tablnum ON_ERROR 2 parmtabl StrArr 3 256 center 1 subcenter 1 tablnum 1 First Subscript 3 is name description units Second 256 is defined size of a parameter table IF n_elements tablename EQ 0 THEN return openr lun tablename get line read first line which eventually contains information about center subcenter and table number readf lun line parts STR_SEP line : IF n_elements parts GT 3 THEN BEGIN center fix parts 1 subcenter fix parts 2 tablnum fix parts 3 ENDIF ELSE BEGIN IF n_elements parts GE 3 THEN parmtabl 0:1 fix parts 0 parts 1:2 ELSE IF n_elements parts EQ 2 THEN parmtabl 0 fix parts 0 parts 1 ENDELSE loop over remaining lines REPEAT BEGIN readf lun line parts STR_SEP line : IF n_elements parts GE 3 THEN parmtabl 0:1 fix parts 0 parts 1:2 ELSE IF n_elements parts EQ 2 THEN parmtabl 0 fix parts 0 parts 1 END UNTIL EOF lun free_lun lun fill up missing varible names index WHERE parmtabl 0 EQ count IF count GT 0 THEN parmtabl 0 index var strcompress index rem END"); 222 a[220] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_code.html", "scan_grib_code.pro", "", "FUNCTION scan_grib_code num recstart nrec n_elements recstart codes bytarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 8 9 1 codes i a 0 ENDFOR RETURN codes END"); 223 a[221] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_date.html", "scan_grib_date.pro", "", "FUNCTION scan_grib_date num recstart nrec n_elements recstart dates lonarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 8 1 dates i a 13 100L a 25 1 10000L a 14 100L a 15 ENDFOR RETURN dates END"); 224 a[222] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_messize.html", "scan_grib_messize.pro", "", "FUNCTION scan_grib_messize num recstart nrec n_elements recstart messize lonarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 4 messize i bit2int binary a 0 binary a 1 binary a 2 ENDFOR RETURN messize END"); 225 a[223] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_nbits.html", "scan_grib_nbits.pro", "", "FUNCTION scan_grib_nbits num recstart nrec n_elements recstart nbits bytarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 ddd bit2int binary a 27 binary a 28 checkneg offset offset sizepds IF gdsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizedds bit2int binary a 1 binary a 2 binary a 3 offset offset sizedds ENDIF IF bmsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizebms bit2int binary a 1 binary a 2 binary a 3 offset offset sizebms ENDIF a assoc num bytarr 1 nozero offset 1 nbits i a 11 ENDFOR RETURN nbits END"); 226 a[224] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_recstart.html", "scan_grib_recstart.pro", "", "FUNCTION scan_grib_recstart num infofile fstat num minimum size of one record minisize 8L 28L 4L 4L maxoffset infofile size minisize start 0L offset 0L previousrecsize 0L WHILE offset LT maxoffset DO BEGIN Every record must begin with GRIB However their is no rule to define the space between 2 records 1 we try space previousrecsize MOD 8 because for echam outputs the total size of the records is rounded to modulo 8 addoff 8 previousrecsize MOD 8 offset offset addoff IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN offset offset addoff 2 we try space previousrecsize MOD 120 because for ecmwf outputs the total size of the records is rounded to modulo 120 addoff 120 previousrecsize MOD 120 IF typefile NE GRIB THEN BEGIN offset offset addoff IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN offset offset addoff ENDIF 3 we try space 0 IF typefile NE GRIB THEN BEGIN a assoc num bytarr 4 nozero offset typefile string a 0 ENDIF 4 we try any value for space IF typefile NE GRIB THEN BEGIN REPEAT BEGIN CASE 1 OF array_equal a 0 3 byte G :offset offset 3 array_equal a 0 2:3 byte GR :offset offset 2 array_equal a 0 1:3 byte GRI :offset offset 1 else:offset offset 4 ENDCASE IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 ENDREP UNTIL typefile EQ GRIB ENDIF start start offset a assoc num bytarr 1 nozero offset 4 recsize bit2int binary a 0 binary a 1 binary a 2 offset offset recsize previousrecsize recsize ENDWHILE out: RETURN start 1:n_elements start 1 END"); 227 a[225] = new Array("./ToBeReviewed/LECTURE/binary.html", "binary.pro", "", "function binary number Name: binary Purpose: Returns the binary representation of a number of any numerical type Argument: number scalar or array of numbers any numerical type Returns: Byte array with binary representation of numbers Examples: Binary representation of 11b: IDL print binary 11b 0 0 0 0 1 0 1 1 Binary representation of pi x86: Little endian IEEE representation : IDL print format z9 8 5x 4 1x 8i1 long pi 0 binary pi 40490fdb 01000000 01001001 00001111 11011011 x86 Linux 0fdb4149 00001111 11011011 01000001 01001001 Alpha OpenVMS IDL print format 8 1x 8i0 binary dpi 01000000 00001001 00100001 11111011 01010100 01000100 00101101 00011000 Some first tests before type double was added: print format 2a6 4x 2z9 8 4x 8z3 2 version arch version os long dpi 0 2 byte dpi 0 8 x86 linux 54442d18 400921fb 18 2d 44 54 fb 21 09 40 sparc sunos 400921fb 54442d18 40 09 21 fb 54 44 2d 18 alpha vms 0fda4149 68c0a221 49 41 da 0f 21 a2 c0 68 Beginning with IDL 5 1 Alpha VMS uses IEEE representation as well Modification history: 19 Dec 1997 Originally a news posting by David Fanning Re: bits from bytes 20 Dec 1997 Complete rewrite: eliminate loops 22 Dec 1997 Bit shift instead of exponentiation return byte array handle input arrays Think about double and complex types 22 Sep 1998 Complete rewrite: reduce every numerical type to single bytes Check that big and little endian machines return exactly the same results if IEEE 7 May 2003 Added newish data types unsigned and long64 BT s size number type s s 0 1 n_no s s 0 2 Numerical types: will have to be completed if IDL adds double long 1: byte 1 byte unsigned integer 2: integer 2 byte signed integer 3: long 4 byte signed integer 4: floating point 4 byte single precision 5: double precision 8 byte double precision 6: complex 2x4 byte single precision 9: double complex 2x8 byte double precision 12: uInt 2 byte unsigned integer 13: uLong 4 byte unsigned integer 14: Long64 8 byte signed integer 15: uLong64 8 byte unsigned integer Non numerical types: 0: undefined 7: string 8: structure 10: pointer 11: object reference nbyt 0 1 2 4 4 8 8 0 0 16 0 0 number of bytes per type code 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 nbyt 0 1 2 4 4 8 8 0 0 16 0 0 2 4 8 8 ntyp nbyt type if ntyp eq 0 then message Invalid argument must be numerical type bits 128 64 32 16 8 4 2 1 ishft 1b 7 indgen 8 For correct array handling and byte comparison number and bits require same dimensions numvalue and bitvalue bitvalue bits intarr ntyp intarr n_no little_endian byte 1 0 1 0 In case of complex type and little endian machine swap the two float values before the complete second dimension is reversed at returning if type eq 6 or type eq 9 and little_endian then type complex numvalue reform byte number 0 1 ntyp 2 2 n_no intarr 8 1 0 8 ntyp n_no else numvalue byte number 0 1 ntyp n_no intarr 8 On little endian machines the second dimension of the return value must be reversed if little_endian AND type NE 1 then return reverse numvalue and bitvalue ne 0 2 else return numvalue and bitvalue ne 0 end"); 228 a[226] = new Array("./ToBeReviewed/LECTURE/changeread.html", "changeread.pro", "", "FUNCTION changeread newread common newread must be two structures if size newread type NE 8 then return 0 we compare the two structure which caracterise the read case 1 of ccreadparameters funclec_name NE newread funclec_name: ccreadparameters jpidta NE newread jpidta: ccreadparameters jpjdta NE newread jpjdta: ccreadparameters jpkdta NE newread jpkdta: ccreadparameters ixmindta NE newread ixmindta: ccreadparameters ixmaxdta NE newread ixmaxdta: ccreadparameters iymindta NE newread iymindta: ccreadparameters iymaxdta NE newread iymaxdta: ccreadparameters izmindta NE newread izmindta: ccreadparameters izmaxdta NE newread izmaxdta: ELSE:return 0 endcase update the common paramaters ccreadparameters newread jpidta newread jpidta jpjdta newread jpjdta jpkdta newread jpkdta ixmindta newread ixmindta ixmaxdta newread ixmaxdta iymindta newread iymindta iymaxdta newread iymaxdta izmindta newread izmindta izmaxdta newread izmaxdta return 1 end"); 229 a[227] = new Array("./ToBeReviewed/LECTURE/inverse_binary.html", "inverse_binary.pro", "", " NAME: inverse_binary PURPOSE: inverse function of the binary pro function given a input array of 0 1 return its corresponding byte integer long representation CATEGORY: CALLING SEQUENCE: res inverse_binary binnum INPUTS: binnum must be a binary type array containing only 0 and 1 According to binary pro outputs binnum array must have the following dimensions values: 8 t d1 d2 t gives the output type: t 1 byte t 2 integer t 4 long d1 d2 are the output dimensions KEYWORD PARAMETERS: no OUTPUTS: a byte integer long array with d1 d2 dimensions COMMON BLOCKS: no RESTRICTIONS:the binary number can represent only byte integer long EXAMPLE: IDL a indgen 5 IDL b binary a IDL help b B BYTE Array 8 2 5 IDL print b 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 IDL help inverse_binary b INT Array 5 IDL print inverse_binary b 0 1 2 3 4 MODIFICATION HISTORY: Sebastien Masson smasson jamstec go jp July 2004 FUNCTION inverse_binary binnumb s size binnumb dimensions IF n_elements s EQ 1 THEN numbofbit 8 ELSE numbofbit 8 s 1 nvalues n_elements binnumb numbofbit bn reform long binnumb numbofbit nvalues CASE numbofbit OF 8:res byte total temporary bn 2b reverse indgen numbofbit replicate 1b nvalues 1 1 16:res fix total temporary bn 2 reverse indgen numbofbit replicate 1 nvalues 1 1 double 32:res long total temporary bn 2L reverse indgen numbofbit replicate 1L nvalues 1 1 double ENDCASE CASE n_elements s OF 1:res res 0 2:res res 0 3: ELSE:res reform res s 2:n_elements s 1 over ENDCASE return res end"); 230 a[228] = new Array("./ToBeReviewed/LECTURE/litchamp.html", "litchamp.pro", "", " NAME:litchamp PURPOSE:permet de lire un simple tableau ou une structure correspondant a un champ Si en entree on a : un simple tableau litchamp renvoie le tableau une stucture litchamp renvoie le premier element de la structure qui doit obligatoirement etre le champ sous forme d un tableau Au passage litchamp regarde les autres elements de la structure et met a jour si besoin les variables globales qui se rapportent au champ: vargrid varname varunit vardate varexp valmask et time CATEGORY:permet d appeler plt pltz pltt avec un tableau ou une structure et de mettre a jour les variables globales liees au champ CALLING SEQUENCE:res litchamp struct INPUTS: struct: c est soit un tableau soit une structure Si struct est une structure elle doit suivre les regles suivantes: le premier element est le tableau contenant le champ les autres elements sont des strings qui contiennent des informations sur le champ SAUF pour l element relatif a date Ce dernier peut etre soit un string pour designer une date particuliere ex: August 1999 ou bien un vecteur de jours juliens d IDL correspondant au calendrier a associer au champ si c est une serie temporelle l ordre des elements autre que le premier n a pas d importance les autres elements autre que le premier sont tous optionnels ils sont reconnus par la premiere lettre de leur nom: g pour actualiser vargrid u pour actualiser varunit e pour actualiser varexp d pour actualiser vardate n pour actualiser varname m pour actualiser valmask KEYWORD PARAMETERS: GRID: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par g si il existe et dans le cas contraire UNIT: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par u si il existe et dans le cas contraire EXP: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par e si il existe et dans le cas contraire DATE: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par d si il existe et dans le cas contraire NAME: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par n si il existe et dans le cas contraire LEVEL: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par l si il existe et 1 dans le cas contraire MASK: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par m si il existe et 1 dans le cas contraire OUTPUTS:c est le tableau qui continent le champ COMMON BLOCKS: common pro SIDE EFFECTS: actualise au besion les variables globales vargrid varname varunit vardate varexp valmask et time RESTRICTIONS: EXAMPLE: IDL print vargrid varname varunit vardate varexp T 0 IDL help litchamp a:indgen 5 u: C name: toto INT Array 5 IDL print vargrid varname varunit vardate varexp T toto C 0 IDL help litchamp a:indgen 5 da: 1999 INT Array 5 IDL print vargrid varname varunit vardate varexp T toto C 1999 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 28 5 1999 FUNCTION litchamp struct GRID grid NAME name UNIT unit EXP exp DATE date LEVEL level MASK mask common if size struct type ne 8 then BEGIN alors contour n est pas une structure if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct ENDIF IF n_tags struct EQ 1 then BEGIN la structure n a qu un element if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct 0 ENDIF nomelements tag_names struct for i 1 n_tags struct 1 do begin case strlowcase strmid nomelements i 0 1 of g :BEGIN if keyword_set grid then return strupcase struct i vargrid strupcase struct i END n :BEGIN if keyword_set name then return struct i varname struct i END u :BEGIN if keyword_set unit then return struct i varunit struct i END e :BEGIN if keyword_set exp then return struct i varexp struct i END m :BEGIN if keyword_set mask then return struct i valmask struct i END d :BEGIN if size struct i type EQ 7 THEN BEGIN vardate struct i ENDIF ELSE BEGIN time struct i jpt n_elements time if jpt EQ 1 then vardate strtrim vairdate struct i 0 2 ELSE vardate strtrim vairdate struct i 0 2 strtrim vairdate struct i jpt 1 2 ENDELSE if keyword_set date then return vardate END h :BEGIN computehopegrid struct i xaxis struct i yaxis struct i zaxis struct i linetype FIRSTS struct i firsts LASTS struct i lasts FORTHEMASK struct 0 pttype struct i pttype END ELSE:BEGIN ras report Le nom nomelements i ne correspont a aucun element reconnu de la structure cf IDL xhelp litchamp end endcase endfor if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct 0 end"); 231 a[229] = new Array("./ToBeReviewed/LECTURE/ncdf_lec.html", "ncdf_lec.pro", "", " NAME:ncdflec PURPOSE:donne des infos sur un fichier netcdf et permet de recupere les variables qui y sont ecrites CATEGORY:lecture de fichiers netcdf CALLING SEQUENCE: res ncdflec nom_de _fichier INPUTS:nom_de _fichier:nom d un fichier net cdf situe ds e repertoire stipule par iodir KEYWORD PARAMETERS: ATT: global ou au nom d une variable permet de voir tous les attributs rattaches a une variable DIM:donne la liste des dimensions VAR: 1 var: donne la liste des variables 2 var nom de variable : ds ce cas la fonction retourne la variable IODIR: string contenant le repertoire ou aller chercher le fichier a lire _EXTRA: permet de passer les mots cles definits par IDL pour les fonction NETCDF en particulier OFFSET et COUNT ds ncdf_varget OUTPUTS: 1 sauf si var nom de variable auquel cas la fonction retourne la variable REMARQUE:les noms des variables du programme sont similaires a ceux employes ds le manuel IDL scientific data formats MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 4 1 98 function ncdf_lec nom ATT att DIM dim VAR var IODIR iodir _extra ex res 1 if NOT keyword_set IODIR then iodir if not keyword_set att or keyword_set dim or keyword_set var then BEGIN att 1 dim 1 var 1 commande ncdump c iodir nom spawn commande goto fini endif ouverture du fichier nom cdfid ncdf_open iodir nom que contient le fichier wathinside ncdf_inquire cdfid print dans le fichier iodir nom il y a: if keyword_set dim then begin print nombre de dimensions: strtrim wathinside ndims 1 print numero de la dimension dont la valeur est infini: strtrim wathinside recdim 1 endif if keyword_set var then if size var type NE 7 then print nombre de variables : strtrim wathinside nvars 1 if keyword_set att then begin if strlowcase att ne global then goto nonglobal print nombre de attributs globaux : strtrim wathinside ngatts 1 endif attributs globaux if keyword_set att then begin print print ATTRIBUTS GLOBAUX for attiq 0 wathinside ngatts 1 do begin name ncdf_attname cdfid attiq global nom de l atribut ncdf_attget cdfid name value global valeur de l atribut print name : string value endfor endif nonglobal: affichage des differentes dimensions if keyword_set dim then begin print print DIMENSIONS endif nomdim strarr wathinside ndims tailledim lonarr wathinside ndims for dimiq 0 wathinside ndims 1 do begin ncdf_diminq cdfid dimiq name value nom et valeur de la dimension nomdim dimiq name tailledim dimiq value if keyword_set dim then begin print dimension numero strtrim dimiq 1 nom: nomdim dimiq valeur: strtrim tailledim dimiq 1 endif endfor affichage des differentes variables if keyword_set att or keyword_set var then begin vature de var string ou 1 help var output nature if strpos nature STRING 0 NE 1 then nature string ELSE nature 1 si on doit juste lire la variable if nature EQ string then begin ncdf_varget cdfid var res _extra ex GOTO sortie ENDIF si c est pour avoir des renseignements if not keyword_set att then att rien print for varid 0 wathinside nvars 1 do begin varcontent ncdf_varinq cdfid varid que contient la variable if strlowcase att eq strlowcase varcontent name or keyword_set var then begin print variable numero: strtrim varid 1 nom: varcontent name type: varcontent datatype dimensions: nomdim varcontent dim if strlowcase att eq strlowcase varcontent name then begin for attiq 0 varcontent natts 1 do begin name ncdf_attname cdfid varid attiq ncdf_attget cdfid varid name value print strtrim attiq name : strtrim string value 1 endfor goto sortie endif endif endfor endif sortie: ncdf_close cdfid fini: return res end"); 232 a[230] = new Array("./ToBeReviewed/LECTURE/read_ftp.html", "read_ftp.pro", "", " READ_FTP Syntax: READ_FTP remote_host files directory FILE DATA variable USER string PASS string PTR Arguments remote_host Name of the remote host ftp server that you want to connect to or a complete ftp location such as for example: ftp: ftp rsinc com pub gzip README GZIP directory Remote directory where the files reside on the ftp server files A single filename or an array of filenames to be retrieved Keywords FILE Set this keyword to make a local copy of the file to be transferred The local file will have the same name as the remote file and will be placed in the current working directory DATA Set this to a named variable that will contain either a byte array or an array of pointers to byte arrays with the transferred data If there is more than one file an array of pointers is returned one for each file Note that when downloading large files using FILE instead will require much less memory since the entire file is not stored in a variable in that case PTR Set this keyword to return an array of pointers even when there is only one file USER Specify user name to connect to server with Default is: anonymous PASS Specify password to use when connecting Default is: test test com Examples of use 1 Retrieve and print the contents of ftp: ftp rsinc com pub gzip README GZIP: IDL READ_FTP ftp: ftp rsinc com pub gzip README GZIP DATA data IDL help data DATA BYTE Array 2134 IDL print string data README file: Research Systems Anonymous FTP site ftp rsinc com pub directory gzip directory 2 Retrieve some files from podaac jpl nasa gov and store the files in the current working directory: IDL files string lindgen 10 50 format MGB370 3 3d gz IDL READ_FTP podaac jpl nasa gov files IDL pub sea_surface_height topex_poseidon mgdrb data MGB_370 FILE IDL spawn dir MGB log_output Volume in drive C is Local Disk Volume Serial Number is 34CE 24DF Directory of C: test test0307 07 28 2003 11:58a 362 167 MGB370 050 gz 07 28 2003 11:58a 333 005 MGB370 051 gz 07 28 2003 11:58a 310 287 MGB370 052 gz 07 28 2003 11:58a 358 771 MGB370 053 gz 07 28 2003 11:59a 387 282 MGB370 054 gz 07 28 2003 11:59a 361 633 MGB370 055 gz 07 28 2003 11:59a 383 075 MGB370 056 gz 07 28 2003 11:59a 365 844 MGB370 057 gz 07 28 2003 11:59a 383 918 MGB370 058 gz 07 28 2003 12:00p 372 712 MGB370 059 gz 10 File s 3 618 694 bytes These compressed files can cosequently be opened with OPENR and the COMPRESSED keyword pro ftp_post u cmd res out out count count compile_opt idl2 if cmd ne then begin printf u cmd format a comment out the following line to disable debug info print cmd endif if size out type eq 0 then out 2 catch err if err ne 0 then return line count 0 while arg_present res do begin readf u line if count eq 0 then res line else res res line count count 1 comment out the following line to disable debug info print line if strmatch line out then break endwhile end pro ftp_parse_pasv text host port t strtrim text 2 ind where strcmp t 227 3 i ind 0 if i ne 1 then begin sub stregex t i 0 9 extract p strsplit strmid sub 1 strlen sub 2 extract p strtrim p 2 host p 0 p 1 p 2 p 3 port 256 long p 4 long p 5 endif end pro read_ftp site files dir port data data file file user user pass pass ptr ptr compile_opt idl2 if n_elements port eq 0 then port ftp if n_elements files eq 0 then begin if strcmp site ftp: 6 then host strmid site 6 else host site pos strpos host dir strmid host pos host strmid host 0 pos pos strpos dir reverse_search files strmid dir pos 1 dir strmid dir 0 pos endif else host site if size user type eq 0 then user anonymous if size pass type eq 0 then pass test test com socket u host port connect_timeout 5 read_timeout 5 get_lun ftp_post u res ftp_post u USER user res out 3 ftp_post u PASS pass res ftp_post u TYPE I res if size dir type ne 0 then ftp_post u CWD dir res if keyword_set file or arg_present data then begin bufsize 512 buffer bytarr bufsize n n_elements files if arg_present data then dat ptrarr n for i 0 n 1 do begin ftp_post u SIZE files i res out 213 sz long64 strmid res n_elements res 1 4 if arg_present data then dat i ptr_new bytarr sz ftp_post u PASV res ftp_parse_pasv res host port ftp_post u RETR files i res out 1 socket v host port connect_timeout 5 read_timeout 5 get_lun rawio tc 0ll if keyword_set file then openw w files i get_lun while tc lt sz do begin if sz tc lt bufsize then begin bufsize sz tc buffer bytarr bufsize endif readu v buffer transfer_count dtc if arg_present data then dat i tc dtc eq bufsize buffer:buffer 0:dtc 1 if keyword_set file then writeu w dtc eq bufsize buffer:buffer 0:dtc 1 tc tc dtc endwhile free_lun v if keyword_set file then free_lun w ftp_post u res endfor if arg_present data then begin if n gt 1 or keyword_set ptr then data dat else data temporary dat 0 endif endif ftp_post u QUIT res free_lun u end"); 233 a[231] = new Array("./ToBeReviewed/LECTURE/read_ncdf.html", "read_ncdf.pro", "", " NAME: read_ncdf PURPOSE:fonction de lecture pour fichier net_cdf Ce programme est moins universel que ncdf_lec il fait appelle au variables declarees dans common pro mais il est du cop bcp plus facile d utilisation Il prend en compte la declaration des differents zoom qui ont ete definis ixminmesh premierx la declaration de la variable key_shift bref le resultat de read_ncdf peut dorectement etre utilise dans plt C est aussi ce programme qui est utilise par defaut dans mes widgets pour la partie lecture CATEGORY:lecture de fichiers NetCdf CALLING SEQUENCE:res read_ncdf name debut fin INPUTS: name: un string definissant le champ a lire debut et fin: sont relatifs a l axe des temps Ce peut etre 2 dates du type yyyymmdd et ds ce cas on selectionne les dates qui sont comprisent entre ces 2 dates 2 indices qui definissent entre quel et quel pas de temps on doit extraire la dimension temporelle exp: ne sert a rien KEYWORD PARAMETERS: utilisables hors du contexte des widgets BOXZOOM: contient la boxzoom sur laquelle on doit faire la lecture FILENAME: string contennant le nom du fichier INIT to call automatically initncdf filename and thus redefine all the grid parameters GRID UTVWF to specify the type of grid Defaut is 1 based on the name of the file if the file ends by GRID _ TUVFW NC not case sensible or 2 T if case 1 is not found IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir TIMESTEP:activer pour specifier que debut et fin font reference a des indices de l axe du temps et non pas a des dates TOUT: activer si on veut lire le ficher sur l ensemble du domaine sans tenir compte du sous domaine definit par boxzoom ou lon1 lon2 lat1 lat2 vert1 vert2 NOSTRUCT: activer si on ne veut pas que read_ncdf reourne une structure mais uniquement le tableau se rapportant au champ TIMEVAR: a string to define the name of the variable that contains the time axis This keyword can be usefull if there is no unlimited dimension or if the time axis selected by defaut the first 1D array with unlimited dimension is not the good one OUTPUTS:une stucture lisible par litchamp pro ou un simple tableau si NOSTRUCT est active COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS:le champ doit avoir une dimension temporelle EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 10 1999 FUNCTION read_ncdf name debut fin pour_etre_compatible BOXZOOM boxzoom FILENAME filename PARENTIN parentin TIMESTEP timestep TIMEVAR timevar TOUT tout NOSTRUCT nostruct CONT_NOFILL CONT_NOFILL INIT init GRID grid FBASE2TBASE fbase2tbase _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF we find the filename print filename is parent a valid widget if keyword_set parentin then BEGIN parent long parentin parent parent widget_info parent managed ENDIF filename isafile filename filename IODIRECTORY iodir _EXTRA ex ouverture du fichier nom if size filename type NE 7 then return report read_ncdf cancelled IF version OS_FAMILY EQ unix THEN spawn file filename dev null cdfid ncdf_open filename contient ncdf_inquire cdfid we check if the variable name exists in the file if ncdf_varid cdfid name EQ 1 then BEGIN ncdf_close cdfid return report variable name C not found in the file filename ENDIF varcontient ncdf_varinq cdfid name shall we redefine the grid parameters if keyword_set init THEN initncdf filename _extra ex check the time axis and the debut and fin dates if n_elements debut EQ 0 then begin debut 0 timestep 1 endif if keyword_set timestep then begin firsttps debut 0 if n_elements fin NE 0 then lasttps fin 0 ELSE lasttps firsttps jpt lasttps firsttps 1 time julday 1 1 1 lindgen jpt ENDIF ELSE BEGIN if keyword_set parent then BEGIN widget_control parent get_uvalue top_uvalue filelist extractatt top_uvalue filelist IF filelist 0 EQ many THEN filelist filename currentfile where filelist EQ filename 0 time extractatt top_uvalue fileparameters currentfile time_counter date1 date2jul debut 0 if n_elements fin NE 0 then date2 date2jul fin 0 ELSE date2 date1 firsttps where time EQ date1 firsttps firsttps 0 lasttps where time EQ date2 lasttps lasttps 0 ENDIF ELSE BEGIN IF keyword_set timevar THEN BEGIN timeid ncdf_varid cdfid timevar IF timeid EQ 1 THEN BEGIN ncdf_close cdfid return report the file filename as no variable timevar C Use the TIMESTEP keyword endif timecontient ncdf_varinq cdfid timeid contient recdim timecontient dim 0 ENDIF ELSE BEGIN we find the infinite dimension timedim contient recdim if timedim EQ 1 then BEGIN ncdf_close cdfid return report the file filename as no infinite dimension C Use TIMESTEP or TIMEVAR keyword endif we find the FIRST time axis timeid 0 repeat BEGIN tant que l on a pas trouve une variable qui n a qu une dimension: la dimension infinie timecontient ncdf_varinq cdfid timeid que contient la variable timeid timeid 1 endrep until n_elements timecontient dim EQ 1 AND timecontient dim 0 EQ contient recdim OR timeid EQ contient nvars 1 if timeid EQ contient nvars 1 then BEGIN ncdf_close cdfid return report the file filename as no time axis variable C Use the TIMESTEP keyword endif timeid timeid 1 ENDELSE we must found the time origin of the julian calendar used in the time axis does the attribut units an dcalendar exist for the variable time axis if timecontient natts EQ 0 then BEGIN ncdf_close cdfid return report the variable timecontient name has no attribut C Use the TIMESTEP keyword or add the attribut units to the variable endif attnames strarr timecontient natts for attiq 0 timecontient natts 1 do attnames attiq ncdf_attname cdfid timeid attiq if where attnames EQ units 0 EQ 1 then BEGIN ncdf_close cdfid return report Attribut units not found for the variable timecontient name C Use the TIMESTEP keyword ENDIF now we try to find the attribut called calendar the the attribute calendar exists If no we suppose that the calendar is gregorian calendar if where attnames EQ calendar 0 NE 1 then BEGIN ncdf_attget cdfid timeid calendar value value string value CASE value OF noleap :key_caltype noleap 360d :key_caltype 360d greg :IF n_elements key_caltype EQ 0 THEN key_caltype greg ELSE:BEGIN notused report Unknown calendar: value we use greg calendar key_caltype greg END ENDCASE ENDIF ELSE BEGIN notused report Unknown calendar we use key_caltype calendar IF n_elements key_caltype EQ 0 THEN key_caltype greg ENDELSE now we take acre of units attribut ncdf_attget cdfid timeid units value time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 we decript the units attribut to find the time origin value strtrim strcompress string value 2 mots str_sep value unite mots 0 depart str_sep mots 2 ncdf_varget cdfid timeid time time double time unite strlowcase unite IF strpos unite s strlen unite 1 NE 1 THEN unite strmid unite 0 strlen unite 1 IF strpos unite julian_ NE 1 THEN unite strmid unite 7 case unite of second :time julday depart 1 depart 2 depart 0 time 86400 d hour :time julday depart 1 depart 2 depart 0 time 24 d day :time julday depart 1 depart 2 depart 0 time month :BEGIN if total fix time NE time NE 0 then we switch to days with 30d m time julday depart 1 depart 2 depart 0 round time 30 ELSE for t 0 n_elements time 1 DO time t julday depart 1 time t depart 2 depart 0 END year :BEGIN if total fix time NE time NE 0 then we switch to days with 365d y time julday depart 1 depart 2 depart 0 round time 365 ELSE for t 0 n_elements time 1 do time t julday depart 1 depart 2 depart 0 time t END ELSE:BEGIN ncdf_close cdfid return report The units attribu of the time axis must be something like: C seconds since 0001 01 01 C days since 1979 01 01 C months since 1979 01 01 C years since 1979 01 01 end ENDCASE date1 date2jul debut 0 if n_elements fin NE 0 then date2 date2jul fin 0 ELSE date2 date1 time double time firsttps where time GE date1 firsttps firsttps 0 if firsttps EQ 1 THEN BEGIN ncdf_close cdfid return report date 1: strtrim jul2date date1 1 is not found in the time axis ENDIF lasttps where time LE date2 if lasttps 0 EQ 1 THEN BEGIN ncdf_close cdfid return report the time axis as no date before date 2: strtrim jul2date date2 1 endif lasttps lasttps n_elements lasttps 1 if lasttps LT firsttps then BEGIN ncdf_close cdfid return report the time axis as no dates between date1 and date 2: strtrim jul2date date1 1 strtrim jul2date date2 1 endif ENDELSE time time firsttps:lasttps jpt lasttps firsttps 1 ENDELSE nom de la grille a laquelle se rapporte le champ IF keyword_set grid THEN vargrid strupcase grid ELSE BEGIN vargrid T default definition IF finite glamu 0 EQ 1 THEN BEGIN pattern GRID GRID_ GRID UPID_ 30ID_ gdtype T U V W F fnametest strupcase filename FOR i 0 n_elements pattern 1 DO BEGIN FOR j 0 n_elements gdtype 1 DO BEGIN substr pattern i gdtype j pos strpos fnametest substr IF pos NE 1 THEN vargrid strmid fnametest pos strlen substr 1 1 ENDFOR ENDFOR ENDIF ENDELSE call the init function redefinition du domaine if keyword_set tout then begin nx jpi ny jpj nz jpk firstx 0 firsty 0 firstz 0 lastx jpi 1 lasty jpj 1 lastz jpk 1 case strupcase vargrid of T :mask tmask U :mask umask V :mask vmask W :mask tmask F :mask fmask endcase ENDIF ELSE BEGIN if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: BEGIN ncdf_close cdfid return report Wrong Definition of Boxzoom end ENDCASE savedbox 1b saveboxparam boxparam4rdncdf dat domdef bte GRIDTYPE T vargrid _extra ex ENDIF grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz undefine glam undefine gphi on libere un peu de memoire ENDELSE on initialise les ixmindta iymindta au besoin if n_elements jpidta EQ 0 THEN jpidta jpiglo if n_elements jpjdta EQ 0 THEN jpjdta jpjglo if n_elements jpkdta EQ 0 THEN jpkdta jpkglo if n_elements ixmindta EQ 0 THEN ixmindta 0 if n_elements ixmaxdta EQ 0 then ixmaxdta jpidta 1 if ixmindta EQ 1 THEN ixmindta 0 IF ixmaxdta EQ 1 then ixmaxdta jpidta 1 if n_elements iymindta EQ 0 THEN iymindta 0 IF n_elements iymaxdta EQ 0 then iymaxdta jpjdta 1 if iymindta EQ 1 THEN iymindta 0 IF iymaxdta EQ 1 then iymaxdta jpjdta 1 if n_elements izmindta EQ 0 THEN izmindta 0 IF n_elements izmaxdta EQ 0 then izmaxdta jpkdta 1 if izmindta EQ 1 THEN izmindta 0 IF izmaxdta EQ 1 then izmaxdta jpkdta 1 on va lire le fichier if n_elements key_stride LE 2 then key_stride 1 1 1 key_stride 1l long key_stride key_shift long testvar var key_shift IF n_elements key_yreverse EQ 0 THEN key_yreverse 0 IF keyword_set key_yreverse THEN BEGIN tmp jpj 1 firsty firsty jpj 1 lasty lasty tmp ENDIF IF keyword_set fbase2tbase THEN BEGIN case strupcase vargrid of U :BEGIN IF NOT keyword_set key_periodic THEN BEGIN firstx firstx 1 lastx lastx 1 ENDIF END V :BEGIN firsty firsty 1 lasty lasty 1 END F :BEGIN firsty firsty 1 lasty lasty 1 IF NOT keyword_set key_periodic THEN BEGIN firstx firstx 1 lastx lastx 1 ENDIF END ELSE: endcase ENDIF IF keyword_set fbase2tbase AND keyword_set key_periodic AND strupcase vargrid EQ U OR strupcase vargrid EQ F THEN key_shift key_shift 1 read_ncdf_varget IF keyword_set fbase2tbase AND keyword_set key_periodic AND strupcase vargrid EQ U OR strupcase vargrid EQ F THEN key_shift key_shift 1 on definit les variables globales rattachees a la variable varname varname name varunit if varcontient natts NE 0 then begin attnames strarr varcontient natts for attiq 0 varcontient natts 1 do attnames attiq ncdf_attname cdfid name attiq lowattnames strlowcase attnames found where lowattnames EQ units 0 IF found NE 1 then ncdf_attget cdfid name attnames found value ELSE value varunit strtrim string value 2 found where lowattnames EQ add_offset 0 if found NE 1 then ncdf_attget cdfid name attnames found add_offset ELSE add_offset 0 found where lowattnames EQ scale_factor 0 if found NE 1 then ncdf_attget cdfid name attnames found scale_factor ELSE scale_factor 1 missing_value no found where lowattnames EQ _fillvalue 0 if found NE 1 then ncdf_attget cdfid name attnames found missing_value found where lowattnames EQ missing_value 0 if found NE 1 then ncdf_attget cdfid name attnames found missing_value ENDIF ELSE BEGIN varunit add_offset 0 scale_factor 1 missing_value no ENDELSE vardate on construit une belle date lisible en fonction du langage specifie year long debut 0 10000 month long debut 0 100 MOD 100 day long debut 0 MOD 100 vardate string format C CMoA 31 month 1 strtrim day 1 strtrim year 1 varexp file_basename filename we apply reverse if keyword_set key_yreverse then res reverse temporary res 2 if keyword_set key_zreverse AND size res 0 EQ 3 AND jpt EQ 1 then res reverse temporary res 3 if keyword_set key_zreverse AND size res 0 EQ 4 THEN res reverse temporary res 3 on applique la valeur valmask sur les points terre if NOT keyword_set cont_nofill then begin valmask 1e20 case 1 of varcontient ndims eq 2:BEGIN xy array mask mask 0 earth where mask EQ 0 END varcontient ndims eq 3 AND where varcontient dim EQ contient recdim 0 EQ 1:BEGIN xyz array earth where mask EQ 0 END varcontient ndims eq 3 AND where varcontient dim EQ contient recdim 0 NE 1:BEGIN xyt array mask mask 0 earth where mask EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate nx ny n_elements earth lindgen jpt END END varcontient ndims eq 4:BEGIN xyzt array earth where mask EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate nx ny nz n_elements earth lindgen jpt END END endcase ENDIF ELSE earth 1 we look for missing_value IF size missing_value type NE 7 then BEGIN IF size missing_value type EQ 1 THEN BEGIN IF isnumber string missing_value tmp EQ 1 THEN missing_value tmp ENDIF if missing_value NE valmask then begin if abs missing_value LT 1e6 then missing where res EQ missing_value ELSE missing where abs res gt abs missing_value 10 ENDIF ELSE missing 1 ENDIF ELSE missing 1 on applique les add_offset scale_factor et missing_value if scale_factor NE 1 then res temporary res scale_factor if add_offset NE 0 then res temporary res add_offset if missing 0 NE 1 then res temporary missing values f_nan if earth 0 NE 1 then res temporary earth 1e20 ncdf_close cdfid if keyword_set savedbox THEN restoreboxparam boxparam4rdncdf dat if keyword_set nostruct then return res ELSE BEGIN IF keyword_set key_forgetold THEN BEGIN return arr:res grid:vargrid unit:varunit experiment:varexp name:varname ENDIF ELSE BEGIN return tab:res grille:vargrid unite:varunit experience:varexp nom:varname ENDELSE ENDELSE END "); 234 a[232] = new Array("./ToBeReviewed/LECTURE/read_ncdf_varget.html", "read_ncdf_varget.pro", "", ""); 235 a[233] = new Array("./ToBeReviewed/LECTURE/xncdf_lec.html", "xncdf_lec.pro", "", " La lecture de ce programme se fait de bas en haut: 1 xncdf_lec 2 xncdf_lec_event 3 wid_var wid_var_event pro wid_var_event event NAME:wid_var_event PURPOSE:procedure appele par xmanager qd on appuie sur un bouton du 2eme widget cree par wid_var INPUTS: event une structure caracterisant le type d evenement qui arrive au widget numero1 2 COMMON BLOCKS:wididbase resultat infovariable indicewid motcle COMMON wididbase base COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON indicewid_var widbase1 widbase2111 widbase212 widbase213 selectatt COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar quel est le type d evenement widget_control event id get_uvalue uval tailledimvar tailledim varcontient dim if n_elements uval EQ 0 then return case sur le type d evenement case uval OF 1:BEGIN on change des valeurs dans le tableau on controle que les valeurs mises dans le tableau ne sont pas completement fausses widget_control widbase1 get_value table agument du bon type si le type est mauvais on change automatiquement par des valeurs par defaut if event x GT size table 1 then return if event y GT size table 2 then return if size table event x event y type GE 6 OR size table event x event y type EQ 0 then BEGIN if event x EQ 1 then widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y ELSE widget_control widbase1 use_table_select event x event y event x event y set_value 0 endif agument avec une valeur nom debile table fix table case event x of 0:BEGIN on a touche a l offset: if table 0 event y LT 0 then BEGIN table 0 event y 0 widget_control widbase1 use_table_select 0 event y 0 event y set_value 0 endif si il depasse la dim du tableau on le met au max et le cont a 1 if table 0 event y GT tailledimvar event y table 3 event y then begin widget_control widbase1 use_table_select 0 event y 1 event y set_value tailledimvar event y table 3 event y 1 ENDIF ELSE BEGIN si avec le nouvel offset le count est trop grand on le diminue juste de ce qu il faut if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then begin widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif ENDELSE END 1:BEGIN on a touche au count if table 1 event y LT 1 then BEGIN table 1 event y 1 widget_control widbase1 use_table_select 1 event y 1 event y set_value 1 endif si il est trop grand on le diminue juste de ce qu il faut if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then BEGIN widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif END 2:BEGIN on a touche au shift widget_control widbase1 use_table_select 2 event y 2 event y set_value table 2 event y MOD tailledimvar event y table 3 event y END 3:BEGIN on touche au stride if table 3 event y LT 1 then BEGIN table 3 event y 1 widget_control widbase1 use_table_select 3 event y 3 event y set_value 1 endif if table 3 event y EQ 0 then il ne doit pas etre nul widget_control widbase1 use_table_select 3 event y 3 event y set_value 1 il ne doit pas etre trop grand if table 3 event y GT tailledimvar event y then widget_control widbase1 use_table_select 0 event y 3 event y set_value 0 1 0 tailledimvar event y ELSE BEGIN if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then begin widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif ENDELSE END ELSE: endcase END 2111:BEGIN on a touche aux boutons oui non on actualise le vecteur selectatt a 0 ou 1 pour l attribut concerne numero event id selectatt where widbase2111 EQ event id event select end 31:BEGIN on a appuye sur get widget_control widbase1 get_value table table fix table mcshift where table 2 NE 0 mcoffset table 0 mccount table 1 mcstride table 3 if mcshift 0 NE 1 then BEGIN il y a des shifts on lit l integralite des dimensions pour lesquelles il y a un shift mcoffset mcshift 0 mccount mcshift tailledimvar mcshift on active pas stride qd il n y en a pas besoin car ca fait ecrire a l ecran qqch de louche if total mcstride EQ n_elements mcstride then ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount ELSE ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount STRIDE mcstride pour faire le shift mcshift table 2 mcoffset table 0 mccount table 1 on definit commende qui permet de faire un shift commande res shift res for dim 0 varcontient ndims 1 do commande commande string table 2 dim commande commande rien execute commande on redefinit commnade qui permet de couper les dimensions qui n ont pas ete encore coupees c est celles que l on shift commande res res initialisation de la commende for dim 0 varcontient ndims 1 do BEGIN if mcshift dim EQ 0 then commande commande ELSE commande commande string mcoffset dim : string mccount dim mcoffset dim 1 ENDFOR commande strmid commande 0 strlen commande 1 rien execute commande cas sans shift on lit directement le bon bout de tableau ENDIF ELSE BEGIN if total mcstride EQ n_elements mcstride then ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount ELSE ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount STRIDE mcstride ENDELSE faut il constituer une structure avec les attributs qui on ete selectionnes if total selectatt NE 0 then BEGIN il y a des attributs selectionnes res create_struct varcontient name res on cree la structure selectatt where selectatt EQ 1 on trouve les attributs selectiones for attid 0 n_elements selectatt 1 do BEGIN pour lesquels on prend widget_control widbase212 selectatt attid get_value attname le nom widget_control widbase213 selectatt attid get_value attvalue la valeur res create_struct res attname 0 attvalue 0 on concatene la structe endfor endif widget_control event top destroy on ferme le 2eme widget widget_control base destroy on ferme le 1eme widget ncdf_close cdfid END 32: cas de l affichage d un held avec xdisplayfile 33:widget_control event top destroy on ferme le 2eme widget ELSE: endcase return end PRO wid_var widid_pere NAME: wid_var PURPOSE: cette procedure gere le 2eme widget cree qd on appelle xncdf_lec ce widget concerne la lecture de la variable INPUTS: widid_pere: un scalere contenant l identite du widget pere qui a etait cree par xncdf_lec et qui a permis de selectionner la variable a lire OUTPUTS: indirectement res le tableau ou la structure resultat COMMON BLOCKS:resultat infovariable indicewid_var motcle COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON indicewid_var widbase1 widbase2111 widbase212 widbase213 selectatt COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar res 1 ouverture de la fenetre de base sous forme de colonnes widbase widget_base column title variable: varcontient name align_center group_leader widid_pere ouverture de sous fenetres de base widbase1 tableau des offsets rien widget_label widbase value on saute une ligne defintion des lables des lignes du tableau rowlab string tailledim varcontient dim for i 0 n_elements rowlab 1 do rowlab i strtrim rowlab i 1 rowlab nomdim varcontient dim replicate : n_elements varcontient dim rowlab definition des valeurs initiales du tableau valinit lonarr 4 n_elements varcontient dim colonne 0 : les offset if keyword_set mcoffset AND n_elements mcoffset EQ varcontient ndims THEN valinit 0 mcoffset ELSE valinit 0 0 colonne 1 : les counts if keyword_set mccount AND n_elements mccount EQ varcontient ndims THEN valinit 1 mccount ELSE valinit 1 tailledim varcontient dim colonne 2 : les shifts if keyword_set mcshift AND n_elements mcshift EQ varcontient ndims THEN valinit 2 mcshift ELSE valinit 2 0 colonne 3 : les strides if keyword_set mcstride AND n_elements mcstride EQ varcontient ndims THEN valinit 3 mcstride ELSE valinit 3 1 test des valeurs initiales du tableau valinit fix valinit valinit 3 1 valinit 3 valinit 0 valinit 1 tailledim varcontient dim valinit 3 valinit 0 valinit 2 valinit 2 MOD tailledim varcontient dim valinit 3 test des shifts declaration du tableau widbase1 widget_table widbase row_labels rowlab value valinit editable column_labels Offset Count Shift Stride uvalue 1 un petit blabla rien widget_label widbase value ATTENTION: Faire des return pour que les valeurs align_center rien widget_label widbase value du tableau ou des textes soient bien prises en compte align_center widbase2 choix des attributs rien widget_label widbase value on saute une ligne widbase2 widget_base widbase column pour chaque attribut on cree un widget widbase21 qui contient en ligne un bouton oui non widbase211 et deux wigdet text widbase212 widbase213 comportant le nom et la valeur de l attribut widbase21 lonarr varcontient natts widbase211 lonarr varcontient natts widbase2111 lonarr varcontient natts vecteur qui serviera a savoir quels boutons oui non sont selectiones cf wid_var_event selectatt lonarr varcontient natts selectatt 0 widbase212 lonarr varcontient natts widbase213 lonarr varcontient natts for attid 0 varcontient natts 1 do BEGIN boucle sur le nombre d attributs widbase21 attid widget_base widbase2 row name ncdf_attname cdfid varid attid ncdf_attget cdfid varid name value widbase211 attid widget_base widbase21 attid nonexclusive widbase2111 attid widget_button widbase211 attid value uvalue 2111 widbase212 attid widget_text widbase21 attid value name editable widbase213 attid widget_text widbase21 attid value strtrim string value 1 editable endfor widbase3 boutons du bas widbase3 widget_base widbase row align_center widbase31 widget_button widbase3 value GET uvalue 31 widbase32 widget_button widbase3 value Help uvalue 32 widbase33 widget_button widbase3 value DONE uvalue 33 execution de la fentre de base et des sous fenetres widget_control widbase realize xmanager wid_var widbase return end PRO xncdf_lec_event event NAME:xncdf_lec_event PURPOSE: procedure appele par xmanager qd on appuie sur un bouton du 1ere widget cree par xncdf_lec INPUTS: event une structure caracterisant le type d evenement qui arrive au widget numero1 COMMON BLOCKS:resultat infovariable motcle COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar quel est le type d evenement widget_control event id get_uvalue uval case sur le type d evenement case uval of 1:BEGIN on veut lire un autre fichier widget_control event id get_value nom on recupere le nom widget_control event top destroy on ferme le widget ncdf_close cdfid on ferme le mauvais fichier qui a ete ouvert on reapelle xncdf_lec res xncdf_lec nom 0 ATT mcatt COUNT mccount OFFSET mcoffset IODIR mciodir SHIFT mcshift STRIDE mcstride VAR mcvar return END 2:BEGIN une variable est selectionee varid event index on recupere son numero ds le fichier Netcdf varcontient ncdf_varinq cdfid varid wid_var event top on appelle le programme qui lance le 2eme widget cf haut END 3:BEGIN bouton done widget_control event top destroy on tue le widget ncdf_close cdfid on ferme le fichier END ELSE: endcase return end NAME: xncdf_lec PURPOSE: lecture d un fichier Net Cdf avec des widgets CATEGORY: lecture de fichiers avec widgets CALLING SEQUENCE: res xncdf_lec nom_fichier INPUTS: OPTIONNEL nom_fichier: c est un string qui donne le nom du fichier a ouvrir Si nomfichier ne contient pas le caractere separateur de repertoirte sous unix par ex Le fichier sera cherche ds le repertoire courant KEYWORD PARAMETERS: IODIR: string contenant le repertoire ou aller chercher le fichier a lire Si nomfichier ne contient pas le caractere separateur de repertoirte sous unix par ex Le fichier cherche s appelera iodir nom_fichier COUNT: An optional vector containing the counts to be used in reading Value COUNT is a 1 based vector with an element for each dimension of the data to be written The default matches the size of the variable so that all data is written out GROUP: The widget ID of the widget that calls XNCDF_LEC When this ID is specified a death of the caller results in a death of XNCDF_LEC OFFSET: An optional vector containing the starting position for the read The default start position is 0 0 SHIFT: un vecteur d entiers specifiant pour chaque dimension de combien il faut la shifter Par defaut c est 0 0 cf la fonction shift pour d explications ATTENTION le shift est effectue sur le tableau de taille maximum avant la reduction eventuelle determinee par OFFSET et COUNT Par contre il est effectue apres l extraction eventuelle cree par le STRIDE STRIDE: An optional vector containing the strides or sampling intervals between accessed values of the netCDF variable The default stride vector is that for a contiguous read 1 1 OUTPUTS: 2 cas possibles: 1 aucun attributs n a ete selectionne Dans ce cas res est le tableau que l on voulait lire 2 Des attributs ont ete selectionnes Dans ce cas res est une structre dont le premier element portant le nom de la variable est le tableau de valeurs et les autre auguments sont les arguments selectiones COMMON BLOCKS: wididbase infovariable resultat motcle SIDE EFFECTS: RESTRICTIONS: EXAMPLE: help xncdf_lec MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 24 8 1999 FUNCTION xncdf_lec nom ATT att COUNT count GROUP group OFFSET offset IODIR iodir SHIFT shift STRIDE stride VAR var COMMON wididbase base COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON resultat res COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar bidouille pour utiliser les mots cles on passe par des variables declarees ds un common res 1 if keyword_set att then mcatt att ELSE mcatt 0 if keyword_set count then mccount count ELSE mccount 0 if keyword_set offset then mcoffset offset ELSE mcoffset 0 if keyword_set shift then mcshift shift ELSE mcshift 0 if keyword_set stride then mcstride stride ELSE mcstride 0 if keyword_set var then mcvar var ELSE mcvar 0 choix du nom du fichier Quel type de machine est utiliee thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :sep : WIN :sep ELSE: sep ENDCASE si iodir n est pas definit on l initialise au repertoire courant if NOT keyword_set iodir then cd current iodir mciodir iodir on complete iodir d un caractere separateur de repertoire si besoin est IF rstrpos iodir sep NE strlen iodir 1 THEN iodir iodir sep if n_elements nom EQ 0 then BEGIN si nom n est pas definit on en trouve un grace au programme dialog_pickfile nom dialog_pickfile filter iodir nc if nom 0 EQ then return 1 si on a rien trouve on sort on complete nom par iodir si nom ne contient pas de caractere separateur derepertoire ENDIF ELSE if strpos nom sep EQ 1 then nom iodir nom test findfile nom le nom cherche correspond bien a un fichier while test 0 EQ OR n_elements test GT 1 do BEGIN on en cherche un tant qu il ne correspond a rien test test 0 nom dialog_pickfile filter iodir nc if nom EQ then return 1 test findfile nom endwhile ouverture du fichier nom cdfid ncdf_open nom contient ncdf_inquire cdfid que contient le fichier ouverture de la fenetre de base sous forme de colonnes if n_elements group EQ 0 then base widget_base column title Fichier: nom align_left ELSE base widget_base column title Fichier: nom align_left GROUP_LEADER group ouverture de sous fenetres de base base 1 titre portant le nom du fichier base1 widget_base base column align_center rien widget_label base1 value Net Cdf filename align_center blabla rien widget_text base1 value nom align_center uvalue 1 editable nom du fichier que l on peut changer rien widget_label base1 value on saute une ligne base 2 informations generales sur le fichier base2 widget_base base column informations sur les attributs globaux if contient ngatts NE 1 then begin rien widget_label base2 value Nombre de attributs globaux: strtrim contient ngatts 1 align_left for attiq 0 contient ngatts 1 do BEGIN bouble sur le nombre d attributs globaux name ncdf_attname cdfid attiq global nom de l atribut ncdf_attget cdfid name value global valeur de l atribut rien widget_text base2 value name : strtrim string value 1 xsize 60 scroll wrap align_right endfor rien widget_label base2 value endif informations sur les dimensions rien widget_label base2 value Nombre de dimensions: strtrim contient ndims 1 align_left if contient recdim NE 1 then begin bouble sur le nombre de dimensions ncdf_diminq cdfid contient recdim name value nom et valeur de la dimension rien widget_label base2 value nom de la dimension infinie: name align_left endif nomdim strarr contient ndims vecteur contenant le nom des dimensions tailledim lonarr contient ndims vecteur contenant la valeur des dimensions for dimiq 0 contient ndims 1 do begin bouble sur le nombre de dimensions ncdf_diminq cdfid dimiq name value nom et valeur de la dimension nomdim dimiq name tailledim dimiq value rien widget_label base2 value name de taille: strtrim value 1 align_right ENDFOR rien widget_label base2 value on saute une ligne base 3 choix de la variable base3 widget_base base column rien widget_label base3 value Nombre de variables: strtrim contient nvars 1 align_left base31 widget_base base3 row align_center creation d un vecteur listename contenant le nom de toutes les variables du fichier listename strarr contient nvars for varid 0 contient nvars 1 do begin varcontient ncdf_varinq cdfid varid que contient la variable listename varid varcontient name endfor rien widget_label base31 value variable creation d un bouton a menu deroulant base311 widget_droplist base31 value listename uvalue 2 rien widget_label base3 value base 4 bouton done base4 widget_base base row base42 widget_button base4 value done uvalue 3 align_right execution de la fentre de base et des sous fenetres widget_control base realize xmanager xncdf_lec base return res end"); 236 a[234] = new Array("./ToBeReviewed/MATRICE/cmapply.html", "cmapply.pro", "", " NAME: CMAPPLY AUTHOR: Craig B Markwardt NASA GSFC Code 662 Greenbelt MD 20770 craigm lheamail gsfc nasa gov PURPOSE: Applies a function to specified dimensions of an array MAJOR TOPICS: Arrays CALLING SEQUENCE: XX CMAPPLY OP ARRAY DIMS DOUBLE TYPE TYPE DESCRIPTION: CMAPPLY will apply one of a few select functions to specified dimensions of an array Unlike some IDL functions you do have a choice of which dimensions that are to be collapsed by this function Iterative loops are avoided where possible for performance reasons The possible functions are: and number of loop iterations: Performs a sum as in TOTAL number of collapsed dimensions AND Finds LOGICAL AND not bitwise same OR Finds LOGICAL OR not bitwise same Performs a product LOG_2 no of collapsed elts MIN Finds the minimum value smaller of no of collapsed MAX Finds the maximum value or output elements USER Applies user defined function no of output elements It is possible to perform user defined operations arrays using CMAPPLY The OP parameter is set to USER:FUNCTNAME where FUNCTNAME is the name of a user defined function The user defined function should be defined such that it accepts a single parameter a vector and returns a single scalar value Here is a prototype for the function definition: FUNCTION FUNCTNAME x KEYWORD1 key1 scalar function of x or keywords RETURN scalar END The function may accept keywords Keyword values are passed in to CMAPPLY through the FUNCTARGS keywords parameter and passed to the user function via the _EXTRA mechanism Thus while the definition of the user function is highly constrained in the number of positional parameters there is absolute freedom in passing keyword parameters It s worth noting however that the implementation of user defined functions is not particularly optimized for speed Users are encouraged to implement their own array if the number of output elements is large INPUTS: OP The operation to perform as a string May be upper or lower case If a user defined operation is to be passed then OP is of the form USER:FUNCTNAME where FUNCTNAME is the name of the user defined function ARRAY An array of values to be operated on Must not be of type STRING 7 or STRUCTURE 8 OPTIONAL INPUTS: DIMS An array of dimensions that are to be collapsed where the the first dimension starts with 1 ie same convention as IDL function TOTAL Whereas TOTAL only allows one dimension to be added you can specify multiple dimensions to CMAPPLY Order does not matter since all operations are associative and transitive NOTE: the dimensions refer to the input array not the output array IDL allows a maximum of 8 dimensions DEFAULT: 1 ie first dimension KEYWORDS: DOUBLE Set this if you wish the internal computations to be done in double precision if necessary If ARRAY is double precision real or complex then DOUBLE 1 is implied DEFAULT: not set TYPE Set this to the IDL code of the desired output type refer to documentation of SIZE Internal results will be rounded to the nearest integer if the output type is an integer type DEFAULT: same is input type FUNCTARGS If OP is USER: then the contents of this keyword are passed to the user function using the _EXTRA mechanism This way you can pass additional data to your user supplied function via keywords without using common blocks DEFAULT: undefined i e no keywords passed by _EXTRA RETURN VALUE: An array of the required TYPE whose elements are the result of the requested operation Depending on the operation and number of elements in the input array the result may be vulnerable to overflow or underflow EXAMPLES: Shows how CMAPPLY can be used to total the second dimension of the array called IN This is equivalent to OUT TOTAL IN 2 IDL IN INDGEN 5 5 IDL OUT CMAPPLY IN 2 IDL HELP OUT OUT INT Array 5 Second example Input is assumed to be an 5x100 array of 1 s and 0 s indicating the status of 5 detectors at 100 points in time The desired output is an array of 100 values indicating whether all 5 detectors are on 1 at one time Use the logical AND operation IDL IN detector_status 5x100 array IDL OUT CMAPPLY AND IN 1 collapses 1st dimension IDL HELP OUT OUT BYTE Array 100 note that MIN could also have been used in this particular case although there would have been more loop iterations Third example Shows sum over first and third dimensions in an array with dimensions 4x4x4: IDL IN INDGEN 4 4 4 IDL OUT CMAPPLY IN 1 3 IDL PRINT OUT 408 472 536 600 Fourth example A user function MEDIAN is used: IDL IN RANDOMN SEED 10 10 5 IDL OUT CMAPPLY USER:MEDIAN IN 3 IDL HELP OUT OUT FLOAT Array 10 10 OUT i j is the median value of IN i j MODIFICATION HISTORY: Mar 1998 Written CM Changed usage message to not bomb 24 Mar 2000 CM Signficant rewrite for MIN and MAX inspired by Todd Clements FOR loop indices are now type LONG copying terms are liberalized CM 22 Aug 2000 More efficient MAX MIN inspired by Alex Schuster CM 25 Jan 2002 Make new MAX MIN actually work with 3d arrays CM 08 Feb 2002 Add user defined functions ON_ERROR CM 09 Feb 2002 Correct bug in MAX MIN initialization of RESULT CM 05 Dec 2002 Id: cmapply pro 31 2006 05 02 13:54:11Z pinsard Copyright C 1998 2000 2002 Craig Markwardt This software is provided as is without any warranty whatsoever Permission to use copy modify and distribute modified or unmodified copies is granted provided this copyright and disclaimer are included unchanged Utility function adapted from CMPRODUCT function cmapply_product x sz size x n sz 1 while n GT 1 do begin if n mod 2 EQ 1 then x 0 x 0 x n 1 n2 floor n 2 x x 0:n2 1 x n2: n n2 endwhile return reform x 0 overwrite end Utility function used to collect collaped dimensions pro cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep sz size newarr First task: rearrange dimensions so that the dimensions that are kept ie uncollapsed are at the back dimkeep where histogram dimapply min 1 max sz 0 ne 1 nkeep if nkeep EQ 0 then return newarr transpose temporary newarr dimapply 1 dimkeep totcol is the total number of collapsed elements totcol sz dimapply 0 for i 1 n_elements dimapply 1 do totcol totcol sz dimapply i totkeep sz dimkeep 0 1 for i 1 n_elements dimkeep 1 do totkeep totkeep sz dimkeep i 1 this new array has two dimensions: the first all elements that will be collapsed the second all dimensions that will be preserved the ordering is so that all elements to be collapsed are adjacent in memory newarr reform newarr totcol totkeep overwrite end Main function function cmapply op array dimapply double dbl type type functargs functargs nocatch nocatch if n_params LT 2 then begin message USAGE: XX CMAPPLY OP ARRAY 2 info message where OP is AND OR MIN MAX info return 1L endif if NOT keyword_set nocatch then on_error 2 else on_error 0 Parameter checking 1 the dimensions of the array sz size array if sz 0 EQ 0 then message ERROR: ARRAY must be an array 2 The type of the array if sz sz 0 1 EQ 0 OR sz sz 0 1 EQ 7 OR sz sz 0 1 EQ 8 then message ERROR: Cannot apply to UNDEFINED STRING or STRUCTURE if n_elements type EQ 0 then type sz sz 0 1 3 The type of the operation szop size op if szop szop 0 1 NE 7 then message ERROR: operation OP was not a string 4 The dimensions to apply default is to apply to first dim if n_params EQ 2 then dimapply 1 dimapply dimapply dimapply dimapply sort dimapply Sort in ascending order napply n_elements dimapply 5 Use double precision if requested or if needed if n_elements dbl EQ 0 then begin dbl 0 if type EQ 5 OR type EQ 9 then dbl 1 endif newop strupcase op newarr array newarr reform newarr sz 1:sz 0 overwrite case 1 of Addition newop EQ : begin for i 0L napply 1 do begin newarr total temporary newarr dimapply i i double dbl endfor end Multiplication newop EQ : begin Multiplication by summation of logarithms cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin newarr reform newarr n_elements newarr 1 overwrite return cmapply_product newarr 0 endif result cmapply_product newarr result reform result sz dimkeep 1 overwrite return result end LOGICAL AND or OR newop EQ AND OR newop EQ OR : begin newarr temporary newarr NE 0 totelt 1L for i 0L napply 1 do begin newarr total temporary newarr dimapply i i totelt totelt sz dimapply i endfor if newop EQ AND then return round newarr EQ totelt if newop EQ OR then return round newarr NE 0 end Operations requiring a little more attention over how to iterate newop EQ MAX OR newop EQ MIN : begin cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin if newop EQ MAX then return max newarr if newop EQ MIN then return min newarr endif Next task: create result array result make_array totkeep type type Now either iterate over the number of output elements or the number of collapsed elements whichever is smaller if totcol LT totkeep then begin Iterate over the number of collapsed elements result 0 reform newarr 0 totkeep overwrite case newop of MAX : for i 1L totcol 1 do result 0 result newarr i MIN : for i 1L totcol 1 do result 0 result newarr i endcase endif else begin Iterate over the number of output elements case newop of MAX : for i 0L totkeep 1 do result i max newarr i MIN : for i 0L totkeep 1 do result i min newarr i endcase endelse result reform result sz dimkeep 1 overwrite return result end User function strmid newop 0 4 EQ USER : begin functname strmid newop 5 if functname EQ then message ERROR: newop is not a valid operation cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin if n_elements functargs GT 0 then return call_function functname newarr _EXTRA functargs return call_function functname newarr endif Next task: create result array result make_array totkeep type type Iterate over the number of output elements if n_elements functargs GT 0 then begin for i 0L totkeep 1 do result i call_function functname newarr i _EXTRA functargs endif else begin for i 0L totkeep 1 do result i call_function functname newarr i endelse result reform result sz dimkeep 1 overwrite return result end endcase newsz size newarr if type EQ newsz newsz 0 1 then return newarr Cast the result into the desired type if necessary castfns UNDEF BYTE FIX LONG FLOAT DOUBLE COMPLEX UNDEF UNDEF DCOMPLEX if type GE 1 AND type LE 3 then return call_function castfns type round newarr else return call_function castfns type newarr end "); 237 a[235] = new Array("./ToBeReviewed/MATRICE/cmset_op.html", "cmset_op.pro", "", " NAME: CMSET_OP AUTHOR: Craig B Markwardt NASA GSFC Code 662 Greenbelt MD 20770 craigm lheamail gsfc nasa gov PURPOSE: Performs an AND OR or XOR operation between two sets CALLING SEQUENCE: SET CMSET_OP A OP B DESCRIPTION: SET_OP performs three common operations between two sets The three supported functions of OP are: OP Meaning AND to find the intersection of A and B OR to find the union of A and B XOR to find the those elements who are members of A or B but not both Sets as defined here are one dimensional arrays composed of numeric or string types Comparisons of equality between elements are done using the IDL EQ operator The complements of either set can be taken as well by using the NOT1 and NOT2 keywords For example it may be desireable to find the elements in A but not B or B but not A they are different The following IDL expressions achieve each of those effects: SET CMSET_OP A AND NOT2 B A but not B SET CMSET_OP NOT1 A AND B B but not A Note the distinction between NOT1 and NOT2 NOT1 refers to the first set A and NOT2 refers to the second B Their ordered placement in the calling sequence is entirely optional but the above ordering makes the logical meaning explicit NOT1 and NOT2 can only be set for the AND operator and never simultaneously This is because the results of an operation with OR or XOR and any combination of NOTs or with AND and both NOTs formally cannot produce a defined result The implementation depends on the type of operands For integer types a fast technique using HISTOGRAM is used However this algorithm becomes inefficient when the dynamic range in the data is large For those cases and for other data types a technique based on SORT is used Thus the compute time should scale roughly as A B ALOG A B or better rather than A B for the brute force approach For large arrays this is a significant benefit INPUTS: A B the two sets to be operated on A one dimensional array of either numeric or string type A and B must be of the same type Empty sets are permitted and are either represented as an undefined variable or by setting EMPTY1 or EMPTY2 OP a string the operation to be performed Must be one of AND OR or XOR lower or mixed case is permitted Other operations will cause an error message to be produced KEYWORDS: NOT1 NOT2 if set and OP is AND then the complement of A for NOT1 or B for NOT2 will be used in the operation NOT1 and NOT2 cannot be set simultaneously EMPTY1 EMPTY2 if set then A for EMPTY1 or B for EMPTY2 are assumed to be the empty set The actual values passed as A or B are then ignored INDEX if set then return a list of indices instead of the array values themselves The slower set operations are always performed in this case The indices refer to the combined array A B To clarify in the following call: I CMSET_OP INDEX returned values from 0 to NA 1 refer to A I and values from NA to NA NB 1 refer to B I NA COUNT upon return the number of elements in the result set This is only important when the result set is the empty set in which case COUNT is set to zero RETURNS: The resulting set as a one dimensional array The set may be represented by either an array of data values default or an array of indices if INDEX is set Duplicate elements if any are removed and element order may not be preserved The empty set is represented as a return value of 1L and COUNT is set to zero Note that the only way to recognize the empty set is to examine COUNT SEE ALSO: SET_UTILS PRO by RSI MODIFICATION HISTORY: Written CM 23 Feb 2000 Added empty set capability CM 25 Feb 2000 Documentation clarification CM 02 Mar 2000 Incompatible but more consistent reworking of EMPTY keywords CM 04 Mar 2000 Minor documentation clarifications CM 26 Mar 2000 Corrected bug in empty_arg special case CM 06 Apr 2000 Add INDEX keyword CM 31 Jul 2000 Clarify INDEX keyword documentation CM 06 Sep 2000 Made INDEX keyword always force SLOW_SET_OP CM 06 Sep 2000 Added CMSET_OP_UNIQ and ability to select FIRST_UNIQUE or LAST_UNIQUE values CM 18 Sep 2000 Removed FIRST_UNIQUE and LAST_UNIQUE and streamlined CMSET_OP_UNIQ until problems with SORT can be understood CM 20 Sep 2000 thanks to Ben Tupper Still trying to get documentation of INDEX and NOT right CM 28 Sep 2000 no code changes Correct bug for AND case when input sets A and B each only have one unique value and the values are equal CM 04 Mar 2004 thanks to James B jbattat at cfa dot harvard dot edu Add support for the cases where the input data types are mixed but still compatible also attempt to return the same data type that was passed in CM 05 Feb 2005 Fix bug in type checking thanks to marit CM 10 Dec 2005 Work around a stupidity in the built in IDL HISTOGRAM routine which tries to help you by restricting the MIN MAX to the range of the input variable thanks to Will Maddox CM 16 Jan 2006 Id: cmset_op pro v 1 6 2006 01 16 19:45:22 craigm Exp Copyright C 2000 2004 2005 2006 Craig Markwardt This software is provided as is without any warranty whatsoever Permission to use copy modify and distribute modified or unmodified copies is granted provided this copyright and disclaimer are included unchanged Utility function similar to UNIQ but allowing choice of taking first or last unique element or non unique elements Unfortunately this doesn t work because of implementation dependent versions of the SORT function function cmset_op_uniq a first first non non count ct sort sortit if n_elements a LE 1 then return 0L sh 2L keyword_set first 1L 2L keyword_set non 1 if keyword_set sortit then begin Sort it manually ii sort a b a ii if keyword_set non then wh where b EQ shift b sh ct else wh where b NE shift b sh ct if ct GT 0 then return ii wh endif else begin Use the user s values directly if keyword_set non then wh where a EQ shift a sh ct else wh where a NE shift a sh ct if ct GT 0 then return wh endelse if keyword_set first then return 0L else return n_elements a 1 end Simplified version of CMSET_OP_UNIQ which sorts and takes the first value whatever that may mean function cmset_op_uniq a if n_elements a LE 1 then return 0L ii sort a b a ii wh where b NE shift b 1L ct if ct GT 0 then return ii wh return 0L end function cmset_op a op0 b not1 not1 not2 not2 count count empty1 empty1 empty2 empty2 maxarray ma index index on_error 2 return on error count 0L index0 1L Histogram technique is used for array sizes max2 nbins maxx minn 1 if maxx minn GT floor ma 0 then goto SLOW_SET_OP Work around a stupidity in the built in IDL HISTOGRAM routine if tp1 EQ 2 OR tp2 EQ 2 AND minn LT 32768 OR maxx GT 32767 then goto SLOW_SET_OP Following operations create a histogram of the integer values ha histogram a min minn max maxx 1 hb histogram b min minn max maxx 1 Compute NOT cases if keyword_set not1 then ha 1b ha if keyword_set not2 then hb 1b hb case op of Boolean operations AND : mask temporary ha AND temporary hb OR : mask temporary ha OR temporary hb XOR : mask temporary ha XOR temporary hb endcase wh where temporary mask count if count EQ 0 then return 1L result temporary wh minn if tp1 NE tp2 then return result szr size result tpr szr szr 0 1 Cast to the original type if necessary if tpr NE tp1 then begin fresult make_array n_elements result type tp1 fresult 0 temporary result result temporary fresult endif return result endelse return 1L DEFAULT CASE end Here is how I did the INDEX stuff with fast histogramming It works but is complicated so I forced it to go to SLOW_SET_OP ha histogram a min minn max maxx reverse ra 1 rr ra 0:nbins mask rr NE rr 1: ra ra rr mask 1L mask hb histogram b min minn max maxx reverse rb 1 rr rb 0:nbins mask rr NE rr 1: rb rb rr mask 1L mask AND OR XOR NOT masking here ra ra wh rb rb wh return ra ra GE 0 rb n1 ra LT 0 is last ra right "); 238 a[236] = new Array("./ToBeReviewed/MATRICE/colle.html", "colle.pro", "", " NAME:colle PURPOSE: Cette fonction de concatenation existe ds IDL avec cf ds le programme ds le case pour direc egale 1 2 3 tant que l on ne cherche pas a coller suivant une dimensionsuperieure ou egale a 4 CATEGORY:bidouillage de matrice CALLING SEQUENCE:res colle bableau_de_pointeur direc ou bien res colle tab1 tab2 tab3 tab4 direc INPUTS: CAS 1: tableau_de_pointeur:comme son nom l indique c est un tableau de pointeur dont chaque elements pointe sur tableau a coller par ex ds un programme on veut coller n tableaux entre eux tab ptrarr n allocate_heap for i 0 n 1 do begin tab n replicate n 2 3 endfor res colle tab 1 CAS 2: on donne directement les tableaux a coller rq: ds ce cas on peut au plus donner 20 tableaux en entree ATTENTION : sans le mot cle SAUVE les arguments en entree sont detruits lorsque l on construit res ds le cas 1 on detruit le tableau de pointeurs et les variables sur lesquelles on pointe direc: la direction suivant laquelle les coller 1 2 3 KEYWORD PARAMETERS: SAUVE: mot cle qui force a sauvegarder le tableau de pointeur et les tableaux a coller OUTPUTS:res matrice resultat RESTRICTIONS: EXAMPLE: IDL print colle replicate 1 2 2 2 indgen 2 2 2 2 1 1 1 1 0 1 2 3 1 1 1 1 4 5 6 7 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 13 1 98 pour suprimer une variable PRO UNDEFINE varname tempvar SIZE TEMPORARY varname END FUNCTION colle a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 SAUVE sauve res 1 on met en place ptrtab et direc en fonction des arguments en entree case 1 of n_params EQ 2:BEGIN cas ou l on donne directement le tableau de pointeurs ptrtab a0 direc a1 if NOT keyword_set sauve then undefine a0 on recupere le nombre de tableaux a coller nbretab size ptrtab 1 end n_params GT 2:BEGIN on recupere le nombre de tableaux a coller nbretab n_params 1 bidon execute direc a strtrim n_params 1 2 on ecrit le tableau de pointeur dont chaque element pointe sur un tableau ptrtab ptrarr nbretab allocate_heap for n 0 nbretab 1 do begin bidon execute ptrtab n a strtrim n 2 if NOT keyword_set sauve then bidon execute undefine a strtrim n 2 endfor sauve 0 end ELSE: endcase case sur la valeure de direc case direc of 1:BEGIN on colle suivant la dimension 1 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END 2:BEGIN on colle suivant la dimension 2 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END 3:BEGIN on colle suivant la dimension 3 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END ELSE:BEGIN on transpose res de facon a mettre la dimension a coller numero 1 pour cela on contient le vecteur permute qui donne la place que doivent prendre les dimensions ds la matrice transposee siz size ptrtab 0 0 if siz LT direc then ptrtab 0 reform ptrtab 0 size ptrtab 0 1:siz replicate 1 direc siz over permute indgen size ptrtab 0 0 permute 0 direc 1 permute direc 1 0 res transpose ptrtab 0 permute if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN on colle suivant la dimension 1 if size ptrtab n 0 LT direc then ptrtab n reform ptrtab n size ptrtab n 1:siz replicate 1 direc siz res temporary res transpose ptrtab n permute if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR res transpose temporary res permute END ENDCASE if NOT keyword_set sauve then undefine ptrtab sortie: return res END "); 239 a[237] = new Array("./ToBeReviewed/MATRICE/congridseb.html", "congridseb.pro", "", " NAME:CONGRIDSEB PURPOSE:meme chose que congrid mais qui marche cf par ex: IDL print congrid 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 3 4 4 1 1 1 2 2 2 3 3 3 3 4 4 5 5 5 6 6 6 7 7 7 7 8 8 5 5 5 6 6 6 7 7 7 7 8 8 IDL print rebin 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 4 4 4 3 3 3 4 4 4 5 5 5 6 6 6 5 5 5 6 6 6 7 7 7 8 8 8 5 5 5 6 6 6 7 7 7 8 8 8 IDL print congridseb 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 4 4 4 1 1 1 2 2 2 3 3 3 4 4 4 5 5 5 6 6 6 7 7 7 8 8 8 5 5 5 6 6 6 7 7 7 8 8 8 CATEGORY:bidouille matrices CALLING SEQUENCE:res congridseb tableau x y INPUTS:tableau:un tableau 1 ou 2d x:dim en x du resultat doit etre un multiple de dim en x de tableau y:dim en y du resultat doit etre un multiple de dim en y de tableau KEYWORD PARAMETERS: OUTPUTS:res un tableau de dim x y COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 20 3 98 18 6 1999 supression d une horrible boucle function congridseb tableau x y res tableau taille size tableau CASE N_PARAMS OF 2: begin res replicate 1 1 x taille 1 res return res end 3: begin res transpose res res replicate 1 1 y taille 2 res res reform res y taille 1 over res transpose res res replicate 1 1 x taille 1 res return reform res x y overwrite end else: return report Mauvais nombre de parametre dans l appel de CONGRIDSEB endcase end"); 240 a[238] = new Array("./ToBeReviewed/MATRICE/different.html", "different.pro", "", " NAME:different PURPOSE:calcule les elements differents de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res different a b INPUTS:a et b:arrays of positive integers which need not be sorted Duplicate elements are ignored as they have no effect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 different a b 4 8 Elements in A but not in B MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION different a b a and not b elements in A but not in B mina Min a Max maxa minb Min b Max maxb IF minb GT maxa OR maxb LT mina THEN RETURN a No intersection r Where Histogram a Min mina Max maxa 1 Histogram b Min mina Max maxa count IF count eq 0 THEN RETURN 1 ELSE RETURN r mina END"); 241 a[239] = new Array("./ToBeReviewed/MATRICE/extrait.html", "extrait.pro", "", " NAME:extrait PURPOSE:extraction de sous domaines de matrices Meme si le sous domaine est troue cf : l exemple Par defaut IDL peut faire des extractions de sous domaines: IDL a indgen 5 5 IDL print a 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 IDL print a 0 2 3 15 17 IDL print a 0 2 0 2 5 7 10 12 15 17 20 22 mais IDL print a 0 2 3 4 15 22 alors que IDL print extrait a 0 2 3 4 15 17 20 22 CATEGORY:bidouille avec les matrices CALLING SEQUENCE:res extrait tab indicex indicey indicez indicet INPUTS: tab: un tableau 1 2 3 ou 4 d indicex: indicex peut avoir deux formes: 1 un vecteur contenant les indices des lignes a garder 2 le string dans ce cas touts les lignes sont gardees indicey z t: la meme chose que indicex mais pour les dimensions 2 3 et 4 rq: il faut autant de vecteurs indice que tab a de dimensions KEYWORD PARAMETERS: OUTPUTS: res: une matice 1 2 3 ou 4d extraite a partir de tab COMMON BLOCKS: SIDE EFFECTS:res 1 en cas d erreur RESTRICTIONS: EXAMPLE: j ai une matrice A de dim 2 je veux en extraire une petite matrice 2d interscetion de la ligne 2 3 et 7 et de la colonne 0 et 1 res extrait A 2 3 7 0 1 autre ex: IDL print a a b c d e f g h i IDL print extrait a 0 2 0 2 a c g i MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 12 1 1999 29 4 1999: correction d un bug et complement de l en tete FUNCTION extrait tab indicex indicey indicez indicet taille size tab test du nombre de parametres et de la nature de indice pour LE cas x if n_params NE taille 0 1 THEN return report il faut autant d indices que de dimension du tableau IF n_params GE 5 THEN BEGIN if size indicet type EQ 7 then indicet lindgen taille 4 ELSE indicet long indicet nt n_elements indicet ENDIF IF n_params GE 4 THEN BEGIN if size indicez type EQ 7 then indicez lindgen taille 3 ELSE indicez long indicez nz n_elements indicez ENDIF IF n_params GE 3 THEN BEGIN if size indicey type EQ 7 then indicey lindgen taille 2 ELSE indicey long indicey ny n_elements indicey ENDIF IF n_params GE 2 THEN BEGIN if size indicex type EQ 7 then indicex lindgen taille 1 ELSE indicex long indicex nx n_elements indicex ENDIF construction du tableau d indice et du resultat suivant la taille de tab case taille 0 of 1:res tab indicex 2:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey res tab indice END 3:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey indice temporary indice replicate 1 nz taille 1 taille 2 replicate 1 nx ny indicez res tab reform indice nx ny nz over END 4:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey indice temporary indice replicate 1 nz taille 1 taille 2 replicate 1 nx ny indicez indice temporary indice replicate 1 nt taille 1 taille 2 taille 3 replicate 1 nx ny nz indicet res tab reform indice nx ny nz nz over END endcase return res end"); 242 a[240] = new Array("./ToBeReviewed/MATRICE/inter.html", "inter.pro", "", " NAME:inter PURPOSE:calcule l intersection de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res inter a b INPUTS:a et b:arrays of positive integers which need not to be sorted Duplicate elements are ignored as they have noeffect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 inter a b 2 6 Common elements MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION inter a b case 1 of n_elements a EQ 0:return 1 n_elements b EQ 0:return 1 n_elements a EQ 1 AND n_elements b NE 1: if where b EQ a 0 0 EQ 1 then return 1 ELSE return a 0 n_elements b EQ 1 AND n_elements a NE 1: if where a EQ b 0 0 EQ 1 then return 1 ELSE return b 0 n_elements a EQ 1 AND n_elements b EQ 1: if where a 0 EQ b 0 0 EQ 1 then return 1 ELSE return a 0 ELSE: ENDCASE minab Min a Max maxa Min b Max maxb Only need intersection of ranges maxab maxa maxb If either set is empty or their ranges don t intersect: result NULL IF maxab LT minab OR maxab LT 0 THEN RETURN 1 r Where Histogram a Min minab Max maxab Histogram b Min minab Max maxab count IF count EQ 0 THEN RETURN 1 ELSE RETURN r minab END"); 243 a[241] = new Array("./ToBeReviewed/MATRICE/make_selection.html", "make_selection.pro", "", " Id: make_selection pro 31 2006 05 02 13:54:11Z pinsard NAME: MAKE_SELECTION function PURPOSE: Convert an array of selected values to an index array that identifies the selected values in a list or data array CATEGORY: Tools CALLING SEQUENCE: index MAKE_SELECTION NAMES SELNAMES keywords INPUTS: NAMES A list or array of values to choose from SELNAMES A list of selected values KEYWORD PARAMETERS: ONLY_VALID Return only indices of found values Values not found are skipped Default is to return 1 index value for each SELNAME which is 1 if SELNAME is not contained in NAMES If ONLY_VALID is set the 1 values will be deleted and a value of 1 indicates that no SELNAME has been found at all REQUIRED Normally MAKE_SELECTION will return indices for all values that are found simply ignoring the selected values that are not in the NAMES array although an error message is displayed Set this keyword to return with 1 as soon as a selected value is not found QUIET Suppress printing of the error message if a selected value is not found the error condition will still be set OUTPUTS: A long array with indices to reference the selected values in the NAMES array SUBROUTINES: REQUIREMENTS: NOTES: If the NAMES array contains multiple entries of the same value only the index to the first entry will be returned A selection can contain multiple instances of the same value The index array will contain one entry per selected item See example below EXAMPLE: names Alfred Anton Peter John Mary index MAKE_SELECTION names Peter Mary print index prints 2 4 vals indgen 20 index MAKE_SELECTION vals 9 5 8 7 7 8 9 print index prints 9 1 8 7 7 8 9 index MAKE_SELECTION vals 9 5 8 7 7 8 9 ONLY_VALID print index prints 9 8 7 7 8 9 index MAKE_SELECTION vals 9 5 8 7 7 8 9 REQUIRED print index prints 1 MODIFICATION HISTORY: mgs 28 Aug 1998: VERSION 1 00 mgs 29 Aug 1998: changed behaviour and added ONLY_VALID keyword Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine make_selection function make_selection names selnames only_valid only_valid required required quiet quiet return an index array with a number for each element in selnames that is found in names Set the REQUIRED keyword to return 1 if one element is not found otherwise 1 will only be returned if no element is found reset error state to 0 message reset quiet keyword_set quiet result 1L for i 0 n_elements selnames 1 do begin test where names eq selnames i result result test 0 if test 0 lt 0 then begin if keyword_set ONLY_VALID OR keyword_set REQUIRED then message Selected name not found in names array strtrim selnames i 2 CONT NOPRINT quiet if keyword_set required then return 1L endif endfor if n_elements result gt 1 then result result 1: if keyword_set only_valid then begin ind where result ge 0 if ind 0 ge 0 then result result ind else result 1L endif return result end"); 244 a[242] = new Array("./ToBeReviewed/MATRICE/union.html", "union.pro", "", " NAME:union PURPOSE:calcule l union de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res union a b INPUTS:a et b:arrays of positive integers which need not be sorted Duplicate elements are ignored as they have no effect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 union a b 1 2 3 4 6 8 Elements in either set MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION union a b IF a 0 LT 0 THEN RETURN b A union NULL a IF b 0 LT 0 THEN RETURN a B union NULL b RETURN Where Histogram a b OMin omin omin Return combined set END"); 245 a[243] = new Array("./ToBeReviewed/MATRICE/zeroun.html", "zeroun.pro", "", " NAME:zeroun PURPOSE:renvoie un vecteur ou une matrice constitue de o et de 1 en alternance CATEGORY:function matrices CALLING SEQUENCE:resultat zeroun n1 n2 INPUTS: n1 nombre d elements dans la premiere dimension n2 nombre d elements dans la deuxieme dimension KEYWORD PARAMETERS: OUTPUTS:resultat COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 1 12 98 function zeroun n1 n2 CASE N_PARAMS OF 1:return findgen n1 mod 2 2:BEGIN if fix n1 2 EQ n1 2 then BEGIN nombre pair de colonnes res findgen n1 1 n2 mod 2 return res 0:n1 1 ENDIF ELSE return findgen n1 n2 mod 2 nombre impair de colonnes END else: return report Mauvais nombre de parametre dans l appel de ZEROUN endcase end"); 246 a[244] = new Array("./ToBeReviewed/PLOTS/DESSINE/bar_plot.html", "bar_plot.pro", "", " Id: bar_plot pro 35 2006 05 02 14:44:47Z pinsard Copyright c 1990 2000 Research Systems Inc All rights reserved Unauthorized reproduction prohibited pro bar_plot values baselines baselines colors colors barnames barnames title title xtitle xtitle ytitle ytitle baserange baserange barwidth barwidth barspace barspace baroffset baroffset outline outline overplot overplot background background rotate rotate _EXTRA ex NAME: BAR_PLOT PURPOSE: Create a bar graph or overplot on an existing one CATEGORY: Graphics CALLING SEQUENCE: BAR_PLOT Values INPUTS: Values: A vector containing the values to be represented by the bars Each element in VALUES corresponds to a single bar in the output KEYWORD PARAMETERS: BASELINES: A vector the same size as VALUES that contains the base value associated with each bar If not specified a base value of zero is used for all bars COLORS: A vector the same size as VALUES containing the color index to be used for each bar If not specified the colors are selected based on spacing the color indices as widely as possible within the available colors specified by D N_COLORS BARNAMES: A string array containing one string label per bar If the bars are vertical the labels are placed beneath them If horizontal rotated bars are specified the labels are placed to the left of the bars TITLE: A string containing the main title to for the bar plot XTITLE: A string containing the title for the X axis YTITLE: A string containing the title for the Y axis BASERANGE: A floating point scalar in the range 0 0 to 1 0 that determines the fraction of the total available plotting area in the direction perpendicular to the bars to be used If not specified the full available area is used BARWIDTH: A floating point value that specifies the width of the bars in units of nominal bar width The nominal bar width is computed so that all the bars and the space between them set by default to 20 of the width of the bars will fill the available space optionally controlled with the BASERANGE keyword BARSPACE: A scalar that specifies in units of nominal bar width the spacing between bars For example if BARSPACE is 1 0 then all bars will have one bar width of space between them If not specified the bars are spaced apart by 20 of the bar width BAROFFSET: A scalar that specifies the offset to be applied to the first bar in units of nominal bar width This keyword allows for example different groups of bars to be overplotted on the same graph If not specified the default offset is equal to BARSPACE OUTLINE: If set this keyword specifies that an outline should be drawn around each bar OVERPLOT: If set this keyword specifies that the bar plot should be overplotted on an existing graph BACKGROUND: A scalar that specifies the color index to be used for the background color By default the normal IDL background color is used ROTATE: If set this keyword indicates that horizontal rather than vertical bars should be drawn The bases of horizontal bars are on the left Y axis and the bars extend to the right OUTPUTS: A bar plot is created or an existing one is overplotted EXAMPLE: By using the overplotting capability it is relatively easy to create stacked bar charts or different groups of bars on the same graph For example if ARRAY is a two dimensional array of 5 columns and 8 rows it is natural to make a plot with 5 bars each of which is a stacked composite of 8 sections First create a 2D COLORS array equal in size to ARRAY that has identical color index values across each row to ensure that the same item is represented by the same color in all bars With ARRAYS and COLORS defined the following code fragment illustrates the creation of stacked bars note that the number of rows and columns is arbitrary : Y RANGE 0 ymax Scale range to accommodate the total bar lengths BASE INTARR NROWS FOR I 0 NROWS 1 DO BEGIN BAR_PLOT ARRAY I COLORS COLORS I BASELINES BASE BARWIDTH 0 75 BARSPACE 0 25 OVER I GT 0 BASE BASE ARRAY I ENDFOR To plot each row of ARRAY as a clustered group of bars within the same graph use the BASERANGE keyword to restrict the available plotting region for each set of bars The sample code fragment below illustrates this method: FOR I 0 NROWS 1 DO BAR_PLOT ARRAY I COLORS COLORVECT BARWIDTH 0 8 BARSPACE 0 2 BAROFFSET I 1 0 BARSPACE NCOLS OVER I GT 0 BASERANGE 0 19 where NCOLS is the number of columns in ARRAY and COLORVECT is a vector containing the color indices to be used for each group of bars In this example each group uses the same set of colors but this could easily be changed MODIFICATION HISTORY: August 1990 T J Armitage RSI initial programming Replacement for PLOTBAR and OPLOTBAR routines written by William Thompson September 1990 Steve Richards RSI changed defaults to improve the appearance of the bar plots in the default mode Included spacing the bars slightly if n_params d eq 0 then begin Print call return if no parameters print bar_test values baselines baselines colors colors barnames barnames print title title xtitle xtitle ytitle ytitle baserange baserange print barwidth barwidth barspace barspace baroffset baroffset print outline outline overplot overplot background background print rotate rotate return endif nbars n_elements values Determine number of bars Baselines bars extend from baselines through values default 0 if not keyword_set baselines then baselines intarr nbars Default colors spaced evenly in current color table if not keyword_set colors then colors fix d n_colors float nbars indgen nbars 0 5 Labels for the individual bars none by default if not keyword_set barnames then barnames strarr nbars Main title if not keyword_set title then title Centered title under X axis if not keyword_set xtitle then xtitle Title for Y axis if not keyword_set ytitle then ytitle Fraction 0 1 of full X range to use if not keyword_set baserange then baserange 1 0 Space betw bars taken from nominal bar widths default is none If not keyword_set barspace then barspace 0 2 Bar width scaling factor relative to nominal if not keyword_set barwidth then barwidth 1 0 barspace barspace nbars Initial X offset in scaled bar widths default is none if not keyword_set baroffset then baroffset barspace barwidth Outline of bars default is none outline keyword_set outline Overplot do not erase the existing display default is to create new plot overplot keyword_set overplot Background color index defaults to 0 usually black if not specified if not keyword_set background then background 0 Rotate make horizontal bars default is vertical bars rotate keyword_set rotate mnB MIN baselines MAX mxB NAN mnV MIN values MAX mxV NAN range mnB mxV Maximum of bases values if rotate then begin Horizontal bars if x range 0 eq 0 and x range 1 eq 0 Determine range for X axis then xrange range else xrange x range Or use range specified if y range 0 eq 0 and y range 1 eq 0 Plot will calculate then defaults for X but not yrange 0 n_elements values for Ys so fill in here else yrange y range Axis perpend to bars yticks 1 Suppress ticks in plot ytickname strarr 2 xticks 0 xtickname strarr 1 endif else begin Vertical bars if y range 0 eq 0 and y range 1 eq 0 Determine range for Y axis then yrange range else yrange y range Or use range specified xrange x range Axis perpend to bars xticks 1 Suppress ticks in plot xtickname strarr 2 yticks 0 ytickname strarr 1 endelse if overplot eq 0 then Create new plot no data plot values nodata title title xtitle xtitle ytitle ytitle noerase overplot xrange xrange yrange yrange xticks xticks xtickname xtickname yticks yticks ytickname ytickname xstyle 1 ystyle 1 data background background _EXTRA ex if rotate then begin Horizontal bars base_win y window Window range in Y scal_fact x s Scaling factors tick_scal_fact y s Tick scaling factors endif else begin Vertical bars base_win x window Window range in X scal_fact y s Scaling factors tick_scal_fact x s Tick scaling factors endelse winrange baserange base_win 1 base_win 0 Normal window range barsize barwidth winrange nbars Normal bar width winoffset base_win 0 baroffset barsize Normal first offset bases scal_fact 0 scal_fact 1 baselines Baselines in normal coor normal scal_fact 0 scal_fact 1 values Values in normal coor barstart indgen nbars barsize barspace winrange nbars Coor at left edges tickv winoffset barstart 0 5 barsize Tick coor centered for i 0 nbars 1 do begin Draw the bars width winoffset barstart i barstart i Compute bar width barstart i barsize barstart i barsize length bases i normal i normal i bases i Compute bar length if rotate then begin Horizontal bars x length X axis is length axis y width Y axis is width axis endif else begin Vertical bars x width X axis is width axis y length Y axis is length axis endelse polyfill x y color colors i normal Polyfill with color if outline then plots x y normal Outline using p color endfor tickv tickv tick_scal_fact 0 tick_scal_fact 1 Locations of the ticks if rotate then Label the bars Y axis axis yaxis 0 ystyle 1 yticks nbars 1 ytickv tickv ytickname barnames yticklen 0 0 else Label the bars X axis axis xaxis 0 xstyle 1 xticks nbars 1 xtickv tickv xtickname barnames xticklen 0 0 return end"); 247 a[245] = new Array("./ToBeReviewed/PLOTS/DESSINE/plt.html", "plt.pro", "", " NAME: PLT PURPOSE: trace des graphes horizontaux cartes CATEGORY: Graphics trace des graphes horizontaux CALLING SEQUENCE: plt champ min max INPUTS: champ: le champ dont on veut faire la carte horizontale champ peut etre de 2 types: 1 an array if needed its mean along the z and t direction will be automatically performed 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp ces ARGUMENTS ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tab1 sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tab1 sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique sur laquelle doit etre faite la coupe Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom 0 max gdept gdepw 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 sont les variables globales definies lors du dernier domdef REALCONT:Permet de dessiner les continents definits ds IDL REALCONT peut prendre deux formes: REALCONT: on dessine les continents a la place du mask REALCONT 2 on dessine le contours des continents par dessus le dessin masque ceci permet de voir si le masque correspond bien aux continents reels CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations CMREF: la longeur en cm sur le papier que doit faire la fleche de norme normeref par defaut ajuste au dessin et compris entre 5 et 1 5 cm COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ repondant aux meme caracteristiques que l argument numero 1 de plt GRIDTYPE: U T V W ou F pour specifer eventuellement la grille a laquelle est rattache le champ Rq: il afaut mieux utiliser ds ce cas une structure comme champ INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilise pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot MAP:Mot cle a actine losque l on veut faire une projection Ce mot cle peut etre de 2 formes: MAP P0lat P0lon Rot Pour la description de ces 3 valeurs cf l aide en ligne de MAP_SET MAP: dans ce cas map est calcule tout seul et vaut: map 0 lon1 lon2 2 0 Rq: Un bon moyen de choisir sa projection est la valeur du vecteur MAP est d utiliser la demo d IDL5 2: IDL demo Puis choisir earth sciences et mapping Rq2: Par defaut c est une projection cylindrique qui est effectuee avec ou sans le mot cle map Si on veut une autre projection MAP doit etre active et il faut rajouter le mot cle: nom_projection par ex pour une projection polaire centree sur le pole sud: IDL domdef 180 180 90 45 IDL plt tab stereo map 90 0 0 labmap: corresponds to label keywords of map_set Defaut definition is labmap 1 MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre NORMEREF: la norme de la fleche de reference par defaut on essaie de faire qqch qui colle pas trop mal NOTRI: pour forcer a ne pas utiliser de triangulation Attention dans ce cas le trace ne marchera que si la grille est non deformee cad chaque pts d une longitude donnee a la meme latitude et chaque pts d une latitude donnee a la meme longitude sauf si on utilise le mot clef CELL_FILL 2 Rq si le champ contient des points a values f_nan alors on fait qd meme une triangulation OVERPLOT: pour faire un plt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR ou de VECTEUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours UNVECTSUR:un scalaire n on un tableau a 2 elements n1 n2 dans le premier cas on tracera un vecteur sur n suivant les x et les y dans le second cas on tracera un vecteur sur n1 suivant x et un vecteur sur n2 suivant y Rq pour tracer tous les vecteurs suivant y et 1 sur 2 suivant x mettre unvectsur 2 1 Rq: ce mot cle est passe ds _extra VECTCOLOR: la couleur de la fleche Par defaut noir couleur 0 VECTEUR: une structure a 2 elements contenant les 2 champs U et V des valeurs de la composante zonale et meridienne du champ de vecteurs a tracer Ces champs peuvent etre un tableau ou une structure par ex: vecteur matriceu:lec unsurface matricev:lec vnsurface rq:le nom des elements de vecteur n a aucune importance vecteur u:lec unsurface v:lec vnsurface convient aussi VECTMIN norme minimum des vecteurs a tracer VECTMAX norme maximum des vecteurs a tracer VECTTHICK l epaissuer de la fleche par defaut 1 WINDOW: numero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x par ex: 1 pour un repere orthonorme 2 si l axe des y est deux fois plus dilate que celui des x Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1999 Sebastien Masson 08 02 2000 checkfield and notri keyword or triangule 1 pro plt tab1 giventype givenmin givenmax REALCONT realcont CONTOUR contour INTERVALLE intervalle INV inv GRIDTYPE gridtype BOXZOOM boxzoom CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel VECTEUR vecteur MAP map MININ minin MAXIN maxin CONT_NOFILL cont_nofill USETRI usetri NOTRI notri MASKFILL maskfill DUPLICATE duplicate STRICTFILL strictfill OVERPLOT overplot DECIMATETRI decimatetri LABMAP labmap _extra ex include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preparation de l environnement graphique et petites verifications I1 verification du type de grille associe a tab1 if keyword_set gridtype then vargrid gridtype if keyword_set vecteur AND NOT keyword_set gridtype then BEGIN vargrid litchamp tab1 grid if vargrid eq then BEGIN vargrid xquestion What is the grid associated to the data to contour T chkwidget vargrid strupcase vargrid endif ENDIF I2 lecture du champ et checkup if keyword_set boxzoom AND n_elements contour ne 4 then BEGIN savedbox 1b saveboxparam boxparam4plt dat END if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin checktypeminmax plt TYPE type MIN min MAX max _extra ex z2d checkfield tab1 plt TYPE type BOXZOOM boxzoom DIREC direc VECTEUR vecteur _extra ex if z2d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4plt dat return ENDIF IF n_elements usetri EQ 0 THEN BEGIN do we have holes in the triangulation holeintri n_elements triangles_list 3 LT jpi 1 keyword_set key_periodic jpj 1 2 the triangulation must be used to draw the data do we have a triangulation wehavetri triangles_list 0 NE 1 the triangulation must be used to draw the continents if we make a map are we periodic and nx jpi CASE strupcase vargrid OF T :nx nxt W :nx nxt U :nx nxu V :nx nxv F :nx nxf ENDCASE mapperio keyword_set map keyword_set key_periodic nx eq jpi usetri wehavetri wehavetri holeintri mapperio keyword_set key_irregular 2 notri ENDIF I3 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot then reinitplt z invert I4 attribution du mask et des tableaux de longitude et latitude IF strupcase vargrid EQ W THEN profond firstzw NE 0 ELSE profond firstzt NE 0 do we need to extract now the triangulation that will be use for contouring the data if keyword_set profond OR usetri EQ 0 AND vargrid EQ T OR vargrid EQ W OR usetri NE 2 AND vargrid NE T AND vargrid NE W THEN BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz forplt _extra ex ENDIF ELSE BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz TRI trifield forplt _extra ex ENDELSE I5 determination du mi:min et du ma:max de z2d ainsi que de max: max et min: min pour le dessin masknan finite z2d nan total masknan NE n_elements z2d faudra t il faire un autoscale autoscale testvar var min EQ testvar var max AND NOT keyword_set intervalle determineminmax z2d mask mi ma glam gphi MININ min MAXIN max nan nan INTERVALLE intervalle usetri usetri _extra ex if z2d 0 EQ 1 THEN GOTO sortie on fait un autoscale si besoin if autoscale then autoscale min max intervalle II mise en place du dessin sur la fenetre ou la page et ouverture eventuelle de la fenetre et de la page if n_elements contour NE 4 AND NOT keyword_set overplot THEN placedessin plt posfenetre posbar CONTOUR contour VECTEUR vecteur MAP map DIREC direc _extra ex III habillage du dessin labels style axe III1 choix des labels if keyword_set intervalle AND NOT keyword_set label then label 1 if keyword_set label eq 0 then cas 0 else cas label label cas min max ncontour level_z2d colnumb NLEVEL nlevel INTERVALLE intervalle strictfill strictfill III2 choix de style if not keyword_set style then style 0 style style level_z2d linestyle thick if keyword_set inv then colnumb reverse colnumb III3 definition des axes if NOT keyword_set overplot THEN axe xy _EXTRA ex IV dessin extrapolation des donnees sur les terres et seuillage if keyword_set nan then begin z2d where masknan EQ 0 max ENDIF ELSE masknan 1 filling the mask values we fill only masknan or we fill mask masknan IF keyword_set nan AND keyword_set cont_nofill THEN z2d remplit z2d nite 1 vargrid NE T AND vargrid NE W mask masknan _extra ex ELSE z2d remplit z2d nite 1 vargrid NE T AND vargrid NE W keyword_set nan 1 keyword_set cont_nofill 1 n_elements maskfill NE 0 mask mask masknan _extra ex IF keyword_set strictfill EQ 0 AND n_elements maskfill EQ 0 then z2d min z2d max if n_elements maskfill NE 0 then BEGIN z2d temporary z2d mask masknan if maskfill NE 0 then z2d temporary z2d maskfill 1 mask masknan ENDIF check the mask and the triangulation according to the grid type and nan values si on fait un dessin en profondeur on redefinit une triangulation sur le zoom cette triangulation sera utilisee pour tracer le champ on utilise tmask pour que les trous de cette triangulation soient bien les memes que ceux utilises pour tracer le masque et correspondent bien au trous qu il y a a cette nouvelle profondeur if keyword_set profond OR keyword_set cont_nofill AND usetri GE 1 AND vargrid EQ T OR vargrid EQ W OR usetri EQ 2 AND vargrid NE T AND vargrid NE W then BEGIN trifield triangule tmask firstx:lastx firsty:lasty firstz coinmonte coinmontemask coindescend coindescendmask keep_cont cont_nofill _extra ex indicezoommask lindgen jpi jpj firstx:lastx firsty:lasty ENDIF triangulation for nan mask if keyword_set nan then BEGIN trinan triangule masknan keep_cont coinmonte coinmontenan coindescend coindescendnan indicezoomnan lindgen jpi jpj firstx:lastx firsty:lasty ENDIF IF n_elements twin_corners_up EQ 0 THEN coinmontemask 1 ELSE coinmontemask twin_corners_up IF n_elements twin_corners_dn EQ 0 THEN coindescendmask 1 ELSE coindescendmask twin_corners_dn if vargrid EQ T OR vargrid EQ W then BEGIN glammsk glam gphimsk gphi ENDIF ELSE begin decoupe terre: pour que le trace des cotes soit propre on essaye de prendre des points en pour la terre comme ca on ne voit pas le decalage des grilles c est ce que fait decoupeterre au passage on redefinit trimsk decoupeterre mask glammsk gphimsk type xy TRI trimsk usetri usetri indicezoom indicezoommask coinmonte coinmontemask coindescend coindescendmask _EXTRA ex ENDELSE IV1 choix du type de dessin typetrace classique if keyword_set map AND key_onearth then BEGIN appelle de mapset qd on veut faire des projections IF n_elements map NE 3 THEN map 0 lon1 lon2 2 MOD 360 0 typetrace projection map_lat map 0 map_lon map 1 map_rot map 2 if chkstru ex TITLE then begin maptitre ex title ex title endif map_set map_lat map_lon map_rot _extra ex position posfenetre iso limit lat1 lon1 lat2 lon2 noborder if n_elements maptitre ne 0 then ex title maptitre if n_elements trifield GE 2 then trifield ciseauxtri trifield glam gphi _EXTRA ex if n_elements trimsk GE 2 then trimsk ciseauxtri trimsk glammsk gphimsk _EXTRA ex if n_elements trinan GE 2 then BEGIN trinan ciseauxtri trinan glam gphi _EXTRA ex if trinan 0 EQ 1 then undefine trinan endif ENDIF ELSE BEGIN pour que les axes de coordonees soient pris en compte if x type EQ 0 AND n_elements contour LE 4 then plot 0 0 nodata xstyle 5 ystyle 5 title subtitle noerase if keyword_set key_periodic then BEGIN ds ce cas la triangulation est refermee en x et couvre toute la sphere il faut dont la couper au niveau ou l on coupe la sphere pour faire le dessin if n_elements trifield GE 2 then trifield ciseauxtri trifield glam gphi _EXTRA ex if n_elements trimsk GE 2 then trimsk ciseauxtri trimsk glammsk gphimsk _EXTRA ex if n_elements trinan GE 2 then trinan ciseauxtri trinan glam gphi _EXTRA ex ENDIF endelse IV2 coutours et coloriages if keyword_set duplicate then BEGIN pour marina uniquement ATTENTION C EST TRES MAL CODE lon glam 0 decalage max lon min lon lon shift lon 1 n_elements lon 1 x range 1 x range 1 duplicate 1 decalage for i 1 duplicate 1 do BEGIN z2d z2d z2d gphi gphi gphi mask mask mask gphimsk gphimsk gphimsk glam glam glam i decalage glammsk glammsk glammsk ENDFOR endif save glam gphi trifield file tri dat if keyword_set decimatetri then BEGIN tempsdeux systime 1 pour key_performance IF n_elements trimsk EQ 0 THEN trimsk trifield Verts transpose temporary glam temporary gphi temporary z2d Conn replicate 3 1 n_elements trifield 3 trifield Result mesh_decimate temporary verts temporary Conn Connout vertices Vertsout percent_vertices decimatetri connout reform connout 4 n_elements connout 4 over trifield temporary connout 1:3 glam reform Vertsout 0 gphi reform Vertsout 1 z2d reform Vertsout 2 undefine Vertsout print temps decimatetri systime 1 tempsdeux ENDIF pltbase z2d glam gphi mask glammsk gphimsk trichamp trifield trimsk trimsk forplt level_z2d colnumb contour contour usetri usetri realcont realcont overplot keyword_set overplot keyword_set map c_linestyle linestyle c_labels 1 indgen n_elements level_z2d MOD 2 c_thick thick cont_nofill cont_nofill nan nan coinmontemask coinmontemask coindescendmask coindescendmask coinmontenan coinmontenan coindescendnan coindescendnan indicezoommask indicezoommask indicezoomnan indicezoomnan masknan masknan trinan trinan _extra ex IV3 rappelle de plt en boucle qd contour est active if n_elements contour eq 4 then BEGIN c est la 2eme fois que je passe ds pltt contour mietma: mi ma unit:varunit inter:intervalle je renvoie le min le max et l unite return endif if keyword_set contour THEN BEGIN pourlegende 1 1 1 1 oldattributs saveatt oldcolnumb colnumb plt contour contmin contmax CONTOUR pourlegende NOERASE USETRI usetri INTERVALLE contintervalle LABEL contlabel STYLE style NLEVEL contnlevel DUPLICATE duplicate STRICTFILL strictfill MASKFILL maskfill _extra ex restoreatt oldattributs colnumb oldcolnumb ENDIF V petites finitions V1 ajout eventuel de vecteurs en surimpression if keyword_set vecteur then BEGIN oldattributs saveatt ajoutvect vecteur vectlegende _extra ex restoreatt oldattributs ENDIF if keyword_set overplot then GOTO fini V2 Trace de la ligne de changement de date l equateur et le meridien de greenwich if NOT keyword_set map AND key_onearth then meridienparallele xy V3 pour tracer les continents d IDL if keyword_set realcont then BEGIN si noease est passe de _extra on s assure qu il est a 1 if chkstru ex NOERASE then begin oldnoerase ex noerase ex noerase 1 ENDIF if chkstru ex coast_thick then mlinethick ex coast_thick ELSE mlinethick 1 if chkstru ex coast_color then mcolor ex coast_color ELSE mcolor 0 IF NOT keyword_set map THEN map_set 0 lon1 lon2 2 MOD 360 0 position posfenetre limit lat1 lon1 lat2 lon2 NOERASE noborder color 0 _extra ex if realcont NE 2 AND NOT keyword_set cont_nofill then BEGIN if chkstru ex cont_color then cntcol ex coast_color ELSE cntcol d n_colors 1 255 map_continents fill_continents color cntcol _extra ex noerase ENDIF map_continents continents color mcolor MLINETHICK mlinethick noerase _extra ex if chkstru ex NOERASE THEN ex noerase oldnoerase ENDIF V4 legendes affichage de celles ci legende mi ma xy CONTOUR pourlegende VECTLEGENDE vectlegende INTERVALLE intervalle DIREC direc _EXTRA ex if n_elements ex NE 0 then BEGIN pour garder les axes du cadre en noir if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR coast_color endif case typetrace of classique : plot 0 0 nodata noerase color 0 xstyle 1 ystyle 1 _extra ex projection : BEGIN if chkstru ex NOERASE then begin oldnoerase ex noerase ex noerase 1 endif if chkstru ex SUBTITLE then p subtitle ex SUBTITLE if n_elements maptitre ne 0 then ex title maptitre map_set map_lat map_lon map_rot _extra ex iso limit lat1 lon1 lat2 lon2 NOERASE noborder title p title color 0 map_proj_info numproj current map_proj_info numproj name nomproj if nomproj EQ Mercator OR nomproj EQ Cylindrical OR nomproj EQ LambertConic OR nomproj EQ Gnomic OR nomproj EQ AlbersEqualAreaConic OR nomproj EQ TransverseMercator OR nomproj EQ MillerCylindrical OR nomproj EQ LambertConicEllipsoid then map_grid box_axes 1 latdel 10 londel 10 ELSE map_grid charsize 0 75 label latalign 1 lonalign 1 latdel 10 londel 30 IF n_elements labmap EQ 0 THEN labmap 1 map_grid charsize 0 75 label labmap latalign 1 lonalign 1 latdel 10 londel 30 color 0 _extra ex if chkstru ex NOERASE THEN ex noerase oldnoerase end endcase V5 barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex VI impression eventuelle fini: terminedessin _extra ex sortie: if keyword_set savedbox THEN restoreboxparam boxparam4plt dat if keyword_set key_performance NE 0 THEN print temps plt systime 1 tempsun return end "); 248 a[246] = new Array("./ToBeReviewed/PLOTS/DESSINE/plt1d.html", "plt1d.pro", "", " NAME: PLT1D PURPOSE: trace des graphes 1d CATEGORY: Graphics trace des graphes 1d: x y z ou t mais ds ce cas on rapelle directement pltt CALLING SEQUENCE: plt1d champ type min max INPUTS: champ: le champ dont on veut faire le hovmoller champ peut etre de 2 types: 1 un tableu qui peut etre: 2d 3d ou 4d: tableau xy xyz xyt ou xyzt dans ce cas le tableau va passer dans moyenne ou grossemoyenne pour etre moyennee et devenir un tableau 1 1d 1d:type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 2 une structure repondant aux critaires specifies par litchamp pro cf IDL xhelp litchamp Le tableau contennu ds la structure repondant aux criteres du cas 1 cf ci dessus TYPE: un string: type de plot 1d que l on veut faire: trace suivant: x y z ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace du plot Par defaut on prend le max de tableau sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace du plot Par defaut on prend le min de tableau sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique 3d sur laquelle doit etre fait l extraction du champ pour faire le hovmoeller Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom vert1 vert2 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 vert1 vert2 sont les variables globales definies lors du dernier domdef COL1d: OBSOLETE numero de la couleur qd on fait un trace 1d par defaut 0 il faut mieux utiliser le mot cle COLOR utilise par plot ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre Rq: activer ds le cas d un Postscript de plusieurs traces de type t pour ne pas faire un Postscript de plusieurs pages OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin SIN: activer ce mot cle si l on veut que l axe des x soit trace en sinus de la latitude qd on fait un frace f y STY1D: OBSOLETE numero du style utilise lors d un trace 1d Il faut mieux utiliser le mot cle LINESTYLE qui est celui de plot Attention ce mot cle est encore utile si on veut faire des barres plutot qu un courbe mettre sty1d bar TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x Par defaut 1 Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: creation 24 6 99 Eric Guilyardi a partir routine pltt de Sebastien Masson 8 7 1999 Sebastien Masson smasson lodyc jussieu fr inspection des travaux finis 8 2 2000 Sebastien Masson: checkfield pro plt1d tab giventype givenmin givenmax BOXZOOM boxzoom SIN sin MININ minin MAXIN maxin TYPEIN typein ENDPOINTS endpoints COL1D col1d STY1D sty1d OV1D ov1d X x Y y Z z TT tt REVERSE_X reverse_x REVERSE_Y reverse_y SWITCHXY switchxy _extra ex include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance 1ere partie: initialisation et petits calculs verification de la valeur de type if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if keyword_set tt then typein t if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein endif checktypeminmax plt1d TYPE type MIN min MAX max ENDPOINTS endpoints XX keyword_set x YY keyword_set y ZZ keyword_set z if type EQ t then BEGIN pltt tab type min max BOXZOOM boxzoom SIN sin TYPEIN typein COL1D col1d STY1D sty1d OV1D ov1d ENDPOINTS endpoints _extra ex return endif I2 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt1d if NOT keyword_set ov1d then reinitplt I1 lecture du champ if keyword_set boxzoom OR keyword_set endpoints THEN BEGIN savedbox 1b saveboxparam boxparam4plt1d dat ENDIF if keyword_set endpoints then begin section tab z1d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc nx n_elements glam ny nx if strupcase vargrid EQ W then begin z gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN z gdept firstzt:lastzt nz nzt ENDELSE ENDIF ELSE BEGIN z1d checkfield tab plt1d TYPE type BOXZOOM boxzoom direc direc _extra ex grille mask glam gphi gdep nx ny nz ENDELSE if z1d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4plt1d dat return endif on construit le mask pour cela le tableau doit etre masque fait automatiquement a la valeure valmask si on passe ds moyenne ou grossemoyenne mask fltarr n_elements z1d if n_elements valmask EQ 0 then valmask 1e20 nan total finite z1d nan 1 if keyword_set nan then begin notanum where finite z1d EQ 0 z1d notanum 0 mask where z1d LT valmask 10 1 z1d notanum values f_nan ENDIF ELSE mask where z1d LT valmask 10 1 determination du min et du max apres la moyenne nan total finite z1d nan 1 determineminmax z1d mask mi ma MININ min MAXIN max nan nan INTERVALLE intervalle _extra ex if z1d 0 EQ 1 THEN return if NOT keyword_set ov1d THEN placedessin autre posfenetre posbar contour contour DIREC direc endpoints endpoints _extra ex 2eme partie: dessin definition des vecteurs abscisse et ordonee la triangulation est definie pour que le trace soit effectue du bas a gauche vers le haut a droite il faut donc la matrice e contourer se presente de cette maniere d ou certains transpose et reverse case type of y : begin yy z1d IF size gphi 0 EQ 1 then xx gphi ELSE BEGIN IF keyword_set key_irregular THEN BEGIN cln where gphi EQ max gphi 0 xx reform gphi cln MOD nx ENDIF ELSE xx reform gphi 0 ENDELSE if keyword_set sin then xx sin pi 180 xx min0 lat1 max0 lat2 END x :begin yy z1d xx glam 0 min0 lon1 max0 lon2 END z :begin yy reverse gdep 1 xx reverse z1d 1 min0 0 max0 0 case n_elements boxzoom of 0: y range vert1 vert2 1: y range 0 boxzoom 2: y range boxzoom 4: y range vert1 vert2 5: y range 0 boxzoom 4 6: y range boxzoom 4:5 endcase if NOT keyword_set ov1d then y range reverse y range END ENDCASE definition des axes if keyword_set integrationtps then axe type time 0 time jpt 1 SIN sin _extra ex ELSE axe type SIN sin if NOT keyword_set ov1d then axe type SIN sin dessin if type EQ z then begin idx where xx NE valmask if NOT keyword_set ov1d then BEGIN if min EQ mi then x range min abs max min 5 max abs max min 5 ELSE x range min max ENDIF ENDIF ELSE BEGIN idx where yy NE valmask if NOT keyword_set ov1d then BEGIN if min EQ mi then y range min abs max min 5 max abs max min 5 ELSE y range min max ENDIF ENDELSE if NOT keyword_set ov1d then BEGIN legende mi ma type CONTOUR contour DIREC direc ENDPOINTS endpoints _EXTRA ex ENDIF IF keyword_set switchxy THEN BEGIN tmp xx xx yy yy temporary tmp if NOT keyword_set ov1d then BEGIN tmp x x y y temporary tmp ENDIF ENDIF if NOT keyword_set ov1d then BEGIN if keyword_set reverse_x then x range reverse x range if keyword_set reverse_y then y range reverse y range ENDIF xx xx idx yy yy idx if not keyword_set col1d then col1d 0 if keyword_set sty1d then BEGIN si on veut faire des barres IF strlowcase strtrim sty1d EQ bar then begin y range y range 0 y range 1 y range 0 05 y range 1 bar_plot yy background d n_colors 1 255 baselines replicate y range 0 n_elements yy barnames colors replicate col1d n_elements yy outline if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 noerase nodata _extra ex GOTO fini ENDIF ENDIF if NOT keyword_set ov1d then BEGIN plot xx yy color col1d linestyle sty1d thick 2 title subtitle _extra ex if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur 0 et trace une ligne a y 0 if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 if where tag_names ex EQ LINESTYLE 0 NE 1 then ex LINESTYLE 0 if where tag_names ex EQ THICK 0 NE 1 then ex THICK 0 ENDIF plot x range 0 0 noerase nodata xstyle 1 4 keyword_set endpoints AND type EQ x AND lat1 NE lat2 OR type EQ y AND lon1 NE lon2 ystyle 1 _extra ex ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex trace une ligne a x 0 plot 0 0 y range noerase nodata title subtitle _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex 3eme partie: impression eventuelle fini: terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4plt1d dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps plt1d systime 1 tempsun return end "); 249 a[247] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltbase.html", "pltbase.pro", "", " NAME:pltbase PURPOSE: surcouche de contour pour tracer un champ eventuellement masque brique elementaire de plt pltz et pltt CATEGORY:un tarce vite fait et ou delestage de l ecriture de plt pltz pltt CALLING SEQUENCE: pltbase z2d x y mask xm ym levels colors INPUTS: z2d:le tableau a tracer x et y les axes vecteurs ou tableaux de meme taille que z2d Ce sont les coordonnees de z2d mask: le tableau qui masque z2d avec des 0 sur les points a masquer et des 1 sur les autres si z2d n est pas masque mettre cet argument egale a 1 xm et ym les axes du mask vecteurs ou tableaux de meme taille que mask Ce sont les coordonnees de mask levels et colors: optionnels les vecteurs qui contiennent les niveaus et les couleurs necessaires au contour S il ne sont pas donnes on prends 20 niveau entre le min et le max KEYWORD PARAMETERS: COLORTRICHAMP : la couleur que l on veut utiliser pour dessiner la triangulation qui est utilisee pour faire les contour du champ COLORTRIMASK : la couleur que l on veut utiliser pour dessiner la triangulation qui est utilisee pour faire les contour du mask COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 COLOR_C: to draw the contour in color instead of in black with filling in color CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white DESSTRICHAMP: pour dessiner la triangulation qui est utilisee pour faire les contour du champ DESSTRIMASK: pour dessiner la triangulation qui est utilisee pour faire les contour du mask FORPLT: a activer si on veut que le trace des cote soit realise par tracecote plutot que tracemask I_COLORS: un vecteur specifiant la couleur a utiliser pour tracer les contours C est la meme chose que c_colors qui ajit sur les contours MORE: chiffre a donner pour eviter les bug du style: Out of range subscript encountered: Execution halted at: PLTBASE 151 par defaut more 10 si le bug existe tjs augmenter la valeur de more l explication et la justification de cette methode n ont pas encore de fondements scientifiques NOFILL: pour faire juste les isolignes NOCONTOUR: pour faire juste les couleurs UNSUR2: pour tarcer une isoligne sur 2 UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n CONTOUR: pour etrte utilise depuis plt pltz ou pltt cf ces routines _EXTRA: mot cle magique d idl pour faire passer tous lse mots cles acceptes par les routines et fonctions utilises ds ce programme sans les declarer explicitement OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS:ds le cas ou z2d x et y sont des tableaux de meme taille il faut les metre sous forme de vecteur: z2d x y EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 8 2 2000 check if the tri array is not equal to 1 allow contour with out using a triangulation PRO pltbase z2d x y mask xm ym levels colors UNSUR2 unsur2 CONTOUR contour NOCONTOUR nocontour NOFILL nofill TRICHAMP trichamp TRIMSK trimsk REALCONT realcont NAN nan usetri usetri COLORTRICHAMP colortrichamp COLORTRIMASK colortrimask COLORTRINAN colortrinan COLORPOINTS colorpoints DRAWPOINTS drawpoints TH_TRICHAMP th_trichamp TH_TRIMASK th_trimask DESSTRICHAMP desstrichamp DESSTRIMASK desstrimask DESSTRINAN desstrinan COLOR_C color_c I_COLORS i_colors CONT_COLOR CONT_COLOR CONT_NOFILL cont_nofill UNLABSUR unlabsur COINMONTEMASK coinmontemask COINDESCENDMASK coindescendmask COINMONTENAN coinmontenan COINDESCENDNAN coindescendnan INDICEZOOMMASK indicezoommask INDICEZOOMNAN indicezoomnan MASKNAN masknan TRINAN trinan FORPLT forplt REALSECTION realsection MORE more EXCHANGE_XY exchange_xy _EXTRA ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF explication concernant contour Ce mot cle est active qd on on trace un contour en couleur different de celui en trait noir si il est active cas n_elements contour NE 0 on passe 2 fois ds pltbase: 1 on trace les couleurs puis on sort c est le cas: n_elements contour NE 0 AND n_elements contour NE 4 2 on trace les contour en trait puis les continents c est le cas n_elements contour NE 0 AND n_elements contour EQ 4 tempsun systime 1 pour key_performance if n_elements mask EQ 0 then mask 1b if n_elements masknan EQ 0 then masknan 1b IF total mask EQ n_elements z2d THEN mask 1b si les niveaux et les couleurs ne sont pas donnes if n_params EQ 4 then label 0 min z2d mask max z2d mask ncontour levels colors attention bidouille inexplicable pour que tout se passe bien avec les postcript ds pltz if n_elements contour LE 4 AND x type EQ 0 THEN plot 0 0 xstyle 5 ystyle 5 nodata noerase title subtitle si cell_fill fait partit de _extra on le desactive si il n est pas egale a 2 IF chkstru ex CELL_FILL THEN BEGIN cell_fill ex CELL_FILL if ex CELL_FILL NE 2 then ex CELL_FILL 0 ENDIF ELSE cell_fill 0 I remplissage des contours en palette de couleur if NOT keyword_set more then more 10 if NOT keyword_set nofill AND NOT keyword_set color_c then begin if n_elements contour NE 4 THEN BEGIN if usetri EQ 2 then BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size z2d 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size z2d 1 y contour z2d fltarr more x fltarr more y fltarr more levels levels c_color colors noerase fill TRIANGULATION trichamp _extra ex ENDIF ELSE BEGIN IF size x n_dimensions EQ 2 THEN x x 0 IF size y n_dimensions EQ 2 THEN y reform y 0 contour z2d x y levels levels c_color colors noerase fill _extra ex ENDELSE ENDIF ENDIF if n_elements contour NE 0 AND n_elements contour NE 4 THEN GOTO fini IF chkstru ex C_ORIENTATION THEN ex extractstru ex C_ORIENTATION IF chkstru ex C_SPACING THEN ex extractstru ex C_SPACING IF chkstru ex C_COLORS THEN ex extractstru ex C_COLORS II trace des contours en trait if n_elements contour EQ 4 OR n_elements contour EQ 0 THEN BEGIN we put the masked values to NaN IF n_elements mask GT 1 OR n_elements masknan GT 1 AND NOT keyword_set cont_nofill THEN BEGIN tonan where mask masknan EQ 0 count tonan where remplit mask masknan nite 1 mask mask masknan basique fillval 0 fillxdir keyword_set realsection EQ 0 count IF count NE 0 THEN z2d temporary tonan values f_nan ENDIF on ne passe pas si on doit faire des contours differents ds le cas on unsur2 est active on reduit levels if NOT keyword_set nocontour then begin IF keyword_set unsur2 THEN levels levels where zeroun n_elements levels eq 1 unlabsur est active C_LABEL est passe via _EXTRA if keyword_set unlabsur THEN IF chkstru ex C_LABELS THEN ex C_LABELS 1 indgen n_elements ex C_LABELS MOD unlabsur 1 pour ne pas filler qd cell_fill est impose IF chkstru ex CELL_FILL THEN ex CELL_FILL 0 CASE 1 OF keyword_set color_c :c_colors colors keyword_set i_colors :c_colors i_colors ELSE: ENDCASE IF usetri EQ 2 THEN BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size z2d 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size z2d 1 y contour z2d fltarr more x fltarr more y fltarr more levels levels overplot 1 keyword_set nofill noerase keyword_set nofill c_colors c_colors TRIANGULATION trichamp _extra ex ENDIF ELSE BEGIN IF size x n_dimensions EQ 2 THEN x x 0 IF size y n_dimensions EQ 2 THEN y reform y 0 contour z2d x y levels levels overplot 1 keyword_set nofill noerase keyword_set nofill c_colors c_colors _extra ex ENDELSE ENDIF III remplissage des continents de couleur IF chkstru ex CELL_FILL THEN ex CELL_FILL cell_fill 1 IF chkstru ex LEVELS THEN ex extractstru ex LEVELS IF chkstru ex NODATA THEN ex extractstru ex NODATA IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 si il y a des points a nan on trace en blanc les points a nan avant de dessiner les cotes avec un trait if keyword_set trinan THEN BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size masknan 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size masknan 1 y contour 1b masknan fltarr more x fltarr more y fltarr more levels 0 5 overplot fill c_colors cont_color TRIANGULATION trinan _extra ex IF keyword_set forplt THEN completecointerre COINMONTE coinmontenan COINDESCEND coindescendnan INDICEZOOM indicezoomnan CONT_COLOR cont_color _EXTRA ex ELSE fillcornermask x 0 y 0 COINMONTE coinmontenan COINDESCEND coindescendnan CONT_COLOR cont_color _extra ex ENDIF remplissage des continents if keyword_set realcont then if realcont EQ 1 then mask 1b if n_elements mask NE 1 then BEGIN si mask 1 on saute if NOT keyword_set cont_nofill then BEGIN mask filling case 1 of keyword_set realsection :drawsectionbottom mask xm ym CONT_NOFILL cont_nofill CONT_COLOR cont_color _EXTRA ex usetri GE 1:BEGIN if n_elements trimsk eq 0 then trimsk trichamp IF size xm N_DIMENSIONS EQ 1 THEN xm xm replicate 1 size mask 2 IF size ym N_DIMENSIONS EQ 1 THEN ym replicate 1 size mask 1 ym contour 1b mask fltarr more xm fltarr more ym fltarr more LEVELS 0 5 OVERPLOT FILL C_COLORS cont_color TRIANGULATION trimsk _extra ex IF keyword_set forplt THEN completecointerre COINMONTE coinmontemask COINDESCEND coindescendmask INDICEZOOM indicezoommask CONT_COLOR cont_color _EXTRA ex ELSE fillcornermask xm 0 ym 0 COINMONTE coinmontemask COINDESCEND coindescendmask CONT_COLOR cont_color _extra ex END ELSE:BEGIN IF size xm n_dimensions EQ 2 THEN xm xm 0 IF size ym n_dimensions EQ 2 THEN ym reform ym 0 contour 1b mask xm ym LEVELS 0 5 OVERPLOT FILL C_COLORS cont_color _EXTRA ex END ENDCASE ENDIF NOT keyword_set cont_nofill IV trace les cotes en trait case 1 of keyword_set realsection AND NOT keyword_set cont_nofill : keyword_set realsection AND keyword_set cont_nofill : drawsectionbottom mask xm ym CONT_NOFILL cont_nofill _extra ex keyword_set forplt AND map projection GT 0 OR key_irregular OR keyword_set nan :tracecote _extra ex ELSE:tracemask mask xm ym _extra ex endcase ENDIF n_elements mask NE 1 ENDIF draw the triangulations if keyword_set desstrichamp then dessinetri trichamp x y color colortrichamp thick th_trichamp if keyword_set desstrimask then dessinetri trimsk xm ym color colortrimask thick th_trimask if keyword_set desstrinan then dessinetri trinan x y color colortrinan if keyword_set drawpoints then tracegrille x y color colorpoints fini: IF keyword_set key_performance THEN print temps pltbase systime 1 tempsun return end"); 250 a[248] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltsc.html", "pltsc.pro", "", "PRO pltsc tab1 tab2 min1 max1 min2 max2 varname2 BOXZOOM boxzoom COL1D col1d STY1D sty1d OV1D ov1d _extra ex scatter plot inspired from plt1d include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF Rq: on ne reinitialise pas qd on rapelle pltsc if NOT keyword_set ov1d then reinitplt reduce data xyzt domain if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: Begin ras report Wrong Definition of Boxzoom return End endcase savedbox 1b saveboxparam boxparam4pltsc dat domdef bte GRIDTYPE vargrid ENDIF extract indexes to plot indexm where tab1 LE valmask 10 tab1 tab1 indexm tab2 tab2 indexm npts size indexm 1 deal with min and max of plot IF finite min1 EQ 0 THEN min1 min tab1 IF finite max1 EQ 0 THEN max1 max tab1 IF finite min2 EQ 0 THEN min2 min tab2 IF finite max2 EQ 0 THEN max2 max tab2 init plot if not overlay IF NOT keyword_set ov1d THEN placedessin yfx posfenetre posbar contour contour _extra ex yy tab1 xx tab2 axis range x range min2 abs max2 min2 5 max2 abs max2 min2 5 y range min1 abs max1 min1 5 max1 abs max1 min1 5 IF NOT keyword_set sty1d THEN sty1d 0 IF NOT keyword_set col1d THEN col1d 0 IF NOT keyword_set ov1d THEN BEGIN legende min1 max1 yfx VARNAME2 varname2 NPTS npts _EXTRA ex plot xx yy background 255 psym sty1d 1 color col1d thick 2 title subtitle _extra ex if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur 0 et trace une ligne a y 0 if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 if where tag_names ex EQ LINESTYLE 0 NE 1 then ex LINESTYLE 0 ENDIF plot x range 0 0 noerase nodata xstyle 1 ystyle 1 _extra ex trace une ligne a x 0 plot 0 0 y range noerase nodata title subtitle _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex 3eme partie: impression eventuelle fini: terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4pltsc dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps plt1d systime 1 tempsun return end "); 251 a[249] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltt.html", "pltt.pro", "", " NAME: PLTT PURPOSE: trace des graphes hovmoller CATEGORY: Graphics trace des graphes hovmoller: xt yt zt t CALLING SEQUENCE: pltt champ type min max datmin datmax INPUTS: champ: le champ dont on veut faire le hovmoller champ peut etre de 2 types: 1 un tableu qui peut etre: 3d ou 4d: la derniere composante etant le temps dans ce cas le tableau va passer dans grossemoyenne pour etre moyennee suivant et devenir un tableau 2d ou 1d 2d: si tableau est deja 2d il n est pas modifie attention les terres doivent etre masquees a la valeure valmask et type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 1d: uniquement pour les traces de type t Type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp Le tableau contennu ds la structure repondant aux criteres du cas 1 cf ci dessus TYPE: type de hovmoller que l on veut faire: xt yt zt t ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tableau sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tableau sur les pts mer DATMIN: c est la borne inf de l axe temporel c est un longinteger de la forme yyyymmdd ou bien yymmdd DATMAX: c est la borne max de l axe temporel c est un longinteger de la forme yyyymmdd ou bien yymmdd KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique 3d sur laquelle doit etre fait l extraction du champ pour faire le hovmoeller Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom vert1 vert2 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 vert1 vert2 sont les variables globales definies lors du dernier domdef CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ reponadnt aux meme caracteristiques que l argument numero 1 de pltt ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees EXCHANGE_XY: permet d intervertir les axes FILTER: applique une moyenne glissante de largeur FILTER INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilise pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot COL1d: OBSOLETE numero de la couleur qd on fait un trace 1d par defaut 0 il faut mieux utiliser le mot cle COLOR utilise par plot MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie CONTNLEVEL: nombre de contours a dessiner qd on utilise ajoutcontour active par le mot cle CONTOUR actif si CONTLABEL 0 par defaut 20 NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre Rq: activer ds le cas d un Postscript de plusieurs traces de type t pour ne pas faire un Postscript de plusieurs pages OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d OVERPLOT: pour faire un pltt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur dans le cas d un plot 1d contrairement a ov1d on peut changer les axes et les ranges PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REPEAT_C n pour repeter une serie temporelle n fois REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro STY1D: OBSOLETE numero du style utilise lors d un trace 1d Il faut mieux utiliser le mot cle LINESTYLE qui est celui de plot Attention ce mot cle est encore utile si on veut faire des barres plutot qu une courbe mettre sty1d bar TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant TREND_TYPE: modify data by calling trends pro TYPEIN: permet de specifier la valeur type de hovmoller que l on veut faire: xt yt zt t a l aide d un mot cle plutot que par l argument type Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue USETRI: pour forcer a utiliser de triangulation UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x Par defaut 1 Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 27 5 98 Jerome Vialard adapting plt to hovmoller drawing 2 7 98 Sebastien Masson 14 8 98 continents barres 15 1 98 adaptation pour les tableaux 3 et 4d pour que la moyenne soit faite dans pltt plutot que lors de la lecture Sebastien Masson 14 8 98 7 1999 Eric Guilyardi 29 7 99 FILTER TREND_TYPE REPEAT_C Sebastien Masson 08 02 2000 checkfield and usetri keyword pro pltt tab giventype givenmin givenmax datmin datmax BOXZOOM boxzoom CONTOUR contour ENDPOINTS endpoints INTERVALLE intervalle INV inv CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel COL1D col1d STY1D sty1d MININ minin MAXIN maxin OV1D ov1d FILTER filter TREND_TYPE trend_type REPEAT_C repeat_c TYPEIN typein XT XT YT YT ZT zt TT tt STRICTFILL strictfill OVERPLOT overplot EXCHANGE_XY exchange_xy _extra ex include common cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I2 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot AND NOT keyword_set ov1d then reinitplt I1 lecture du champ if keyword_set boxzoom OR keyword_set endpoints AND n_elements contour ne 4 THEN BEGIN savedbox 1b saveboxparam boxparam4pltt dat ENDIF if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein ENDIF checktypeminmax pltt TYPE type MIN min MAX max XT XT YT YT ZT zt TT tt ENDPOINTS endpoints _extra ex if keyword_set endpoints then begin section tab z2d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc nx n_elements glam ny nx if strupcase vargrid EQ W then begin z gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN z gdept firstzt:lastzt nz nzt ENDELSE ENDIF ELSE BEGIN z2d checkfield tab pltt TYPE type BOXZOOM boxzoom direc direc _extra ex if z2d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4pltt dat return endif grille mask glam gphi gdep nx ny nz ENDELSE calcul de tendance anomaly suivant TREND_TYPE IF NOT keyword_set trend_type THEN trend_type 0 IF trend_type GT 0 THEN z2d trends z2d trend_type type filtrage des donnee dans le cas t IF type EQ t AND keyword_set filter THEN BEGIN print Applying a running mean filter of width string filter format I3 z2d smooth z2d filter z2d 0:filter 2 1 0 z2d size z2d 1 filter 2 1: size z2d 1 1 0 ENDIF repetition de la serie temporelle IF NOT keyword_set repeat_c THEN repeat_c 1 temps time 0:jpt 1 IF repeat_c GT 1 THEN BEGIN taille size z2d CASE taille 0 OF 1: z2d reform z2d replicate 1 repeat_c taille 1 repeat_c 2: BEGIN z2d z2d replicate 1 repeat_c z2d reform z2d taille 1 taille 2 repeat_c over END ELSE: ENDCASE temps temps lindgen jpt REPEAT_c 1 1 temps 1 temps 0 temps jpt 1 ENDIF selection du type de graphique taille size z2d case taille 0 of 2 : typdes 2d 1 : begin z1d z2d typdes 1d if keyword_set OV1D then begin yy z2d if n_elements datmin NE 0 then tempsmin date2jul datmin ELSE tempsmin temps 0 on shift l axe du temps pour des questions de precision sur les dates du calendier julien en long qui sont passes en float ds les axes xx temps tempsmin x range x range tempsmin x tickv x tickv tempsmin on fait un faux plot pour appliquer ces changements plot 0 0 noerase xstyle 5 ystyle 5 title subtitle ytitle xtitle goto trace1d endif end endcase on construit le mask pour cela le tableau doit etre masque fait automatiquement a la valeur valmask si on passe ds moyenne ou grossemoyenne nan total finite z2d nan z2d not very nice when xgridstyle 2 same if xticklen 0 5 not very nice in the middle so we draw the top right axis by hand using axis if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 nodata noerase _extra ex xstyle 1 4 keyword_set endpoints AND type EQ xt AND lat1 NE lat2 8 type EQ yt OR type EQ zt ystyle 1 4 keyword_set endpoints AND type EQ yt 8 type EQ xt call axis for the missing axis IF type EQ xt AND NOT keyword_set endpoints THEN BEGIN if n_elements ex NE 0 then if where tag_names ex EQ YTICKNAME 0 NE 1 then ex YTICKNAME replicate n_elements ex YTICKNAME axis yaxis 1 ystyle 1 yticklen 0 ytickname replicate y ticks 1 _extra ex ENDIF IF type EQ yt OR type EQ zt AND NOT keyword_set endpoints THEN BEGIN if n_elements ex NE 0 then if where tag_names ex EQ XTICKNAME 0 NE 1 then ex XTICKNAME replicate n_elements ex XTICKNAME axis xaxis 1 xstyle 1 xticklen 0 xtickname replicate x ticks 1 _extra ex ENDIF ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex endif 1d trace1d: if typdes eq 1d then begin if not keyword_set col1d then col1d 0 if keyword_set sty1d then BEGIN si on veut faire des barres IF strlowcase strtrim sty1d EQ bar then begin y range y range 0 y range 1 y range 0 05 y range 1 bar_plot yy background d n_colors 1 not very nice when xgridstyle 2 same if xticklen 0 5 not very nice in the middle so we draw the top axis by hand using axis if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 nodata noerase xstyle 1 8 1 keyword_set exchange_xy ystyle 1 8 keyword_set exchange_xy _extra ex call axis for the missing axis if n_elements ex NE 0 then BEGIN force tickname to blank array if where tag_names ex EQ YTICKNAME 0 NE 1 AND keyword_set exchange_xy then ex YTICKNAME replicate n_elements ex YTICKNAME if where tag_names ex EQ XTICKNAME 0 NE 1 AND NOT keyword_set exchange_xy then ex XTICKNAME replicate n_elements ex XTICKNAME ENDIF if keyword_set exchange_xy then axis yaxis 1 ystyle 1 yticklen 0 ytickname replicate y ticks 1 _extra ex ELSE axis xaxis 1 xstyle 1 xticklen 0 xtickname replicate x ticks 1 _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex endif fini: on remet l axe du temps en jours julien IDL et non pas en jours juliens comptes a partir tempsmin if type EQ xt then BEGIN y range y range tempsmin y tickv y tickv tempsmin ENDIF ELSE BEGIN x range x range tempsmin x tickv x tickv tempsmin ENDELSE on fait un faut plot pour que ces valeurs soient prises en consideration plot 0 0 nodata noerase xstyle 5 ystyle 5 title subtitle ytitle xtitle 3eme partie: impression eventuelle terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4pltt dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps pltt systime 1 tempsun return end "); 252 a[250] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltz.html", "pltz.pro", "", " NAME: PLTZ PURPOSE: trace des graphes verticaux CATEGORY: Graphics CALLING SEQUENCE: pltz champ min max INPUTS: champ: le champ dont on veut faire la coupe verticale champ peut etre de 2 types: 1 un tableau 2d ou 3d Si le champ est 2d undiquer avec le mot cle boxzoom les delimitations geographiques de la boxzoom Si le chyamp est 3d on extrait la section et on moyenne eventuellement avant de faire le plot 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp le tableau contenu ds la structure doit etre 2 ou 3d cf cas 1 si dessus ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tab1 sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tab1 sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique sur laquelle doit etre faite la coupe Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom 0 200 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 sont les variables globales definies lors du dernier domdef CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ reponadnt aux meme caracteristiques que l argument numero 1 de pltz ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilisee pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee ZRATIO: lorsque le dessin presente une partie zoomee rapport de taille entre la partie zommee hz hauteur zoom et le dessin entier ht hauteur total Par defaut 2 3 LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou la fenetre a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre NOTRI: pour forcer a ne pas utiliser de triangulation OVERPLOT: pour faire un plt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin SIN: activer ce mot cle si l on veut que l axe des x soit trace en sinus de la latitude qd on fait une coupe yz STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W XZ: force a faire une coupe xz YZ: force a faire une coupe yz YXASPECT: rapport d echelle entre y et x par ex: 1 pour un repere presque orthonorme 2 si l axe des y est environ deux fois plus dilate que celui des x Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W ZOOM: profondeur jusqu a laquelle on fait un zoom par defaut 200m ou la profondeur maximale si elle est inf a 200 ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1999 Sebastien Masson 08 02 2000 checkfield and notri keyword pro pltz tab giventype givenmin givenmax BOXZOOM boxzoom CONTOUR contour ENDPOINTS endpoints INTERVALLE intervalle INV inv ZRATIO zratio CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax SIN sin TYPEIN typein CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel NOTRI notri USETRI usetri FILLXDIR fillxdir ZOOM zoom XZ xz YZ yz MININ minin MAXIN maxin STRICTFILL strictfill OVERPLOT overplot MASKFILL maskfill WDEPTH wdepth REALSECTION realsection _EXTRA ex include common cm_4mesh cm_4data cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance 1ere partie: initialisation et petits calculs on ne reinitialise pas qd on rapelle pltz en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot then reinitplt if n_elements contour ne 4 THEN saveboxparam boxparam4pltz dat lecture du champ if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if n_elements realsection EQ 0 then realsection 1 IF n_elements usetri EQ 0 THEN BEGIN IF n_elements notri NE 0 THEN usetri 2 notri ELSE usetri 1 ENDIF no need of triangulation IF usetri EQ 1 AND keyword_set realsection THEN usetri 0 did we specify the type if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein ENDIF checktypeminmax pltz TYPE type MIN min MAX max XZ xz YZ yz ENDPOINTS endpoints _extra ex if keyword_set endpoints then begin section tab z2d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc WDEPTH wdepth _extra ex if z2d 0 EQ 1 AND n_elements contour ne 4 then BEGIN restoreboxparam boxparam4pltz dat return ENDIF nx n_elements glam ny nx if strupcase vargrid EQ W then begin gdep gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN gdep gdept firstzt:lastzt nz nzt ENDELSE mask z2d LE valmask 10 ENDIF ELSE BEGIN z2d checkfield tab pltz TYPE type BOXZOOM boxzoom DIREC direc WDEPTH wdepth _extra ex if z2d 0 EQ 1 AND n_elements contour ne 4 then BEGIN restoreboxparam boxparam4pltz dat return ENDIF IF realsection EQ 1 THEN grille mask glam gphi gdep nx ny nz ifpltz type WDEPTH wdepth ELSE grille mask glam gphi gdep nx ny nz WDEPTH wdepth ENDELSE stop profmax y range 0 profmin y range 1 if not keyword_set zoom then zoom 200 zoom zoom 0 IF zoom LT profmin THEN zoom profmax if zoom GE vert2 then zoom profmax construction of the mask and of the axis axis4pltz type mask glam gphi gdep XXAXIS xxaxis ZZAXIS zzaxis SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex to draw from bottom to top avoid using cell_fill z2d reverse z2d 2 determination du mi:min et du ma:max de tab1 ainsi que de max: max et min: min pour le dessin nan total finite z2d nan z2d max if n_elements maskfill NE 0 then BEGIN z2d z2d mask masknan if maskfill NE 0 then z2d temporary z2d maskfill 1b mask masknan ENDIF check the mask and the triangulation according to the grid type and nan values find the coordinates of the mask if where mask EQ 0 0 EQ 1 AND NOT keyword_set nan then notri 1 if keyword_set notri then trifield 1 ELSE trifield triangule mask basic if usetri GE 1 AND vargrid EQ T OR vargrid EQ W OR usetri EQ 2 AND vargrid NE T AND vargrid NE W THEN trifield triangule mask basic IF NOT keyword_set endpoints THEN BEGIN if keyword_set nan then trinan triangule masknan basic coinmonte coinmontenan coindescend coindescendnan decoupeterre mask glammsk gphimsk gdepmsk type type WDEPTH wdepth REALSECTION realsection axis4pltz type mask glammsk gphimsk gdepmsk XXAXIS xmask ZZAXIS zmask SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex ENDIF ELSE BEGIN xmask xxaxis zmask zzaxis ENDELSE if usetri GE 1 AND vargrid NE T AND vargrid NE W THEN BEGIN IF keyword_set realsection THEN trimsk triangule mask basic ELSE trimsk triangule mask basic coinmonte coinmontemask coindescend coindescendmask ENDIF dessin en lui meme pltbase z2d xxaxis zzaxis mask xmask zmask level_z2d colnumb overplot overplot contour contour trichamp trifield trimsk trimsk c_linestyle linestyle c_labels 1 indgen n_elements level_z2d MOD 2 c_thick thick unsur2 unsur2 masknan masknan trinan trinan coinmontenan coinmontenan coindescendnan coindescendnan coinmontemask coinmontemask coindescendmask coindescendmask REALSECTION realsection USETRI usetri _extra ex rappelle de pltz en boucle qd contour est active if n_elements contour eq 4 then BEGIN c est la 2eme fois que je passe ds pltt contour mietma: mi ma unit:varunit inter:intervalle je renvoie le min le max et l unite return endif if keyword_set contour THEN BEGIN pourlegende 1 1 1 1 oldattributs saveatt oldcolnumb colnumb pltz contour contmin contmax CONTOUR pourlegende ZRATIO zratio INTERVALLE contintervalle LABEL contlabel STYLE style noerase NLEVEL contnlevel ZOOM zoom BOXZOOM boxzoom ENDPOINTS endpoints STRICTFILL strictfill REALSECTION realsection MASKFILL maskfill USETRI usetri WDEPTH wdepth _extra ex restoreatt oldattributs colnumb oldcolnumb ENDIF 3eme partie: dessin du cadre legendes colorbar if keyword_set overplot then BEGIN y range zoom profmin on repasse en coordonees physiques plot 0 0 nodata noerase title subtitle xstyle 5 ystyle 5 GOTO fini endif legendes affichage de celles ci legende mi ma type CONTOUR pourlegende INTERVALLE intervalle DIREC direc endpoints endpoints _EXTRA ex if type eq yz then xaxe lataxe else xaxe lonaxe if keyword_set sin OR NOT key_onearth then xaxe cadre applique par defaut plot xxaxis 0 xxaxis n_elements xxaxis 1 zratio zratio noerase xstyle 1 4 keyword_set endpoints AND type EQ xz AND lat1 NE lat2 OR type EQ yz AND lon1 NE lon2 xtickformat xaxe _extra ex ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex axe y en 1 ou 2 parties if n_elements ex NE 0 then BEGIN pour ne plus mettre de titre if where tag_names ex EQ TITLE 0 NE 1 then ex TITLE pour ne plus mettre de sous titre if where tag_names ex EQ SUBTITLE 0 NE 1 then ex SUBTITLE pour n avoir q un ytitle if where tag_names ex EQ YTITLE 0 NE 1 then BEGIN ytitle ex YTITLE ex YTITLE endif ENDIF htotal posfenetre 3 posfenetre 1 hzoom 1 zratio htotal if zoom LT profmax then plot 0 0 nodata noerase ystyle 1 yrange profmax zoom 0 001 position posfenetre 0 0 0 hzoom _extra ex title subtitle ytitle y range zoom profmin on repasse en coordonees physiques plot 0 0 nodata noerase ystyle 1 _extra ex title subtitle ytitle position posfenetre 0 htotal hzoom 0 0 pour ecrire le ytitle if d name EQ PS then xs max page_size min mi 1 key_portrait mi key_portrait d x_px_cm ELSE xs d x_size if n_elements ytitle NE 0 then y title ytitle charsize chkstru ex ycharsize extract if charsize EQ 1 then charsize p charsize IF chkstru ex charsize THEN ex charsize charsize if chkstru ex ytitle extract NE then decalage string format e10 3 profmax decalage float strmid decalage strpos decalage e 1 posy posfenetre 1 1 htotal 2 posx posfenetre 0 decalage 3 d x_ch_size charsize xs xyouts posx posy y title normal orientation 90 color 0 ALIGNMENT 5 charsize charsize _extra ex barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex 4eme partie: impression eventuelle fini: terminedessin _extra ex sortie: restoreboxparam boxparam4pltz dat if keyword_set key_performance NE 0 THEN print temps pltz systime 1 tempsun return end "); 253 a[251] = new Array("./ToBeReviewed/PLOTS/DESSINE/sbar_plot.html", "sbar_plot.pro", "", " NAME:sbar_plot super bar_plot PURPOSE: meme chose que bar_plot mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: sbar_plot y INPUTS: cd IDL bar_plot KEYWORD PARAMETERS: meme que ceux de bar_plot avec en plus: COLORS: un entier donnant la couleur de toutes les barres de couleurs contrairement a colors qui est en vecteur donnant le couleur de chaque barre de couleur NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: Si NOREINITPLT n est pas ective toutes les variables d environnemet p x y z sont reinitialisees par la procedure reinitplt RESTRICTIONS: EXAMPLE: IDL sbar_plot indgen 10 small 2 2 2 rempli IDL sbar_plot indgen 10 small 2 2 3 noerase IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 10 1999 PRO sbar_plot Values COLORS colors NOREINITPLT noreinitplt _extra ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript IF chkstru ex overplot EQ 0 THEN placedessin autre _extra ex 3 je fais mon joli dessin if n_elements COLORS NE 0 then BEGIN if n_elements COLORS EQ n_elements Values then col colors ELSE col replicate colors 0 n_elements Values ENDIF ELSE col congrid indgen d n_colors 256 n_elements Values bar_plot Values background p background colors col xstyle 1 ystyle 1 _extra ex 4 je termine le dessin terminedessin _extra ex return end"); 254 a[252] = new Array("./ToBeReviewed/PLOTS/DESSINE/scontour.html", "scontour.pro", "", " NAME:scontour super contour PURPOSE: meme chose que contour mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: scontour z x y INPUTS:cd IDL contour KEYWORD PARAMETERS: meme que ceux de bar_plot avec en plus: NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL z dist 100 IDL scontour z nlevels 10 small 1 2 1 xstyle 1 ystyle 1 IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 10 1999 PRO scontour x y z NOREINITPLT noreinitplt _EXTRA ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript if ex contains norease and c_orientation keywords we force ex noerase 0 IF chkstru ex overplot EQ 0 THEN placedessin autre _extra ex fiddle when noerase is used with c_orentation call contour with nodata to get the graphic envoronment then force noerase 0 and overplot 1 IF size ex type EQ 8 THEN BEGIN check if noerase is used with c_orentation alltags strlowcase tag_names ex dummy where alltags EQ noerase count1 dummy where alltags EQ c_orientation count2 IF count1 count2 NE 0 THEN BEGIN case n_params OF 1:contour x nodata _EXTRA ex 2:contour x y nodata _EXTRA ex 3:contour x y z nodata _EXTRA ex endcase ex noerase 0 ex get_extra overplot _extra ex noerase_orientation 1 ENDIF ENDIF 3 je fais mon joli dessin case n_params OF 1:contour x xstyle 1 ystyle 1 _EXTRA ex 2:contour x y xstyle 1 ystyle 1 _EXTRA ex 3:contour x y z xstyle 1 ystyle 1 _EXTRA ex ENDCASE fiddle when noerase is used with c_orentation draw the contour axis IF keyword_set noerase_orientation THEN BEGIN ex noerase 1 ex overplot 0 case n_params OF 1:contour x xstyle 1 ystyle 1 nodata _EXTRA ex 2:contour x y xstyle 1 ystyle 1 nodata _EXTRA ex 3:contour x y z xstyle 1 ystyle 1 nodata _EXTRA ex ENDCASE ENDIF 4 je termine le dessin terminedessin _extra ex return end"); 255 a[253] = new Array("./ToBeReviewed/PLOTS/DESSINE/splot.html", "splot.pro", "", " NAME:splot super plot PURPOSE: meme chose que plot mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: PLOT X Y INPUTS:cd IDL plot KEYWORD PARAMETERS: meme que ceux de plot avec en plus: NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: Si NOREINITPLT n est pas ective toutes les variables d environnemet p x y z sont reinitialisees par la procedure reinitplt COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL splot indgen 10 ystyle 1 small 1 2 1 portrait IDL splot indgen 10 ystyle 1 small 1 2 2 noerase IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 PRO splot x y NOREINITPLT noreinitplt _EXTRA ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript placedessin autre _extra ex 3 je fais mon joli dessin if n_elements y EQ 0 then plot x xstyle 1 ystyle 1 _EXTRA ex ELSE plot x y xstyle 1 ystyle 1 _EXTRA ex 4 je termine le dessin terminedessin _extra ex return end"); 256 a[254] = new Array("./ToBeReviewed/PLOTS/DESSINE/tvplus.html", "tvplus.pro", "", " NAME: tvplus PURPOSE: enhanced version of tvscl CATEGORY: quick exploration of 2D arrays CALLING SEQUENCE: tvplus z2d cellsize INPUTS: z2d: 2D array to visualize cellsize: optional this is the size in pixel of the square representing 1 array element By default this size is computed automatically in order that the size of the plotting window do not exceed the screen size If the user specify a large value of cellsize that forces tvplus to create a window larger than the screen a scrolling window will be displayed instead of a regular window Unfortunately the nice fonctionnalities of tvplus are not coded for scrolling window case KEYWORD PARAMETERS: BOTTOM: The lowest color index of the colors to be loaded in the bar default is 0 C_NAN: The color number that should be used for the NaN values default value is d n_colors 1 e6 the test to find the masked value is ge abs mask 10 This is necessary to avoid the rounding errors MIN and MAX: scalars used to specify the min and max values of the color bar default is from 0 to d n_colors tvplus dist 100 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 18 12 98 Aug 2005: quick cleaning english PRO tvplus z2d cellsize BOTTOM bottom C_MASK c_mask C_NAN c_nan WINDOW window MIN min MAX max MASK mask OFFSET offset NOUSEINFOS NOUSEINFOS NCOLORS ncolors NOINTERP nointerp _EXTRA ex IF n_elements z2d EQ 0 THEN return arr reform float z2d check the size of the input array if size arr 0 NE 2 then begin ras report Input array must have only 2 dimensions and not strtrim size arr n_dimensions 1 return endif def of ncolmax bottom topcol et ncolors ncolmax d n_colors arr truemin min ENDIF ELSE truemin min arr if n_elements max NE 0 then BEGIN arr arr floor x cellsize floor y cellsize floor x cellsize floor y cellsize floor x2 cellsize floor y2 cellsize size arr 2 cellsize 1 x x x2 x x sort x y y y2 y y sort y IF keyword_set OFFSET THEN offset x 0 y 0 offset ELSE offset x 0 y 0 tvplus z2d x 0 :x 1 y 0 :y 1 WINDOW window MIN min MAX max MASK mask C_MASK c_mask C_NAN c_nan NOUSEINFOS OFFSET OFFSET NCOLORS ncolors NOINTERP nointerp BOTTOM bottom _EXTRA ex return END ELSE: endcase ENDWHILE x xenvsauve y yenvsauve p penvsauve x range 1 0 nx cellsize 5 offset 0 y range 1 0 ny cellsize 5 offset 1 return end"); 257 a[255] = new Array("./ToBeReviewed/PLOTS/DIVERS/addaxe.html", "addaxe.pro", "", " NAME:addaxe PURPOSE:ajoute un axe qd on fait une section oblique ds pltz pltt ou plt1d CATEGORY:autour de pltz pltt et plt1d CALLING SEQUENCE:addaxe type posfenetre INPUTS:endpoints:coordonnees des extremites de a section type: un string de 2 characteres specifiant qule type de plot on fait posfenetre: ler vecteur p posotion correspondant a a position du cadre de la partie dessin du plot KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO addaxe endpoints type posfenetre _EXTRA ex common IF strpos type x NE 1 THEN BEGIN IF endpoints 1 EQ endpoints 3 THEN return IF key_onearth THEN BEGIN formeaxe0 lonaxe formeaxe1 lataxe titreaxe latitude ENDIF ELSE BEGIN formeaxe0 formeaxe1 titreaxe j index ENDELSE range endpoints 1 endpoints 3 if endpoints 2 LT endpoints 0 THEN range reverse range ENDIF ELSE BEGIN IF endpoints 0 EQ endpoints 2 THEN return IF key_onearth THEN BEGIN formeaxe0 lataxe formeaxe1 lonaxe titreaxe longitude ENDIF ELSE BEGIN formeaxe0 formeaxe1 titreaxe i index ENDELSE range endpoints 0 endpoints 2 if endpoints 3 LT endpoints 1 THEN range reverse range ENDELSE if type EQ yt then BEGIN axis yaxis 0 ytickformat formeaxe0 color 0 ystyle 1 _EXTRA ex axis yaxis 1 ytickformat formeaxe1 color 0 ystyle 1 ytitle titreaxe yrange range _EXTRA ex ENDIF ELSE BEGIN axis xaxis 0 xtickformat formeaxe0 color 0 xstyle 1 _EXTRA ex axis xaxis 1 xtickformat formeaxe1 color 0 xstyle 1 xtitle titreaxe xrange range _EXTRA ex ENDELSE return end"); 258 a[256] = new Array("./ToBeReviewed/PLOTS/DIVERS/autoscale.html", "autoscale.pro", "", " NAME: autoscale PURPOSE: on donne un min et un max et la procedure renvoie le contour intevalle qui va bien et la valeur des labels CATEGORY: autour de CONTOUR CALLING SEQUENCE: autoscale min max ci INPUTS: min et max: 2 reels specifiants entre quel min et quel max on veut tracer un contour KEYWORD PARAMETERS: none OUTPUTS: ci et evenuellement levels ci est un reel qui donne le contour intevalle A utiliser ds CONTOUR avlec le mot clef LEVEL COMMON BLOCKS: SIDE EFFECTS: CI est un multiple de l unite en unite log de 10 force le nombre de contour a etre pair RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: G Roullet aout 99 gr lodyc jussieu fr PRO autoscale min max ci estimation d un premier CI notez la presence du floor arrondi inferieur ce CI est un multiple de l unite en unite log de 10 ci max min 20 ci 10 floor alog10 ci n 0 ci0 ci coef 2 2 5 5 10 test differents CI contour intervales i e 1 2 2 5 5 et 10 jusqu a ce que le nombre de contours soit inferieur a 30 WHILE ceil max min ci GE 30 DO BEGIN ci ci0 coef n n n 1 ENDWHILE min floor min ci 2 ci 2 max ceil max ci 2 ci 2 nlevels round max min ci force le nombre de contour a etre pair IF nlevels MOD 2 EQ 1 THEN BEGIN nlevels nlevels 1 max max ci END END "); 259 a[257] = new Array("./ToBeReviewed/PLOTS/DIVERS/axis4pltz.html", "axis4pltz.pro", "", " NAME:axis4pltz PURPOSE:compute the mask and the axis for a vertical section CATEGORY: CALLING SEQUENCE: INPUTS:mask: 3d mask glam gphi: 2d longitudes and latitudes z:1d depth KEYWORD PARAMETERS: XXAXIS to get the xaxis we need to use in pltbase ZZAXIS to get the yaxis we need to use in pltbase Others: see pltz OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 24 2002 PRO axis4pltz type mask glam gphi z XXAXIS xxaxis ZZAXIS zzaxis SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex include common cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF define the mask used for this section if mask 0 NE 1 AND size mask 0 NE 2 then begin if type EQ xz then mask total mask 2 1 ELSE mask total mask 1 1 endif define xxaxis and yyaxis the axis used for this section nx size glam 1 CASE size gphi 0 OF 1:ny size gphi 1 2:ny size gphi 2 ENDCASE CASE size z 0 OF 1:nz size z 1 2:nz size z 2 ENDCASE if type eq yz then BEGIN IF size gphi 0 EQ 1 then xxaxis gphi ELSE BEGIN IF keyword_set key_irregular THEN BEGIN cln where gphi EQ max gphi 0 xxaxis reform gphi cln MOD nx ENDIF ELSE xxaxis reform gphi 0 ENDELSE if keyword_set sin then xxaxis sin pi 180 xxaxis if size z 0 EQ 1 THEN zzaxis z ELSE zzaxis z ENDIF ELSE BEGIN xxaxis glam 0 if size z 0 EQ 1 then zzaxis z ELSE zzaxis z ENDELSE on projette l axe z dans 0 1 if not keyword_set zratio then zratio 2 3 if zoom ge profmax then zratio 1 if zoom LT profmax then begin mp projsegment profmin zoom 0 zratio mp zzaxis where zzaxis LE zoom mp 0 zzaxis where zzaxis LE zoom mp 1 mp projsegment zoom profmax zratio 1 mp zzaxis where zzaxis GE zoom mp 0 zzaxis where zzaxis GE zoom mp 1 ENDIF ELSE BEGIN mp projsegment profmin profmax 0 1 mp zzaxis mp 0 zzaxis mp 1 ENDELSE to draw from bottom to top avoid using cell_fill CASE size zzaxis n_dimensions OF 1:zzaxis reverse zzaxis 2:zzaxis reverse zzaxis 2 ENDCASE if mask 0 NE 1 then mask reverse mask 2 return end"); 260 a[258] = new Array("./ToBeReviewed/PLOTS/DIVERS/barrecouleur.html", "barrecouleur.pro", "", " NAME:barrecouleur PURPOSE:surcouche de colorbar CATEGORY:delestage de l ecriture de plt pltz pltt CALLING SEQUENCE:barrecouleur SIDE EFFECTS: passer tous les arguments que l on veut grace a _extra MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 23 12 98 PRO barrecouleur colnumb clbinf clbsup clbdiv NOCOLORBAR nocolorbar CB_TITLE cb_title NOFILL nofill COLOR_c color_c min min max max divisions divisions CB_SUBTITLE cb_subtitle POST post _extra ex cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF if keyword_set min then clbinf min if keyword_set max then clbsup min if keyword_set divisions THEN clbdiv divisions nocolorbar keyword_set nocolorbar keyword_set nofill keyword_set color_c def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used colorbarparam colnumb:colnumb clbinf:clbinf clbsup:clbsup clbdiv:clbdiv ENDIF ELSE BEGIN save colnumb clbinf clbsup clbdiv file myuniquetmpdir 4colorbar dat ENDELSE if keyword_set nocolorbar then return ancienx x ancieny y ancienp p reinitplt x style 1 y style 1 colorbar cb_color 0 cb_charsize ancienp charsize pscolor keyword_set post division clbdiv min clbinf max clbsup cb_title cb_title discret colnumb _extra ex x ancienx y ancieny p ancienp return end"); 261 a[259] = new Array("./ToBeReviewed/PLOTS/DIVERS/checkfield.html", "checkfield.pro", "", " NAME:checkfield PURPOSE:en entree de plt pltz pltt et plt1d verifie que le champ donne a bien une taille compatible avec le domaine et fait au besoin les moyennes pour ressortir en fin de fonction un tableau 2d si on fait un plot du type: xy xz xt yz yt zt ou un tableau 1d si on fait un plot du type x y z t CATEGORY:en entree de plt pltz pltt et plt1d CALLING SEQUENCE:res checkfield field procedure INPUTS: filed: un champ recomdant aux criteres de litchamp pro cf IDL xhelp litchamp KEYWORD PARAMETERS: WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 08 02 2000 FUNCTION err_1d type n1 name n2 return report Error in type type plot with a 1D input array: the number of elements of the input vector strtrim n1 1 is not equal to name strtrim n2 1 simple END FUNCTION err_2d type sz nx ny nz cm_4mesh cm_4cal return report Error in type type plot with a 2D input array: the array dimensions tostr sz 1:2 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION err_3d type sz nx ny nz cm_4mesh cm_4cal return report Error in type type plot with a 3D input array: the array dimensions tostr sz 1:3 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION checkfield field procedure TYPE type BOXZOOM boxzoom DIREC direc NOQUESTION noquestion VECTEUR vecteur WDEPTH wdepth _EXTRA ex include commons cm_4mesh cm_4cal cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF I1 lecture du champ if n_elements field EQ 0 then return report field undefined arr litchamp field first check IF n_elements arr EQ 1 THEN BEGIN if arr EQ 1 then return report Error: input array 1 Maybe the reading did ont perform well simple ELSE return report Error: input array is a scalar simple ENDIF nan total finite arr nan firstzw 1 lastzw lastzw 1 firstzt 1 lastzt lastzt 1 jpk 1 nzt lastzt firstzt 1 ENDELSE updateold ENDIF make the automatic definition of type for pltz if type is not specified IF type EQ z AND procedure EQ pltz THEN if lon2 lon1 gt lat2 lat1 then type xz else type yz make the automatic definition of type for pltt if type is not specified IF type EQ unkownpltt AND procedure EQ pltt THEN if lon2 lon1 gt lat2 lat1 then type xt else type yt verification de la taille du tableau d entree et de la valeur de type grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth basic checks CASE 1 OF nx EQ 1: IF strpos type x NE 1 THEN return report Error: impossible to make a type type plot with nx 1 simple ny EQ 1: IF strpos type y NE 1 THEN return report Error: impossible to make a type type plot with ny 1 simple nz EQ 1: IF strpos type z NE 1 THEN return report Error: impossible to make a type type plot with nz 1 simple jpt EQ 1: IF strpos type t NE 1 THEN return report Error: impossible to make a type type plot with jpt 1 simple ELSE: ENDCASE is the size of the array compatible with teh domain arr fitintobox temporary arr nx ny nz firstx firsty firstz lastx lasty lastz sz size arr case sz 0 of 0:return arr 1:BEGIN nele n_elements arr case type of t :if jpt NE nele THEN return err_1d type nele jpt jpt x :IF nx NE nele THEN return err_1d type nele nx nx y :IF ny NE nele THEN return err_1d type nele ny ny z :IF nz NE nele THEN return err_1d type nele nz nx ELSE:return report Error: Impossible to make a type plot with a 1D array simple ENDCASE END 2:BEGIN case type of x :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny:direc y xy array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz:direc z x y z array sz 1 EQ nx AND sz 2 EQ jpt:direc t xt array ELSE:return err_2d type sz nx ny nz endcase end y :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny:direc x xy array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz:direc z x yz array sz 1 EQ ny AND sz 2 EQ jpt:direc t yt array ELSE:return err_2d type sz nx ny nz endcase END z :BEGIN case 1 of sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz:direc x x y z array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz:direc y x yz array sz 1 EQ nz AND sz 2 EQ jpt:direc t zt array ELSE:return err_2d type sz nx ny nz endcase END t :BEGIN case 1 OF sz 1 EQ nx AND sz 2 EQ jpt:direc x xt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpt:direc y x yt array nx EQ 1 AND ny EQ 1 AND sz 1 EQ nz AND sz 2 EQ jpt:direc z x y zt array ELSE:return err_2d type sz nx ny nz ENDCASE END xy :IF sz 1 NE nx OR sz 2 ne ny THEN return err_2d type sz nx ny nz xy array xz :IF sz 1 NE nx OR sz 2 ne nz THEN return err_2d type sz nx ny nz xz array yz :IF sz 1 NE ny OR sz 2 NE nz THEN return err_2d type sz nx ny nz yz array xt :IF sz 1 NE nx OR sz 2 NE jpt THEN return err_2d type sz nx ny nz xt array yt :IF sz 1 NE ny OR sz 2 NE jpt THEN return err_2d type sz nx ny nz yt array zt :IF sz 1 NE nz OR sz 2 NE jpt THEN return err_2d type sz nx ny nz zt array ENDCASE END 3:BEGIN case type of x :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc yz xyz array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc zt x y zt array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc yt xyt array ELSE:return err_3d type sz nx ny nz endcase END y :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc xz xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc zt x yzt array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc xt xyt array ELSE:return err_3d type sz nx ny nz endcase END z :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc xy xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc yt x yzt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc xt x y zt array ELSE:return err_3d type sz nx ny nz endcase END t :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc xy xyt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc yz x yzt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc xz x y zt array ELSE:return err_3d type sz nx ny nz endcase END xy :BEGIN case 1 OF sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc z xyz array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc t xyt array ELSE:return err_3d type sz nx ny nz endcase END xz :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc y xyz array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc t x y zt ELSE:return err_3d type sz nx ny nz endcase END yz :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc x xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc t x yzt ELSE:return err_3d type sz nx ny nz endcase END xt :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc y xyt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc z x y zt array ELSE:return err_3d type sz nx ny nz endcase END yt :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc x xyt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc z x yzt array ELSE:return err_3d type sz nx ny nz endcase END zt :BEGIN case 1 of sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc x x y zt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc y x yzt array ELSE:return err_3d type sz nx ny nz ENDCASE END ENDCASE END 4:BEGIN CASE type OF x :direc yzt y :direc xzt z :direc xyt t :direc xyz xy :direc zt xz :direc yt yz :direc xt xt :direc yz yt :direc xz zt :direc xy ENDCASE END ENDCASE IF keyword_set direc THEN BEGIN IF strpos direc t NE 1 OR strpos type t NE 1 THEN arr grossemoyenne temporary arr direc boxzoom localbox NAN nan NODOMDEF WDEPTH wdepth _extra ex ELSE arr moyenne temporary arr direc boxzoom localbox NAN nan NODOMDEF WDEPTH wdepth _extra ex ENDIF RETURN arr END"); 262 a[260] = new Array("./ToBeReviewed/PLOTS/DIVERS/checktypeminmax.html", "checktypeminmax.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO checktypeminmax procedure TYPE type MIN min MAX max XY xy XZ xz YZ yz XT XT YT YT ZT zt TT tt XX xx YY yy ZZ zz XINDEX xindex YINDEX yindex ENDPOINTS endpoints _extra ex common case size type type of 0: 7: ELSE:BEGIN vraimin type case size min type of 0:BEGIN min vraimin type 0 END 7:BEGIN type min min vraimin end ELSE:BEGIN case size max type of 0:BEGIN max min min vraimin type 0 END 7:BEGIN type max max min min vraimin end ELSE:BEGIN rien report Probleme dans la definition des arguments en entree de procedure chkwidget return end endcase end endcase end endcase if keyword_set xy then type xy if keyword_set xz then type xz if keyword_set yz then type yz if keyword_set xt then type xt if keyword_set yt then type yt if keyword_set zt then type zt if keyword_set tt then type t if keyword_set xx then type x if keyword_set yy then type y if keyword_set zz then type z if keyword_set type then begin if type EQ plt then type if type EQ pltz then type if type EQ pltt then type if type EQ plt1d then type endif determination du type de plot que l on veut faire if NOT keyword_set type then BEGIN case procedure of plt :type xy pltz :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 if lon2 lon1 gt lat2 lat1 then type xz else type yz ENDIF ELSE type z END pltt :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 lat2 max endpoints 1 endpoints 3 if lon2 lon1 gt lat2 lat1 then type xt else type yt ENDIF ELSE type unkownpltt END plt1d :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 if lon2 lon1 gt lat2 lat1 then type x else type y ENDIF ELSE BEGIN type WHILE type NE x AND type NE y AND type NE z DO BEGIN type xquestion Quel type de plot 1D voulez vous faire x y z ou t chkwidget type strlowcase type endwhile ENDELSE END endcase ENDIF WHILE type NE xy AND type NE xz AND type NE yz AND type NE xt AND type NE yt AND type NE zt AND type NE t AND type NE x AND type NE y AND type NE z AND type NE unkownpltt DO BEGIN type xquestion What kind of plot do you want to do xy xz yz xt yt zt t x y z chkwidget type strlowcase type ENDWHILE return end"); 263 a[261] = new Array("./ToBeReviewed/PLOTS/DIVERS/determineminmax.html", "determineminmax.pro", "", " NAME:determineminmax PURPOSE:determiner le min et le max d un tableau masque CATEGORY: delestage de l ecriture de plt pltz pltt CALLING SEQUENCE:determineminmax tab mask vraimin vraimax INPUTS: tab: le tableau dont il faut determiner le min et le max mask: le tableau de masque KEYWORD PARAMETERS: minin et maxin deux scalaire qui s il ne sont pas definits prennent la valeur de vraimin et vraimax ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max OUTPUTS: vraimin et vraimax: le min et le max du tableau COMMON BLOCKS: common pro SIDE EFFECTS:degarde si le champ est constant sur la mer RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 PRO determineminmax tab mask vraimin vraimax glam gphi MAXIN maxin MININ minin INTERVALLE intervalle usetri usetri ZEROMIDDLE zeromiddle _extra ex common type de grille verticale: if vargrid EQ W then nz nzw ELSE nz nzt liste des points mer if size mask 0 EQ 3 then mer mask 0 ELSE mer mask si key_irregular eq 1 on masque aussi les points qui ne rentrent pas ds le domaine geographique definit par lon1 lon2 lat1 lat2 if keyword_set key_irregular AND n_elements glam NE 0 AND n_elements gphi NE 0 then begin dom where glam LT lon1 OR glam GT lon2 OR gphi LT lat1 OR gphi GT lat2 if dom 0 NE 1 then mer dom 0 endif mer where mer eq 1 if mer 0 eq 1 then begin ras report Il n y a que de la terre sur le dessin vraimax 0 vraimin 0 maxin vraimax 1 minin vraimin 1 usetri 0 return endif ma et mi : max et min sur les points mer vraimax max tab mer min vraimin _extra ex sameminmax testvar var minin EQ testvar var maxin if n_elements maxin EQ 0 OR sameminmax then maxin vraimax if n_elements minin EQ 0 OR sameminmax then BEGIN if keyword_set intervalle then minin floor vraimin intervalle intervalle ELSE minin vraimin endif if vraimin eq vraimax then BEGIN IF size vraimin type EQ 1 THEN vraimin fix vraimin question Warning: constant filed same value everywhere : strtrim vraimin 2 Shall we make the plot answer report question default_no question if answer then begin maxin vraimax 1 minin vraimin 1 endif ELSE tab 1 ENDIF IF keyword_set zeromiddle THEN BEGIN maxin max abs minin maxin minin maxin ENDIF return end"); 264 a[262] = new Array("./ToBeReviewed/PLOTS/DIVERS/givewindowsize.html", "givewindowsize.pro", "", "FUNCTION givewindowsize include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF dimensions get_screen_size RESOLUTION resolution coef floor 1 resolution 0 if NOT keyword_set windowsize_scale then BEGIN windowsize_scale 1 IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF ENDIF coef windowsize_scale coef mipgsz min page_size max mapgsz xsize coef mipgsz key_portrait mapgsz 1 key_portrait ysize coef mipgsz 1 key_portrait mapgsz key_portrait return xsize ysize end"); 265 a[263] = new Array("./ToBeReviewed/PLOTS/DIVERS/meridienparallele.html", "meridienparallele.pro", "", " NAME:meridienparallele PURPOSE:trace certains medidiens ou paralles CATEGORY: CALLING SEQUENCE:meridienparallele coupe INPUTS:coupe: le type de dessin que l on traite COMMON BLOCKS: common pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 PRO meridienparallele coupe common case coupe of xy :BEGIN if lon1 lt 180 and lon2 gt 180 then plot 180 180 lat1 lat2 noerase color 0 if lon1 lt 0 and lon2 gt 0 then plot 0 0 lat1 lat2 noerase color 0 if lon1 lt 360 and lon2 gt 360 then plot 360 360 lat1 lat2 noerase color 0 if lat1 lt 0 and lat2 gt 0 then plot lon1 lon2 0 0 noerase color 0 END endcase return end"); 266 a[264] = new Array("./ToBeReviewed/PLOTS/DIVERS/placecolor.html", "placecolor.pro", "", " NAME:PLACECOLOR PURPOSE:permet de tracer la colorbar independammment d un graphe CATEGORY:graph CALLING SEQUENCE:placecolor pos INPUTS: pos:vecteur de 4 elements donnant les coordonnees du coin en bas a gauche et de celui en haut a droite en cm ds lequel on veut faire la barre de couleur KEYWORD PARAMETERS: tous ceux de colorbar pro par defaut trace une barre de couleur du meme type que celle presente ds plt et pltz si max min et divisions ne sont pas stipulees alors max sup min inf et divisions div OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS:utilisable que pour les POSTCRIPT effectues avec plein2dessin EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 5 98 pro placecolor pos _extra ex include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF xsave x ysave y psave p reinitplt z invert pos 1 pos mipgsz min page_size max mapgsz if key_portrait eq 1 then begin pos 0 pos 0 mipgsz pos 1 pos 1 mapgsz pos 2 pos 2 mipgsz pos 3 pos 3 mapgsz endif else begin pos 0 pos 0 mapgsz pos 1 pos 1 mipgsz pos 2 pos 2 mapgsz pos 3 pos 3 mipgsz ENDELSE def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used colnumb colorbarparam colnumb clbinf colorbarparam clbinf clbsup colorbarparam clbsup clbdiv colorbarparam clbdiv ENDIF ELSE BEGIN file myuniquetmpdir 4colorbar dat IF file_test file THEN BEGIN restore file if size ex type EQ 8 then BEGIN if where tag_names ex EQ MIN 0 NE 1 then clbinf ex MIN if where tag_names ex EQ MAX 0 NE 1 then clbsup ex MAX if where tag_names ex EQ DIVISIONS 0 NE 1 then clbdiv ex DIVISIONS ENDIF COLORBAR COLOR 0 DIVISIONS clbdiv DISCRET colnumb cb_color 0 POSITION pos MAX clbsup MIN clbinf cb_charsize p charsize _extra ex ENDIF ENDELSE x xsave y ysave p psave return end"); 267 a[265] = new Array("./ToBeReviewed/PLOTS/DIVERS/placedessin.html", "placedessin.pro", "", " NAME:placedessin PURPOSE: mise en place du dessin ouverture de la fenetre ou du PS CATEGORY: pour alleger les programmes plt pltz pltt CALLING SEQUENCE: placedessin typedessin posfenetre posbar INPUTS: typedessin: une chaine de charactere specifiant quelle procedure appelle placedessin: plt pltz pltt KEYWORD PARAMETERS: pleins ce de CALIBRE de WINDOW LCT: intier designant le numero de la palette de couleur que l on veut utiliser pour les plot OUTPUTS: posfenetre: un vecteur de 4 elements contenant la position de cadre contenant les legendes le graphe en coordonnes normalises Rq: pour positionner le dessin il faut apres l appelle de calibre faire p position posfenetre posbar: cf posfentre mais pour la barre de couleur meme remarque pour positionner la barre de couleur p position posbar COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 26 4 1999 PRO placedessin typedessin posfenetre posbar BARMARGES barmarges NOCOLORBAR nocolorbar NOFILL nofill COLOR_c color_c CONTOUR contour VECTEUR vecteur PORTRAIT portrait LANDSCAPE landscape SMALL small MARGES marges MAP map REMPLI REMPLI POST post WINDOW window ENDPOINTS endpoints TYPE type BASICMARGES basicmarges NOERASE noerase LCT lct DIREC direc CB_TITLE cb_title _extra ex include common cm_4ps cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF 1 determination de la taille des marges unite nbre de lignes ou colonnes a gauche a droite en bas en haut ATTENTION ds margebar le dernier element est le coint en haut a droite au lieu de la marge en haut if n_elements typedessin EQ 0 then typedessin autre if keyword_set basicmarges then begin marge 1 6 2 4 3 if keyword_set marges THEN marge marge marges margebar 1 marge 0 1 marge 1 1 marge 2 8 marge 2 6 if keyword_set barmarges then margebar margebar barmarges ENDIF ELSE BEGIN nocolorbar keyword_set nocolorbar keyword_set nofill keyword_set color_c case typedessin of plt :marge 1 6 2 4 3 pltt :marge 1 6 4 type EQ xt 2 4 4 pltz :marge 1 6 2 4 3 else:marge 1 6 2 4 3 ENDCASE if keyword_set marges THEN marge marge marges if NOT keyword_set barmarges then barmarges replicate 0 4 barmarges 3 barmarges 3 margebar 1 marge 0 1 marge 1 1 2 4 barmarges marge marge 0 0 4 0 keyword_set cb_title IF keyword_set direc THEN marge marge 0 0 2 0 strlowcase direc NE t marge marge 0 0 2 0 keyword_set contour marge marge 0 0 2 0 keyword_set vecteur if n_elements lon1 NE 0 and n_elements lon2 NE 0 and n_elements lat1 NE 0 and n_elements lat2 NE 0 then begin if keyword_set type then marge marge 0 3 type EQ yt AND lon1 NE lon2 0 2 type NE yt AND lat1 NE lat2 keyword_set endpoints ELSE marge marge 0 0 0 2 lat1 NE lat2 keyword_set endpoints endif marge marge 0 0 2 margebar 3 0 1 keyword_set nocolorbar ENDELSE portrair ou landscape IF NOT keyword_set noerase THEN BEGIN CASE 1 OF n_elements portrait NE 0:key_portrait portrait n_elements landscape NE 0:key_portrait 1 landscape ELSE: ENDCASE ENDIF Quel type de rapport d aspect sera ecrase si YXASPECT existe case typedessin of plt :yaspect 1 lat2 lat1 lon2 lon1 pltt :yaspect 1 pltz :yaspect 5 ELSE:yaspect 1 endcase 2 calcul de p position cf calibre pro IF NOT keyword_set small then small 1 1 1 if keyword_set map then rempli 1 calibre yaspect marge margebar small posfenetre posbar REMPLI rempli _extra ex p position posfenetre 3 ouverture de la fenetre graphique ou du postscript case 1 of cas du premier dessin sur un postcript keyword_set post AND d name ne PS :openps _extra ex cas du premier dessin sur un ecran keyword_set post EQ 0 AND keyword_set noerase EQ 0 AND d name ne PS AND d name ne Z :BEGIN if not keyword_set window then window 0 pour l utilisation de ps oups et de vzoom if lmgr demo EQ 0 then BEGIN on est en mode demo if journal NE 0 then journal on ferme le journal s il est ouvert homedir isadirectory io homedir title Bad definition of homedir def_myuniquetmpdir journal myuniquetmpdir idlsave pro on en ouvre un nouveau help recall_commands output listecommande on recupere la derniere commande listecommande strmid strcompress listecommande 1 2 journal listecommande on l ecrit dans le journal ENDIF windsize givewindowsize window window xsize windsize 0 ysize windsize 1 retain 2 _extra ex qd on utilise des couleurs codees sur 24 bit je n arrive pas a stipuler la couleur du fond d une fenetre a l aide de p background je suis oblige de faire cette bidouille if d n_colors gt 256 then begin device decomposed 1 p background ffffff x plot 0 0 nodata xstyle 4 ystyle 4 device decomposed 0 endif END ELSE: endcase if n_elements lct NE 0 then lct lct _extra ex return end"); 268 a[266] = new Array("./ToBeReviewed/PLOTS/DIVERS/projsegment.html", "projsegment.pro", "", " NAME: projsegment PURPOSE: projecte lineairement un segment un vecteur dont les bornes sont a b sur un vecteur dont les bornes sont c d CATEGORY: caculs a 2 francs CALLING SEQUENCE: res projsegment vecteur bornes INPUTS: vecteur: un vecteur dont le premier element doit etre le plus petit element et le dernier doit etre le plus grand bornes: les nouvelles bornes du vecteur KEYWORD PARAMETERS: MP: activer ce motcle pour que la fonction retourne un vecteur de 2 elements qui sont les coefficient m et p de la projection lineaire y mx p utilisee pour passer du segment a b au segment c d OUTPUTS:un vecteurs dont les nouvelles bornes sont specifiees par bornes COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL a indgen 9 IDL print a 0 1 2 3 4 5 6 7 8 IDL print projsegment a 0 80 0 10 20 30 40 50 60 70 80 IDL print projsegment a 0 80 0 10 20 30 40 50 60 70 80 IDL print projsegment a 80 0 80 70 60 50 40 30 20 10 0 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 24 6 1999 FUNCTION projsegment vecteur bornes MP mp a1 float vecteur 0 b1 float vecteur n_elements vecteur 1 a2 float bornes 0 b2 float bornes 1 if a1 EQ b1 then return 1 m b2 a2 b1 a1 p a2 m a1 if keyword_set mp then return m p ELSE return m vecteur p end"); 269 a[267] = new Array("./ToBeReviewed/PLOTS/DIVERS/restoreatt.html", "restoreatt.pro", "", " NAME:restoreatt PURPOSE:permet de reattribuer les variables globales associees a un champ qd on donne une stucture cree par ex par saveatt pro CATEGORY:allegement d ecriture CALLING SEQUENCE:restoreatt structure INPUTS:une structure comme celle que lit litchamp cf IDL xhelp litchamp COMMON BLOCKS: common pro SIDE EFFECTS: change la valeur des variables globales attributs d un champ: vargrid varname varunit vardate varexp valmask et time MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 15 6 1999 PRO restoreatt struct common nomelements tag_names struct for i 0 n_tags struct 1 do begin case strlowcase strmid nomelements i 0 1 of g :vargrid strupcase struct i n :varname struct i u :varunit struct i e :varexp struct i m :valmask struct i d :BEGIN if size struct i type EQ 7 THEN BEGIN vardate struct i ENDIF ELSE BEGIN vardate time series time struct i ENDELSE end ELSE:BEGIN ras report Le nom nomelements i ne correspont a aucun element reconnu de la structure C cf IDL xhelp litchamp end endcase endfor return end"); 270 a[268] = new Array("./ToBeReviewed/PLOTS/DIVERS/rotation.html", "rotation.pro", "", " NAME: ROTATION PURPOSE: Rotate two vectors by a specified amount CALLING SEQUENCE: ROTATION X Y DEG NX NY INPUTS: X Y :orignal data point pairs DEG :degrees to rotate OUTPUTS: Nx Ny rotated point pairs MODIFICATION HISTORY: Jeff Bennett U of Colorado PRO ROTATION X Y DEG NX NY ang deg dtor convert to polar coordinates for rotation r sqrt x x y y theta r 0 get angle in for loop so that zero radii will be left as zero angle for i 0 n_elements r 1 do if r i ne 0 then theta i atan y i x i range from pi to pi add rotation angle theta theta ang convert back to rectangular coordinates now rotated nx r cos theta ny r sin theta return end"); 271 a[269] = new Array("./ToBeReviewed/PLOTS/DIVERS/saveatt.html", "saveatt.pro", "", " NAME:saveatt PURPOSE:permet de mettre dans une structure les attributs qui peuvent etre associes a une variable CATEGORY:allegement d ecriture CALLING SEQUENCE:res saveatt OUTPUTS: une stucture de la forme: n:varname g:vargrid d:vardate e:varexp u:varunit m:valmask l:niveau COMMON BLOCKS: common pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 15 6 1999 FUNCTION saveatt common return n:varname g:vargrid d:vardate e:varexp u:varunit m:valmask end"); 272 a[270] = new Array("./ToBeReviewed/PLOTS/DIVERS/terminedessin.html", "terminedessin.pro", "", " NAME:terminedessin PURPOSE:termnine le dessin si besion est qd c est un postcsript CATEGORY:mise en forme et allegement de l ecrityre de plt pltz et pltt CALLING SEQUENCE:terminedessin INPUTS: KEYWORD PARAMETERS:POST et SMALL cf l aide de plt OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 3 6 1999 PRO terminedessin POST post SMALL small _extra ex cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF if keyword_set post then BEGIN if keyword_set small then if total small NE page_margins 2 page_margins 0 total page_size page_margins 1 page_margins 3 then return closeps printps endif return end"); 273 a[271] = new Array("./ToBeReviewed/PLOTS/LABEL/label.html", "label.pro", "", " NAME:label PURPOSE:permet de choisir le stype de label que l on veut utiliser lors d un contour CATEGORY:graphique CALLING SEQUENCE:pro label cas min max ncontour level_z2d INPUTS: cas numero du type de label que l on veut tracer min et max valeures min et max entre lesquelles on veut faire des contours KEYWORD PARAMETERS: INTERVALLE: valeur d un intervalle entre deux isolignes par defaut est calcule pour tracer 20 isolighnes Dans tous les cas ce not cle doit etre retourne pour pouvoir avoir une belle legende Si les niveaux ne comportent pas d intevalle regulier le mettre a 1 NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou nest pas specifie OUTPUTS: ncontour nombre de contour a tracer level_z2d vecteur contenant les valeurs des contours que l on trace colnumb: un vecteur contenant le numero des couleurs qui serviront a remplir entre les contours COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 5 98 pro label cas min max ncontour level_z2d colnumb NLEVEL nlevel INTERVALLE intervalle STRICTFILL strictfill common if d name EQ PS OR d name EQ Z then BEGIN old_dname d name thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 ncontour level_z2d min max min findgen Ncontour Ncontour colnumb ncoul findgen Ncontour Ncontour ncoul 2 ncontour intervalle level_z2d 1 level_z2d 0 end 1: begin un certain nombre de label en partant du min jusqu au plus pres de max avec un pas fixe par intervalle ncontour fix max min intervalle ncontour 1 ncontour level_z2d min intervalle findgen Ncontour colnumb ncoul findgen Ncontour Ncontour ncoul 2 ncontour max level_z2d Ncontour 1 intervalle end label pour faire les memes sss que dessier 2: begin lct 63 file palette tbl level_z2d 20 25 30 31 32 33 33 5 34 25 findgen 16 ncontour 23 colnumb findgen 23 1 masx 37 75 intervalle 1 return end 3: begin lecture intervalles palette dans fichier GMT label_gmt min max intervalle ncoul ncontour level_z2d colnumb end else: begin ras report Le numero de label demande n existe pas end ENDCASE if keyword_set strictfill then begin ncontour ncontour 1 level_z2d level_z2d max colnumb colnumb ncoul 1 endif return end"); 274 a[272] = new Array("./ToBeReviewed/PLOTS/LABEL/label_date.html", "label_date.pro", "", " Id: label_date pro 39 2006 05 02 15:05:06Z pinsard Copyright c 1993 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited FUNCTION LABEL_DATE axis index x DATE_FORMAT format MONTHS months OFFSET offs _EXTRA ex NAME: LABEL_DATE PURPOSE: This function labels axes with dates and times CATEGORY: Plotting CALLING SEQUENCE: To set up: dummy LABEL_DATE DATE_FORMAT string To use: PLOT x y XTICKFORMAT LABEL_DATE INPUTS: No explicit user defined inputs When called from the plotting routines the input parameters are Axis Index Value KEYWORD PARAMETERS: DATE_FORMAT: a format string which may contain the following: M for month 3 character abbr N for month 2 digit abbr D for day of month Y for 4 digit year Z for last two digits of year For time: H for Hours 2 digits I for mInutes 2 digits S for Seconds 2 digits is Other characters are passed directly thru For example M D Y prints DEC 11 1993 M 2Y yields DEC 93 D M yields 11 DEC D N Y yields 11 12 1993 M C Y yields DEC on the top line 1993 on the bottom C is the new line graphic command MONTHS: The names of the months a twelve element string array If omitted use Jan Feb Dec OFFSET: An optional starting offset of the plot Unfortunately single precision floating point is not accurate enough to properly represent Julian times This offset which may be double precision contains an offset that is added to all x values before conversion to Julian date and time OUTPUTS: The date string to be plotted COMMON BLOCKS: LABEL_DATE_COM RESTRICTIONS: Only one date axis may be simultaneously active PROCEDURE: Straightforward For an alternative way to label a plot axis with dates refer to the C format code accepted within format strings applicable via the XYZ TICKFORMAT keywords This new format code was introduced in IDL 5 2 EXAMPLE: For example to plot from Jan 1 1993 to July 12 1994: Start_date julday 1 1 1993 End_date julday 7 12 1994 Dummy LABEL_DATE DATE_FORMAT N D Simple mm dd x findgen end_date 1 start_date start_date Time axis PLOT x sqrt x XTICKFORMAT LABEL_DATE XSTYLE 1 Plot with X axis style set to exact Example with times: For example to plot from 3PM Jan 1 1993 to 5AM Jan 3 1993: Start_date Julday 1 1 1993 Also starting offset Start_time 3 12 24 Starting_time less offset End_time Julday 1 3 1993 Start_date 5 24 Ending date time offset note that the order of operations is important to avoid loss of precision Dummy LABEL_DATE DATE_FORMAT D M C H: I offset Start_date MMM NN HH:MM format x findgen 20 End_time Start_time 19 start_time Time axis PLOT x sqrt x XTICKFORMAT LABEL_DATE XSTYLE 1 MODIFICATION HISTORY: DMS RSI April 1993 Written DMS RSI March 1997 Added Time format COMMON label_date_com fmt month_chr offset if keyword_set format then begin Save format string if n_elements offs ne 0 then offset double offs else offset 0 0d0 if keyword_set months then month_chr months else month_chr Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec fmt format return 0 endif if n_elements month_chr ne 12 or n_elements fmt le 0 or n_elements offset eq 0 then message Not initialized x1 x offset caldat long x1 month day year _EXTRA ex Get the calendar date from julian frac x1 long x1 time of day from 0 to 1 n strlen fmt out for i 0 n 1 do begin Each format character c strmid fmt i 1 The character if c eq then begin i i 1 c strmid fmt i 1 The function case c of format character M : out out month_chr month 1 N : out out string format i2 2 month D : out out string format i2 2 day Y : out out string format i4 year Z : out out string format i2 2 year mod 100 H : out out string format i2 2 floor 24 frac I : out out string format i2 2 floor 1440 frac mod 60 S : out out string format i2 2 86400L frac mod 60 : out out else : message Illegal character in date format string: fmt endcase endif else out out c endfor return out end"); 275 a[273] = new Array("./ToBeReviewed/PLOTS/LABEL/label_gmt.html", "label_gmt.pro", "", " Apply GMT palette into IDL color intervals system PRO label_gmt min max intervalle ncoul ncontour level_z2d coul common com_eg IF pal_type NE 2dom THEN BEGIN color defined in lec_pal_gmt pro ncontour ncont_gmt level_z2d levels_gmt coul coul_gmt max max_gmt intervalle 1 ENDIF ELSE BEGIN grey_shade palette case 1 in label IF finite min EQ 0 THEN read Grey shade needs a min max : min max ncontour fix max min intervalle level_z2d min intervalle findgen Ncontour max level_z2d Ncontour 1 intervalle print Number of contour intervals plotting min max ncontour min max print color index IF idx_pal EQ 0 THEN BEGIN build palette red lonarr 99 red 255 red 50:98 long 100 float grey_shade 100 255 IF field origin EQ diff THEN BEGIN difference plot : lighter below first negative interval red 51:98 long 100 float grey_shade_2 100 255 red 1:48 long 100 float grey_shade 100 255 red 50 255 ENDIF first color black last white red 0 red red 99 255 gray scale green red blue red tvlct red green blue ENDIF mid_index max where level_z2d LE fldatt mid coul findgen Ncontour 49 mid_index 2 ENDELSE END "); 276 a[274] = new Array("./ToBeReviewed/PLOTS/LABEL/lataxe.html", "lataxe.pro", "", " NAME:LATAXE PURPOSE:fonction appelee par XYZ TICKFORMAT cf l help pour voir comment l utiliser pour labeller les axes en latitude CATEGORY:graphe CALLING SEQUENCE: XYZ TICKFORMAT lataxe INPUTS:fournis et imposes automatiquement par IDL: axis index value: Axis is the axis number: 0 for X axis 1 for Y axis 2 for Z axis Index is the tick mark index which starts at 0 Value is the default tick mark value a floating point number KEYWORD PARAMETERS: OUTPUTS:un string utilise automatiquement pour labeller COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 10 1999 format des labels FUNCTION lataxe axis index value on ramenne value ds le segment 0 180 lat value mod 360 if lat lt 0 then lat lat 360 if lat gt 180 then lat lat 180 format des labels: case 1 of lat EQ round lat :fmt i4 10 lat EQ round 10 lat :fmt f6 1 ELSE:fmt f7 2 endcase on ecrit le label if lat le 90 and lat ne 0 then nom string lat format fmt N if lat gt 90 then nom string 180 lat format fmt S if lat eq 0 then nom string lat format fmt return nom end "); 277 a[275] = new Array("./ToBeReviewed/PLOTS/LABEL/lonaxe.html", "lonaxe.pro", "", " NAME:LONAXE PURPOSE:fonction appelee par XYZ TICKFORMAT cf l help pour voir comment l utiliser pour labeller les axes en longitude CATEGORY:graphe CALLING SEQUENCE: XYZ TICKFORMAT lonaxe INPUTS:fournis et imposes automatiquement par IDL: axis index value: Axis is the axis number: 0 for X axis 1 for Y axis 2 for Z axis Index is the tick mark index which starts at 0 Value is the default tick mark value a floating point number KEYWORD PARAMETERS: OUTPUTS:un string utilise automatiquement pour labeller COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 10 1999 format des labels FUNCTION lonaxe axis index value on ramenne value ds le segment 0 360 lon value mod 360 if lon lt 0 then lon lon 360 format des labels: case 1 of lon EQ round lon :fmt i4 10 lon EQ round 10 lon :fmt f6 1 ELSE:fmt f7 2 endcase on ecrit le label if lon lt 180 then nom string lon format fmt E if lon gt 180 then nom string 360 lon format fmt W if lon eq 180 then nom string lon format fmt return nom end "); 278 a[276] = new Array("./ToBeReviewed/PLOTS/VECTEUR/ajoutvect.html", "ajoutvect.pro", "", " NAME:ajoutvect PURPOSE:surimprimme des vecteur sur un champ tarce par plt CATEGORY:grafique CALLING SEQUENCE:ajoutvect vecteur INPUTS: vecteur: une structure a 2 elements contenant les 2 matrices U et V des valeurs de la composante zonale et meridienne du champ de vecteurs a tracer par ex: vecteur matriceu:lec unsurface matricev:lec vnsurface rq:le nom des elements de vecteur n a aucune importance vecteur u:lec unsurface v:lec vnsurface convient aussi KEYWORD PARAMETERS: UNVECTSUR:un scalaire n on un tableau a 2 elements n1 n2 dans le premier cas on tracera un vecteur sur n suivant les x et les y dans le second cas on tracera un vecteur sur n1 suivant x et un vecteur sur n2 suivant y Rq pour tracer tous les vecteurs suivant y et 1 sur 2 suivant x mettre unvectsur 2 1 VECTMIN norme minimun des vecteurs a tracer VECTMAX norme minimun des vecteurs a tracer OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 10 3 1999 11 6 1999 compatibilite avec NAN et la lecture des structures pro ajoutvect vecteur vectlegende UNVECTSUR unvectsur VECTMIN vectmin VECTMAX vectmax _EXTRA ex common tempsun systime 1 pour key_performance u litchamp vecteur 0 u checkfield u plt TYPE xy NOQUESTION v litchamp vecteur 1 v checkfield v plt TYPE xy NOQUESTION on recupere les eventuelles info sur les champs grilleu litchamp vecteur 0 grid if grilleu EQ then grilleu U grillev litchamp vecteur 1 grid if grillev EQ then grillev V IF grilleu EQ V AND grillev EQ U THEN inverse 1 IF grilleu EQ grillev THEN interpolle 0 ELSE interpolle 1 if keyword_set inverse then begin rien u u v v rien endif on trouve les points que u et v ont en communs if interpolle then begin indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: return size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:BEGIN ras report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs return end endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if ny EQ 1 then begin u reform u nx ny v reform v nx ny endif construction de u et v aux pts T a u 0 u u shift u 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin vargrid T msku umask indice2d jpi jpj firstzt mskv vmask indice2d jpi jpj firstzt glam glamt indice2d gphi gphit indice2d if ny EQ 1 then begin msku reform msku nx ny mskv reform mskv nx ny glam reform glam nx ny gphi reform gphi nx ny endif on masque u et v le long des cotes la on l on ne peut pas calculer la moyenne extention du mask u u msku shift msku 1 0 v v mskv shift mskv 0 1 ENDIF ELSE BEGIN u u tmask firstxt:lastxt firstyt:lastyt firstzt v v tmask firstxt:lastxt firstyt:lastyt firstzt indice2d lindgen jpi jpj indice2d indice2d firstxt:lastxt firstyt:lastyt nx nxt ny nyt endelse tabnorme sqrt u 2 v 2 nan where finite u nan EQ 1 if nan 0 NE 1 then u nan 1e5 nan where finite v nan EQ 1 if nan 0 NE 1 then v nan 1e5 if keyword_set vectmin then BEGIN toosmall where tabnorme lt vectmin if toosmall 0 NE 1 then begin u toosmall 1e5 v toosmall 1e5 ENDIF endif if keyword_set vectmax then BEGIN toobig where tabnorme gt vectmax if toobig 0 NE 1 then begin u toobig 1e5 v toobig 1e5 ENDIF ENDIF remise d une grande valeur sur tous les points pour lesquelles on ne put faire le calcul if interpolle then t2 msku shift msku 1 0 mskv shift mskv 0 1 ELSE t2 tmask firstxt:lastxt firstyt:lastyt firstzt if NOT keyword_set key_periodic OR nx NE jpi then t2 0 0 t2 0 0 terre where t2 eq 0 if terre 0 ne 1 then begin u terre 1e5 v terre 1e5 ENDIF tracer qu un vecteur sur if keyword_set unvectsur then BEGIN indx est un vecteur contenant les numero des colonnes a selectionner indy est un vecteur contenant les numero des lignes a selectionner if n_elements unvectsur EQ 1 then begin indx where lindgen nx MOD unvectsur 0 eq 0 indy where lindgen ny MOD unvectsur 0 eq 0 ENDIF ELSE BEGIN indx where lindgen nx MOD unvectsur 0 eq 0 indy where lindgen ny MOD unvectsur 1 eq 0 ENDELSE a partir de indx et indy on va construire un tableau d indices 2d qui donnera les indices des points intersections des colonnes specifiee par indx indicereduit indx replicate 1 n_elements indy nx replicate 1 n_elements indx indy on reduit les tableaux qui vont etre passes a vecteur u u indicereduit v v indicereduit tabnorme tabnorme indicereduit endif if keyword_set inverse then begin rien u u v v rien endif trace des vecteurs vecteur u v tabnorme indice2d indicereduit missing 1e5 _extra ex on complete la legende if terre 0 ne 1 then mini min tabnorme where t2 eq 1 max maxi nan ELSE mini min tabnorme max maxi nan if litchamp vecteur 0 u NE then vectlegende minmax: mini maxi unite:litchamp vecteur 0 u ELSE vectlegende minmax: mini maxi unite:varunit sortie: if keyword_set key_performance NE 0 THEN print temps ajoutvect systime 1 tempsun return end "); 279 a[277] = new Array("./ToBeReviewed/PLOTS/VECTEUR/vecteur.html", "vecteur.pro", "", " NAME:vecteur PURPOSE: trace des vecteurs meme situees sur une grille tordue sur n importe quelle projection de telle sorte que tous les vecteurs aient une norme comparable sur le dessin en clair un vecteur qui doit faire 1cm le fait quelque soit la projection et sa position sur la sphere CATEGORY:trace de vecteur CALLING SEQUENCE:vecteur composanteu composantev normevecteur indice2d reduitindice2d INPUTS: COMPOSANTEU et COMPOSANTEV: ce sont les composantes des vecteurs a tracer Ces tableaux 2d ont la meme dimension que reduitindice2d cf apres INDICE2D: indice permettant de passer d un tableau jpi jpj au zoom surlequel on fait le dessin REDUITINDICE2D: indice permettant de passer d un tableau definit par indice2d au tableau pourlequel on a reelement des vecteurs a tracer en clair: c est par ex qd on ne trace par exemple que un vecteur sur 2 KEYWORD PARAMETERS: CMREF: la longeur en cm sur le papier que diot faire la fleche de norme normeref par defaut ajuste au dessin et compris entre 5 et 1 5 cm MISSING: la valeur d une missing value ne pas utilisder ce mot cle fixe a 1e5 par ajoutvect pro NORMEREF: la norme de la fleche de reference par defaut on essaie de faire qqch qui colle pas trop mal VECTCOLOR: la couleur de la fleche Par defaut noir couleur 0 VECTTHICK l epaissuer de la fleche par defaut 1 VECTREFPOS: vecteur de 2 elements specifiant la position en coordonnees DATA du debut du vecteur de reference Par defaut en bas a droite du dessin VECTREFFORMAT: format a utiliser pour specifier la norme du vecteur de reference NOVECTREF: pour supprimer l affichage du vecteur de reference OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Creation : 13 02 98 G Roullet grlod lodyc jussieu fr Modification : 14 01 99 realise la transformation spheriquecartesien G Roullet 12 03 99 verification de la routine G Roullet 8 11 1999: G Roullet et Sebastien Masson smasson lodyc jussieu fr adaptation pour les zoom reverification traitement separe de la direction et de la norme des vecteurs mots cles NORMEREF et CMREF FUNCTION cv_cm2normal angle donne la longeur en coordonnes normales d un trait ortiente de angle par rapport a l axe des x et qui doit faire 1 cm sur le dessin angle peut etre un tableau common quelle est la longeur en coordonnees normales d un trait qui fera 1 cm sur le parier et qui est parallele a x mipgsz min page_size max mapgsz sizexfeuille mipgsz key_portrait mapgsz 1 key_portrait sizeyfeuille mapgsz key_portrait mipgsz 1 key_portrait cm_en_normal 1 sizexfeuille si le rapport d aspect de la fenetre n est pas egale a 1 la longeur en coordonees normalise d un trait de 1cm varie suivant l angle polaire de ce trait aspect sizexfeuille sizeyfeuille cm_en_normal cm_en_normal sqrt 1 aspect 2 1 sin angle 2 return cm_en_normal END PRO normalise u v w normalise le vecteur IF n_elements w NE 0 THEN BEGIN norme sqrt u 2 v 2 w 2 ind where norme NE 0 u ind u ind norme ind v ind v ind norme ind w ind w ind norme ind ENDIF ELSE BEGIN norme sqrt u 2 v 2 ind where norme NE 0 u ind u ind norme ind v ind v ind norme ind ENDELSE END PRO vecteur composanteu composantev normevecteur indice2d reduitindice2d CMREF cmref MISSING missing NORMEREF normeref VECTCOLOR vectcolor VECTTHICK vectthick VECTREFPOS vectrefpos VECTREFFORMAT vectrefformat NOVECTREF novectref _extra extra common tempsun systime 1 pour key_performance taille size composanteu nx taille 1 ny taille 2 if n_elements reduitindice2d EQ 0 then reduitindice2d lindgen nx ny zu composanteu zv composantev norme normevecteur taille size indice2d nxgd taille 1 nygd taille 2 msk replicate 1 nx ny if keyword_set missing then terre where abs zu GE missing 10 ELSE terre 1 if terre 0 NE 1 then BEGIN msk terre 0 zu terre 0 zv terre 0 norme terre 0 ENDIF Etape 1: etant donne la direction et le sens que le vecteur a sur la sphere il faut se debrouiller pour determiner cette direction et le sens qu aura le vecteur sur l ecran ou la feuille une fois qu il aura ete projete En theorie: sur la sphere un vecteur en un point donne a pour direction la tangente au cercle qui passe par le centre de la terre et par le vecteur Donc trouver la direction une fois la projection faite ds le plan 2d c est trouver la tangente a la courbe representant la projection du cercle sur le plan 2d au point representant la projection du point de depart de la shere sur le plan 2d En pratique on ne connait pas la definition de la courbe que donne la projection d un cercle alors trouver sa tangente en un point Ce que l on fait: Ds un repere cartesien 3d a on trouve les coordonnees du point T debut de la fleche situe sur la shere b pour chaque point T on determine les directions locales definies par la grille en ce point et auxquelles se rapportent les coordonnes u v du vecteur Ces directions locales sont definies par les gradiants des glam et gphi Une fois ces directions obtenues on les considere comme orthogonales et en les normant on construit un repere orthonormal nu nv auquel se rapporte les coordonnes u v du vecteur Ds le repere cartesien 3d de depart le vecteur est definit par: V u nu v nv ou V nu et nv sont des vecteurs 3d et u et v des scalaires c pour approximer la tangente au cercle par la corde definie par le debut et la fin de la fleche on va normaliser V puis le diviser par 100 d ceci nous permet de determiner les coordonnees ds le repere cartesien 3d des extremites de la corde on les passe en coordonnes sphereriques de facon a recuperer les positions en latitude longitude de ces points sur la sphere e on passe les coordonnees de ces points en coordonnees normalise puis en corrdonnes polaire de facon a trouver l angle et la direction qu ils determinent sur le dessin etape 1 a coordonnes du point T debut de la fleche en coordonnes sheriques glam glamt indice2d reduitindice2d gphi gphit indice2d reduitindice2d coordonnes du point T debut de la fleche dans le repere cartesien on utilise comme shere une shere de rayon 1 radius replicate 1 nx ny coord_sphe transpose glam gphi radius r cv_coord from_sphere coord_sphe to_rect degrees x0 reform r 0 nx ny y0 reform r 1 nx ny z0 reform r 2 nx ny etape 1 b Construction du vecteur nu resp nv vecteur norme porte par l axe des points u i j et u i 1 j resp v i j et v i j 1 qui definissent pour chaque point sur la shere les directions locales associee a u et v ces vecteurs definissent un repere orthonorme local ces vecteurs sont construits dans un repere cartesien cv_coord on a choisit un rayon de la terre unite unit definition de nu radius replicate 1 nxgd nygd IF finite glamu 0 gphiu 0 NE 0 THEN coord_sphe transpose glamu indice2d gphiu indice2d radius ELSE coord_sphe transpose glamf indice2d gphit indice2d radius r cv_coord from_sphere coord_sphe to_rect degrees coordonnes de points de la grille u en cartesien ux reform r 0 nxgd nygd uy reform r 1 nxgd nygd uz reform r 2 nxgd nygd calcul de nu nux ux shift ux 1 0 nuy uy shift uy 1 0 nuz uz shift uz 1 0 conditions aux limites if NOT keyword_set key_periodic OR nxgd NE jpi then begin nux 0 nux 1 nuy 0 nuy 1 nuz 0 nuz 1 ENDIF reduction de la grille nux nux reduitindice2d nuy nuy reduitindice2d nuz nuz reduitindice2d definition de nv IF finite glamv 0 gphiv 0 NE 0 THEN coord_sphe transpose glamv indice2d gphiv indice2d radius ELSE coord_sphe transpose glamt indice2d gphif indice2d radius r cv_coord from_sphere coord_sphe to_rect degrees coordonnes de points de la grille v en cartesien vx reform r 0 nxgd nygd vy reform r 1 nxgd nygd vz reform r 2 nxgd nygd calcul de nv nvx vx shift vx 0 1 nvy vy shift vy 0 1 nvz vz shift vz 0 1 conditions aux limites nvx 0 nvx 1 nvy 0 nvy 1 nvz 0 nvz 1 reduction de la grille nvx nvx reduitindice2d nvy nvy reduitindice2d nvz nvz reduitindice2d normalisation normalise nux nuy nuz normalise nvx nvy nvz etape 1 c coordonnes du vecteur V ds le repere cartesion direcx zu nux zv nvx direcy zu nuy zv nvy direcz zu nuz zv nvz normalisation du vecteur v normalise direcx direcy direcz on divise par 100 direcx direcx 100 direcy direcy 100 direcz direcz 100 etape 1 d coordonnees de la pointe de la fleche dans le repere cartesien x1 x0 direcx y1 y0 direcy z1 z0 direcz coordonnees de la pointe en spherique coord_rect transpose x1 y1 z1 r cv_coord from_rect coord_rect to_sphere degrees glam1 reform r 0 nx ny gphi1 reform r 1 nx ny modif des glam tout se passe bien au niveau de la ligne de changement de date attention il ne faut pas couper les fleches qui sortent de la fenetre test: si il sort du cadre mais qu avec un 360 il y rentre on le modifie ind where glam1 LT x range 0 AND glam1 360 LE x range 1 if ind 0 NE 1 then glam1 ind glam1 ind 360 ind where glam1 GT x range 1 AND glam1 360 GE x range 0 if ind 0 NE 1 then glam1 ind glam1 ind 360 ind where glam LT x range 0 AND glam 360 LE x range 1 if ind 0 NE 1 then glam ind glam ind 360 ind where glam GT x range 1 AND glam 360 GE x range 0 if ind 0 NE 1 then glam ind glam ind 360 etape 1 e r convert_coord glam gphi data to_normal x0 r 0 coordonnes normales du debut de la fleche y0 r 1 r convert_coord glam1 gphi1 data to_normal x1 r 0 coordonnes normales de la fin de la fleche avant scaling y1 r 1 tests pour eviter que des fleches soient dessineees hors du domaine out where x0 LT p position 0 OR x0 GT p position 2 OR y0 LT p position 1 OR y0 GT p position 3 if out 0 NE 1 THEN x0 out values f_nan suivant les projections il peu y a voir des points a nan qd on passe en coordonnes normales on supprime ces points nan finite x0 y0 x1 y1 number where nan EQ 1 x0 x0 number x1 x1 number y0 y0 number y1 y1 number msk msk number norme norme number on definit le vecteur direction dans le repere normalise dirx x1 x0 diry y1 y0 on passe en polaire pour recuperer l angle qui etait le but de toute la partie 1 dirpol cv_coord from_rect transpose dirx diry to_polar dirpol msk dirpol 0 2eme etape maintenant on s occupe de la norme Mise a l echelle automatique if NOT keyword_set cmref then BEGIN mipgsz min page_size max mapgsz sizexfeuille mipgsz key_portrait mapgsz 1 key_portrait sizexfeuille 10 sizexfeuille cmref 5 floor sizexfeuille 10 15 cmref cmref 10 ENDIF if NOT keyword_set normeref then BEGIN value max norme puissance10 10 floor alog10 value normeref puissance10 floor value puissance10 endif cm 1 normeref cmref on modifie le tableau norme de facon a ce que un element qui a la valeur cm soit represente par un trait de longueur 1cm sur le papier norme contient la norme des vecteur que l on veut dessiner norme 1 1 cm norme cv_cm2normal dirpol 3eme etape maintenant qu on a l angle et la norme et bien on recupere les coordonnes en rectangulaire et on dessine les fleches r cv_coord from_polar transpose dirpol norme to_rect composantex r 0 composantey r 1 x1 x0 composantex y1 y0 composantey c est parti pour le trace if NOT KEYWORD_SET vectcolor then vectcolor 0 points where msk EQ 1 IF points 0 NE 1 THEN arrow x0 points y0 points x1 points y1 points norm hsize 2 COLOR vectcolor THICK vectthick Dessine une fleche en bas a droite de la figure en guise de legende if NOT keyword_set novectref then BEGIN dx cmref cv_cm2normal 0 longuer du vecteur de reference en coordonnes normalisees if keyword_set vectrefformat then normelegende strtrim string normeref format vectrefformat 1 ELSE normelegende strtrim normeref 1 if keyword_set vectrefpos then begin r convert_coord vectrefpos data to_normal x0 r 0 y0 r 1 ENDIF ELSE BEGIN x0 x window 1 dx r convert_coord d x_ch_size d y_ch_size device to_normal dy 3 r 1 p charsize y0 y window 0 dy ENDELSE arrow x0 y0 x0 dx y0 norm hsize 2 color 0 xyouts x0 y0 normelegende norm align 1 charsize p charsize color 0 endif if keyword_set key_performance NE 0 THEN print temps vecteur systime 1 tempsun return END "); 280 a[278] = new Array("./ToBeReviewed/PLOTS/VECTEUR/velovect.html", "velovect.pro", "", " Id: velovect pro 41 2006 05 02 15:12:07Z pinsard Copyright c 1983 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited PRO VELOVECT U V X Y Missing Missing Length length Dots dots Color color CLIP clip NOCLIP noclip OVERPLOT overplot _EXTRA extra NAME: VELOVECT PURPOSE: Produce a two dimensional velocity field plot A directed arrow is drawn at each point showing the direction and magnitude of the field CATEGORY: Plotting two dimensional CALLING SEQUENCE: VELOVECT U V X Y INPUTS: U: The X component of the two dimensional field U must be a two dimensional array V: The Y component of the two dimensional field Y must have the same dimensions as X The vector at point i j has a magnitude of: U i j 2 V i j 2 0 5 and a direction of: ATAN2 V i j U i j OPTIONAL INPUT PARAMETERS: X: Optional abcissae values X must be a vector with a length equal to the first dimension of U and V Y: Optional ordinate values Y must be a vector with a length equal to the first dimension of U and V KEYWORD INPUT PARAMETERS: COLOR: The color index used for the plot DOTS: Set this keyword to 1 to place a dot at each missing point Set this keyword to 0 or omit it to draw nothing for missing points Has effect only if MISSING is specified LENGTH: Length factor The default of 1 0 makes the longest U V vector the length of a cell MISSING: Missing data value Vectors with a LENGTH greater than MISSING are ignored OVERPLOT: Set this keyword to make VELOVECT overplot That is the current graphics screen is not erased no axes are drawn and the previously established scaling remains in effect Note: All other keywords are passed directly to the PLOT procedure and may be used to set option such as TITLE POSITION NOERASE etc OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: Plotting on the selected device is performed System variables concerning plotting are changed RESTRICTIONS: None PROCEDURE: Straightforward Unrecognized keywords are passed to the PLOT procedure MODIFICATION HISTORY: DMS RSI Oct 1983 For Sun DMS RSI April 1989 Added TITLE Oct 1990 Added POSITION NOERASE COLOR Feb 91 RES August 1993 Vince Patrick Adv Visualization Lab U of Maryland fixed errors in math August 1993 DMS Added _EXTRA keyword inheritance January 1994 KDB Fixed integer math which produced 0 and caused divide by zero errors December 1994 MWR Added _EXTRA inheritance for PLOTS and OPLOT June 1995 MWR Removed _EXTRA inheritance for PLOTS and changed OPLOT to PLOTS September 1996 GGS Changed denominator of x_step and y_step vars February 1998 DLD Add support for CLIP and NO_CLIP keywords June 1998 DLD Add support for OVERPLOT keyword on_error 2 Return to caller if an error occurs s size u t size v if s 0 ne 2 then begin baduv: message U and V parameters must be 2D and same size endif if total abs s 0:2 t 0:2 ne 0 then goto baduv if n_params 0 lt 3 then x findgen s 1 else if n_elements x ne s 1 then begin badxy: message X and Y arrays have incorrect size endif if n_params 1 lt 4 then y findgen s 2 else if n_elements y ne s 2 then goto badxy if n_elements missing le 0 then missing 1 0e30 if n_elements length le 0 then length 1 0 mag sqrt u 2 v 2 magnitude Subscripts of good elements nbad 0 of missing points if n_elements missing gt 0 then begin good where mag lt missing if keyword_set dots then bad where mag ge missing nbad endif else begin good lindgen n_elements mag endelse ugood u good vgood v good x0 min x get scaling x1 max x y0 min y y1 max y x_step x1 x0 s 1 1 0 Convert to float Integer math y_step y1 y0 s 2 1 0 could result in divide by 0 maxmag max max abs ugood x_step max abs vgood y_step sina length ugood maxmag cosa length vgood maxmag if n_elements title le 0 then title plot to get axes if n_elements color eq 0 then color p color if n_elements noclip eq 0 then noclip 1 x_b0 x0 x_step x_b1 x1 x_step y_b0 y0 y_step y_b1 y1 y_step if not keyword_set overplot then begin if n_elements position eq 0 then begin plot x_b0 x_b1 y_b1 y_b0 nodata xst yst color color _EXTRA extra endif else begin plot x_b0 x_b1 y_b1 y_b0 nodata xst yst color color _EXTRA extra endelse endif if n_elements clip eq 0 then clip x crange 0 y crange 0 x crange 1 y crange 1 r 3 len of arrow head angle 22 5 dtor Angle of arrowhead st r sin angle sin 22 5 degs length of head ct r cos angle for i 0 n_elements good 1 do begin Each point x0 x good i mod s 1 get coords of start end dx sina i x1 x0 dx y0 y good i s 1 dy cosa i y1 y0 dy xd x_step yd y_step plots x0 x1 x1 ct dx xd st dy yd xd x1 x1 ct dx xd st dy yd xd y0 y1 y1 ct dy yd st dx xd yd y1 y1 ct dy yd st dx xd yd color color clip clip noclip noclip _EXTRA extra endfor if nbad gt 0 then Dots for missing PLOTS x bad mod s 1 y bad s 1 psym 3 color color clip clip noclip noclip _EXTRA extra end"); 281 a[279] = new Array("./ToBeReviewed/PLOTS/axe.html", "axe.pro", "", " NAME:axe PURPOSE:gerre les axes pour les differents dessins crees par plt pltz et pltt CATEGORY:environnement graphique CALLING SEQUENCE:axe coupe tempsmin tempsmax INPUTS: coupe: un string qui designe le type de coupe auquel doit de raporter les axes que l on cree par ex: xy xt tempsmin et tempsmax: ds le cas ou l on fait une coupe contenant la dimension temps il faut specifier le debut et la fin de l axe des temps en jours julien KEYWORD PARAMETERS: SIN active qd on trace en sinus de la latitude SEPDATE: string separant les differents constituants de la date Par defaut c est un retour a la ligne qd on fait un yt zt ou t dans les autres cas c est un blanc DIGITSYEAR 2 to use Z format 2 digits to code years instead of Y format See help of label_date for more informations on Z and Y OUTPUTS:les variables globales d environnement graphique: x et y COMMON BLOCKS: common pro SIDE EFFECTS:modifie x et y RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 Eric Guilyardi types x y z amelioration de l axe temporel PRO axe coupe tempsmin tempsmax REVERSE_X reverse_x REVERSE_Y reverse_y SIN sin SEPDATE sepdate DIGITSYEAR digitsyear _EXTRA ex common tempsun systime 1 pour key_performance gestion des ticks de l axe des temps ds le ces ou tempsmin et tempsmax sont definits divday 0 if n_params EQ 3 then BEGIN if keyword_set sepdate then sep sepdate ELSE if coupe EQ yt OR coupe EQ zt OR coupe EQ t then sep C ELSE sep caldat tempsmin mmin dmin ymin hmin mnmin smin _EXTRA ex caldat tempsmax mmax dmax ymax hmax mnmax smax _EXTRA ex format used for the year 2 or 4 5 digits IF NOT keyword_set digitsyear THEN digitsyear 4 IF digitsyear EQ 2 THEN fmtyr Z ELSE fmtyr Y if ymax EQ ymin then BEGIN if mmin ne mmax then BEGIN meme annee mais plusieurs mois nticks mmax mmin 1 ticknom lonarr nticks for m 0 nticks 1 do ticknom m julday m mmin 1 ymin _EXTRA ex tminor 6 datfmt M sep fmtyr on verifie que les labels rentrent bien entre tempsmin et tempsmax ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom cas particulier ou l on est a cheval sur 2 mois if nticks LE 1 then begin nticks dmax jourdsmois mmin ymin 0 dmin 1 2 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d 2 dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M endif ENDIF ELSE BEGIN meme annee et meme mois IF dmax dmin 1 GT 4 THEN BEGIN more than 4 days nticks dmax dmin 1 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M ENDIF ELSE BEGIN less than 4 days : divday ticks per day divday 4 nticks dmax dmin divday 1 ticknom fltarr nticks for d 0 nticks 1 do ticknom d julday mmin d divday dmin ymin _EXTRA ex d MOD divday float divday tminor 2 datfmt H:00 ENDELSE ENDELSE ENDIF ELSE BEGIN plusieurs annees CASE 1 OF ymax ymin 1 LE 10: BEGIN freq 1 tminor 12 datfmt M sep fmtyr end ymax ymin 1 LE 20: BEGIN freq 2 tminor 6 datfmt M sep fmtyr end ymax ymin 1 LE 50: BEGIN freq 5 tminor 5 datfmt M sep fmtyr end ymax ymin 1 LE 100: BEGIN freq 10 tminor 10 datfmt fmtyr end ymax ymin 1 LE 1000: BEGIN freq 50 tminor 5 datfmt fmtyr end ELSE : BEGIN freq 100 tminor 50 datfmt Y end ENDCASE nticks floor ymax ymin freq 1 IF floor ymin freq NE ymin freq THEN yminf floor ymin freq 1 freq ELSE yminf floor ymin freq freq ticknom lonarr nticks for y 0 nticks 1 do ticknom y julday 1 1 yminf y freq _EXTRA ex on verifie que les labels rentrent bien entre tempsmin et tempsmax ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom cas particulier ou l on est a cheval sur 2 annees if nticks LE 1 then begin nticks mmax 12 mmin 1 ticknom lonarr nticks for m 0 nticks 1 do ticknom m julday m mmin 1 ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 6 datfmt M sep fmtyr cas particulier ou l on est a cheval sur 2 mois if nticks LE 1 then begin nticks dmax jourdsmois mmin ymin 0 dmin 1 2 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d 2 dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M endif endif ENDELSE toto label_date 0 0 0 DATE_FORMAT datfmt _EXTRA ex if chkstru ex DATE_FORMAT then ex DATE_FORMAT ENDIF definition des parametres des axes au cas par cas case coupe of xy :BEGIN if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range lat2 lat1 ELSE y range lat1 lat2 IF key_onearth THEN x tickformat lonaxe IF key_onearth THEN y tickformat lataxe END yz :BEGIN if keyword_set reverse_x then x range lat2 lat1 ELSE x range lat1 lat2 if keyword_set reverse_y then y range 0 1 ELSE y range 1 0 if keyword_set sin then BEGIN nombre de ticks par defaut plot 0 0 noerase nodata xtick_get xaxe on augmente ce nombre pour qu il soit autour de 10 ticks n_elements xaxe 1 ticks ticks 1 2 4 8 ticks ticks sort abs ticks 10 0 on recupere l axex pour ce nouveau nombre de ticks plot 0 0 xticks ticks noerase nodata xtick_get xaxe x ticks ticks x tickv sin pi 180 xaxe tickname strarr ticks 1 for i 0 ticks do tickname i lataxe 0 0 xaxe i x tickname tickname x range sin pi 180 x range endif end xz :BEGIN if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range 0 1 ELSE y range 1 0 end xt : begin if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range tempsmax tempsmin tempsmin ELSE y range tempsmin tempsmax tempsmin IF key_onearth THEN x tickformat lonaxe result LABEL_DATE DATE_FORMAT M sep fmtyr y tickformat LABEL_DATE y tickname LABEL_DATE 1 0 ticknom _EXTRA ex y ticklen 1 y gridstyle 2 y ticks nticks 1 y tickv ticknom tempsmin y minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end yt : begin if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin if keyword_set reverse_y then y range lat2 lat1 ELSE y range lat1 lat2 IF key_onearth THEN y tickformat lataxe x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end zt : begin if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin if vargrid EQ W then gdep gdepw 0:nzw 1 ELSE gdep gdept 0:nzt 1 x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end t : BEGIN if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end x : begin x range lon1 lon2 IF key_onearth THEN x tickformat lonaxe END y : begin if keyword_set sin then BEGIN nombre de ticks par defaut plot 0 0 nodata noerase xstyle 5 ystyle 5 xtick_get xaxe on augmente ce nombre pour qu il soit autour de 10 ticks n_elements xaxe 1 ticks ticks 1 2 4 8 ticks ticks sort abs ticks 10 0 on recupere l axex pour ce nouveau nombre de ticks plot 0 0 xticks ticks nodata noerase xstyle 5 ystyle 5 xtick_get xaxe x ticks ticks x tickv sin pi 180 xaxe tickname strarr ticks 1 for i 0 ticks do tickname i lataxe 0 0 xaxe i x tickname tickname x range sin pi 180 x range ENDIF ELSE x range lat1 lat2 IF key_onearth THEN x tickformat lataxe END z : begin if vargrid EQ W then gdep gdepw 0:nzw 1 ELSE gdep gdept 0:nzt 1 if keyword_set reverse_y then y range gdep 0 gdep n_elements gdep 1 ELSE y range gdep n_elements gdep 1 gdep 0 END endcase if keyword_set key_performance THEN print temps axe systime 1 tempsun return end"); 282 a[280] = new Array("./ToBeReviewed/PLOTS/legende.html", "legende.pro", "", " NAME:legende pro PURPOSE:fournit les legendes CATEGORY:graph annexe CALLING SEQUENCE:legende mi ma coupe title subtitle xtitle ytitle INPUTS:mi et ma: le max et le min du dessin cf plt pro et pltz pro coupe caractere de 2 lettres donnant le type de coupe par ex: xz KEYWORD PARAMETERS: TITRE: chaine de caracteres qui doit etre le titre du dessin Par defaut le titre est le nom vairmer du champ ENDPOINTS:utilise qd on fait des coupes veticales en diagonale OUTPUTS:le titre sous titre titre de x et titre de y COMMON BLOCKS: common pro SIDE EFFECTS: l utilisation de la variable globale langage permet de changer de langue ou de facon de legender facilement On peut facilement personnaliser la chose en rajoutant un cas au case sur la valeur de langage RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 8 98 Eric Guilyardi ericg lodyc jussieu fr GB version 11 6 99 pro legende mi ma coupe CONTOUR contour ENDPOINTS endpoints DIREC direc VECTLEGENDE vectlegende INTERVALLE intervalle TYPE_YZ type_yz VARNAME2 varname2 NPTS npts _EXTRA ex common tempsun systime 1 pour key_performance grille 1 1 1 gdep nx ny nz English legends fmt_mm f12 2 fmt_bt f7 1 colorf contourf Contour plot vecteurf Vector norm expf datef fieldf depthf endpointsf Diag Section zonalf IF key_onearth THEN latintf latitudes in ELSE latintf j index in timintf time in onf depthf2 Depth m Meridf Zonal Mean IF key_onearth THEN lonintf longitudes in ELSE lonintf i in hovxt XT plot diaghovxt Diag XT plot depintf depths in timef Time hovyt YT plot diaghovyt Diag YT plot hovzt ZT plot hovt IF key_onearth THEN lontitle Longitude ELSE lontitle i index IF key_onearth THEN lattitle Latitude ELSE lattitle j index vertz depthf2 legniv m IF keyword_set TYPE_YZ THEN BEGIN IF type_yz EQ hPa THEN vertz hPa IF type_yz EQ hPa THEN legniv hPa ENDIF Start legende definition et complement eventuelle de p subtitle if n_elements varunit ne 0 then unite varunit else unite p subtitle colorf unite : Min strtrim string format fmt_mm mi 2 Max strtrim string format fmt_mm ma 2 if keyword_set intervalle then BEGIN if intervalle NE 1 then p subtitle p subtitle Int strtrim string format fmt_mm intervalle 2 endif if size contour type EQ 8 then BEGIN c est une structure unite contour 1 p subtitle p subtitle C contourf unite : Min strtrim string format fmt_mm contour 0 0 2 Max strtrim string format fmt_mm contour 0 1 2 if contour inter NE 1 then p subtitle p subtitle Int strtrim string format fmt_mm contour inter 2 ENDIF if size vectlegende type EQ 8 then begin unite vectlegende 1 p subtitle p subtitle C vecteurf unite : Min strtrim string format fmt_mm vectlegende 0 0 2 Max strtrim string format fmt_mm vectlegende 0 1 2 endif mise en forme des dimensions du sous domaine la1 strtrim string format fmt_bt lat1 2 la2 strtrim string format fmt_bt lat2 2 lo1 strtrim string format fmt_bt lon1 2 lo2 strtrim string format fmt_bt lon2 2 pr1 strtrim string format fmt_bt vert1 2 pr2 strtrim string format fmt_bt vert2 2 gestion de la date if n_elements vardate EQ 0 then vardate if NOT keyword_set direc then direc if strpos direc t NE 1 then begin svardate strtrim vairdate time 0 1 strtrim vairdate time jpt 1 1 ENDIF ELSE svardate vardate case sur le cas auquel s applique la legende case coupe of xy :begin if strupcase vargrid EQ W then firstz firstzw ELSE firstz firstzt if strpos direc z EQ 1 AND firstz NE 0 then BEGIN prof strtrim round gdep 0 1 p title expf varexp datef svardate fieldf varname depthf prof legniv ENDIF ELSE p title expf varexp datef svardate fieldf varname x title lontitle y title lattitle end xz :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim ny 1 IF long n LE 3 THEN zonalf Section if keyword_set endpoints AND lat1 NE lat2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title zonalf varexp datef svardate fieldf varname x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF y title depthf2 end yz :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx 1 IF long n LE 3 THEN meridf if keyword_set endpoints AND lon1 NE lon2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title meridf varexp datef svardate fieldf varname y title vertz x title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF end xt :begin IF keyword_set npts THEN n strtrim npts 1 if keyword_set endpoints AND lat1 NE lat2 then p title diaghovxt varexp fieldf varname ELSE p title hovxt varexp fieldf varname IF time size time 0 1 time 0 GE 10 THEN y title timef x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF end yt :begin IF keyword_set npts THEN n strtrim npts 1 if keyword_set endpoints AND lon1 NE lon2 then p title diaghovyt varexp fieldf varname ELSE p title hovyt varexp fieldf varname IF time size time 0 1 time 0 GE 10 THEN x title timef y title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF end zt :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny 1 p title hovzt varexp fieldf varname y title depthf2 IF time size time 0 1 time 0 GE 10 THEN x title timef end t :begin IF keyword_set npts THEN n strtrim npts 1 ELSE BEGIN if keyword_set integration3d then n strtrim nx ny nz 1 ELSE n strtrim nx ny 1 ENDELSE p title hovt varexp fieldf varname y title varname IF time size time 0 1 time 0 GE 10 THEN x title timef end x :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim ny nz 1 if keyword_set endpoints AND lat1 NE lat2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title varexp datef svardate fieldf varname x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF y title varname end y :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx nz 1 if keyword_set endpoints AND lon1 NE lon2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title varexp datef svardate fieldf varname x title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF y title varname end z :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny 1 p title varexp datef svardate fieldf varname y title depthf2 x title varname end yfx : BEGIN IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny nz 1 p title varexp datef svardate varunit x title varname2 y title varname END else: ENDCASE if keyword_set direc then BEGIN if strpos direc x NE 1 then p subtitle lonintf lo1 lo2 onf strtrim nx 1 points C p subtitle if strpos direc y NE 1 then BEGIN if strpos p subtitle EQ 1 then p subtitle latintf la1 la2 onf strtrim ny 1 points C p subtitle ELSE p subtitle latintf la1 la2 onf strtrim ny 1 points p subtitle ENDIF if strpos direc z NE 1 AND nz NE 1 OR coupe NE xy then BEGIN if strpos p subtitle EQ 1 then p subtitle depintf pr1 pr2 onf strtrim nz 1 points C p subtitle ELSE p subtitle depintf pr1 pr2 onf strtrim nz 1 points p subtitle ENDIF ENDIF if keyword_set endpoints AND coupe NE yt AND lat1 NE lat2 then p title p title C C if keyword_set key_performance THEN print temps legende systime 1 tempsun return end"); 283 a[281] = new Array("./ToBeReviewed/PLOTS/plotsym.html", "plotsym.pro", "", "function plotsym circle circle triangle triangle diamond diamond angle angle box box line line scale scale _extra extra NAME: plotsym PURPOSE: function to make plotting symbols much easier Usage: plot x y psym plotsym circle scale 2 fill CATEGORY: Graphics Keywords: circle circle symbol triangle triangle symbol diamond diamond symbold box box symbol line line symbol scale scales the symbol angle angle the symbol should be rotated _extra extra keywords for usersym These are thick color and fill Written by: Ronn Kling Ronn Kling Consulting 7038 Westmoreland Dr Warrenton VA 20187 klingrl juno com copyright 1999 all rights reserved if not keyword_set scale then scale 1 0 if not keyword_set angle then angle 0 0 if keyword_set circle then begin theta findgen 30 29 360 endif else if keyword_set triangle then begin theta 30 90 210 30 endif else if keyword_set diamond then begin theta 0 90 180 270 0 endif else if keyword_set box then begin theta 315 45 135 225 315 endif else if keyword_set line then begin theta 180 0 endif theta theta angle x cos theta dtor scale y sin theta dtor scale usersym x y _extra extra return 8 end"); 284 a[282] = new Array("./ToBeReviewed/PLOTS/reinitplt.html", "reinitplt.pro", "", " NAME: REINITPLT PURPOSE: This procedure will reinitialise all or a selection ofthe system plot variables CATEGORY: Plot Utility CALLING SEQUENCE: clearplt all clear the p x y z clearplt x z clear the x and z variables clearplt x only clear the x variable clearplt x invert clear all except the x INPUTS: KEYWORDS: x y z p clear the appropriate variable all clear all this is equivalent to x y z p invert invert the logic Clear all unselected variables Therefore clearplt all invert does nothing OUTPUTS: none COMMON BLOCKS: common pro SIDE EFFECTS: The sytem plot variables are changed MODIFICATION HISTORY: Written by: Trevor Harris Physics Dept University of Adelaide July 1990 Sebastien Masson 7 5 98 pro reinitplt all all x x y y z z p p invert invert clearx 0 cleary 0 clearz 0 clearp 0 if keyword_set x then clearx 1 if keyword_set y then cleary 1 if keyword_set z then clearz 1 if keyword_set p then clearp 1 if keyword_set all or not keyword_set x and not keyword_set y and not keyword_set z and not keyword_set p then begin clearx 1 cleary 1 clearz 1 clearp 1 endif if keyword_set invert then begin clearx not clearx cleary not cleary clearz not clearz clearp not clearp endif if clearx then begin x charsize 0 x GRIDSTYLE 0 X MARGIN 10 3 X MINOR 0 X OMARGIN 0 0 x region 0 X RANGE 0 x STYLE 5 x tick 1 x TICKFORMAT x TICKLEN 0 x tickname x ticks 0 X TICKV 0 X TICKV 1 x title x TYPE 0 endif if cleary then begin y charsize 0 y GRIDSTYLE 0 Y MARGIN 10 3 Y MINOR 0 Y OMARGIN 0 0 y region 0 Y RANGE 0 y STYLE 5 y tick 1 y TICKFORMAT y TICKLEN 0 y tickname y ticks 0 Y TICKV 0 Y TICKV 1 y title y TYPE 0 endif if clearz then begin z charsize 0 z GRIDSTYLE 0 Z MARGIN 10 3 Z MINOR 0 Z OMARGIN 0 0 z region 0 Z RANGE 0 z STYLE 1 z tick 1 z TICKFORMAT z TICKLEN 0 z tickname z ticks 0 Z TICKV 0 Z TICKV 1 z title z TYPE 0 endif if clearp then begin p BACKGROUND d n_colors 1 255 p CHARSIZE 1 p CHARTHICK 0 p LINESTYLE 0 p MULTI replicate 0 5 p NOERASE 0 p POSITION 0 p region 0 p title p subtitle p ticklen 0 02 p thick 0 1 p color 0 endif return end "); 285 a[283] = new Array("./ToBeReviewed/PLOTS/style.html", "style.pro", "", " NAME:style PURPOSE:choisit la facon de tracer les isolignes CATEGORY:graphique CALLING SEQUENCE:style labstyle level_z2d linestyle thick INPUTS:labstyle: nombre auquel se refaire le styel de trace choisit level_z2d:vecteur contenant les valeures des isolignes a tracer KEYWORD PARAMETERS: OUTPUTS: linestyle:vecteur utilise pour definir le style des isocontours rq: pour memoire: Index Linestyle 0 Solid 1 Dotted 2 Dashed 3 Dash Dot 4 Dash Dot Dot Dot 5 Long Dashes thick:vecteur definissant l epaisseur de l isoligne COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr pro style labstyle level_z2d linestyle thick case labstyle of 0: begin serie: deux lignes continues fines une ligne continue grasse thick 1 1 2 linestyle 0 return end 1: begin serie: avant le mileu des levels: tiret fin apres trait continu fin si le mileu est dessine il est en trait continu gras impair n_elements level_z2d 2 fix n_elements level_z2d 2 a replicate 0 fix n_elements level_z2d 2 b replicate 1 fix n_elements level_z2d 2 c replicate 2 fix n_elements level_z2d 2 if impair then begin thick b 2 b linestyle c 0 a endif else begin thick 0 linestyle c a endelse return end 2: begin serie: avant le seuil definit en repondant a une question : tiret fin apres trait continu fin si le seuil est dessine il est en trait continu gras seuil xquestion Quelle est la limite tirets trait continu 0 seuil float seuil rien where level_z2d lt seuil n a replicate 0 n_elements level_z2d n c replicate 2 n if seuil eq level_z2d n then begin thick replicate 1 n 2 replicate 1 n_elements level_z2d 1 n linestyle c a endif else begin thick 0 linestyle c a endelse return end 3: begin n n_elements level_z2d seuil level_z2d 1 n 2 thick intarr n thick indgen n 4 4 1 thick indgen n 4 4 1 1 thick indgen n 4 4 2 2 thick indgen n 4 4 3 1 linestyle intarr n linestyle indgen n 4 4 3 linestyle indgen n 4 4 1 0 linestyle indgen n 4 4 2 0 linestyle indgen n 4 4 3 0 labels intarr n labels indgen n 2 2 1 labels n 2 0 return end 4: begin trait continu gras pour 0 seuil 1 e 6 thick replicate 5 n_elements level_z2d linestyle 0 rien where abs level_z2d max abs level_z2d LT seuil if rien 0 NE 1 then thick rien 0 3 end else: begin ras report Le numero de labstyle demande n existe pas stop end endcase return end"); 286 a[284] = new Array("./ToBeReviewed/PLOTS/symbols.html", "symbols.pro", "", " NAME: SYMBOLS PURPOSE: Create custom plotting symbols CALLING SEQUENCE: SYMBOLS SYMBOL_NUMBER SCALE INPUTS: SYMBOL_NUMBER: 1 open circle 2 filled circle 3 arrow pointing right 4 arrow pointing left 5 arrow pointing up 6 arrow pointing down 7 arrow pointing up and left 45 degrees 8 arrow pointing down and left 9 arrow pointing down and right 10 arrow pointing up and right 11 through 18 are bold versions of 3 through 10 19 horizontal line 20 box 21 diamond 22 triangle 30 filled box 31 filled diamond 32 filled triangle SCALE size of symbols KEYWORD PARAMETERS: COLOR color of symbols SIDE EFFECTS: The desired symbol is stored in the user buffer and will be plotted if P PSYM 8 MODIFICATION HISTORY: Jeff Bennett U of Colorado 198 pro symbols nsym scale color col on_error 2 fill 0 case 1 of nsym le 2 : begin circles for large scales increase number of points for res if scale ge 4 then a findgen 25 else a findgen 13 a a 3 14159 6 0 12 or 24 pi 6 xarr cos a yarr sin a if nsym eq 2 then fill 1 end nsym ge 3 nsym le 18 : begin arrow heads xarr fltarr 5 yarr xarr xarr 1 10 xarr 2 6 yarr 2 2 nsyms greater than 10 should be filled arrows if nsym gt 10 then begin xarr 3 6 xarr 4 10 yarr 3 2 fill 1 endif else begin xarr 3 10 xarr 4 6 yarr 4 2 endelse case 1 of nsym eq 3 : dummy 0b nsym eq 4 : xarr 1 xarr nsym eq 11 nsym eq 12 : begin xarr extrac xarr 0 11 yarr extrac yarr 0 11 yarr 6 0 5 xarr 7 6 yarr 7 0 5 xarr 8 6 yarr 8 0 5 yarr 9 0 5 if nsym eq 12 then begin rotation xarr yarr 180 nx ny xarr nx yarr ny endif end nsym eq 5 nsym eq 13 : begin temp xarr xarr yarr yarr temp end nsym eq 6 nsym eq 14 : begin temp 1 xarr xarr yarr yarr temp end nsym ge 7 nsym le 10 nsym ge 15 nsym le 18 : begin case 1 of nsym eq 7 nsym eq 15 : deg 45 nsym eq 8 nsym eq 16 : deg 135 nsym eq 9 nsym eq 17 : deg 225 nsym eq 10 nsym eq 18 : deg 315 endcase rotation xarr yarr deg nx ny xarr nx yarr ny end end nsym ge 7 endcase end nsym between 3 and 18 nsym eq 20 nsym eq 21 nsym eq 30 nsym eq 31 : begin xarr fltarr 5 3 yarr xarr xarr 1 3 xarr 2 3 yarr 2 3 yarr 3 3 if nsym eq 21 nsym eq 31 then begin rotation xarr yarr 45 nx ny nx 0 70 nx shrink the x direction xarr nx yarr ny endif if nsym ge 30 then fill 1 end nsym 20 21 30 31 nsym eq 22 nsym eq 32 : begin side length 6 0 at centroid yarr fltarr 4 6 4 xarr fltarr 4 6 2 xarr 1 6 2 xarr 2 0 yarr 2 6 sqrt 3 2 6 4 if nsym eq 32 then fill 1 end else: begin xarr fltarr 2 1 yarr xarr 0 xarr 1 1 end endcase xarr xarr scale yarr yarr scale set symbol buffer if keyword_set col then usersym xarr yarr fill fill color col else usersym xarr yarr fill fill return end"); 287 a[285] = new Array("./ToBeReviewed/POSTSCRIPT/calibre.html", "calibre.pro", "", " NAME: calibre PURPOSE:a partir d un rapport d aspect et des valeurs en ligne de characteres des differentes marges calcul posfenetre et posbar qui servent a placer le dessin et la barre de couleur grace a p position sur une feuille ou sur une sortie ecran dont la fenetre a les memes proportions CATEGORY: positionnement du graphe CALLING SEQUENCE: calibre rapportyx marge margebar smalldraw posfenetre posbar INPUTS: rapportyx: rapport d echelle entre la longueur de l axe des y et celle des x par ex pour une carte xy rapportyx lat2 lat1 lon2 lon1 marge: vecteur de 4 elements contenant la taille des marges a gauche a droite en bas et en haut devant entourer le graphe tout est mesure en lignes de characteres margebar: vecteur de 4 elements contenant la taille des marges a gauche a droite en bas et ATTENTION le dernier element est cette fois ci la position de coin en haut a droite devant entourer la barre de couleur tout est mesure en lignes de characteres smalldraw: 2 possiblites un vecteur de 4 elements donnant en portrait ou en landscape la position de cadre ds lequel doit rentrer le dessin cette position est donne par les coordonnes des 2 coins du cadre: en bas a gauche et en haut a droite elle s exprime tjs pour un postscript ou une sortie ecran en cm l origine etant le coin en bas a gauche un vecteur de 3 elements donnant le nombre de colonnes a faire de le dessin le nombre de lignes et enfin le numero de la case que doit occuper le dessin cf matlab par ex pour faire 6 dessin en 2 colonnes et 3 lignes et occuper la 4 eme case small 2 3 4 KEYWORD PARAMETERS: REMPLI:oblige le dessin a occuper l espace maximum definit par smalldraw sans resperter le rapport y sur x YXASPECT: force le rapport y sur x a prendre la valeur rapportyx yxaspect ce mot cle est utile ds deux cas: 1 yxaspect 1 : oblige rapportyx a etre bien respecte sinon calibre se reserve le droit de changer un peu celui ci dans le cas ou le rapport d aspect de small dessin est trop different de celui de smalldraw 2 yxaspect n : multiplie par n le rapport d aspect donne par defaut par ex ds plt rapportyx est calcule pour que le repere soit orthonorme pour avoir un repere ou l axe des y est 2 fois plus dilate que celui des y YXASPECT 2 PORTRAIT et LANDSCAPE: mots cles plus utilises mais tjs fonctionnels OUTPUTS: posfenetre: un vecteur de 4 elements contenant la position de cadre contenant les legendes le graphe en coordonnes normalises Rq: pour positionner le dessin il faut apres l appelle de calibre faire p position posfenetre posbar: cf posfentre mais pour la barre de couleur meme remarque pour positionner la barre de couleur p position posbar COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 pro calibre rapportyx marge margebar smalldraw posfenetre posbar REMPLI rempli YXASPECT yxaspect PORTRAIT portrait LANDSCAPE lanscape _extra ex cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance if keyword_set portrait then key_portrait 1 if keyword_set landscape then key_portrait 0 if keyword_set yxaspect then begin rapportyx rapportyx yxaspect test2 0 endif else begin yxaspect 1 test2 1 ENDELSE mipgsz min page_size max mapgsz choix de Landscape ou Portrait if n_elements key_portrait eq 0 then begin if rapportyx ge 1 then key_portrait 1 if rapportyx lt 1 then key_portrait 0 endif si smalldraw est compte comme ds matlab if n_elements smalldraw EQ 3 then begin if n_elements page_margins EQ 0 then page_margins 1 1 1 1 smalldraw long smalldraw nbrecol smalldraw 0 nbrelig smalldraw 1 numero smalldraw 2 1 numlig numero nbrecol numcol numero numlig nbrecol bas mipgsz key_portrait mapgsz 1 key_portrait cote mapgsz key_portrait mipgsz 1 key_portrait poscol page_margins 0 findgen nbrecol 1 1 bas page_margins 0 page_margins 1 nbrecol poslig cote page_margins 3 findgen nbrelig 1 1 cote page_margins 2 page_margins 3 nbrelig smalldraw poscol numcol poslig numlig 1 poscol numcol 1 poslig numlig endif determination de la taille des characteres p charsize nombre_de_mots_ds_titre 60 p charsize 1 smalldraw 2 smalldraw 0 d x_px_cm nombre_de_mots_ds_titre d y_ch_size if p charsize gt 1 then p charsize 1 transfert de marge en cm cm 1 d x_px_cm marge 1 marge d y_ch_size p charsize cm margebar 1 margebar d y_ch_size p charsize cm definition de la portion de feuille ou on dessine if key_portrait eq 0 then begin big smalldraw 2 smalldraw 0 small smalldraw 3 smalldraw 1 endif else begin small smalldraw 2 smalldraw 0 big smalldraw 3 smalldraw 1 endelse if key_portrait eq 0 then rapportmax 1 small marge 3 marge 1 big marge 2 marge 0 else rapportmax 1 small marge 2 marge 0 big marge 3 marge 1 si yxaspect n est pas specifie on modifie la valeur de rapportyx pour que ca colle un peu plus aux proportions de la feuille if rapportyx le rapportmax then begin if test2 then begin rap 1 rapportmax rapportyx if rap ge 5 and rap lt 6 then rapportyx rapportyx 1 5 if rap ge 6 and rap lt 7 then rapportyx rapportyx 2 if rap ge 7 and rap lt 8 then rapportyx rapportyx 2 5 if rap ge 8 then rapportyx rapportyx 3 endif endif else begin if test2 then begin rap 1 rapportmax rapportyx if rap lt 1 5 and rap ge 1 6 then rapportyx rapportyx 1 5 if rap lt 1 6 and rap ge 1 7 then rapportyx rapportyx 2 if rap lt 1 7 and rap ge 1 8 then rapportyx rapportyx 2 5 if rap lt 1 8 then rapportyx rapportyx 3 endif endelse dans le cas ou on fait un Landscape: if key_portrait eq 0 then begin if keyword_set rempli then begin xs big ys small endif else begin if rapportyx le rapportmax then begin xs big ys 1 big marge 0 marge 1 rapportyx marge 2 marge 3 if ys gt small then begin xs 1 small marge 2 marge 3 rapportyx marge 0 marge 1 ys small endif endif else begin xs 1 small marge 2 marge 3 rapportyx marge 0 marge 1 ys small if xs gt big then begin xs big ys 1 big marge 0 marge 1 rapportyx marge 2 marge 3 endif endelse endelse xoff 1 small ys 2 smalldraw 1 yoff 1 big xs 2 xs mapgsz smalldraw 2 a 1 mapgsz yoff mapgsz b 1 xoff mipgsz c a 1 xs mapgsz d b 1 ys mipgsz endif dans le cas ou on fait un portrait: else begin if keyword_set rempli then begin xs small ys big endif else begin if rapportyx le rapportmax then begin xs small ys 1 small marge 0 marge 1 rapportyx marge 2 marge 3 if ys gt big then begin xs 1 big marge 2 marge 3 rapportyx marge 0 marge 1 ys big endif endif else begin xs 1 big marge 2 marge 3 rapportyx marge 0 marge 1 ys big if xs gt small then begin xs small ys 1 small marge 0 marge 1 rapportyx marge 2 marge 3 endif endelse endelse xoff 1 small xs 2 smalldraw 0 yoff 1 big ys 2 smalldraw 1 a 1 xoff mipgsz b 1 yoff mapgsz c a 1 xs mipgsz d b 1 ys mapgsz xset xoff yset yoff endelse bas mapgsz 1 key_portrait mipgsz key_portrait cote mipgsz 1 key_portrait mapgsz key_portrait posfenetre a b c d marge 0 bas marge 2 cote marge 1 bas marge 3 cote posbar a b c d margebar 0 bas margebar 2 cote margebar 1 bas ys margebar 3 cote if keyword_set key_performance THEN print temps calibre systime 1 tempsun IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end"); 288 a[286] = new Array("./ToBeReviewed/POSTSCRIPT/chcolps.html", "chcolps.pro", "", "PRO format_colortable_hexa table tvlct r g b get z strarr 256 y strarr 256 for k 0 255 do z k 00 strtrim string r k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 for k 0 255 do z k 00 strtrim string g k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 for k 0 255 do z k 00 strtrim string b k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 table strlowcase y END PRO build_table tableout Fabrique le bloc de colortable format_colortable_hexa table tableout strarr 25 tableout 0 COLORTAB def END PRO chcolps n1 n2 file PALIT1 palit1 PALIT2 palit2 Modifie les couleurs d un fichier postscript Creation : G Roullet 1999 recupere les palettes lct n1 IF keyword_set palit1 THEN palit palit1 tvlct red green blue get lct n2 IF keyword_set palit2 THEN palit palit2 tvlct red1 green1 blue1 get filein file fileout file new openr numin filein get_lun openw numout fileout get_lun ligne nl 0 colortab 0 Scan le fichier WHILE NOT eof numin DO BEGIN readf numin ligne format A nl nl 1 Replace setrgbcolor statements pos strpos ligne setrgbcolor IF pos NE 1 THEN BEGIN r round float strmid ligne pos 18 6 255 g round float strmid ligne pos 12 6 255 b round float strmid ligne pos 6 6 255 ind where r EQ red AND g EQ green AND b EQ blue ind ind 0 IF ind 0 NE 1 THEN BEGIN r1 red1 ind 255 g1 green1 ind 255 b1 blue1 ind 255 color string r1 g1 b1 format 3 F5 3 : X strput ligne color pos 18 ENDIF ELSE BEGIN print erreur ligne : nl dist abs r red abs g green abs b blue ind where dist EQ min dist 0 ind ind 0 print je trouve long r g b print je remplace par red ind green ind blue ind r1 red1 ind 255 g1 green1 ind 255 b1 blue1 ind 255 color string r1 g1 b1 format 3 F5 3 : X strput ligne color pos 18 ENDELSE ENDIF Replace COLORTAB pos strpos ligne COLORTAB IF pos NE 1 THEN BEGIN build_table table n 0 colortab 1 ENDIF IF colortab THEN BEGIN ligne table n n n 1 IF n EQ 24 THEN colortab 0 ENDIF Ecrit le fichier de sorti printf numout ligne format A ENDWHILE close numin close numout free_lun numin free_lun numout spawn gs fileout END "); 289 a[287] = new Array("./ToBeReviewed/POSTSCRIPT/ps.html", "ps.pro", "", ""); 290 a[288] = new Array("./ToBeReviewed/STATISTICS/a_correlate2d.html", "a_correlate2d.pro", "", " NAME: A_CORRELATE2d PURPOSE: This function computes the autocorrelation Px K L or autocovariance Rx K L of a sample population X nx ny as a function of the lag K L CATEGORY: Statistics CALLING SEQUENCE: Result a_correlate2d X Lag INPUTS: X: an 2 dimension Array nx ny LAG: 2 element vector in the intervals nx 2 nx 2 ny 2 ny 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample autocovariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE: PROCEDURE: nx k 1 ny l 1 sigma sigma X i j Xmean X i k j l Ymean i 0 j 0 correlation X k l nx 1 ny 1 sigma sigma X i j Xmean 2 i 0 j 0 nx k 1 ny l 1 sigma sigma X i j Xmean Y i k j l Ymean i 0 j 0 covariance X k l nx ny Where Xmean is the mens of the sample population x x 0 0 x 1 0 x nx 1 ny 1 REFERENCE: MODIFICATION HISTORY: 28 2 2000 Sebastien Masson smasson lodyc jussieu fr Based on the A_CORRELATE procedure of IDL FUNCTION Auto_Cov2d X Lag Double Double zero2nan zero2nan XDim SIZE X dimensions nx XDim 0 ny XDim 1 Sample autocovariance function Xmean TOTAL X Double Double 1 nx ny res TOTAL X 0:nx 1 lag 0 0:ny 1 lag 1 Xmean X lag 0 :nx 1 lag 1 :ny 1 Xmean Double Double if keyword_set zero2nan AND res EQ 0 then res values f_nan RETURN res END FUNCTION A_Correlate2d X Lag Covariance Covariance Double Double Compute the sample autocorrelation or autocovariance of Xt Xt l as a function of the lag l ON_ERROR 2 XDim SIZE X dimensions XNDim SIZE X n_dimensions nx XDim 0 ny XDim 1 if XNDim NE 2 then MESSAGE X array must contain 2 dimensions Check length if nx lt 2 then MESSAGE first dimension of X array must contain 2 or more elements if ny lt 2 then MESSAGE second dimension of X array must contain 2 or more elements if n_elements Lag NE 2 THEN MESSAGE Lag array must contain 2 elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double SIZE X type eq 5 if KEYWORD_SET Covariance eq 0 then begin Compute Autocorrelation Auto Auto_Cov2d X ABS Lag Double Double Auto_Cov2d X 0L 0L Double Double zero2nan endif else begin Compute Autocovariance Auto Auto_Cov2d X ABS Lag Double Double n_elements X endelse if Double eq 0 then RETURN FLOAT Auto else RETURN Auto END"); 291 a[289] = new Array("./ToBeReviewed/STATISTICS/a_timecorrelate.html", "a_timecorrelate.pro", "", " NAME: A_TIMECORRELATE PURPOSE: Same function as A_CORRELATE but accept array until 4 dimension for input and do the autocorrelation or the autocovariance along the time dimension which must be the last one of the input array This function computes the autocorrelation Px L or autocovariance Rx L of a sample population X as a function of the lag L CATEGORY: Statistics CALLING SEQUENCE: Result a_timecorrelate X Lag INPUTS: X: an Array which last dimension is the time dimension os size n LAG: A scalar or n element vector in the interval n 2 n 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample autocovariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE Define an n element sample population x 3 73 3 67 3 77 3 83 4 67 5 87 6 70 6 97 6 40 5 57 Compute the autocorrelation of X for LAG 3 0 1 3 4 8 lag 3 0 1 3 4 8 result a_correlate x lag The result should be: 0 0146185 1 00000 0 810879 0 0146185 0 325279 0 151684 PROCEDURE: n L 1 sigma X k Xmean X k L Xmean k 0 correlation X L n 1 sigma X k Xmean 2 k 0 n L 1 sigma X k Xmean X k L Xmean k 0 covariance X L n Where Xmean is the Time mean of the sample population x x t 0 x t 1 x t n 1 REFERENCE: INTRODUCTION TO STATISTICAL TIME SERIES Wayne A Fuller ISBN 0 471 28715 6 MODIFICATION HISTORY: 24 2 2000 Sebastien Masson smasson lodyc jussieu fr Based on the A_CORRELATE procedure of IDL FUNCTION TimeAuto_Cov X M nT Double Double zero2nan zero2nan Sample autocovariance function TimeDim size X n_dimensions Xmean TOTAL X TimeDim Double Double nT if double then one 1 0d ELSE one 1 0 Xmean Xmean replicate one nT M case TimeDim of 1:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 2:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 3:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 4:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double ENDCASE if keyword_set zero2nan then begin zero where res EQ 0 if zero 0 NE 1 then res zero values f_nan endif RETURN res END FUNCTION A_TimeCorrelate X Lag COVARIANCE Covariance DOUBLE Double Compute the sample autocorrelation or autocovariance of Xt Xt l as a function of the lag l ON_ERROR 2 XDim SIZE X dimensions XNDim SIZE X n_dimensions nT XDim XNDim 1 Check length if nT lt 2 then MESSAGE Time axis of X array must contain 2 or more elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double SIZE X type eq 5 if n_elements lag EQ 0 then lag 0 nLag N_ELEMENTS Lag if nLag eq 1 then Lag Lag Create a 1 element vector case XNDim of 1:if Double eq 0 then Auto FLTARR nLag else Auto DBLARR nLag 2:if Double eq 0 then Auto FLTARR XDim 0 nLag else Auto DBLARR XDim 0 nLag 3:if Double eq 0 then Auto FLTARR XDim 0 XDim 1 nLag else Auto DBLARR XDim 0 XDim 1 nLag 4:if Double eq 0 then Auto FLTARR XDim 0 XDim 1 XDim 2 nLag else Auto DBLARR XDim 0 XDim 1 XDim 2 nLag endcase if KEYWORD_SET Covariance eq 0 then begin Compute Autocorrelation for k 0 nLag 1 do case XNDim of 1:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 2:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 3:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 4:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan endcase endif else begin Compute Autocovariance for k 0 nLag 1 do case XNDim of 1:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 2:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 3:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 4:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT endcase endelse if Double eq 0 then RETURN FLOAT Auto else RETURN Auto END"); 292 a[290] = new Array("./ToBeReviewed/STATISTICS/c_timecorrelate.html", "c_timecorrelate.pro", "", " NAME: C_TIMECORRELATE PURPOSE: This function computes the time cross correlation Pxy L or the time cross covariance between 2 arrays this is some kind of c_correlate but for multidimenstionals arrays as a function of the lag L CATEGORY: Statistics CALLING SEQUENCE: Result c_timecorrelate X Y Lag INPUTS: X: an Array which last dimension is the time dimension of size n float or double Y: an Array which last dimension is the time dimension of size n float or double LAG: A scalar or n element vector in the interval n 2 n 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample cross covariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE Define two n element sample populations x 3 73 3 67 3 77 3 83 4 67 5 87 6 70 6 97 6 40 5 57 y 2 31 2 76 3 02 3 13 3 72 3 88 3 97 4 39 4 34 3 95 Compute the cross correlation of X and Y for LAG 5 0 1 5 6 7 lag 5 0 1 5 6 7 result c_timecorrelate x y lag The result should be: 0 428246 0 914755 0 674547 0 405140 0 403100 0 339685 PROCEDURE: FOR L 0 n L 1 sigma X k Xmean Y k L Ymean k 0 correlation X Y L n 1 n 1 sqrt sigma X k Xmean 2 sigma Y k Ymean 2 k 0 k 0 n L 1 sigma X k Xmean Y k L Ymean k 0 covariance X Y L n FOR L 0 n L 1 sigma X k L Xmean Y k Ymean k 0 correlation X Y L n 1 n 1 sqrt sigma X k Xmean 2 sigma Y k Ymean 2 k 0 k 0 n L 1 sigma X k L Xmean Y k Ymean k 0 covariance X Y L n Where Xmean and Ymean are the time means of the sample populations x x t 0 x t 1 x t n 1 and y y t 0 y t 1 y t n 1 respectively REFERENCE: INTRODUCTION TO STATISTICAL TIME SERIES Wayne A Fuller ISBN 0 471 28715 6 MODIFICATION HISTORY: 01 03 2000 Sebastien Masson smasson lodyc jussieu fr Based on the C_CORRELATE procedure of IDL August 2003 Sebastien Masson update according to the update made in C_CORRELATE by W Biagiotti and available in IDL 5 5 FUNCTION TimeCross_Cov Xd Yd M nT Ndim Double Double ZERO2NAN zero2nan Sample cross covariance function compile_opt hidden case Ndim OF 1:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Double Double 2:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double 3:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double 4:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double ENDCASE if keyword_set zero2nan then begin zero where res EQ 0 if zero 0 NE 1 then res zero values f_nan ENDIF RETURN res END FUNCTION C_Timecorrelate X Y Lag Covariance Covariance Double Double Compute the sample cross correlation or cross covariance of Xt Xt l and Yt Yt l as a function of the lag l ON_ERROR 2 xsize SIZE X ysize SIZE Y nt float xsize xsize 0 NDim xsize 0 if total xsize 0:xsize 0 NE ysize 0:ysize 0 NE 0 then MESSAGE X and Y arrays must have the same size and the same dimensions Check length if nt lt 2 then MESSAGE Time dimension of X and Y arrays must contain 2 or more elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double Xsize Xsize 0 1 eq 5 or ysize ysize 0 1 eq 5 if n_elements lag EQ 0 then lag 0 nLag N_ELEMENTS Lag Deviations if double then one 1 0d ELSE one 1 0 Ndim size X n_dimensions Xd TOTAL X Ndim Double Double nT Xd X Xd replicate one nT Yd TOTAL Y Ndim Double Double nT Yd Y Yd replicate one nT if nLag eq 1 then Lag Lag Create a 1 element vector case NDim of 1:if Double eq 0 then Cross FLTARR nLag else Cross DBLARR nLag 2:if Double eq 0 then Cross FLTARR Xsize 1 nLag else Cross DBLARR Xsize 1 nLag 3:if Double eq 0 then Cross FLTARR Xsize 1 Xsize 2 nLag else Cross DBLARR Xsize 1 Xsize 2 nLag 4:if Double eq 0 then Cross FLTARR Xsize 1 Xsize 2 Xsize 3 nLag else Cross DBLARR Xsize 1 Xsize 2 Xsize 3 nLag endcase if KEYWORD_SET Covariance eq 0 then begin Compute Cross Crossation for k 0 nLag 1 do begin if Lag k ge 0 then BEGIN case NDim of 1: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 2: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 3: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 4: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double endcase ENDIF else BEGIN case NDim of 1: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 2: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 3: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 4: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double endcase ENDELSE ENDFOR div sqrt TimeCross_Cov Xd Xd 0L nT Ndim Double Double zero2nan TimeCross_Cov Yd Yd 0L nT Ndim Double Double zero2nan Cross temporary Cross temporary div replicate one nLag endif else begin Compute Cross Covariance for k 0 nLag 1 do begin if Lag k ge 0 then BEGIN case NDim of 1: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 2: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 3: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 4: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT ENDCASE ENDIF else BEGIN case NDim of 1: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 2: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 3: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 4: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT ENDCASE ENDELSE endfor endelse if Double eq 0 then RETURN FLOAT Cross else RETURN Cross END "); 293 a[291] = new Array("./ToBeReviewed/STRING/chkeywd.html", "chkeywd.pro", "", " NAME: chkeywd change keyword PURPOSE: ds un string qui contient une commande a executer avec EXECUTE par ex On change la valeur d un des mot cle Plus generalement ds un string on cherche la chaine de chacarteres: keywdname et on change la valeur de CATEGORY: pour bidouiller des commandes passees par execute CALLING SEQUENCE: stringout chkeywd stringin keywdname keywdvalue INPUTS: stringin: un string keywdname: un string designant le nom du mot clef a chercher keywdvalue: nouvelle valeur du mot clef a considerer ds stringin KEYWORD PARAMETERS: pour chercher le mot cle on cherche le premier signe qui suit la position de keywdname on substitue pardefaut tout le bout de string qui suit jusqu a la prochaine virgule avec les mots cles SEPARATOR et AFTER on peut modifier cette decoupe du string: SEPARATOR donne un chatactere avant ou apres si AFTER est active lequel il faut chercher la virgule qui delimite le mot cle ds le string cf les exemples OUTPUTS:stringout stringin modifie si keywdname a ete trouve ds stringin COMMON BLOCKS:common pro SIDE EFFECTS: Si keywdvalue est un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des mots clefs de grosse taille avec bcp d elements et avec des elements etant de gros tableaux le mot clef en entree ne doit pas contenir de Complex floating de structure de Double precision complex de Pointer de Object reference de Unsigned Integer de Unsigned Longword Integer de 64 bit Integer de Unsigned 64 bit Integer EXAMPLE: IDL b ok 111 year 1997 1998 1999 age_capitaine 35 IDL print b ok 111 year 1997 1998 1999 age_capitaine 35 IDL print chkeywd b ok c est bon ok c est bon year 1997 1998 1999 age_capitaine 35 IDL print chkeywd b YEAR indgen 5 sep ok 111 year 0 1 2 3 4 age_capitaine 35 IDL print chkeywd b YEAR indgen 5 sep after ok 111 year 0 1 2 3 4 age_capitaine 35 IDL b ok 111 year age_capitaine IDL print chkeywd b year c est bon ok 111 year c est bon age_capitaine MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 24 11 1999: adaptation pour les mots cles commencant par FUNCTION chkeywd stringin keywdname keywdvalue SEPARATOR separator AFTER after stringout stringin poskeywd strpos strlowcase stringout strlowcase keywdname if poskeywd EQ 1 then return stringout while poskeywd NE 1 do BEGIN changer un mot cle qui commence par toto if strmid stringout poskeywd 1 1 EQ then BEGIN ajoute keywdname tostr keywdvalue stringout strmid stringout 0 poskeywd 1 ajoute strmid stringout poskeywd strlen keywdname poskeywd poskeywd strlen ajoute poskeywd strpos stringout keywdname poskeywd ENDIF ELSE BEGIN changer un mot cle qui commence par toto posegal strpos stringout poskeywd if posegal EQ 1 then return stringout if NOT keyword_set separator then separator posvirgule strpos stringout separator posegal 1 if keyword_set after then posvirgule strpos stringout posvirgule 1 ELSE posvirgule rstrpos stringout posvirgule 1 if posvirgule EQ 1 then posvirgule strlen stringout stringout strmid stringout 0 posegal 1 tostr keywdvalue strmid stringout posvirgule poskeywd strpos stringout keywdname posvirgule 1 ENDELSE endwhile return stringout end"); 294 a[292] = new Array("./ToBeReviewed/STRING/delchr.html", "delchr.pro", "", " NAME: DELCHR PURPOSE: Delete all occurrences of a character from a text string CATEGORY: CALLING SEQUENCE: new delchr old char INPUTS: old original text string in char character to delete in KEYWORD PARAMETERS: OUTPUTS: new resulting string out COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 5 Jul 1988 Johns Hopkins Applied Physics Lab RES 11 Sep 1989 converted to SUN R Sterner 27 Jan 1993 dropped reference to array Copyright C 1988 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt FUNCTION DELCHR OLD C help hlp if n_params 0 lt 2 or keyword_set hlp then begin print Delete all occurrences of a character from a text string print new delchr old char print old original text string in print char character to delete in print new resulting string out return 1 endif B BYTE OLD convert string to a byte array CB BYTE C convert char to byte w where b ne cb 0 if w 0 eq 1 then return Nothing left return string b w Return new string END"); 295 a[293] = new Array("./ToBeReviewed/STRING/getfile.html", "getfile.pro", "", " NAME: GETFILE PURPOSE: Read a text file into a string array CATEGORY: CALLING SEQUENCE: s getfile f INPUTS: f text file name in KEYWORD PARAMETERS: Keywords: ERROR err error flag: 0 ok 1 file not opened 2 no lines in file QUIET means give no error message FIND search te file in the all path directories use find pro OUTPUTS: s string array out COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 20 Mar 1990 S Masson smasson lodyc jussieu fr 4 Feb 2002 search te file in the all path directories use find pro when using find keyword Use spawn cat for unix os Copyright C 1990 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt function getfile filein error err help hlp quiet quiet find find if n_params 0 lt 1 or keyword_set hlp then begin print Read a text file into a string array print s getfile f print f text file name in print s string array out print Keywords: print ERROR err error flag: 0 ok 1 file not opened print 2 no lines in file print QUIET means give no error message return 1 endif if keyword_set find then begin file find filein file file 0 if file EQ NOT FOUND then begin print Error in getfile: File filein not fouond return 1 endif ENDIF ELSE file filein if version os_family EQ unix then begin spawn cat file res if res 0 NE then return res ELSE return endif get_lun lun on_ioerror err openr lun file s t while not eof lun do begin readf lun t s s t endwhile close lun free_lun lun if n_elements s eq 1 then begin if not keyword_set quiet then print No lines in file err 2 return 1 endif err 0 return s 1: err: if err eq 168 then begin if not keyword_set quiet then print Non standard text file format free_lun lun return s 1: endif if not keyword_set quiet then print Error in getfile: File file not opened free_lun lun err 1 return 1 end"); 296 a[294] = new Array("./ToBeReviewed/STRING/getwrd.html", "getwrd.pro", "", " NAME: GETWRD PURPOSE: Return the n th word from a text string CATEGORY: CALLING SEQUENCE: wrd getwrd txt n m INPUTS: txt text string to extract from in n word number to get first 0 def in m optional last word number to get in KEYWORD PARAMETERS: Keywords: LOCATION l Return word n string location DELIMITER d Set word delimiter def space tab LAST means n is offset from last word So n 0 gives last word n 1 gives next to last If n 2 and m 0 then last 3 words are returned NOTRIM suppresses whitespace trimming on ends NWORDS n Returns number of words in string OUTPUTS: wrd returned word or words out COMMON BLOCKS: getwrd_com NOTES: Note: If a NULL string is given txt then the last string given is used This saves finding the words again If m n wrd will be a string of words from word n to word m If no m is given wrd will be a single word n n wrd will be a string of words from word n to print word m If no m is given wrd will be a single word print n 0 Smaller of in and im im im 0 to zero if in gt lst and im gt lst then return Out of range in in lst Larger of in and im im im lst to be last ll loc in Nth word start return strtrim strmid txtstr0 ll loc im loc in len im 2 endif N ABS NTH Allow nth 0 IF N GT NWDS 1 THEN RETURN out of range null ll loc n N th word position IF NTH LT 0 THEN GOTO NEG Handle nth 0 IF MTH GT NWDS 1 THEN MTH NWDS 1 Words to end if keyword_set notrim then begin RETURN STRMID TXTSTR0 ll LOC MTH LOC NTH LEN MTH endif else begin RETURN strtrim STRMID TXTSTR0 ll LOC MTH LOC NTH LEN MTH 2 endelse NEG: if keyword_set notrim then begin RETURN STRMID TXTSTR0 ll 9999 endif else begin RETURN strtrim STRMID TXTSTR0 ll 9999 2 endelse END"); 297 a[295] = new Array("./ToBeReviewed/STRING/isnumber.html", "isnumber.pro", "", " NAME: ISNUMBER PURPOSE: Determine if a text string is a valid number CATEGORY: CALLING SEQUENCE: i isnumber txt x INPUTS: txt text string to test in KEYWORD PARAMETERS: OUTPUTS: x optionaly returned numeric value if valid out i test flag: out 0: not a number 1: txt is a long integer 2: txt is a float 1: first word of txt is a long integer 2: first word of txt is a float COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 15 Oct 1986 Johns Hopkins Applied Physics Lab R Sterner 12 Mar 1990 upgraded Richard Garrett 14 June 1992 fixed bug in returned float value Copyright C 1986 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt FUNCTION ISNUMBER TXT0 X help hlp if n_params 0 lt 1 or keyword_set hlp then begin print Determine if a text string is a valid number print i isnumber txt x print txt text string to test in print x optionaly returned numeric value if valid out print i test flag: out print 0: not a number print 1: txt is a long integer print 2: txt is a float print 1: first word of txt is a long integer print 2: first word of txt is a float return 1 endif TXT STRTRIM TXT0 2 trim blanks X 0 define X IF TXT EQ THEN RETURN 0 null string not a number SN 1 IF NWRDS TXT GT 1 THEN BEGIN get first word if more than one SN 1 TXT GETWRD TXT 0 ENDIF f_flag 0 Floating flag b byte txt w where b eq 43 cnt if cnt gt 1 then return 0 t delchr txt w where b eq 45 cnt if cnt gt 1 then return 0 t delchr t w where b eq 46 cnt if cnt gt 1 then return 0 May only be 1 if cnt eq 1 then f_flag 1 If one then floating t delchr t w where b eq 101 cnt e if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t e w where b eq 69 cnt E if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t E w where b eq 100 cnt d if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t d w where b eq 68 cnt D if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t D if total b eq 101 b eq 69 b eq 100 b eq 68 gt 1 then return 0 b byte t if total b ge 65 and b le 122 ne 0 then return 0 c strmid t 0 1 if c lt 0 or c gt 9 then return 0 First char not a digit x txt 0 0 Convert to a float if f_flag eq 1 then return 2 sn Was floating if x eq long x then begin x long x return sn endif else begin return 2 sn endelse END"); 298 a[296] = new Array("./ToBeReviewed/STRING/lenstr.html", "lenstr.pro", "", "function lenstr str ROUTINE: lenstr USEAGE: result lenstr str input: str a single string or string array output: result length of the string s in normalized units the number of elements of RESULT matches the number of elements of STRING procedure: This function returns the physical length of the string on the output device not the number of characters This is done by first switching to X and writing the string s with XYOUTS in graphics mode 5 which disables display to the screen but does not interfere with operation of XYOUTS The WIDTH keyword parameter of XYOUTS is used to retrieve the physical length of the string s author: Paul Ricchiazzi 7apr93 Institute for Computational Earth System Science University of California Santa Barbara dsave d name thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x device get_graphics oldg set_graphics 5 if keyword_set charsize eq 0 then charsize 1 nn n_elements str case nn of 0:w 0 1:xyouts 0 0 device str width w else:begin w fltarr nn for i 0 nn 1 do begin xyouts 0 0 device str i width ww w i ww endfor end endcase fac1 float d x_ch_size d x_vsize ratio of char width to device1 width device set_graphics oldg set_plot dsave IF dsave EQ X OR dsave EQ MAC OR dsave EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF fac2 float d x_ch_size d x_vsize ratio of char width to device2 width return w fac2 fac1 string width adjusted for device width end "); 299 a[297] = new Array("./ToBeReviewed/STRING/nwrds.html", "nwrds.pro", "", " NAME: NWRDS PURPOSE: Return the number of words in the given text string CATEGORY: CALLING SEQUENCE: n nwrds txt INPUTS: txt text string to examine in KEYWORD PARAMETERS: Keywords: DELIMITER d Set delimiter character def space OUTPUTS: n number of words found out COMMON BLOCKS: NOTES: Notes: See also getwrd MODIFICATION HISTORY: R Sterner 7 Feb 1985 Johns Hopkins University Applied Physics Laboratory RES 4 Sep 1989 converted to SUN Copyright C 1985 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt function nwrds txtstr help hlp delimiter delim if n_params 0 lt 1 or keyword_set hlp then begin print Return the number of words in the given text string print n nwrds txt print txt text string to examine in print n number of words found out print Keywords: print DELIMITER d Set delimiter character def space print Notes: See also getwrd return 1 endif if strlen txtstr eq 0 then return 0 A null string has 0 words ddel Default word delimiter is a space if n_elements delim ne 0 then ddel delim Use given word delimiter tst byte ddel 0 Delimiter as a byte value tb byte txtstr String to bytes if ddel eq then begin Check for tabs w where tb eq 9B cnt Yes if cnt gt 0 then tb w 32B Convert any to space endif x tb ne tst Locate words x 0 x 0 Pad ends with delimiters y x shift x 1 eq 1 Look for word beginnings n fix total y Count word beginnings return n end"); 300 a[298] = new Array("./ToBeReviewed/STRING/putfile.html", "putfile.pro", "", " NAME: PUTFILE PURPOSE: Write a text file from a string array CATEGORY: CALLING SEQUENCE: putfile f s INPUTS: f text file name in s string array in KEYWORD PARAMETERS: Keywords: ERROR err error flag: 0 ok 1 invalid string array OUTPUTS: COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 20 Mar 1990 R Sterner 4 Nov 1992 allowed scalar strings Copyright C 1990 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt pro putfile file s error err help hlp if n_params 0 lt 1 or keyword_set hlp then begin print Write a text file from a string array print putfile f s print f text file name in print s string array in print Keywords: print ERROR err error flag: 0 ok 1 invalid string array return endif if lmgr demo then begin print you are in Demo mode It is impossible to write a file return endif if size s type ne 7 then begin print Error in putfile: argument must be a string array err 1 return endif get_lun lun openw lun file for i 0 n_elements s 1 do begin t s i if t eq then t printf lun t endfor close lun free_lun lun err 0 return end"); 301 a[299] = new Array("./ToBeReviewed/STRING/str_size.html", "str_size.pro", "", " Id: str_size pro 18 2006 05 02 09:32:05Z pinsard NAME: STR_SIZE PURPOSE: The purpose of this function is to return the proper character size to make a specified string a specifed width in a window The width is specified in normalized coordinates The function is extremely useful for sizing strings and labels in resizeable graphics windows CATEGORY: Graphics Programs Widgets CALLING SEQUENCE: thisCharSize STR_SIZE thisSting targetWidth INPUTS: thisString: This is the string that you want to make a specifed target size or width OPTIONAL INPUTS: targetWidth: This is the target width of the string in normalized coordinates in the current graphics window The character size of the string returned as thisCharSize will be calculated to get the string width as close as possible to the target width The default is 0 25 KEYWORD PARAMETERS: INITSIZE: This is the initial size of the string Default is 1 0 STEP: This is the amount the string size will change in each step of the interative process of calculating the string size The default value is 0 05 OUTPUTS: thisCharSize: This is the size the specified string should be set to if you want to produce output of the specified target width The value is in standard character size units where 1 0 is the standard character size EXAMPLE: To make the string Happy Holidays take up 30 of the width of the current graphics window type this: XYOUTS 0 5 0 5 ALIGN 0 5 Happy Holidays CHARSIZE STR_SIZE Happy Holidays 0 3 MODIFICATION HISTORY: Written by: David Fanning 17 DEC 96 Added a scaling factor to take into account the aspect ratio of the window in determing the character size 28 Oct 97 DWF FUNCTION STR_SIZE string targetWidth INITSIZE initsize STEP step ON_ERROR 1 Check positional parameters np N_PARAMS CASE np OF 0: MESSAGE One string parameter is required 1: targetWidth 0 25 ELSE: ENDCASE Check keywords Assign default values IF N_ELEMENTS step EQ 0 THEN step 0 05 IF N_ELEMENTS initsize EQ 0 THEN initsize 1 0 Calculate a trial width size initsize XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL Size is perfect IF thisWidth EQ targetWidth THEN RETURN size Float D Y_Size D X_Size Initial size is too big IF thisWidth GT targetWidth THEN BEGIN REPEAT BEGIN XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL size size step ENDREP UNTIL thisWidth LE targetWidth RETURN size Float D Y_Size D X_Size ENDIF Initial size is too small IF thisWidth LT targetWidth THEN BEGIN REPEAT BEGIN XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL size size step ENDREP UNTIL thisWidth GT targetWidth size size step Need a value slightly smaller than target RETURN size Float D Y_Size D X_Size ENDIF END"); 302 a[300] = new Array("./ToBeReviewed/STRING/strcnt.html", "strcnt.pro", "", " NAME: STRCNT PURPOSE: Count number of occurrences of a substring in a string CATEGORY: text strings CALLING SEQUENCE: num strcnt strn substring pos INPUTS: string The string in which to count occurences in substring The substring to count occurrences of in pos the position at which to begin the search in If not supplied start at beginning of string KEYWORD PARAMETERS: HELP Print useful message and return OUTPUTS: num Number of occurances of substring in string out COMMON BLOCKS: SIDE EFFECTS: NOTES: Overlapping occurances are not counted separately For example counting occurances of bb in blah bbb returns one occurance EXAMPLE: MODIFICATION HISTORY: Id: strcnt pro 18 2006 05 02 09:32:05Z pinsard Log: strcnt pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added fast processing using BYTE arrays if we are counting occurences of a single character Added error handling Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strcnt strn substrn startpos HELP Help Return to caller if error On_error 2 Help user if needed IF n_params LT 2 OR keyword_set Help THEN BEGIN offset print offset Count number of occurrences of a substring in a string print offset num strcnt strn substring pos print offset Inputs: print offset offset string The string in which to count occurences in print offset offset substring The substring to count occurrences of in print offset offset pos the position at which to begin the search in print offset offset If not supplied start at beginning of print offset offset string print offset Keywords: print offset offset HELP Print useful message and return print offset Outputs: print offset offset num Number of occurances of substring in string out return 1 ENDIF IF n_params EQ 2 THEN startpos 0 return if we weren t really given a substring to search for IF strlen substrn EQ 0 THEN BEGIN print Error: Can t count occurances of null string return 1 ENDIF or if we were told to start at the end of the string tmpstrn strmid strn startpos strlen strn IF strlen tmpstrn EQ 0 THEN return 0 If looking for occurences of single character process using BYTE array IF strlen substrn EQ 1 THEN BEGIN tmpstrn byte TmpStrn count n_elements where TmpStrn EQ byte substrn 0 ENDIF ELSE BEGIN count 0L pos rstrpos tmpstrn substrn WHILE pos GE 0 DO BEGIN count count 1 pos rstrpos tmpstrn substrn pos ENDWHILE ENDELSE return count END "); 303 a[301] = new Array("./ToBeReviewed/STRING/string2struct.html", "string2struct.pro", "", "function too_cool _extra extra This is a really really cool way to turn keywords into a structure return extra end function string2struct strVal NAME: stringToStructure PURPOSE: Takes an input string set up as keywords and returns an anonymous structure This is particularly useful for taking keywords entered by a user in a text field and passing then to other routines CATEGORY: Utility CALLING SEQUENCE: extra stringToStructure xrange 0 10 linestyle 2 plot findgen 100 _extra extra INPUTS: String set up as keywords Keywords require a little special treatment Such as plot findgen 100 _extra stringToStructure title testing KEYWORD PARAMETERS: None OUTPUTS: This function returns the string as an anonymous structure If an error was found then this function returns a structure with a null field COMMON BLOCKS: None EXAMPLE: The code below creates a widget that uses this routine pro tPlot event widget_control event top get_uvalue field widget_control field get_value strVal extra stringToStructure strVal plot findgen 100 _extra extra wshow return end pro testWid enter any keyword to plot and see how it works base widget_base col field cw_field base title test value ax 0 string void widget_button base value plot event_pro tPlot widget_control base realize set_uvalue field xmanager testWid base no_block return end MODIFICATION HISTORY: Written by: RLK Ronn Kling Consulting ronn rlkling com www rlkling com May 1999 r execute extra too_cool strVal 0 if r 0 then user did not enter keywords correctly so return a structure with a null field if r eq 0 then begin print Error in input string return null:0 endif return extra end "); 304 a[302] = new Array("./ToBeReviewed/STRING/strkeywd.html", "strkeywd.pro", "", " NAME: strkeywd string keywords PURPOSE: traduit une sturcture en un string pouvant etre utilise pour specifier des keywords ds l appelle d une fonction qd on utilise execute cf l exemple CATEGORY: pour passer des mots cles avec execute CALLING SEQUENCE:res strkeywd struct INPUTS:struct: une structure KEYWORD PARAMETERS: OUTPUTS:un string compose de la facon suivante: pour chaque element de la structure on ecrit une partie du string sous la forme: nom_de_l element contennu de l element COMMON BLOCKS: SIDE EFFECTS: Si un element de la structure contient un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des structure de grosse taille avec bcp d elements et avec des elements etant de gros tableaux la structure en entree ne doit pas contenir de Complex floating de structure de Double precision complex de Pointer de Object reference de Unsigned Integer de Unsigned Longword Integer de 64 bit Integer de Unsigned 64 bit Integer EXAMPLE: on cree une structure IDL b get_extra ok 111 year 1997 1998 1999 age_capitaine 35 IDL help b struct Structure 3 tags length 10 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT Array 3 on met cette structure sous forme de string IDL a strkeywd b IDL print a AGE_CAPITAINE 35 OK 111 YEAR 1997 1998 1999 maintenant on peut utiliser le string a pour passer des mots cles ds une fonction a l aide de execute IDL test execute c get_extra a IDL help c struct Structure 3 tags length 10 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT Array 3 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 11 10 1999 FUNCTION strkeywd struct if size struct type NE 8 then return tname tag_names struct if n_elements tname EQ 0 then return on s occupe du premier element res strlowcase tname 0 tostr struct 0 if n_elements tname EQ 1 then return res on s occupe des autres elements for n 1 n_elements tname 1 do res res strlowcase tname n tostr struct n return res end"); 305 a[303] = new Array("./ToBeReviewed/STRING/strrepl.html", "strrepl.pro", "", " Id: strrepl pro 18 2006 05 02 09:32:05Z pinsard NAME: STRREPL function PURPOSE: replace one or more character s string s in a string CATEGORY: string routines CALLING SEQUENCE: Result STRREPL str index rchar INPUTS: STR the string to be changed INDEX position of the character s to be replaced or a string to be changed in STR RCHAR replacement character string KEYWORD PARAMETERS: none OUTPUTS: another string SUBROUTINES: REQUIREMENTS: NOTES: Known shortcoming: if index is an array it must contain all valid elements only the first entry is checked EXAMPLE: Convert one letter into upper case abc abcdefghijklmnopqrstuvwxyz print strrepl abc strpos abc m M prints abcdefghijklMnopqrstuvwxyz Use with strwhere function a abcabcabc print strrepl a strwhere a a prints bc bc bc bc bc IDL print strrepl a bc eeee a eeee a eeee a eeee IDL print strrepl a b 0000 a0000ca0000ca0000 IDL print strrepl a toto 0000 abcabcabc MODIFICATION HISTORY: mgs 02 Jun 1998: VERSION 1 00 sebastien Masson smlod ipsl jussieu fr Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strrepl function strrepl str agument1 rchar if n_elements str eq 0 then return convert strign and replace character to byte BStr byte str new byte rchar if size agument1 type EQ 7 then begin old byte agument1 index strpos str agument1 pos index while strpos str agument1 pos 1 NE 1 do BEGIN pos strpos str agument1 pos 1 index index pos ENDWHILE make sure index is in range if index 0 lt 0 OR index 0 ge n_elements BStr THEN return Str ENDIF ELSE BEGIN index agument1 if index 0 lt 0 OR index 0 ge n_elements BStr then return Str old BStr index 0 ENDELSE replace indexed characters in string nelenew n_elements new neleold n_elements old nindex n_elements index if nelenew neleold NE 1 then begin if index 0 EQ 0 then BStr NEW BStr index 0 neleold: n_elements BStr 1 ELSE BStr BStr 0:index 0 1 NEW BStr index 0 neleold: n_elements BStr 1 if nindex EQ 1 then return string BStr if nindex GT 2 then for i 1 nindex 2 do BStr BStr 0:index i i nelenew neleold 1 NEW BStr index i i nelenew neleold neleold: n_elements BStr 1 BStr BStr 0:index n_elements index 1 nindex 1 nelenew neleold 1 NEW ENDIF ELSE BStr index NEW return result as string return string BStr end"); 306 a[304] = new Array("./ToBeReviewed/STRING/strright.html", "strright.pro", "", " Id: strright pro 18 2006 05 02 09:32:05Z pinsard NAME: STRRIGHT PURPOSE: return right subportion from a string CATEGORY: string handling CALLING SEQUENCE: res STRRIGHT string nlast INPUTS: STRING the string to be searched NLAST the number of characters to be returned Default is 1 If NLAST is ge strlen STRING the complete string is returned KEYWORD PARAMETERS: OUTPUTS: The portion of NLAST characters of STRING counted from the back SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: if strright path ne then path path MODIFICATION HISTORY: mgs 19 Nov 1997: VERSION 1 00 Copyright C 1997 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strright function strright s lastn on_error 2 return to caller if n_elements s le 0 then return 1L l strlen s if n_elements lastn le 0 then lastn 1 if lastn gt l then lastn l result strmid s l lastn l return result end"); 307 a[305] = new Array("./ToBeReviewed/STRING/strsci.html", "strsci.pro", "", " Id: strsci pro 18 2006 05 02 09:32:05Z pinsard NAME: STRSCI function PURPOSE: Given a number returns a string of that B number in scientific notation format e g A x 10 CATEGORY: String Utilities CALLING SEQUENCE: Result STRSCI DATA keywords INPUTS: DATA A floating point or integer number to be converted into a power of 10 KEYWORD PARAMETERS: FORMAT The format specification used in the string conversion for the mantissa i e the A of A x 10 B Default is f12 2 POT_ONLY Will return only the power of 10 part of the string i e the 10 B Default is to return the entire string e g A x 10 B MANTISSA_ONLY return only mantissa of the string SHORT return 10 0 as 1 and 10 1 as 10 TRIM don t insert blanks i e return Ax10 B OUTPUTS: None SUBROUTINES: None REQUIREMENTS: None NOTES: This function does not evaluate the format statement thoroughly which can result in somewhat quirky strings Example: print strsci 9 999 results in 10 0x10 0 instead of 1 0x10 1 Need a better symbol than the x for the multiplier EXAMPLE: Result STRSCI 2000000 format i1 print result 6 prints 2 x 10 u6 n which gets plotted as 2 x 10 Result STRSCI 0 0001 print result 4 prints 1 00 x 10 u 4 n which gets plotted as 1 00 x 10 Result STRSCI 0d0 format f13 8 print result prints 0 00000000 MODIFICATION HISTORY: bmy 28 May 1998: VERSION 1 00 B now returns string of the form A x 10 mgs 29 May 1998: bug fix: now allows negative numbers keyword MANTISSA_ONLY added default format changed to f12 2 bmy 02 Jun 1998: renamed to STRSCI STRing SCIentific notation mgs 03 Jun 1998: added TRIM keyword mgs 22 Sep 1998: added SHORT keyword modified handling of TRIM keyword mgs 24 Sep 1998: bug fix with SHORT flag bmy mgs 02 Jun 1999: now can handle DATA 0 0 correctly updated comments mgs 03 Jun 1999: can now also handle values lt 1 and doesn t choke on arrays Copyright C 1998 1999 Bob Yantosca and Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to bmy io harvard edu or mgs io harvard edu with subject IDL routine strsci function StrSci Data Format Format POT_Only POT_Only MANTISSA_ONLY MANTISSA_ONLY SHORT SHORT TRIM TRIM Error checking Keyword settings on_error 2 if n_elements Data eq 0 then begin return endif if not Keyword_Set Format then Format f12 2 POT_Only keyword_set POT_Only MANTISSA_Only keyword_set MANTISSA_Only Short Keyword_Set Short Trim Keyword_Set Trim NDat n_elements Data Result strarr NDat for i 0 NDat 1 do begin If ABS DATA 0 then we can proceed to take the common log For DATA 0 place a sign in front of the number if Abs Data i ne 0 0 then begin take the common log and store in LOG10DATA Log10Data ALog10 Abs Data i Boolean flag if data 0 sign Data i lt 0 0 Compute the characteristic int part Add the 1d 6 to prevent roundoff errors Characteristic Fix Log10Data 1 0d 6 if Log10Data lt 0 then Characteristic Characteristic 1 Compute the Mantissa frac part and take its antilog Mantissa Log10Data Characteristic Mantissa 10 0 Mantissa print data i log10data mantissa characteristic format 3f24 14 i8 String for the coefficient part The coefficient is just antilog of the Mantissa Add the minus sign if DATA 0 0 A StrTrim String Mantissa Format Format 2 if Sign then A A String for the power of 10 part B 10 u strtrim string Characteristic 2 n if Short then begin if Characteristic eq 0 then B 1 if Characteristic eq 1 then B 10 endif composite string Result i A x B if Short AND B eq 1 then Result i A If DATA 0 then we cannot take the common log so return zeroes for the result strings Use the FORMAT string endif else begin A String 0d0 Format Format B A Result i A endelse Return result to calling program depending on keyword settings Eliminate blanks if TRIM keyword is set if POT_Only then Result i B if MANTISSA_Only then Result i A if Trim then Result i StrCompress Result i Remove_All endfor if n_elements Result eq 1 then Result Result 0 return Result end"); 308 a[306] = new Array("./ToBeReviewed/STRING/strtok.html", "strtok.pro", "", " NAME: STRTOK PURPOSE: Retrieve portion of string up to token CATEGORY: text strings CALLING SEQUENCE: new strtok old token INPUTS: old String to be split Contains text after in out token on output token Token to use in splitting old in KEYWORD PARAMETERS: TRIM set to remove leading blanks from old before returning HELP print useful message and exit OUTPUTS: new portion of string up to token out old portion of old after token out in COMMON BLOCKS: SIDE EFFECTS: Input parameter old is modified NOTES: Token may be one or more characters If token is not found returns old and sets old to EXAMPLE: If old is foo44 bar then strtok old 44 would return foo and upon return old will be left with bar If TRIM were set old would be bar on return If old xyz then new strtok old a would return with new xyz and old THANKS: To D Linder who wrote GETTOK part of the goddard library upon which this is based MODIFICATION HISTORY: Id: strtok pro 18 2006 05 02 09:32:05Z pinsard Log: strtok pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added built in help Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strtok string token TRIM trim HELP Help Back to the caller if error occurs On_error 2 IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Retrieve portion of string up to token print offset new strtok old token print offset Inputs: print offset offset old String to be split Contains text after in out print offset offset token on output print offset offset token Token to use in splitting old in print offset Keywords: print offset offset TRIM set to remove leading blanks from old print offset offset before returning print offset offset HELP print useful message and exit print offset Outputs: print offset offset new portion of string up to token out print offset offset old portion of old after token out in print offset Side effects: print offset offset Input parameter old is modified print offset Notes: print offset offset Token may be one or more characters print offset offset If token is not found returns old and sets old to print offset Examples: print offset offset If old is foo44 bar then strtok old 44 would return print offset offset foo and upon return old will be left with bar If TRIM print offset offset were set old would be bar on return print offset offset If old xyz then new strtok old a would return with print offset offset new xyz and old return 1 ENDIF pos strpos string token IF pos GE 0 THEN BEGIN front strmid string 0 pos string strmid string pos strlen token strlen string IF keyword_set trim THEN string strtrim string 1 return front ENDIF front string string return front END "); 309 a[307] = new Array("./ToBeReviewed/STRING/strtrans.html", "strtrans.pro", "", " NAME: STRTRANS PURPOSE: Translate all occurences of one substring to another CATEGORY: text strings CALLING SEQUENCE: new strtrans oldstr from to ned INPUTS: oldstr string on which to operate in May be an array from substrings to be translated May be in an array to what strings in from should be in translated to May be an array KEYWORD PARAMETERS: HELP Set this to print useful message and exit OUTPUTS: new Translated string Array if oldstr is out an array ned number of substitutions performed in out oldstr Array if oldstr is an array COMMON BLOCKS: SIDE EFFECTS: NOTES: Any of old from and to can be arrays from and to must have the same number of elements EXAMPLE: inp Many bad chars in_here from _ to out strtrans inp from to ned Will produce out Many bad chars in here and set ned to 4 MODIFICATION HISTORY: Id: strtrans pro 18 2006 05 02 09:32:05Z pinsard Log: strtrans pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Sped up significantly by using str_sep to handle the translation No longer relies on routines fromother user libraries Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION strtrans InputString from to ned HELP Help Bomb out to caller if error On_error 2 Offer help if we don t have at least InputString from and to or if the user asks for it IF n_params LT 3 OR keyword_set help THEN BEGIN offset print offset Translate all occurences of one substring to another print offset new strtrans oldstr from to ned print offset Inputs: print offset offset oldstr string on which to operate in print offset offset May be an array print offset offset from substrings to be translated May be in print offset offset an array print offset offset to what strings in from should be in print offset offset translated to May be an array print offset Outputs: print offset offset new Translated string Array if oldstr is out print offset offset an array print offset offset ned number of substitutions performed in out print offset offset oldstr Array if oldstr is an array print offset Notes: print offset offset Any of old from and to can be arrays print offset offset from and to must have the same number of elements return 1 ENDIF strn InputString Check that From To have same number of elements RETURN if they don t NFrom n_elements from NTo n_elements to IF NFrom EQ 0 OR NTo EQ 0 THEN return strn IF NFrom NE NTo THEN BEGIN print Error: Number of elements in from to unequal return 1 ENDIF Make sure there are no null strings in From RETURN if there are FromLen strlen From IF total FromLen EQ 0 GT 0 THEN BEGIN print Error: elements of From must have nonzero length return 1 ENDIF NStrings n_elements strn ned lonarr NStrings tmpned 0L Say strn a b c from and to Then the approach here is to first split strn at all occurances of then recombine the pieces with inserted instead Do this for all elements of strn and all elements of from FOR i 0L NStrings 1 DO BEGIN ned i 0L FOR j 0L NFrom 1 DO BEGIN SepStr str_sep strn i from j NSubs n_elements SepStr 1 strn i SepStr 0 FOR k 1L NSubs DO strn i strn i To j SepStr k ned i ned i NSubs ENDFOR ENDFOR return strn END "); 310 a[308] = new Array("./ToBeReviewed/STRING/strwhere.html", "strwhere.pro", "", " Id: strwhere pro 18 2006 05 02 09:32:05Z pinsard NAME: STRWHERE function PURPOSE: return position array for occurence of a character in a string CATEGORY: string tools CALLING SEQUENCE: pos STRWHERE str schar Count INPUTS: STR the string SCHAR the character to look for KEYWORD PARAMETERS: none OUTPUTS: COUNT optional The number of matches that were found The function returns an index array similar to the result of the where function SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: ind strwhere abcabcabc a returns 0 3 6 MODIFICATION HISTORY: mgs 02 Jun 1998: VERSION 1 00 bmy 30 Jun 1998: now returns COUNT the number of matches that are found this is analogous to the WHERE command Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strwhere function strwhere str schar Count if n_elements str eq 0 then return 1 convert to byte BStr byte Str BSC byte schar 0 Search for matches Ind where Bstr eq BSC Count bmy return where BStr eq BSC return Ind end "); 311 a[309] = new Array("./ToBeReviewed/STRING/tostr.html", "tostr.pro", "", " NAME: tostr to string PURPOSE: convertit un input en un string CATEGORY: CALLING SEQUENCE: res tostr input INPUTS: input ne peut pas contenir ou etre de type: Complex floating structure Double precision complex Pointer Object reference Unsigned Integer Unsigned Longword Integer 64 bit Integer Unsigned 64 bit Integer KEYWORD PARAMETERS: none OUTPUTS: un string COMMON BLOCKS: SIDE EFFECTS: Si un element de input contient un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des inputs de grosse taille avec bcp d elements et avec des elements etant de gros tableaux EXAMPLE: IDL help tostr 1 tostr a tostr indgen 4 tostr a jkfjo STRING 1 STRING a STRING 0 1 2 3 STRING a jkfjo IDL print tostr c est bon c est bon c est bon c est bon MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 FUNCTION tostr input case 1 of size input type LE 5:BEGIN if size input type EQ 1 then input long input if n_elements input EQ 1 then res strtrim input 1 ELSE BEGIN res strtrim input 0 1 for i 1 n_elements input 1 do res res strtrim input i 1 res res ENDELSE END size input type eq 7:BEGIN if n_elements input EQ 1 then BEGIN sinput strrepl input res sinput ENDIF ELSE BEGIN res strrepl input 0 for i 1 n_elements input 1 do res res strrepl input i res res ENDELSE END ELSE:BEGIN ras report la fonction tostr ne marche pas pour input qui est de type size input tname res END ENDCASE return res end"); 312 a[310] = new Array("./ToBeReviewed/STRUCTURE/chkstru.html", "chkstru.pro", "", " Id: chkstru pro 27 2006 05 02 13:10:05Z pinsard NAME: CHKSTRU function PURPOSE: check validity of a structure and test if necessary fields are contained CATEGORY: tools CALLING SEQUENCE: res CHKSTRU STRUCTURE FIELDS VERBOSE INPUTS: STRUCTURE the structure to be tested If STRUCTURE is not of type structure the function will return 0 FIELDS a string or string array with field names to be contained in STRUCTURE CHKSTRU returns 1 true only if all field names are contained in STRUCTURE The entries of FIELDS may be upper or lowercase KEYWORD PARAMETERS: INDEX a named variable that will contain the indices of the required field names in the structure They can then be assessed through structure index i Index will contain 1 for all fields entries that are not in the structure VERBOSE set this keyword to return an error message in case of an error EXTRACT set this keyword to extract a fields from the structure 1 is return is fields or structure are incorrect OUTPUTS: CHKSTRU returns 1 if successful otherwise 0 SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: test a:1 b:2 c:3 required a c if CHKSTRU test required then print found a and c IDL print CHKSTRU test b 1 IDL print CHKSTRU test b extract 2 MODIFICATION HISTORY: mgs 02 Mar 1998: VERSION 1 00 mgs 07 Apr 1998: second parameter FIELDS now optional 12 Jan 2001: EXTRACT keyword by S Masson smasson lodyc jussieu fr Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine chkstru function chkstru structure fields index index verbose verbose extract extract default index index 1 first check number of parameters must be at least 1 if n_params lt 1 then begin if keyword_set verbose then ras report CHKSTRU: invalid number of parameters if keyword_set extract THEN return 1 ELSE return 0 endif check if the user really passed a structure s size structure if s 1 s 0 ne 8 then begin if keyword_set verbose then ras report CHKSTRU: No structure passed if keyword_set extract THEN return 1 ELSE return 0 endif only one parameter: then we are finished if n_params eq 1 then return 1 see if required field names are contained in the structure and return indices of these fields names tag_names structure index intarr n_elements fields 1 default index to not found for i 0 n_elements fields 1 do begin ind where names eq strupcase fields i if ind 0 lt 0 then begin if keyword_set verbose then ras report CHKSTRU: Cannot find field fields i endif else index i ind 0 endfor check minimum value of index field: 1 indicates error if keyword_set extract then BEGIN if index 0 NE 1 THEN return structure index 0 ELSE return 1 ENDIF ELSE return min index ge 0 end "); 313 a[311] = new Array("./ToBeReviewed/STRUCTURE/extractstru.html", "extractstru.pro", "", " NAME:extractstru PURPOSE:extrait des elements d une structure pour constituer une nouvelle structure CATEGORY: dibouille sur les structures CALLING SEQUENCE: res extractstru stru liste INPUTS: stru: une structure liste: un vecteur de string comportant les noms des elements de stru a virer par DEFAUT ou a garder si GARDE est active KEYWORD PARAMETERS: GARDE: specifie que la liste donnee concerne les elements de stru a garder VIRE: specifie que la liste donnee concerne les elements de stru a virer Ce mot cle est active par defaut OUTPUTS:une stucture ou 1 en cas de pb COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: none liste peut contenir des noms d elements qui ne sont pas ds stru le programme se debrouille avec EXAMPLE: IDL extra get_extra ok year 1999 age_capitaine 35 IDL help extra struct Structure 3 tags length 6 refs 1: AGE_CAPITAINE INT 35 OK INT 1 YEAR INT 1999 IDL help extractstru extra ok hhuihi YEAR stru Structure 1 tags length 2 refs 1: AGE_CAPITAINE INT 35 IDL help extractstru extra ok hhuihi YEAR garde stru Structure 2 tags length 4 refs 1: OK INT 1 YEAR INT 1999 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 10 1999 FUNCTION extractstru stru liste GARDE garde VIRE vire if size stru type NE 8 then return 1 if size liste type NE 7 then return 1 cheking for garde and vire keywords garde keyword_set garde 1 keyword_set vire vire keyword_set vire 1 keyword_set garde keyword_set vire EQ garde tname tag_names stru index make_selection tname strupcase liste only_valid quiet if garde then BEGIN on garde que la liste if index 0 EQ 1 then return 1 if n_elements index EQ n_elements tname then return stru res create_struct tname index 0 stru index 0 if n_elements index GT 1 then for i 1 n_elements index 1 do res create_struct res tname index i stru index i ENDIF ELSE BEGIN on vire la liste if n_elements index EQ n_elements tname then return 1 if index 0 EQ 1 then return stru on prend le complementaire de index pour obtenir les indices que l on garde index different indgen n_elements tname index res create_struct tname index 0 stru index 0 if n_elements index GT 1 then for i 1 n_elements index 1 do res create_struct res tname index i stru index i ENDELSE return res end"); 314 a[312] = new Array("./ToBeReviewed/STRUCTURE/mixstru.html", "mixstru.pro", "", " NAME: mixstru PURPOSE: concatene 2 structures ensemble La difference avec CREATE_STRUCT etant que si les 2 stuctures ont les memes noms d elements alors mixstru ne plante pas mais choisit pour valeur de l element commun celle specifiee par la premiere structure CATEGORY: structure CALLING SEQUENCE: rs mixstru stru1 stru2 INPUTS: stru1 et stu2 sont 2 structures qui peuvent avoir des elements portant le meme nom mais avec une valeur differente KEYWORD PARAMETERS: none OUTPUTS: une stucture COMMON BLOCKS: SIDE EFFECTS: si stru1 ou stru2 ne sont pas des structures mixstru renvoie 1 RESTRICTIONS: EXAMPLE: IDL a get_extra toto ok 123 IDL b get_extra ok 111 year 1999 age_capitaine 35 IDL help a b struct Structure 2 tags length 4 refs 1: OK INT 123 TOTO INT 1 Structure 3 tags length 6 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT 1999 IDL help mixstru a b struct Structure 4 tags length 8 refs 1: AGE_CAPITAINE INT 35 YEAR INT 1999 OK INT 123 TOTO INT 1 IDL help mixstru b a struct Structure 4 tags length 8 refs 1: TOTO INT 1 AGE_CAPITAINE INT 35 OK INT 111 YEAR INT 1999 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 7 10 1999 FUNCTION mixstru stru1 stru2 cm_general IF size stru1 type EQ 0 AND size stru2 type EQ 8 THEN return stru2 IF size stru2 type EQ 0 AND size stru1 type EQ 8 THEN return stru1 if size stru1 type NE 8 then return 1 if size stru2 type NE 8 then return 1 tname tag_names stru2 str FOR i 0 n_tags stru2 1 DO str str tname i stru2 strtrim i 2 res createfunc get_extra str _extra stru1 kwdlist stru1 stru1 stru2 stru2 stru1 stru1 stru2 stru2 filename myuniquetmpdir for_createfunc pro return res end"); 315 a[313] = new Array("./ToBeReviewed/STRUCTURE/struct2string.html", "struct2string.pro", "", " NAME:struct2string PURPOSE:convert a structure to an executable string CATEGORY:bidouille CALLING SEQUENCE:sting struct2string struct INPUTS:struct: a structure KEYWORD PARAMETERS: MAX_STRUCT_LENGTH : the maximum length of the structure permetted to convert the structure to string Default is 10000l DIRECT2STRING: to get a string instead an executable string CUT_IN_STRING: try it OUTPUTS: SIDE EFFECTS:use tostr pro cf this function header RESTRICTIONS:use tostr pro cf this function header EXAMPLE: IDL print struct2string d create_struct NAME X X_SIZE 891 Y_SIZE 630 X_VSIZE 891 Y_VSIZE 630 X_CH_SIZE 6 Y_CH_SIZE 10 X_PX_CM 40 0000 Y_PX_CM 40 0000 N_COLORS 16777216 TABLE_SIZE 256 FILL_DIST 1 WINDOW 32 UNIT 0 FLAGS 328124 ORIGIN 0 0 ZOOM 1 1 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 07 03 FUNCTION struct2string struct CUT_IN_STRING cut_in_string MAX_STRUCT_LENGTH max_struct_length DIRECT2STRING direct2string if size struct type NE 8 then return if NOT keyword_set max_struct_length then max_struct_length 10000l if n_tags struct length GT max_struct_length then begin rien report The structure is too big to be converted to string C See the MAX_STRUCT_LENGTH keyword return endif names tag_names struct case 1 of keyword_set direct2string :BEGIN res names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res names i tostr struct i endfor endif END keyword_set CUT_IN_STRING :BEGIN res create_struct names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res create_struct res names i tostr struct i endfor endif END ELSE:BEGIN res create_struct names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res names i tostr struct i endfor endif res res END endcase return res end"); 316 a[314] = new Array("./ToBeReviewed/STRUCTURE/where_tag.html", "where_tag.pro", "", "function where_Tag Struct Nfound TAG_NAME Tag_Name TAG_NUMBER Tag_Num ISELECT ipart NOPRINT noprint RANGE range VALUES values NAME: WHERE_TAG PURPOSE: Like WHERE but works on structure tag names EXPLANATION: Obtain subscripts of elements in structure array for which a particular Tag has values in a range or matching specified values Like the WHERE function but for use with structures CATEGORY: Structures CALLING SEQUENCE: w where_tag struct Nfound TAG_NAME TAG_NUMBER RANGE VALUES RANGE ISELECT NOPRINT INPUTS: Struct structure array to search INPUT KEYWORDS: User must specify 1 TAG_NAME or TAG_NUMBER to search and 2 the VALUES or RANGE to search on TAG_NAME Scalar string specifying Tag Name TAG_NUMBER otherwise give the Tag Number RANGE min max range to search for in Struct VALUES one or array of numbers to match for in Struct ISELECT specifies indices to select only part of structure array use it to recycle subscripts from previous searches NOPRINT suppress informational messages about nothing found OUTPUTS: Nfound of occurences found RESULT: Function returns subscripts indices to desired elements EXAMPLES: Suppose STR is a structure with tags CAT_NO:indgen 10 and NAME:strarr 10 Find the indices where STR CAT_NO is between 3 and 5 IDL print WHERE_TAG str TAG_NAME CAT_NO VALUE 3 4 5 or IDL print WHERE_TAG str TAG_NUM 0 RANGE 3 5 PROCEDURE: Get tag number and apply the WHERE function appropriately MODIFICATION HISTORY: written 1990 Frank Varosi STX NASA GSFC Stop printing Tag not found with NOPRINT CD Pike 8 Jun 93 First check required parameters Ntag N_tags Struct if Ntag LE 1 then begin message expecting a Structure Array try again CONTIN return 1 endif if N_elements Tag_Num NE 1 AND N_elements Tag_Name NE 1 then begin message specify TAG_NAME or TAG_NUMBER to search CONTIN return 1 endif Tags Tag_names Struct if N_elements Tag_Name EQ 1 then begin Tag_Name strupcase Tag_Name Tag_Num where Tags EQ Tag_Name Tag_Num Tag_Num 0 if Tag_Num LT 0 then begin if NOT keyword_set noprint then message Tag not found CONTIN return 2 endif endif if Tag_Num LT 0 OR Tag_Num GE Ntag then begin message Tag strtrim Tag_Num 2 exceeds Max Tag strtrim Ntag 1 2 in structure CONTIN return 1 endif if N_elements ipart GT 0 then begin check if any searching on a subset of input w where ipart GE 0 nf if nf LE 0 then return 1 if nf LT N_elements ipart then ipart ipart w endif Now find out where for RANGE : if N_elements range EQ 2 then begin if N_elements ipart GT 0 then begin w where Struct ipart Tag_Num GE range 0 AND Struct ipart Tag_Num LE range 1 Nfound if Nfound GT 0 then windex ipart w else windex w endif else windex where Struct Tag_Num GE range 0 AND Struct Tag_Num LE range 1 Nfound if Nfound LE 0 AND NOT keyword_set noprint then begin strnums strtrim range 2 string strnums 0 strnums 1 message NO values of found in the Range string CONTIN endif where Values: endif else if N_elements values GE 1 then begin Nval N_elements values vals values Nfound 0 if N_elements ipart GT 0 then begin for v 0 Nval 1 do begin w where Struct ipart Tag_Num EQ vals v Nf if Nf GT 0 then begin if Nfound GT 0 then ww ww w else ww w endif Nfound Nfound Nf endfor if Nfound GT 0 then windex ipart ww sort ww else windex w endif else begin for v 0 Nval 1 do begin w where Struct Tag_Num EQ vals v Nf if Nf GT 0 then begin if Nfound GT 0 then ww ww w else ww w endif Nfound Nfound Nf endfor if Nfound GT 0 then windex ww sort ww else windex w endelse if Nfound LE 0 AND NOT keyword_set noprint then begin strnums strtrim vals 2 string strnums 0 for i 1 Nval 1 do string string strnums i message NO values of found Equaling string CONTIN endif endif else begin message must specify a RANGE or VALUES s CONTIN windex 1 endelse return windex end"); 317 a[315] = new Array("./ToBeReviewed/TRIANGULATION/ciseauxtri.html", "ciseauxtri.pro", "", " NAME: PURPOSE:vire les tableaux qui ne doivent pas etre dessines grace a 2 tests: 1 les coins du tableau doivent etre ds la fenetre 2 les clongeurs des cotes des triangfles exprimes en coordonnees normalisesne doivent pas depasser une certaine longueur seuil CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 20 2 99 FUNCTION ciseauxtri triang glam gphi TOUT tout _EXTRA ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF NOT keyword_set key_periodic AND NOT keyword_set key_irregular AND NOT map projection LE 7 AND map projection NE 0 AND NOT map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 THEN return triang tempsun systime 1 pour key_performance taille size glam nx taille 1 ny taille 2 tempdeux systime 1 pour key_performance 2 z convert_coord glam gphi data to_normal x z 0 y z 1 tempvar SIZE TEMPORARY z delete z IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: convert_coord data to_normal systime 1 tempdeux attention suivant la projection certains points x ou y peuvent devenir NaN cf points deriere la terre ds une projection orthographique il faut dans ce cas enlever tous les triangles qui contiennent un de ces points if map projection LE 7 AND map projection NE 0 OR map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 then begin tempdeux systime 1 pour key_performance 2 test x y triang test finite temporary test nan test total temporary test 1 ind where temporary test EQ 0 if ind 0 NE 1 then triang triang temporary ind ELSE return 1 trichanged 1b IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: recherche points a NAN systime 1 tempdeux endif seuil 5 indxtriang2 indxtriang indxmin nx 1 indxmin EQ 0 AND indxmax EQ nx 1 ENDIF ELSE indxtriang indxmin listrect nx indytriang indxtriang IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: liste des rectangles systime 1 tempdeux maintenant qu on a cette liste on va s assuter que l on a pas de triangles qui n ont qu on sommet en commun test bytarr nx ny test listrect 1 dejavire 1b test tempdeux systime 1 pour key_performance 2 vire1 0 vire2 0 while vire1 0 NE 1 OR vire2 0 NE 1 ne 0 do begin vire1 where test shift test 1 1 1 shift test 0 1 1 shift test 1 0 EQ 1 if vire1 0 NE 1 THEN test vire1 0 on vire le rectangle vire2 where 1 test 1 shift test 1 1 shift test 0 1 shift test 1 0 EQ 1 on vire le rectangle du dessus meme indice x mais egale a 1 if vire2 0 NE 1 THEN test vire2 nx 0 ENDWHILE stop test test temporary dejavire avirer where temporary test EQ 0 IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: determinationdes rectangles a virer systime 1 tempdeux if avirer 0 NE 1 then begin tempdeux systime 1 pour key_performance 2 indnx n_elements listrect indny n_elements avirer ind listrect replicate 1l indny ind ind EQ replicate 1 indnx avirer if indny GT 1 then ind total ind 2 ind where ind EQ 0 if ind 0 NE 1 then triang triang ind ELSE return 1 endif IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: derniere retouche de la triangulation systime 1 tempdeux endif if keyword_set key_performance THEN print temps ciseauxtri systime 1 tempsun return triang end"); 318 a[316] = new Array("./ToBeReviewed/TRIANGULATION/completecointerre.html", "completecointerre.pro", "", " NAME: COMPLETECOINTERRE PURPOSE: pour colorier proprement les continents c est une longue histoire CATEGORY: pour plt CALLING SEQUENCE: completecointerre INPUTS: non KEYWORD PARAMETERS: _EXTRA CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: non COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 01 10 1999 PRO draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex cm_4mesh the triangle must not be out of the domain IF min lons max maxlon GE lon1 AND maxlon LE lon2 AND min lats max maxlat GE lat1 AND maxlat LE lat2 then BEGIN the triangle must not be too big z convert_coord lons lats data to_normal alldist z 0 2 z 0 0 2 z 1 2 z 1 0 2 z 0 0 z 0 1 2 z 1 0 z 1 1 2 z 0 1 z 0 2 2 z 1 1 z 1 2 2 IF max alldist LT seuil 2 THEN polyfill lons lats color cont_color _extra ex return ENDIF end PRO completecointerre COINMONTE coinmonte COINDESCEND coindescend CONT_COLOR cont_color INDICEZOOM indicezoom _extra ex common if NOT keyword_set coinmonte then return if NOT keyword_set coindescend then return if NOT keyword_set indicezoom then return tempsun systime 1 pour key_performance definitions des vecteurs coinmont et coindesc if keyword_set coinmonte then coinmont coinmonte ELSE coinmont twin_corners_up if keyword_set coindescend then coindesc coindescend ELSE coindesc twin_corners_dn IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 definition descoordonnees des points numerotes 1 2 3 4 5 6 cf les schemas en dessous tempdeux systime 1 pour key_performance 2 if coinmont 0 NE 1 OR coindesc 0 NE 1 then BEGIN if keyword_set indicezoom then BEGIN if we use key_stide the t u v and f points are no more related to the same cell because glamf and gphif has be recomputed to be in the middle of two t points IF total key_stride EQ 3 AND finite glamv 0 gphiv 0 NE 0 THEN BEGIN long1 glamv indicezoom lati1 gphiv indicezoom ENDIF ELSE BEGIN long1 glamt indicezoom lati1 gphif indicezoom ENDELSE IF total key_stride EQ 3 AND finite glamu 0 gphiu 0 NE 0 THEN BEGIN long2 glamu indicezoom lati2 gphiu indicezoom ENDIF ELSE BEGIN long2 glamf indicezoom lati2 gphit indicezoom ENDELSE long3 glamf indicezoom lati3 gphif indicezoom ENDIF ELSE BEGIN IF total key_stride EQ 3 AND finite glamv 0 gphiv 0 NE 0 THEN BEGIN long1 glamv lati1 gphiv ENDIF ELSE BEGIN long1 glamt lati1 gphif ENDELSE IF total key_stride EQ 3 AND finite glamu 0 gphiu 0 NE 0 THEN BEGIN long2 glamu lati2 gphiu ENDIF ELSE BEGIN long2 glamf lati2 gphit ENDELSE long3 glamf lati3 gphif ENDELSE nx size long1 dimensions 0 ny size long1 dimensions 1 seuil 5 min nx ny 2 seuil min p position 2 p position 0 seuil p position 3 p position 1 seuil ENDIF IF testvar var key_performance EQ 2 THEN print temps completecointerre: positions des points systime 1 tempdeux cas coin terre en montee: 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante 4 t i nx 1 u i nx t i nx 1 0 1 3 5 v i f i v i 1 t i 0 2 u i t i 1 1 if coinmont 0 NE 1 then BEGIN tempdeux systime 1 pour key_performance 2 for id 0 n_elements coinmont 1 do BEGIN i coinmont id ii i MOD nx ij i nx bottom triangle lons long1 i long2 i long3 i lats lati1 i lati2 i lati3 i draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex upper triangle IF ii NE nx 1 AND ij NE ny 1 THEN BEGIN lons long3 i long1 i 1 long2 i nx lats lati3 i lati1 i 1 lati2 i nx draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex ENDIF ENDFOR IF testvar var key_performance EQ 2 THEN print temps completecointerre: trace de cointerremonte systime 1 tempdeux ENDIF cas coin terre en descendante : 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante 4 t i nx 1 u i nx t i nx 1 0 3 5 v i f i v i 1 1 t i 0 2 u i t i 1 1 if coindesc 0 NE 1 then begin tempdeux systime 1 pour key_performance 2 for id 0 n_elements coindesc 1 do BEGIN i coindesc id ii i MOD nx ij i nx IF ii NE nx 1 AND ij NE ny 1 THEN BEGIN left triangle lons long1 i long3 i long2 i nx lats lati1 i lati3 i lati2 i nx draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex right triangle lons long3 i long2 i long1 i 1 lats lati3 i lati2 i lati1 i 1 draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex ENDIF ENDFOR IF testvar var key_performance EQ 2 THEN print temps completecointerre: trace de cointerredescend systime 1 tempdeux ENDIF IF keyword_set key_performance THEN print temps completecointerre systime 1 tempsun return end"); 319 a[317] = new Array("./ToBeReviewed/TRIANGULATION/definetri.html", "definetri.pro", "", " NAME:definetri PURPOSE:Define a triangulation array like TRIANGULATE But in a VERY SIMPLE CASE: the points are regulary gridded on nx ny array Find a Delaunay triangulation for this set of points is easy: Points define nx 1 ny 1 rectangles which we can cut in 2 triangles cf figure above ny 1 ny 2 1 0 0 1 2 nx 3 nx 2 nx 1 You have 2 ways to cut a rectangle: 1 the upward diagonal 2 the downward diagonal CATEGORY: to understand how TRIANGULATE and TRIANGULATION work CALLING SEQUENCE:triangles definetri nx ny downward INPUTS: nx and ny are the array dimensions OPTIONAL INPUTS: downward: When downward is undefine all rectangles are cut in using the upward diagonal Downward is a vector which contains the rectangles numbers which are cut in using the downward diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle KEYWORD PARAMETERS: OUTPUTS: triangles is a 2d array and is dimensions are 3 and 2 nx 1 ny 1 triangles is define like in the TRIANGULATE procedure OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: triangles definetri 3 3 1 3 triangles will be a this kind of triangulation: MODIFICATION HISTORY: sebastien Masson smlod ipsl jussieu fr 4 3 1999 FUNCTION definetri nx ny downward nx long nx ny long ny if n_elements downward NE 0 THEN BEGIN if n_elements downward GT nx 1 ny 1 then begin print downward a trop d elements par rapport a nx et ny return 1 endif downward long downward ENDIF we define triangles triangles lonarr 3 2 nx 1 ny 1 we cut the rectangles with the upward diagonal if n_elements downward NE nx 1 ny 1 then BEGIN there is some rectangle to cut we define upward: upward is a vector which contains the rectangles numbers which are cut in using the upward diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle upward bytarr nx ny 1 upward ny 1 0 upward nx 1 0 if n_elements downward NE 0 then upward downward 0 upward where upward EQ 1 n1 n_elements upward 4 corners indexes of a rectangle number i are i nx i nx 1 i i 1 trinumber 2 upward upward nx we define the right triangles triangles 0 trinumber upward triangles 1 trinumber upward 1 triangles 2 trinumber upward 1 nx we define the left triangles triangles 0 trinumber 1 upward 1 nx triangles 1 trinumber 1 upward nx triangles 2 trinumber 1 upward ENDIF ELSE n1 0 we cut the rectangles with the downward diagonal if n_elements downward NE 0 then BEGIN n2 n_elements downward trinumber 2 downward downward nx we define the right triangles triangles 0 trinumber downward 1 triangles 1 trinumber downward nx 1 triangles 2 trinumber downward nx we define the left triangles triangles 0 trinumber 1 downward nx triangles 1 trinumber 1 downward triangles 2 trinumber 1 downward 1 endif return triangles end"); 320 a[318] = new Array("./ToBeReviewed/TRIANGULATION/definetri_e.html", "definetri_e.pro", "", "function numtri index nx ny y index nx x index y nx numtri y NE 0 nx 1 2 y 1 1 2 y EQ ny 1 OR y EQ ny 1 x return numtri end NAME:definetri PURPOSE:Define a triangulation array like TRIANGULATE but for a E grid type CATEGORY: make contours with E grid type CALLING SEQUENCE:triangles definetri nx ny vertical INPUTS: nx and ny are the array dimensions OPTIONAL INPUTS: vertical: When vertical is undefine all rectangles are cut in using the horizontal diagonal Vertical is a vector which contains the rectangles numbers which are cut in using the vertical diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle KEYWORD PARAMETERS: OUTPUTS: triangles is a 2d array and is dimensions are 3 and 2 nx 1 ny 1 triangles is define like in the TRIANGULATE procedure OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: MODIFICATION HISTORY: sebastien Masson smlod ipsl jussieu fr June 2001 FUNCTION definetri_e nx ny singular SHIFTED shifted nx long nx ny long ny triangles lonarr 3 2 nx 1 ny 1 build the base triangulation with the diamond cut in two triangles by the vertical diagonal first line index lindgen nx 1 trinumber index triangles 0 trinumber index triangles 1 trinumber index 1 triangles 2 trinumber index nx 1 shifted last line index ny 1 nx lindgen nx 1 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx index nx 1 shifted MOD 2 triangles 2 trinumber index 1 other lines if ny GT 2 then begin index lindgen nx ny index index 0:nx 2 1:ny 2 index index oddeven index nx 1 shifted MOD 2 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx oddeven triangles 2 trinumber index nx oddeven triangles 0 trinumber 1 index nx oddeven triangles 1 trinumber 1 index nx oddeven triangles 2 trinumber 1 index 1 endif cut the diamond specified by singular in two triangles by the horizontal diagonal IF keyword_set singular then BEGIN yindex singular nx otherline where yindex NE 0 AND yindex NE ny 1 if otherline 0 NE 1 then begin index singular otherline oddeven index nx 1 shifted MOD 2 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx oddeven triangles 2 trinumber index 1 triangles 0 trinumber 1 index triangles 1 trinumber 1 index 1 triangles 2 trinumber 1 index nx oddeven endif endif return triangles end "); 321 a[319] = new Array("./ToBeReviewed/TRIANGULATION/dessinetri.html", "dessinetri.pro", "", " NAME:dessinetri PURPOSE:dessine la triangulation CATEGORY:pour comprendre comment ca marche CALLING SEQUENCE:dessinetri tri x y INPUTS:optionnels par defaut on choisit la triangulation qui est utilise pour les plots et on la trace aux points definites par vargrid sinon il faut fournir les tableaux tri definissant la triangulation fournis par triangule pro ou triangulate x et y qui sont les positions de points a laquelle se raporte la triangulation cf les tableau x et y fournis ds triangulate KEYWORD PARAMETERS: All plots or polyfill keywords WAIT x to call wait x second between each triangle draw ONEBYONE: to draw the triangles one by one FILL: to fill the triangles using polyfill instead of plotting them CHANGECOLOR n to change the color of each traingle n colors will be used and repeted if necessary OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO dessinetri tri x y WAIT wait ONEBYONE onebyone FILL fill CHANGECOLOR changecolor _extra ex common tempsun systime 1 pour key_performance a if n_params EQ 3 then BEGIN CASE size x n_dimensions size y n_dimensions OF 2:BEGIN nx n_elements x ny n_elements y glam x replicate 1 ny gphi replicate 1 nx y END 4:BEGIN glam x gphi y END ELSE:BEGIN dummy report x and y inputs of dessinetri must have the same number of dimensions 1 or 2 return END ENDCASE ENDIF ELSE BEGIN grille mask glam gphi tri tri undefine mask tri ciseauxtri tri glam gphi ENDELSE IF keyword_set changecolor THEN BEGIN oldname d name if d name EQ PS OR d name EQ Z then BEGIN thisos strupcase strmid version os_family 0 3 CASE thisOS of MAC : set_plot thisOS WIN : set_plot thisOS ELSE: set_plot X ENDCASE ncolors d n_colors 1 255 set_plot oldname ENDIF ELSE ncolors d n_colors 1 255 color 1 indgen changecolor ncolors changecolor 1 ENDIF ELSE color 0 color color replicate 1 n_elements tri 3 n_elements color 1 tempdeux systime 1 pour key_performance 2 for i 0L n_elements tri 3 1 do begin t tri i tri 0 i IF keyword_set fill THEN polyfill glam t gphi t color color i _extra ex ELSE plots glam t gphi t color color i _extra ex IF keyword_set wait THEN wait wait IF keyword_set onebyone THEN read a prompt press a key ENDFOR IF testvar var key_performance EQ 2 THEN print temps dessinetri: trace des triangles systime 1 tempdeux if keyword_set key_performance THEN print temps dessinetri systime 1 tempsun return end"); 322 a[320] = new Array("./ToBeReviewed/TRIANGULATION/drawcoast_c.html", "drawcoast_c.pro", "", "PRO drawcoast_c mask xf yf nx ny COAST_COLOR coast_color COAST_THICK coast_thick YSEUIL yseuil XSEUIL xseuil _extra ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance on trace les segments verticaux: if NOT keyword_set yseuil then yseuil 5 min nx ny 2 distanceseuil p position 3 p position 1 yseuil liste: liste des points i pourlesquels on va tracer un segment entre le point i j 1 et i j tempdeux systime 1 pour key_performance 2 liste where mask shift mask 1 0 EQ 1 AND xf shift xf 0 1 2 yf shift yf 0 1 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN on recupere lx et ly qui sont les indices ds un tableau 2d des points donnes par liste ly liste nx lx temporary liste nx ly indice where ly NE 0 on ne prend pas les points concernant if indice 0 NE 1 then begin la premiere ligne car ds ce cas le pt j 1 n est pas definit lx lx indice ly ly temporary indice boucle sur les points concernes et trace du segment rq: on utilise plost au lieu de plot car plots est bcp plus rapide IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner liste des points concernes par un trait vertical systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i j 1 xf i j yf i j 1 yf i j color coast_color thick coast_thick normal _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracecote: trace des traits verticaux systime 1 tempdeux endif ENDIF pour le trace des segments horizontaux c est la meme chose sauf qu il faut faire attention si on est periodique: si on est periodique on duplique la premiere colonne et on la met a la fin ceci est fait non pas pour le shift qui est par defaut periodique mais pour le plots tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic AND nx EQ jpi then begin mask mask mask 0 xf xf xf 0 yf yf yf 0 nx nx 1 ENDIF if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste where mask shift mask 0 1 EQ 1 AND xf shift xf 1 0 2 yf shift yf 1 0 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN ly liste nx lx temporary liste nx ly indice where ly NE ny 1 AND lx NE 0 if indice 0 NE 1 then begin on ne prend pas les points de la premiere colonne et de la derniere ligne car on l a rajoute artificiellement lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner liste des points concernes par un trait horizontal systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i 1 j xf i j yf i 1 j yf i j color coast_color thick coast_thick normal _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracecote: trace des traits horizontaux systime 1 tempdeux endif endif if keyword_set key_performance THEN print temps drawcoast_c systime 1 tempsun return end"); 323 a[321] = new Array("./ToBeReviewed/TRIANGULATION/drawcoast_e.html", "drawcoast_e.pro", "", "PRO drawcoast_e mask xf yf nx ny COAST_COLOR coast_color COAST_THICK coast_thick YSEUIL yseuil XSEUIL xseuil onemore onemore _extra ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance if keyword_set key_periodic AND nx EQ jpi then begin mask mask mask 0 xf xf xf 0 yf yf yf 0 nx nx 1 ENDIF we plot the borders of the diamond in this sense : if NOT keyword_set onemore then onemore 0 if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste: liste des points i pourlesquels on va tracer un segment index lindgen nx ny index index 0:nx 2 1:ny 1 indexbis index nx index nx onemore MOD 2 liste where mask index 1 mask indexbis EQ 1 AND xf index xf indexbis 2 yf index yf indexbis 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN index index liste indexbis indexbis liste for pt 0 n_elements index 1 do begin plots xf index pt xf indexbis pt yf index pt yf indexbis pt color coast_color thick coast_thick normal _extra ex endfor ENDIF we plot the borders of the diamond in this sense : if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste: liste des points i pourlesquels on va tracer un segment index lindgen nx ny 1 index index 0:nx 2 indexbis index nx index nx onemore MOD 2 liste where mask index 1 mask indexbis EQ 1 AND xf index xf indexbis 2 yf index yf indexbis 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN index index liste indexbis indexbis liste for pt 0 n_elements index 1 do begin plots xf index pt xf indexbis pt yf index pt yf indexbis pt color coast_color thick coast_thick normal _extra ex endfor ENDIF if keyword_set key_performance THEN print temps drawcoast_e systime 1 tempsun return end"); 324 a[322] = new Array("./ToBeReviewed/TRIANGULATION/drawsectionbottom.html", "drawsectionbottom.pro", "", " NAME:drawsectionbottom PURPOSE:fill and draw the bottom continents for a real section CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS:simple way to fill continents for a section using the fact that continents are wider at the bottom than at the top EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 14 2002 PRO drawsectionbottom maskin xxaxisin depthsin COAST_COLOR coast_color COAST_THICK coast_thick CONT_COLOR cont_color CONT_NOFILL cont_nofill OVERPLOT overplot _extra ex cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF if keyword_set overplot then return mask is from bottom to top boundaries conditions: nx size maskin 1 nz size maskin 2 1 IF size xxaxisin n_dimensions EQ 1 THEN xxaxisin temporary xxaxisin replicate 1 nz IF size depthsin n_dimensions EQ 1 THEN depthsin replicate 1 nx temporary depthsin for the mask : we add ocean at the top then it is always possible to find one ocean point on each water column mask maskin replicate 1 nx for x axis we also add one level xxaxis xxaxisin xxaxisin 0 x axis must cover nx 1 points because we will draw the edge of the mask if it was mot possible in decoupeterre pro to extend the xxaxis we do it now by hand xxaxis xxaxisin 0 if size xxaxis 1 EQ nx then begin if n_elements xxaxis EQ nx then begin deltax abs x range 1 x range 0 10 xxaxis xxaxis 0 deltax xxaxis x0 xxaxis 0 deltax xxaxis replicate x0 1 nz xxaxis ENDIF for the depth usepartial total depthsin 2 usepartial total usepartial NE usepartial 0 GE 1 depths depthsin 0:nx 1 we add one level according to the ocean level we had to the mask deltaz abs y range 1 y range 0 10 zmax max depthsin deltaz depths depths replicate zmax nx 1 depths depths replicate zmax nx if min depths gt 1 then we must add one line at the bottom this appens when the bottom limit is defined between T k and W k points IF min depthsin GT 1 THEN BEGIN zmin min y range deltaz depths replicate zmin nx depths mask replicate 0 nx mask nz nz 1 ENDIF xleft xxaxis 0:nx 1 xright xxaxis 1:nx looking for the position of the bottom of the ocean pos nz 1 total mask 2 depths depths lindgen nx nx pos xx transpose xleft xright xx x range 0 xx zz max y range xx float xx zz float zz filling of the continents IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 if NOT keyword_set cont_nofill then polyfill min xx max maxx xx maxx min zz max mazz zz mazz color cont_color if NOT keyword_set cont_nofill then polyfill min xx max maxx xx maxx y range 0 zz y range 0 color cont_color drawing of the coast bottom line we could have plot directly xx and yy but if countout ne 0 doing this will draw an non existing bottom line along y range values which is not so good we thus do this ugly for if loops to make sure that we don t draw these lines but we keep all vertical lines IF countout NE 0 THEN BEGIN FOR i 0 countout 1 DO BEGIN CASE 1 OF out i EQ 0:BEGIN if we start with a out point xxx values f_nan zzz values f_nan END i EQ 0:BEGIN i eq 0 but out i ne 0 xxx xx 0:out i values f_nan zzz zz 0:out i values f_nan END ELSE:BEGIN two consecutive out values at the same depth: we just keep values f_nan values until the next change of depth IF out i 1 EQ out i 1 AND zz out i 1 EQ zz out i THEN BEGIN xxx xxx values f_nan zzz zzz values f_nan ENDIF ELSE BEGIN we keep everything inbetween the out values including themselves for the vertical lines but we had values f_nan to remove the horizontal lines xxx xxx xx out i 1 :out i values f_nan zzz zzz zz out i 1 :out i values f_nan ENDELSE END ENDCASE IF i EQ countout 1 AND out i NE n_elements xx 1 THEN BEGIN xxx xxx xx out i : zzz zzz zz out i : ENDIF ENDFOR plots xxx zzz color coast_color thick coast_thick _extra ex ENDIF ELSE plots xx zz color coast_color thick coast_thick _extra ex return end "); 325 a[323] = new Array("./ToBeReviewed/TRIANGULATION/fillcornermask.html", "fillcornermask.pro", "", " NAME: FILLCORNERMASK PURPOSE: pour colorier proprement les continents c est une longue histoire CATEGORY: pour plt CALLING SEQUENCE: completecointerre INPUTS: non KEYWORD PARAMETERS: _EXTRA CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: non COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 8 2002 PRO fillcornermask xin yin COINMONTE coinmonte COINDESCEND coindescend CONT_COLOR cont_color INDICEZOOM indicezoom _extra ex common if NOT keyword_set coinmonte AND NOT keyword_set coindescend then return tempsun systime 1 pour key_performance IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 definition descoordonnees des points numerotes 1 2 3 4 5 6 cf les schemas en dessous x1 reform xin y1 reform yin IF size x1 0 EQ 2 THEN x1 x1 0 IF size y1 0 EQ 2 THEN y1 y1 0 x2 5 x1 shift x1 1 y2 5 y1 shift y1 1 nx n_elements x1 ny n_elements y1 cas coin terre en montee: 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante 3 t i nx 1 u i nx t i nx 1 0 1 4 v i f i v i 1 t i 0 2 u i t i 1 1 if keyword_set coinmonte then BEGIN if coinmonte 0 NE 1 then BEGIN iup coinmonte MOD nx jup coinmonte nx for id 0 n_elements coinmonte 1 do BEGIN i iup id j jup id IF i NE nx 1 AND j NE ny 1 THEN BEGIN polyfill x1 i x2 i x2 i x1 i 1 x1 i y2 j y1 j y1 j 1 y2 j y2 j color cont_color _extra ex ENDIF endfor endif endif cas coin terre en descendante : 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante 4 t i nx 1 u i nx t i nx 1 0 3 5 v i f i v i 1 1 t i 0 2 u i t i 1 1 if keyword_set coindescend then BEGIN if coindescend 0 NE 1 then begin idw coindescend MOD nx jdw coindescend nx for id 0 n_elements coindescend 1 do BEGIN i idw id j jdw id IF i NE nx 1 AND j NE ny 1 THEN BEGIN polyfill x1 i x2 i x2 i x1 i 1 x1 i y2 j y1 j 1 y1 j y2 j y2 j color cont_color _extra ex ENDIF endfor endif endif IF keyword_set key_performance THEN print temps fillcornermask systime 1 tempsun return end"); 326 a[324] = new Array("./ToBeReviewed/TRIANGULATION/section.html", "section.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO section field res glamaxe gphiaxe ENDPOINTS endpoints BOXZOOM boxzoom TYPE type WDEPTH wdepth DIREC direc SHOWBUILD showbuild ONLYBOX onlybox _extra ex include common cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF definition de boxzoom en fonction de endpoints puis redefinition du domaine boxzoom2d min endpoints 0 endpoints 2 max ma02 ma02 min endpoints 1 endpoints 3 max ma13 ma13 minprof 0 profdefault 200 if n_elements type EQ 0 then type nothing Case N_Elements Boxzoom OF 0:localbox boxzoom2d minprof profdefault 1:localbox boxzoom2d minprof boxzoom 0 2:localbox boxzoom2d boxzoom 0 4:if strpos type z NE 1 THEN localbox boxzoom2d minprof profdefault ELSE localbox boxzoom2d 5:localbox boxzoom2d minprof boxzoom 4 6:localbox boxzoom2d boxzoom 4:5 Else:BEGIN print report Bad definition of the box stop END ENDCASE nelbox n_elements localbox if keyword_set wdepth then grillechoice vargrid W ELSE grillechoice vargrid domdef localbox GRIDTYPE grillechoice findalways _extra ex grille 1 1 1 1 nx ny if less than 10 points where found we apply domdef over the whole domain problem why 10 points as a test value how can we find a good test value IF nx ny LE 10 THEN domdef GRIDTYPE grillechoice _extra ex on redefinit lon1 au cas ou findalways ait ete utilise ds domdef lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 we extend the box along the z axis i that way the plot will be drawn until its bottom part if strpos type z NE 1 THEN BEGIN on garde les yranges axe z avant de changer la boxzoom y range localbox nelbox 1 localbox nelbox 2 if vargrid EQ W OR keyword_set wdepth then BEGIN firstzw 0 firstzw 1 lastzw lastzw 1 firstzt 1 lastzt lastzt 1 firstx 1 lastx lastx 1 firsty 1 lasty lasty 1 jpj 1 domdef firstx lastx firsty lasty firstz lastz index gridtype vargrid IF keyword_set onlybox THEN return grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz on definit la triangulation qui va nous permetre de determiner la section on la recalcule car elle doit etre definie sur la terre aussi bien que sur la mer suivant le sens de la section plutot longitude ou plutot latitude on definit la facon de trianguler if strpos type x NE 1 then BEGIN downward lindgen nx ny 0:nx 2 0:ny 2 tri definetri nx ny downward ENDIF ELSE tri definetri nx ny If we have an irregular grid that is periodic then it is possible that some of the triangle have a very large size neighborg points on the sphere but far away when doing the projection and should not be taken into account IF keyword_set key_irregular AND keyword_set key_periodic THEN BEGIN glamtri glam tri glamtri abs glamtri shift glamtri 1 0 good temporary glamtri LT 10 max glam nx good where total temporary good 1 EQ 3 tri temporary tri temporary good ENDIF equation de la droite suivant laquelle on fait la section abc linearequation endpoints 0:1 endpoints 2:3 glamtri glam tri gphitri gphi tri quels sont les points de la triangulation qui sont au dessus et au dessous de la droite if abc 1 NE 0 THEN test temporary gphitri GE abc 0 abc 1 temporary glamtri abc 2 abc 1 ELSE test temporary glamtri GE abc 1 abc 0 temporary gphitri abc 2 abc 0 zero123 total test 1 to keep: triangles de la triangulation qui sont a cheval sur la droite tokeep1 where zero123 EQ 1 tokeep2 where temporary zero123 EQ 2 tokeep tokeep1 tokeep2 test test tokeep tri tri tokeep quel est le sommet du triangle qui est seul d un cote de la droite single1 where test 0:n_elements tokeep1 1 EQ 1 single1 single1 single1 3 3 single2 where test n_elements tokeep1 :n_elements tokeep 1 EQ 0 single2 single2 single2 3 3 undefine tokeep undefine tokeep1 undefine tokeep2 undefine test single temporary single1 temporary single2 points1 le point du triangles qui est seul d un cote de la droite point2 l autre point du triangle de l autre cote de la droite point1 single single point2 single EQ 0 1 single LE 1 undefine single ntri size tri 2 index lindgen ntri lindgen ntri points1 tri point1 index points2 tri point2 temporary index points : complexe contenant les couples de points de part et d autre de la droite Ils faut supprimer les doublons points dcomplex points1 points2 points points uniq points sort points symetrique dcomplex imaginary points double points points points where points shift temporary symetrique 1 NE 0 points1 les coordnnees du point du triangles qui est seul d un cote de la droite point2 les coordnnees de l autre point du triangle de l autre cote de la droite points1 complex glam double points gphi double points points2 complex glam imaginary points gphi imaginary points droites les equations des droites dont on cherche l intersection avec la section droites linearequation points1 points2 inter lineintersection droites abc replicate 1 n_elements points1 les ccordonnes geographiques des points que l on cherche sur la section glamaxe float inter gphiaxe imaginary inter on les range ds l ordre croissant entre les bornes de la section if strpos type x NE 1 then BEGIN sort sort glamaxe glamaxe glamaxe sort inbox where glamaxe GE lon1 AND glamaxe LE lon2 glamaxe glamaxe inbox sort sort inbox gphiaxe gphiaxe sort ENDIF ELSE BEGIN sort sort gphiaxe gphiaxe gphiaxe sort inbox where gphiaxe GE lat1 AND gphiaxe LE lat2 gphiaxe gphiaxe inbox sort sort inbox glamaxe glamaxe sort ENDELSE points points sort points1 points1 sort points2 points2 sort inter inter sort poids abs points2 inter abs points2 points1 array litchamp field array fitintobox array if array 0 EQ 1 THEN BEGIN res 1 return ENDIF if n_elements valmask EQ 0 THEN valmask 1e20 taille size array if jpt GT 1 AND taille 0 GE 3 AND strpos type t EQ 1 then BEGIN direc t array grossemoyenne array t taille size array jpt 1 ENDIF case 1 of xy taille 0 EQ 2:BEGIN value1 array double points terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan value2 array imaginary points terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan res poids value1 1 poids value2 END xyz taille 0 EQ 3 AND jpt EQ 1:BEGIN npoints n_elements points index double points replicate 1 nz replicate nx ny npoints lindgen nz value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 nz replicate nx ny npoints lindgen nz value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 nz res poids value1 1 poids value2 moyenne suivant z if strpos type z EQ 1 then begin nan where finite res EQ 0 if vargrid EQ W then e3 e3w firstzw:lastzw ELSE e3 e3t firstzt:lastzt weight replicate 1 npoints e3 if nan 0 NE 1 then weight nan values f_nan totalweight total weight 2 nan zero where totalweight EQ 0 if zero 0 NE 1 then totalweight zero values f_nan res total res weight 2 nan totalweight direc z string byte testvar var toto endif END xyt taille 0 EQ 3 AND jpt NE 1:BEGIN npoints n_elements points index double points replicate 1 jpt replicate nx ny npoints lindgen jpt value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 jpt replicate nx ny npoints lindgen jpt value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 jpt res poids value1 1 poids value2 END xyzt taille 0 EQ 4:BEGIN npoints n_elements points index double points replicate 1 nz jpt replicate nx ny npoints lindgen nz jpt index reform index npoints nz jpt over value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 nz jpt replicate nx ny npoints lindgen nz jpt index reform index npoints nz jpt over value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 nz jpt poids reform poids npoints nz jpt over res poids value1 1 poids value2 moyenne suivant z if strpos type z EQ 1 then begin nan where finite res EQ 0 if vargrid EQ W then e3 e3w firstzw:lastzw ELSE e3 e3t firstzt:lastzt weight replicate 1 npoints e3 weight weight replicate 1 jpt weight reform weight npoints nz jpt over if nan 0 NE 1 then weight nan values f_nan totalweight total weight 2 nan zero where totalweight EQ 0 if zero 0 NE 1 then totalweight zero values f_nan res total res weight 2 nan totalweight direc z string byte testvar var toto endif END endcase terre where finite res EQ 0 if terre 0 NE 1 then res terre valmask if n_elements showbuild then BEGIN winsave window psave p xsave x ysave y plt findgen nx ny nodata nofill rempli title subtitle coast_thick 2 window showbuild p title p subtitle plots endpoints 0 endpoints 2 endpoints 1 endpoints 3 color 50 plots endpoints 0 endpoints 2 endpoints 1 endpoints 3 color 50 psym 2 thick 2 FOR i 0 n_elements points1 1 DO plots float points1 i float points2 i imaginary points1 i imaginary points2 i color 150 plots float points1 imaginary points1 color 150 psym 1 plots float points2 imaginary points2 color 150 psym 1 plots float inter imaginary inter color 250 psym 1 IF terre 0 NE 1 THEN plots float inter terre imaginary inter terre color 0 psym 1 dummy read dummy prompt press return to continue IF d name EQ PS THEN erase ELSE wset winsave p psave x xsave y ysave ENDIF restoreboxparam boxparam4section dat return end"); 327 a[325] = new Array("./ToBeReviewed/TRIANGULATION/tracecote.html", "tracecote.pro", "", " NAME:tracecote PURPOSE: dessine les cotes ds plt CATEGORY: pour faire un joli dessin CALLING SEQUENCE:tracecote mask INPUTS:mask le tableau mask sur la zone consideree pour le dessin KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: l epaisseur du trait pour tracer les continents par defaut c est 1 SURFACE_COASTLINE: to draw the furface coast line instead of the coast line at level firstz tw Usefull only for deep plots XSEUIL: pour eliminer les segments de cote qui sont trop grand qui relient des points qui peuvent etre tres proches sur la sphere mais tres eloignes sur le dessin on supprime tous les egments dot la taille depasse: taille de la fenetre suivant X xseuil Par defaut xseuil est egale a 5 masi peut etre trop grand si on fait un fort zoom ou trout petit pour certaines projections le specifier alors a l aide de ce mot cle YSEUIL: cf xseuil OUTPUTS: rien COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 30 9 1999 PRO tracecote SURFACE_COASTLINE surface_coastline _EXTRA ex include commons cm_4data cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance if n_elements key_gridtype EQ 0 then key_gridtype c on agrandi un peu le cadre definit par les premier dernier de facon a bien recuperer les bords de cote qui sont en bordure du domaine a tracer tempdeux systime 1 pour key_performance 2 firstx 0 min firstxt firstxf 1 lastx max lastxt lastxf 1 min firstyt firstyf 1 lasty max lastyt lastyf 1 jpj 1 nx lastx firstx 1 ny lasty firsty 1 quel niveau vertical choisir IF keyword_set surface_coastline THEN firstz 0 ELSE IF strupcase vargrid eq W THEN firstz firstzw ELSE firstz firstzt attribution du masque et des coordonnes delimitant les limites de la terre coordonnees f mask tmask firstx:lastx firsty:lasty firstz xf glamf firstx:lastx firsty:lasty yf gphif firstx:lastx firsty:lasty IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner mask xf yf systime 1 tempdeux if key_gridtype EQ e then onemore xf 0 0 gT xf 0 1 on passe en coordonnee normaliser pour pouvoir s affranchir du type de projection choisie et du suport surlequel on fait le dessin ecran ou postscript z convert_coord xf yf data to_normal xf reform z 0 nx ny yf reform z 1 nx ny tempvar SIZE TEMPORARY z attention suivant la projection certains points x ou y peuvent devenir NaN cf points deriere la terre ds une projection orthographique on met les points a eliminer a une tres gande valeur comme ca il ne passerons pas le test avec distanceseuil cf plus bas if map projection LE 7 AND map projection NE 0 OR map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 then begin ind where finite xf yf EQ 0 IF ind 0 NE 1 THEN BEGIN xf ind 1e5 yf ind 1e5 ENDIF ENDIF ind where xf LT p position 0 OR xf GT p position 2 IF ind 0 NE 1 THEN xf ind 1e5 ind where yf LT p position 1 OR yf GT p position 3 IF ind 0 NE 1 THEN yf ind 1e5 tempvar SIZE TEMPORARY ind on efface ind if n_elements key_gridtype EQ 0 then key_gridtype c case key_gridtype of c :drawcoast_c mask xf yf nx ny _extra ex e :drawcoast_e mask xf yf nx ny onemore onemore _extra ex endcase if keyword_set key_performance THEN print temps tracecote systime 1 tempsun return end"); 328 a[326] = new Array("./ToBeReviewed/TRIANGULATION/tracemask.html", "tracemask.pro", "", " NAME:tracemask PURPOSE:dessiner des contour d un mask CATEGORY:plus simple que tracecote car ne s occuppe pas du type de projection et de la periodicite de la grille CALLING SEQUENCE: tracemask maskentree xentree yentree INPUTS:maskentree xentree yentree tableaux 2d specifiant le mask et ses coordonees en longitude te latitude KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: l epaisseur du trait pour tracer les continents par defaut c est 1 OUTPUTS: none COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO tracemask maskentree xin yin COAST_COLOR coast_color COAST_THICK coast_thick OVERPLOT overplot _extra ex if keyword_set overplot then return cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF tempsun systime 1 pour key_performance on s afranchit des problemes de bord: tempdeux systime 1 pour key_performance 2 tailleentree size maskentree nx tailleentree 1 1 ny tailleentree 2 1 we check the input axis IF n_elements xin EQ 0 THEN xentree findgen nx 1 ELSE xentree xin IF size xentree 0 EQ 1 THEN xentree xentree replicate 1 ny 1 IF n_elements yin EQ 0 THEN yentree findgen ny 1 ELSE yentree yin IF size yentree 0 EQ 1 THEN yentree replicate 1 nx 1 yentree on agrandi le mask de une colonne a gauche et de une colonne en bas mask intarr tailleentree 1 1 tailleentree 2 1 mask 1:tailleentree 1 1:tailleentree 2 maskentree les 2 premieres colonnes sont identiques mask 0 1:tailleentree 2 maskentree 0 les 2 premieres lignes sont identiques mask 1:tailleentree 1 0 maskentree 0 on calcul la position suivant x des points qui seviront a tracer le masque ils sont situes entre chaque points du masque sauf pour la derniere colonne que l on ne peut pas calculer et que l on met donc a max x range xrange x range sort x range si reverse_x est utilise xentree 5 xentree shift xentree 1 0 IF not keyword_set overplot THEN xentree nx 2 xrange 1 ELSE xentree nx 2 xentree nx 3 on seuil xentree xrange 0 xentree yentree yrange 1 yf fltarr nx ny yf 1:nx 1 1:ny 1 yentree yf 0 1:ny 1 yentree 0 IF not keyword_set overplot THEN BEGIN if yinverse then yf 0 yrange 1 ELSE yf 0 yrange 0 ENDIF ELSE yentree 0 yentree 1 IF testvar var key_performance EQ 2 THEN print temps tracemask: determination du mask et des ses coordonnes systime 1 tempdeux on trace les segments verticaux: tempdeux systime 1 pour key_performance 2 liste where mask shift mask 1 0 EQ 1 IF liste 0 NE 1 THEN BEGIN on recupere lx et ly qui sont les indices ds un tableau 2d des points donnes par liste ly liste nx lx temporary liste nx ly indice where ly NE 0 on ne prend pas les points concernant la premiere ligne car ds ce cas le pt j 1 n est pas definit if indice 0 NE 1 then begin lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracemask: liste traits verticaux systime 1 tempdeux tempdeux systime 1 pour key_performance 2 boucle sur les points concernes et trace du segment rq: on utilise plots au lieu de plot car plots est bcp plus rapide for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i j 1 xf i j yf i j 1 yf i j color coast_color thick coast_thick _extra ex if pt LT 5 then begin endif endfor IF testvar var key_performance EQ 2 THEN print temps tracemask: trace traits verticaux systime 1 tempdeux endif ENDIF on trace les segments horizontaux: tempdeux systime 1 pour key_performance 2 liste where mask shift mask 0 1 EQ 1 IF liste 0 NE 1 THEN BEGIN ly liste nx lx temporary liste nx ly indice where lx NE 0 on ne prend pas les points de la premiere colonne if indice 0 EQ 1 then return lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracemask: liste traits horizontaux systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i 1 j xf i j yf i 1 j yf i j color coast_color thick coast_thick _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracemask: trace traits horizontaux systime 1 tempdeux endif if keyword_set key_performance THEN print temps tracemask systime 1 tempsun return end "); 329 a[327] = new Array("./ToBeReviewed/TRIANGULATION/triangule.html", "triangule.pro", "", "FUNCTION triangule maskentree BASIC basic COINMONTE coinmonte COINDESCEND coindescend _extra ex common IF jpi EQ 1 OR jpj EQ 1 THEN return 1 IF arg_present coinmonte THEN coinmonte 1 IF arg_present coindescend THEN coindescend 1 if keyword_set basic then return triangule_c maskentree BASIC COINMONTE coinmonte COINDESCEND coindescend _extra ex if n_elements key_gridtype EQ 0 then key_gridtype c if n_elements maskentree EQ 0 then maskentree tmask 0 case key_gridtype of e :res triangule_e maskentree _extra ex c :res triangule_c maskentree COINMONTE coinmonte COINDESCEND coindescend _extra ex endcase return res end"); 330 a[328] = new Array("./ToBeReviewed/TRIANGULATION/triangule_c.html", "triangule_c.pro", "", " NAME:triangule_c PURPOSE:construit le tableau de triangulation L idee est de construire une liste de triangles qui relient les points entre eux Ceci est fait automatiquement avec la fonction TRIANGULATE ICI: on tient compte du fait que les points sont disposes sur une grille reguliere ou pas mais pas destructuree cad que les points sont ecrits suivant une matrice rectangulaire Un moyen tres simple de faire des triangles entre tous les points est alors: pour chaque point i j de la matrice sauf ceux de la derniere ligne et de la derniere colonne on on appelle le rectangle i j le rectangle forme par les 4 points i j i 1 j i j 1 i 1 j 1 Pour tracer tous les triangles il suffit de tracer les 2 triangles contenus ds les rectangles i j au passage on remarque que chaque rectangle i j possede 2 diagonales si si faites un dessin c est vrai il y a donc 2 choix possibles pour chaque rectangles qd on veut le couper en 2 triangles C est grace a ce choix que l on va pouvoir tracer les cotes avec des angles droits A chaque angle de cote remarquable par l existance d un unique point terre ou d un unique point mer sur les 4 cotes d un rectangle i j il faut couper le rectangle suivant la diagonale qui qui passe par le point singulier CATEGORY:pour faire de beaux graphiques masques CALLING SEQUENCE:res triangule mask INPUTS:optionnel:mask c est le tableau 2d qui sevira a masquer le champ que l on tracera apres avec CONTOUR TRIANGULATION triangule mask si cet argument n est pas specifie la function utilise tmask KEYWORD PARAMETERS: BASIC: specifie que le masque est sur une grille basice utiliser pour la triangulation ds les coupes verticales et des hovmoellers KEEP_CONT: to keep the triangulation even on the continents COINMONTE tableau pour obtenir le tableau de coins de terre montant a traiter avec completecointerre pro ds la variable tableau plutot que de la faire passer par la variable globale twin_corners_up COINDESCEND tableau cf COINMONTE OUTPUTS: res: tableau 2d 3 nbre de triangles chaque ligne de res represente les indices des points constituants les sommets d un triangle cf comment on trace les triangles ds dessinetri pro COMMON BLOCKS: common pro different pro definetri pro SIDE EFFECTS: RESTRICTIONS:les donnees dont un veut ensuite faire le contour doivent etre disposees dans une matrice Par contre dans la matrice la disposition des points peut ne pas etre irreguliere Si les donnees sont disposees completement de facon irreguliere utiliser TRIANGULE EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 26 4 1999 FUNCTION triangule_c maskentree COINMONTE coinmonte COINDESCEND coindescend BASIC basic KEEP_CONT keep_cont tempsun systime 1 pour key_performance cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF le masque est donne ou il faut prendre tmask msk maskentree taille size msk nx taille 1 ny taille 2 IF n_elements keep_cont EQ 0 THEN keep_cont 1 key_irregular if keyword_set key_periodic nx EQ jpi AND NOT keyword_set basic then BEGIN msk msk msk 0 nx nx 1 ENDIF on va trouver la liste des rectangles i j reperes par leur coin en bas a gauche qu il faut couper suivant une diagonale descendante on appellera cette liste : pts_downward pts_downward 0 on construit le test qui permet de trouver un tel triangle: shift msk 0 1 shift msk 1 1 msk shift msk 1 0 sum1 msk shift msk 1 0 shift msk 1 1 pts qui entourrent le pt en haut a gauche sum2 msk shift msk 0 1 shift msk 1 1 pts qui entourrent le pt en bas a droite tempdeux systime 1 pour key_performance 2 pt terre en haut a gauche entoure de pts mer liste where 4 sum1 1 shift msk 0 1 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt mer en haut a gauche entoure de pts terre liste where 1 sum1 shift msk 0 1 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt terre en bas a droite entoure de pts mer liste where 4 sum2 1 shift msk 1 0 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt mer en bas a droite entoure de pts terre liste where 1 sum2 shift msk 1 0 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste undefine liste IF testvar var key_performance EQ 2 THEN print temps triangule: trouver pts_downward systime 1 tempdeux if NOT keyword_set basic OR keyword_set coinmonte OR keyword_set coindescend then begin tempdeux systime 1 pour key_performance 2 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante coinmont where 1 msk 1 shift msk 1 1 shift msk 0 1 shift msk 1 0 EQ 1 if coinmont 0 NE 1 THEN pts_downward pts_downward coinmont IF testvar var key_performance EQ 2 THEN print temps triangule: trouver coinmont systime 1 tempdeux tempdeux systime 1 pour key_performance 2 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante coindesc where 1 shift msk 0 1 1 shift msk 1 0 msk shift msk 1 1 EQ 1 IF testvar var key_performance EQ 2 THEN print temps triangule: trouver coindesc systime 1 tempdeux ENDIF if n_elements pts_downward EQ 1 then BEGIN tempdeux systime 1 pour key_performance 2 triang definetri nx ny IF testvar var key_performance EQ 2 THEN print temps triangule: definetri systime 1 tempdeux coinmont 1 coindesc 1 ENDIF ELSE BEGIN tempdeux systime 1 pour key_performance 2 pts_downward pts_downward 1:n_elements pts_downward 1 pts_downward pts_downward uniq pts_downward sort pts_downward aucun rectangle ne peut avoir comme coin en bas a gauche un element de la derniere colonne ou de la derniere ligne il faut donc enlever ces points si ils ont ete selectionnes dans pts_downward derniere_colonne lindgen ny 1 nx 1 derniere_ligne lindgen nx ny 1 nx pts_downward different pts_downward derniere_colonne pts_downward different pts_downward derniere_ligne if NOT keyword_set basic OR keyword_set coinmonte OR keyword_set coindescend then begin if coinmont 0 NE 1 then begin coinmont different coinmont derniere_colonne coinmont different coinmont derniere_ligne endif if coindesc 0 NE 1 then begin coindesc different coindesc derniere_colonne coindesc different coindesc derniere_ligne endif ENDIF ELSE BEGIN coinmont 1 coindesc 1 ENDELSE IF testvar var key_performance EQ 2 THEN print temps triangule: menage ds pts_downward coinmont et coindesc systime 1 tempdeux tempdeux systime 1 pour key_performance 2 if pts_downward 0 EQ 1 then triang definetri nx ny ELSE triang definetri nx ny pts_downward IF testvar var key_performance EQ 2 THEN print temps triangule: definetri systime 1 tempdeux ENDELSE on vire les triangles qui ne contiennent que des points terre tres bonne idee qui ne marche pas encore a 200 avec IDL 5 2 ca devrait aller mieux dans les prochaines versions d IDL if NOT keyword_set basic AND NOT keyword_set keep_cont then begin tempdeux systime 1 pour key_performance 2 on enleve les rectangles qui sont entierement dans la terre recdsterre where 1 msk 1 shift msk 1 0 1 shift msk 0 1 1 shift msk 1 1 EQ 1 IF testvar var key_performance EQ 2 THEN print temps triangule: tous les recdsterre systime 1 tempdeux en attendant une version qui marche parfaitement on est contraint de faire un nouveau tri: il ne faut pas enlever les rectangles qui n ont qu un sommet en commun t1 systime 1 indice intarr nx ny trimask intarr nx ny trimask 0:nx 2 0:ny 2 1 IF recdsterre 0 NE 1 then BEGIN tempdeux systime 1 pour key_performance 2 indice recdsterre 1 if NOT keyword_set basic then begin vire1 0 vire2 0 while vire1 0 NE 1 OR vire2 0 NE 1 ne 0 do begin vire sont les rectangles qu il faut retirer de recsterre en fait qu il faut garder bien qu ils soient entirement dans la terre vire1 where indice shift indice 1 1 1 shift indice 0 1 1 shift indice 1 0 trimask EQ 1 if vire1 0 NE 1 THEN BEGIN indice vire1 0 indice vire1 nx 1 0 endif vire2 where 1 indice 1 shift indice 1 1 shift indice 0 1 shift indice 1 0 trimask EQ 1 if vire2 0 NE 1 THEN BEGIN indice vire2 1 0 indice vire2 nx 0 endif endwhile IF testvar var key_performance EQ 2 THEN print temps triangule: trier les recdsterre systime 1 tempdeux endif indice ny 1 1 la deriere colonne te la derniere ligne indice nx 1 1 ne peuvent definir de rectangle tempdeux systime 1 pour key_performance 2 recgarde where indice EQ 0 on recupere les numeros des triangles que l on va garder trigarde 2 recgarde recgarde nx trigarde transpose temporary trigarde trigarde trigarde trigarde 1 triang triang temporary trigarde IF testvar var key_performance EQ 2 THEN print temps triangule: virer les triangle de la liste systime 1 tempdeux endif endif print temps tri triangles systime 1 t1 quand key_periodic eq 1 triang est une liste d indice d un tableau qui a une colonne de trop il faut ramener ca a la matrice initiale en mettant les indivces de la derniere colonne egaux a ceux de la derniere colonne tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic nx 1 EQ jpi AND NOT keyword_set basic then BEGIN indicey triang nx indicex triang indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 then indicex liste 0 triang indicex nx indicey nx nx 1 if coinmont 0 NE 1 then begin indicey coinmont nx indicex coinmont indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coinmont indicex nx indicey nx nx 1 endif if coindesc 0 NE 1 then begin indicey coindesc nx indicex coindesc indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coindesc indicex nx indicey nx nx 1 endif endif IF testvar var key_performance EQ 2 THEN print temps triangule: finitions systime 1 tempdeux if keyword_set coinmonte THEN coinmonte coinmont ELSE twin_corners_up coinmont if keyword_set coindescend THEN coindescend coindesc ELSE twin_corners_dn coindesc IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF IF keyword_set key_performance THEN print temps triangule systime 1 tempsun return triang END "); 331 a[329] = new Array("./ToBeReviewed/TRIANGULATION/triangule_e.html", "triangule_e.pro", "", " NAME:triangule_e PURPOSE:buid the triangulation for a E grid type CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr june 2001 FUNCTION triangule_e maskentree COINMONTE coinmonte COINDESCEND coindescend SHIFTED shifted BASIC basic cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance le masque est donne ou il faut prendre tmask msk maskentree sizem size msk nx sizem 1 ny sizem 2 if keyword_set key_periodic nx EQ jpi AND NOT keyword_set basic then BEGIN msk msk msk 0 nx nx 1 ENDIF we will find the diamond that must be cut in two triangle using the horizontal diagonal index lindgen nx ny index index 0:nx 2 1:ny 2 if n_elements shifted EQ 0 then shifted 1 oddeven index nx 1 shifted MOD 2 msk1 msk index msk2 msk index 1 sum msk index nx oddeven msk index nx oddeven sum1 msk2 sum sum2 msk1 sum horizontal singularpoint where msk1 EQ 0 AND sum1 EQ 3 OR msk1 EQ 1 AND sum1 EQ 0 OR msk2 EQ 0 AND sum2 EQ 3 OR msk2 EQ 1 AND sum2 EQ 0 OR sum EQ 0 AND msk1 msk2 EQ 2 if singularpoint 0 NE 1 then begin horizontal index singularpoint triang definetri_e nx ny horizontal SHIFTED shifted ENDIF ELSE triang definetri_e nx ny SHIFTED shifted coinmont index where sum EQ 2 AND msk1 msk2 EQ 0 coindesc index where sum EQ 0 AND msk1 msk2 EQ 2 we keep only the triangles which are outside the land but for some reasons we will in fact delete the land diamond allrecinland where sum1 msk1 EQ 0 indexallinland index allrecinland otherrec lindgen nx ny 0:nx 2 1:ny 2 otherrec different otherrec indexallinland index lindgen nx ny index index 0:nx 3 2:ny 3 out inter index indexallinland IF out 0 NE 1 THEN begin out inter out 1 indexallinland IF out 0 NE 1 THEN begin out out 1 oddeven out nx 1 shifted MOD 2 out inter out nx oddeven otherrec IF out 0 NE 1 THEN begin out inter out 2 nx otherrec IF out 0 NE 1 THEN begin out out nx out nx shifted MOD 2 endif endif endif ENDIF help out index lindgen nx ny index index 0:nx 3 2:ny 3 out inter index otherrec IF out 0 NE 1 THEN begin out inter out 1 otherrec IF out 0 NE 1 THEN begin out out 1 oddeven out nx 1 shifted MOD 2 out inter out nx oddeven indexallinland IF out 0 NE 1 THEN begin out inter out 2 nx indexallinland IF out 0 NE 1 THEN begin out out nx out nx shifted MOD 2 endif endif endif endif help out IF out 0 EQ 1 THEN out different indexallinland out ELSE out indexallinland triout numtri out nx ny triout triout triout 1 goodtri lindgen 2 nx 1 ny 1 goodtri different goodtri triout triang triang temporary goodtri quand key_periodic eq 1 triang est une liste d indice d un tableau qui a une colonne de trop il faut ramener ca a la matrice initiale en mettant les indivces de la derniere colonne egaux a ceux de la derniere colonne tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic nx 1 EQ jpi AND NOT keyword_set basic then BEGIN indicey triang nx indicex triang indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 then indicex liste 0 triang indicex nx indicey nx nx 1 if coinmont 0 NE 1 then begin indicey coinmont nx indicex coinmont indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coinmont indicex nx indicey nx nx 1 endif if coindesc 0 NE 1 then begin indicey coindesc nx indicex coindesc indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coindesc indicex nx indicey nx nx 1 endif endif IF testvar var key_performance EQ 2 THEN print temps triangule: finitions systime 1 tempdeux if arg_present coinmonte THEN coinmonte coinmont ELSE twin_corners_up coinmont if arg_present coindescend THEN coindescend coindesc ELSE twin_corners_dn coindesc IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF IF keyword_set key_performance THEN print temps triangule systime 1 tempsun return triang END "); 332 a[330] = new Array("./ToBeReviewed/UTILITAIRE/fitintobox.html", "fitintobox.pro", "", " NAME:fitintobox PURPOSE: check that the input array has size and dimensions compatible with the domain that was defined with the previous call of domdef CATEGORY: domain compatibility CALLING SEQUENCE: res fitintobox field nx ny nz firstx firsty firstz lastx lasty lastz INPUTS: field: an array or a structure that can be read by the function litchamp pro nx ny nz firstx firsty firstz lastx lasty lastz: optional parameters If not given they will be define with a call to the procedure grille pro KEYWORD PARAMETERS: none OUTPUTS: an array with dimensions matching the domain or 1 if there is an error COMMON BLOCKS: cm_4mesh and cm_4cal SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL help fitintobox findgen jpi jpj FLOAT Array 41 3 IDL help fitintobox findgen jpi jpj 78 Error: the array dimensions 180 148 78 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt 180 41 148 3 31 31 1 INT 1 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 June 2005: S Masson rewrite all FUNCTION err_mess sz jpi nx jpj ny jpk nz jpt IF n_elements sz EQ 1 THEN RETURN report Error: the vector size tostr sz is incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple RETURN report Error: the array dimensions tostr sz are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION fitintobox field nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth include commons cm_4mesh cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF arr litchamp field IF n_params EQ 1 THEN grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth case according the number of dimensions of the array sz size arr case sz 0 of 0:BEGIN scalar return report Error: scalar value strtrim arr 1 simple END 1:BEGIN 1D arrays CASE 1 OF x arrays sz 1 EQ jpi :arr temporary arr firstx:lastx sz 1 EQ nx : y arrays sz 1 EQ jpj :arr temporary arr firsty:lasty sz 1 EQ ny : z arrays sz 1 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ nz : t arrays sz 1 EQ jpt : ELSE:return err_mess sz 1 jpi nx jpj ny jpk nz jpt ENDCASE END 2:BEGIN 2D arrays CASE 1 OF xy arrays sz 1 EQ jpi AND sz 2 EQ jpj :arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny :arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj :arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny :arr temporary arr x y z arrays sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ jpk :arr temporary arr firstx:lastx firstz:lastz sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ nz :arr temporary arr firstx:lastx sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz : x yz arrays nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ jpk :arr temporary arr firsty:lasty firstz:lastz nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ nz :arr temporary arr firsty:lasty nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpk :arr temporary arr firstz:lastz nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz : xt arrays sz 1 EQ jpi AND sz 2 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpt: yt arrays sz 1 EQ jpj AND sz 2 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ ny AND sz 2 EQ jpt: zt arrays sz 1 EQ jpk AND sz 2 EQ jpt:arr temporary arr firstz:lastz sz 1 EQ nz AND sz 2 EQ jpt: ELSE:return err_mess sz 1:2 jpi nx jpj ny jpk nz jpt ENDCASE END 3:BEGIN 3D arrays CASE 1 OF xyz arrays sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ jpk :arr temporary arr firstx:lastx firsty:lasty firstz:lastz sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ jpk :arr temporary arr firstx:lastx firstz:lastz sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ jpk :arr temporary arr firsty:lasty firstz:lastz sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ nz :arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ nz :arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ nz :arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz : xyt arrays sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ jpt:arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt: x yzt arrays 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 nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ nz AND sz 3 EQ jpt:arr temporary arr firsty:lasty nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpk AND sz 3 EQ jpt:arr temporary arr firstz:lastz nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt: x y zt arrays 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 sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ jpk AND sz 3 EQ jpt:arr temporary arr firstz:lastz sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt: ELSE:return err_mess sz 1:3 jpi nx jpj ny jpk nz jpt ENDCASE END 4:BEGIN 4D arrays CASE 1 OF xyzt arrays 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 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 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 sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpk AND sz 4 EQ jpt:arr temporary arr firstz:lastz 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 sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ nz AND sz 4 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ nz AND sz 4 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz AND sz 4 EQ jpt: ELSE:return err_mess sz 1:4 jpi nx jpj ny jpk nz jpt ENDCASE END ELSE:return report Error: fitintobox is managing arrays with a maximum of 4 dimensions simple ENDCASE return arr end"); 333 a[331] = new Array("./ToBeReviewed/UTILITAIRE/get_extra.html", "get_extra.pro", "", " elle fait quoi elle permet : soit de creer une variable extra contenant les mots clefs que tu desires soit de completer une variable extra avec des mots clefs que tu rajoutes imagine : tu es dans une routine et tu veux passer un mot clef en extra car la routine que tu appelles ne le connait pas mais la routine suivante oui tu fais extra get_extra ok year 1999 age_capitaine 35 et tu obtiens la bonne variable extra fait un help extra struc ou alors tu completes un extra existant : extra get_extra _extra extra name Guillaume FUNCTION get_extra _extra extra return extra END "); 334 a[332] = new Array("./ToBeReviewed/UTILITAIRE/linearequation.html", "linearequation.pro", "", " NAME: linearequation PURPOSE:calcule une equation de droite du type ax by c 0 a partir des coordonnees de 2 points Rq: on peut avoir un tableau de couple de points CATEGORY:petit truc qui peut etre utile sans boucles ca va de soit CALLING SEQUENCE:abc linearequation point1 point2 INPUTS: point1 et point2 dont deux point de s la droite s dont on veut calculer l es equations s deux possibilites sont possibles: 1 point est un complexe ou un tableau de complexes ou chaque element du complexe est les coordonnees du point 2 points est un tableau de reels de dimensions 2 nbre_de_droite ou pour chaque ligne du tableau on a les coordonnees du point KEYWORD PARAMETERS: OUTPUTS:abc c est un tableau de dimensions 3 nbre_de_droite ou pour chaque ligne du tableau on obtient les 3 parametres a b c de l equation de la droite ax by c 0 COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL abc linearequation complex 1 2 3 4 IDL print abc 0 1 abc 1 2 abc 2 0 00000 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 FUNCTION linearequation point1 point2 if size point1 type EQ 6 OR size point1 type EQ 9 then begin x1 float point1 y1 imaginary point1 ENDIF ELSE BEGIN x1 float reform point1 0 y1 float reform point1 1 ENDELSE if size point2 type EQ 6 OR size point2 type EQ 9 then begin x2 float point2 y2 imaginary point2 ENDIF ELSE BEGIN x2 float reform point2 0 y2 float reform point2 1 ENDELSE vertical where x1 EQ x2 novertical where x1 NE x2 abc fltarr 3 n_elements x1 IF novertical 0 NE 1 then BEGIN y mx p nele n_elements novertical m y2 novertical y1 novertical x2 novertical x1 novertical p x2 novertical y1 novertical y2 novertical x1 novertical x2 novertical x1 novertical abc novertical reform m 1 nele replicate 1 1 nele reform p 1 nele ENDIF IF vertical 0 NE 1 then BEGIN x ny p nele n_elements vertical n x2 vertical x1 vertical y2 vertical y1 vertical p y2 vertical x1 vertical x2 vertical y1 vertical y2 vertical y1 vertical abc vertical replicate 1 1 nele reform n 1 nele reform p 1 nele ENDIF return abc end"); 335 a[333] = new Array("./ToBeReviewed/UTILITAIRE/lineintersection.html", "lineintersection.pro", "", " NAME: lineintersection PURPOSE: Calcule les coordonnees de l intersection de 2 droites ou d une serie de 2 droites CATEGORY:petit truc qui peut etre utile sans boucles ca va de soit CALLING SEQUENCE: point lineintersection abc1 abc2 INPUTS: abc est un tableau de dimensions 3 nbre_de_couple_de_droites dont chaque ligne contient les 3 parametres a b c de l equation de droite du type ax by c 0 KEYWORD PARAMETERS: FLOAT: pour retourner l output sous forme de tableau de reel plutot que de vecteur decomplexes par defaut OUTPUTS:2 possibilites: 1 par defaut: c est une vecteur de complexe dont chaque element est les coordonnees du point d intersection d un couple de droites 2 si FLOAT est active c est un tableau de reels de dimensiones 2 nbre_de_couple_de_droites dont chaque ligne est les coordonnees du point d intersection d un couple de droites COMMON BLOCKS: SIDE EFFECTS:si les deux droites dont paralleles on retourne les coordonnes values f_nan values f_nan RESTRICTIONS:attention a la precision de la machine qui fait que les coordonnees calcules de verifient peut etre pas exactement les equations du couple de droites EXAMPLE: IDL abc1 linearequation complex 1 2 3 4 IDL abc2 linearequation complex 1 2 8 15 IDL print lineintersection abc1 abc2 1 00000 2 00000 IDL print lineintersection abc1 abc2 float 1 00000 2 00000 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 FUNCTION lineintersection abc1 abc2 FLOAT float a1 float reform abc1 0 b1 float reform abc1 1 c1 float reform abc1 2 a2 float reform abc2 0 b2 float reform abc2 1 c2 float reform abc2 2 determinant a1 b2 a2 b1 nan where determinant EQ 0 if nan 0 NE 1 THEN determinant values f_nan x b1 c2 c1 b2 determinant y c1 a2 a1 c2 determinant if keyword_set float then begin npts n_elements x res reform x 1 npts over reform y 1 npts over ENDIF ELSE res complex x y return res end"); 336 a[334] = new Array("./ToBeReviewed/UTILITAIRE/oups.html", "oups.pro", "", ""); 337 a[335] = new Array("./ToBeReviewed/UTILITAIRE/pwd.html", "pwd.pro", "", " NAME:pwd PURPOSE:print the current directory CATEGORY:like unix function CALLING SEQUENCE:pwd MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO pwd cd current pwd print pwd return end"); 338 a[336] = new Array("./ToBeReviewed/UTILITAIRE/report.html", "report.pro", "", " NAME:report PURPOSE: comme dialog_message pro si il y a deja des widgets actives ou comme message pro si il n y a pas de widgets actives pour poser des question dont la reponse n est pas oui non utiliser xquestion CATEGORY: CALLING SEQUENCE:res report text INPUTS: text: un string on un vecteur de string Si le string ne comporte qu un element on cherche les eventuels characteres de retour a la ligne: C If text is set to an array of strings each array element is displayed as a separate line of text KEYWORD PARAMETERS: SIMPLE: activate to print only the message without the name and the line of the routine defined by calling routine_name ceux dialog_message pro et message pro avec en PARENT qui fait la meme chose que DIALOG_PARENT de dialog_message pro OUTPUTS: 1 si le mot cle QUESTION n est pas activer si le mot cle est active la fonction retourne 1 pour yes et 0 pour no COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: si aucun widget n est active: IDL help report toto tata MAIN : toto tata INT 1 IDL help report ca marche question ca marche y n default answer is y BYTE 1 IDL help report question1: C ca marche question question1: ca marche y n default answer is y BYTE 1 si des widgets sont deja actives c est la meme chose mais avec des widgets MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 21 10 1999 FUNCTION report text DEFAULT_NO default_no PARENT parent QUESTION question SIMPLE simple _extra ex res 1 on separe le texte en differentes lignes separees par C si ce n est pas deja fait if n_elements text EQ 1 then text str_sep text C trim il y a des widgets actifs c est facile on appelle dialog_massage if widget_info managed 0 NE 0 then BEGIN res dialog_message text dialog_parent parent QUESTION question title routine_name 1 DEFAULT_NO default_no _extra ex if keyword_set question THEN res res EQ Yes ELSE res 1 ENDIF ELSE BEGIN aucun widget n est actif on pose une question if keyword_set question then BEGIN quelle est la reponse par defaut if keyword_set default_no then answer n ELSE answer y default_answer answer if n_elements text GT 1 THEN for i 0 n_elements text 2 do print text i read text n_elements text 1 y n default answer is default_answer answer answer strlowcase answer si la reponse ne convient pas while answer NE and answer NE y and answer NE n do begin read text n_elements text 1 y n default answer is default_answer answer answer strlowcase answer ENDWHILE on ajuste res en fonction de la reponse case answer of :res default_answer EQ y y :res 1 n :res 0 endcase endif ELSE BEGIN si on ne pose pas de question on fait juste un print IF keyword_set simple THEN prefix ELSE prefix routine_name 1 : if n_elements text GT 1 THEN for i 0 n_elements text 2 do print prefix text i print prefix text n_elements text 1 ENDELSE ENDELSE return res end"); 339 a[337] = new Array("./ToBeReviewed/UTILITAIRE/routine_name.html", "routine_name.pro", "", " NAME:routine_name remonte PURPOSE:retourne le nom de la routine procedure ou function ds lequel on se trouve CATEGORY:utilitaire CALLING SEQUENCE:res routine_name remonte INPUTS: remonte: un entier qui donne de combien de niveau on doit remonter ds l empillement des routines ewt sous routines pour retrouver le nom de la routine cherchee KEYWORD PARAMETERS: OUTPUTS:un string donnant soit le nom de la routine en entier avec le path soit MAIN COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: cette fonction utilise le mot cle OUTPUT ds help pro et il est specifie ds l aide en ligne que la syntaxe du retour de ce mot cle peut changer suivant la version du code Cette version marche avec IDL 5 2 EXAMPLE: IDL print routine_name usr1 com smasson IDL_RD UTILITAIRE report pro IDL print routine_name 1 usr1 com smasson IDL_RD PLOTS DIVERS determineminmax pro IDL print routine_name 2 usr1 com smasson IDL_RD PLOTS DESSINE plt pro IDL print routine_name 3 MAIN IDL print routine_name 4 MAIN MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 21 10 1999 FUNCTION routine_name remonte help traceback output name name strtrim name 1 on enleve les blancs en debut de ligne on va mettre les elements du vecteur bout a bout pour former un unique sring allnames for i 0 n_elements name 1 do allnames allnames name i name str_sep allnames on le redecoupe name strtrim name 2 on eleve les blancs devant et derriere name strcompress name on compresse les blancs on ne retient pas les 2 premiers elements qui sont 1 un vide et la ligne concernant routine_name name name 2: n_elements name 1 on choisit la ligne qui nous concerne if NOT keyword_set remonte then remonte 0 if remonte GE n_elements name then return MAIN name name remonte if strpos name MAIN NE 1 then return MAIN name str_sep name if n_elements name LT 3 then name name 0 ELSE name L name 1 name 2 return name end"); 340 a[338] = new Array("./ToBeReviewed/UTILITAIRE/test.html", "test.pro", "", "pro test ok ok if keyword_set ok then print OK else print No return end"); 341 a[339] = new Array("./ToBeReviewed/UTILITAIRE/testvar.html", "testvar.pro", "", " NAME:testvar PURPOSE:une sorte de keyword_set mais qd la valeur existe renvoie celle ci CATEGORY:comme keyword_set CALLING SEQUENCE:res testvar var variable INPUTS:rien KEYWORD PARAMETERS:var : n importe quoi OUTPUTS:0 si la variable n existe pas COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL print testvar var toto 0 IDL print testvar var toto toto MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 14 12 1999 FUNCTION testvar var var if keyword_set var then return var ELSE return 0 end"); 342 a[340] = new Array("./ToBeReviewed/UTILITAIRE/text_box.html", "text_box.pro", "", " PRO text_box text pos pos fg_color fg_color bg_color bg_color center center right right box box vert_space vert_space _EXTRA ex Name : text_box Purpose : Writes a text message within a box in a graphics window Description: This procedure writes a short text message within a box shaped area in a graphics window The message may be split at word boundaries into several lines and the character size and orientation may be adjusted for the text to fit within the box Useage: text_box text pos pos color color justify justify vert_space vert_space Inputs TEXT ASCII text string containing the message keywords pos 4 element vector specifying the box position and size pos 0 pos 1 specify the lower left corner coordinate pos 2 pos 3 specify the upper right corner coordinate data window normalized coordinates are use fg_color color of box and legend titles default 0 bg_color background color Setting BG_COLOR erases the area covered by the text box filling it with color BG_COLOR prior to writing the text If both BG_COLOR and p color are zero then the background color is reset to 255 to gaurantee a readability right if set right justify text center if set center the text vert_space vertical spacing of lines in units of character height default 1 5 author: Paul Ricchiazzi 7Jul93 Institute for Computational Earth System Science University of California Santa Barbara ON_ERROR 2 Check the number of parameters justify 1 if keyword_set right ne 0 then justify 1 if keyword_set center ne 0 then justify 0 if keyword_set vert_space eq 0 then vert_space 1 5 IF n_elements text eq 0 then message must specify text nnx x window d x_vsize nny y window d y_vsize nnx 0 1 d x_vsize nny 0 1 d y_vsize if n_elements pos eq 0 then begin box_cursor xx1 yy1 nx ny xx2 xx1 nx yy2 yy1 ny pos xx1 nnx 0 nnx 1 nnx 0 yy1 nny 0 nny 1 nny 0 xx2 nnx 0 nnx 1 nnx 0 yy2 nny 0 nny 1 nny 0 posstring string form a 4 f5 2 a pos pos 0 pos 1 pos 2 pos 3 print strcompress posstring remove_all endif else begin xx1 nnx 0 pos 0 nnx 1 nnx 0 xx2 nnx 0 pos 2 nnx 1 nnx 0 yy1 nny 0 pos 1 nny 1 nnx 0 yy2 nny 0 pos 3 nny 1 nnx 0 endelse calculate the height and width of the box in characters width xx2 xx1 d x_ch_size height yy2 yy1 d y_ch_size decompose the message into words words str_sep text print f 20a words nwords n_elements words wordlen lenstr words d x_vsize blanklen lenstr d x_vsize maxcharsize xx2 xx1 4 blanklen max wordlen charsize 1 lpnt intarr nwords nomore 0 ntries 0 repeat begin ntries ntries 1 if ntries gt 20 then message Can not fit message into box ychsiz vert_space d y_ch_size charsize wlen wordlen charsize blen blanklen charsize n_lines fix yy2 yy1 ychsiz 1 sum 0 ilines 0 print f 8a8 charsz i ilines n_lines lpnt wlen sum xwdth for i 0 nwords 1 do begin sum sum wlen i blen if sum 3 blen gt xx2 xx1 then begin ilines ilines 1 sum wlen i blen endif lpnt i ilines print f f8 2 4i8 3f8 2 charsize i ilines n_lines lpnt i wlen i blen sum 3 blen xx2 xx1 endfor case 1 of ilines 1 lt n_lines: if charsize 1 1 gt maxcharsize then vert_space yy2 yy1 n_lines 1 d y_ch_size charsize else charsize charsize 1 1 ilines 1 eq n_lines: nomore 1 ilines 1 gt n_lines: charsize charsize 9 endcase endrep until nomore lines strarr n_lines maxlen 0 for i 0 n_lines 1 do begin ii where lpnt eq i nc maxlen total wlen ii nc blen maxlen lines i string f 200a words ii print i words ii print i lines i endfor align 5 1 justify case justify of 1:xx xx1 5 xx2 xx1 maxlen 0:xx 0 5 xx1 xx2 1:xx xx2 5 xx2 xx1 maxlen endcase dy d y_ch_size charsize vert_space yy yy2 0 5 dy xbox xx1 xx2 xx2 xx1 xx1 ybox yy1 yy1 yy2 yy2 yy1 if n_elements bg_color ne 0 then begin if p color eq 0 and bg_color eq 0 then bgc 255 else bgc bg_color polyfill xbox ybox color bgc device endif if n_elements fg_color eq 0 then color 0 else color fg_color for i_line 0 n_lines 1 do begin yy yy dy print xx yy lines i_line charsize xyouts xx yy lines i_line device charsize charsize alignment align color color font 1 _extra ex endfor if keyword_set box then plots xbox ybox color color device return end "); 343 a[341] = new Array("./ToBeReviewed/UTILITAIRE/undefine.html", "undefine.pro", "", " NAME: undefine PURPOSE: effacer une variable meme chose que delvar mais utiulisable ds un programme et utilisable que pour une variable a la fois CATEGORY: CALLING SEQUENCE: UNDEFINE varname INPUTS: varname: la variable a detruire EXAMPLE: IDL a 1 IDL undefine a Compiled module: UNDEFINE IDL help a A UNDEFINED MODIFICATION HISTORY: trouve sur la page web de D Fanning http: www dfanning com : QUESTION: How do I make an IDL variable have a type undefined ANSWER: At the main IDL level you can use the IDL procedure DELVAR to delete an IDL variable and make it undefined Inside of procedures and functions I use this little program named UNDEFINE that I got from Andrew Cool at the DSTO High Frequency Radar Division in Adelaide Australia PRO UNDEFINE varname tempvar SIZE TEMPORARY varname END "); 344 a[342] = new Array("./ToBeReviewed/UTILITAIRE/vzoom.html", "vzoom.pro", "", ""); 345 a[343] = new Array("./ToBeReviewed/UTILITAIRE/xfile.html", "xfile.pro", "", " NAME: xfile PURPOSE: affiche ds un widget un fichier ASCII c est la meme chose que xdisplaydife mais ici on l utilise pour visualiser le contenu d une procedure ou d une fonction meme si elle n est pas ds le repertoire courant grace a path CATEGORY: help CALLING SEQUENCE: xfile nom_fichier INPUTS: nom_fichier:le nom d une procedure ou d une fonction a visualiser avec ou sans le pro a la fin KEYWORD PARAMETERS:ceux de xdisplayfile EXAMPLE:xfile plt MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1 99 6 7 1999: compatibilite mac et windows PRO xfile filename _extra ex pfile strlowcase filename il faut trouver le nom complet if strpos pfile pro lt 0 then pfile pfile pro thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos pfile sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep if rstrpos multipath 0 sep NE strlen multipath 0 1 then multipath multipath sep pfile current multipath pfile ENDIF i 0 repeat begin res findfile pfile i i i 1 endrep until res 0 NE OR i EQ n_elements pfile if res 0 NE then BEGIN on ouvre le fichier ds un widget xdisplayfile pfile i 1 _extra ex ENDIF ELSE ras report le fichier demande n existe pas return end"); 346 a[344] = new Array("./ToBeReviewed/UTILITAIRE/xhelp.html", "xhelp.pro", "", " NAME: xhelp PURPOSE: Display an IDL procedure header using widgets and the widget manager CATEGORY: Widgets CALLING SEQUENCE: xhelp Filename _extra ex INPUTS: Filename: A scalar string that contains the filename of the file to display If FILENAME does not include a complete path specification xhelp will search for the file in the current working directory and then each of the directories listed in PATH environment variable The pro file suffix will be appended if it is not supplied KEYWORD PARAMETERS: Ceux de xdisplayfile OUTPUTS: No explicit outputs A file viewing widget is created SIDE EFFECTS: Triggers the XMANAGER if it is not already in use RESTRICTIONS: None PROCEDURE: Open a file and create a widget to display its contents MODIFICATION HISTORY: Written By Steve Richards December 1990 Graceful error recovery DMS Feb 1992 Modified to extract pro documentation headers PJR ESRG mar94 author: Paul Ricchiazzi jun93 Institute for Computational Earth System Science University of California Santa Barbara 7 1 99 : legeres mofification par Sebastien Masson : utilisation de xdisplayfile de findfile et de _extra 6 7 1999: compatibilite mac et windows PRO xhelp filename _extra ex filename est bien un string cquoidonc size filename type if cquoidonc NE 7 then begin ras report Input parameter must be a string and not a size filename tname return endif il faut trouver le nom complet pfile FILENAME if strpos pfile pro lt 0 then pfile pfile pro thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos pfile sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep if rstrpos multipath 0 sep NE strlen multipath 0 1 then multipath multipath sep pfile current multipath pfile ENDIF on test tous les noms possibles pour trouver ou est le fichier nfile n_elements pfile n 0 repeat begin res findfile pfile n n n 1 endrep until res 0 NE OR n EQ n_elements pfile if res 0 NE then BEGIN openr unit pfile n 1 get_lun ouverture du fichier on selectionne le morceaux en tete a strarr 1000 Maximum of lines xsize 0 i 0 c readon 0 while not eof unit do begin readf unit c if strpos c eq 0 then readon 0 if readon then begin dum where byte c eq 9b ntab count tab characters xsize xsize strlen c 8 ntab a i strmid c 1 200 i i 1 endif if strpos c eq 0 then readon 1 endwhile if i EQ 0 then ras report le programme a etait mal ecrit il n y a pas d en tete utiliser xfile pro ELSE BEGIN a a 0:i 1 on ecrit le contenu de a ds un widget xdisplayfile toto text a title pfile n 1 _extra ex ENDELSE FREE_LUN unit free the file unit ENDIF ELSE ras report le fichier demande n existe pas return end "); 347 a[345] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/buildcmd.html", "buildcmd.pro", "", " NAME:buildcmd PURPOSE:cette fonction reourne un string qui contient la commande de lecture et les parametres du trace CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION buildcmd base BOXZOOM boxzoom FORCETYPE forcetype we get back the ids of the widget parts txtcmdid widget_info base find_by_uname txtcmd domainid widget_info base find_by_uname domain actionid widget_info base find_by_uname action optionid widget_info base find_by_uname option widget_control base get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait strtrim optionsflag where options EQ Portrait Landscape 0 1 0 on determine quelle procedure on va etre appele pour faire le dessin et le type IF keyword_set forcetype THEN type forcetype ELSE type widget_info actionid combobox_gettext case type of plt :procedure plt pltz :procedure pltz pltz diag up :procedure pltz pltz diag dn :procedure pltz pltt :procedure pltt pltt diag up :procedure pltt pltt diag dn :procedure pltt xy :procedure plt xz :procedure pltz yz :procedure pltz xt :procedure pltt yt :procedure pltt zt :procedure pltt x :procedure plt1d y :procedure plt1d z :procedure plt1d t :procedure pltt endcase recherche des options options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag flags optionsflag numdessinin xindex flags where options EQ Longitude x index 0 yindex flags where options EQ Latitude y index 0 drawvecteur flags where options EQ Vecteur 0 procedure eq plt drawover flags where options EQ Overlay 0 alreadyread extractatt top_uvalue alreadyread alreadyvector extractatt top_uvalue alreadyvector alreadyover extractatt top_uvalue alreadyoer que devons nous lire case 1 of alreadyover NE 1:BEGIN toread alreadyover 1 readswitch over END alreadyvector NE 1 AND alreadyvector NE pi:BEGIN toread alreadyvector 1 readswitch vector END alreadyread NE 1 AND alreadyread NE pi AND alreadyread NE 2 pi:BEGIN toread alreadyread 1 readswitch classic END else:BEGIN case 1 of alreadyvector eq pi:BEGIN toread alreadyover 1 readswitch over END alreadyread EQ pi:BEGIN toread alreadyvector 1 readswitch vector END alreadyread EQ 2 pi:BEGIN toread alreadyover 1 readswitch over END ELSE:BEGIN toread alreadyread 1 readswitch classic END endcase END ENDCASE widget_control txtcmdid get_value widcmd widcmd strtrim widcmd 2 IF widcmd 0 EQ THEN widcmd zzz cutcmd widcmd 0 toread numberofread prefix nameexp ending readcmd buildreadcmd base nameexp procedure type BOXZOOM boxzoom complete readswitch EQ classic AND alreadyread EQ 1 we look for the line containing funclec_name currentfile extractatt top_uvalue currentfile readparameters extractatt top_uvalue readparameters currentfile i 0 while strpos readcmd i readparameters funclec_name EQ 1 do i i 1 case readswitch of classic :BEGIN if alreadyread 1 EQ 0 then BEGIN we start the reading command readcmd beginning of reading the field to draw readcmd readcmd i 1 field prefix readcmd i 1 ENDIF ELSE BEGIN we complet the reading command oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE exit if we have to read other fields if alreadyread 1 NE numberofread 1 THEN BEGIN top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyread alreadyread 1 top_uvalue 1 findline top_uvalue noticebase xnotice Select the field number strtrim alreadyread 3 1 return ENDIF we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd field create_struct arr:temporary field grid:vargrid unit:varunit experiment:varexp name:varname end of reading the field to draw we get back _EXTRA: extra extractatt top_uvalue extra if xindex NE 0 then extra create_struct extra xindex xindex if yindex NE 0 then extra create_struct extra yindex yindex exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd temporary readcmd extra sextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd case 1 of drawvecteur:BEGIN we have to read the vectors top_uvalue 1 findline top_uvalue alreadyread pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the zonal component of vector return END drawover:BEGIN we have to read the field to overlay top_uvalue 1 findline top_uvalue alreadyread 2 pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the field to overlay return END finished we draw the plot ELSE: top_uvalue 1 findline top_uvalue alreadyread 1 endcase END vector :BEGIN for the vectors there is 2 components we read u when alreadyvector is a interger and v when alreadyvector is a interger 0 5 if floor alreadyvector 1 EQ 0 then begin if floor alreadyvector EQ alreadyvector then begin readcmd beginning of reading the zonal component of vector readcmd readcmd i 1 fieldu prefix readcmd i 1 ENDIF ELSE BEGIN readcmd beginning of reading the meridional component of vector readcmd readcmd i 1 fieldv prefix readcmd i 1 ENDELSE readcmd extractatt top_uvalue currentreadcmd temporary readcmd ENDIF ELSE BEGIN oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE case alreadyvector 1 of numberofread 1:BEGIN we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd fieldu create_struct arr:temporary fieldu grid:vargrid unit:varunit experiment:varexp name:varname end of reading the zonal component of vector top_uvalue 1 findline top_uvalue currentreadcmd readcmd we finished zonal component reading we know switch to meridional component top_uvalue 1 findline top_uvalue alreadyvector 5 top_uvalue 1 findline top_uvalue noticebase xnotice Select the meridional component of vector return END numberofread 0 5:BEGIN we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd fieldv create_struct arr:temporary fieldv grid:vargrid unit:varunit experiment:varexp name:varname end of reading the meridional component of vector we finished meridional component reading we get back _EXTRA of the vector and we complet extra already build extra extractatt top_uvalue extra exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd readcmd vectorextra sextra extra mixstru extra vectorextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd if drawover then BEGIN shall we do an overlay top_uvalue 1 findline top_uvalue alreadyvector pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the field to overlay return ENDIF ELSE BEGIN it is done know top_uvalue 1 findline top_uvalue alreadyread 1 top_uvalue 1 findline top_uvalue alreadyvector 1 ENDELSE END ELSE:BEGIN we still need to read some vector components top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyvector alreadyvector 1 if floor alreadyvector EQ alreadyvector then text zonal ELSE text meridional top_uvalue 1 findline top_uvalue noticebase xnotice Select the strtrim floor alreadyread 3 1 text component of vector return END endcase END over :BEGIN if alreadyover 1 EQ 0 then begin we start the reading readcmd beginning of reading the field to overdraw readcmd readcmd i 1 fieldover prefix readcmd i 1 readcmd extractatt top_uvalue currentreadcmd temporary readcmd ENDIF ELSE BEGIN oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE if alreadyover 1 NE numberofread 1 THEN BEGIN we still need to read some files top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyover alreadyover 1 top_uvalue 1 findline top_uvalue noticebase xnotice Select the field number strtrim alreadyover 3 1 to overlay return ENDIF we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF on finalise la commande de lecture readcmd readcmd fieldover create_struct arr:temporary fieldover grid:vargrid unit:varunit experiment:varexp name:varname end of reading the field to overdraw we get back _EXTRA of over and we complet extra already build extra extractatt top_uvalue extra exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd readcmd overextra sextra extra mixstru extra overextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd we reinitialize top_uvalue 1 findline top_uvalue alreadyread 1 top_uvalue 1 findline top_uvalue alreadyvector 1 top_uvalue 1 findline top_uvalue alreadyover 1 END endcase determination du nom de la boxzoom if NOT keyword_set boxzoom then widget_control domainid get_value boxzoom ecriture de celle ci sous forme d un string box strtrim boxzoom 0 1 for i 1 n_elements boxzoom 1 3 2 strpos type z EQ 1 do box box strtrim boxzoom i 1 pour les plots en z box doit avoir par defaut 0 profmax if strpos type z NE 1 then BEGIN si de 1 niveau est selectionne: widget_control widget_info base find_by_uname dthlv1 get_value niv1 niv1 niv1 combobox_index widget_control widget_info base find_by_uname dthlv2 get_value niv2 niv2 niv2 combobox_index if niv1 NE niv2 then begin box box strtrim boxzoom 4 1 strtrim boxzoom 5 1 ENDIF ELSE BEGIN if chkstru exextra profmax then pmax exextra profmax ELSE pmax 200 box box 0 strtrim pmax 1 ENDELSE endif box box IF strpos type diag up NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 2 1 strtrim boxzoom 1 1 strtrim boxzoom 3 1 ENDIF IF strpos type diag dn NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 3 1 strtrim boxzoom 1 1 strtrim boxzoom 2 1 ENDIF on determine typein IF strpos type diag NE 1 THEN typein strmid type 0 4 ELSE typein type determination de small ssmall tostr smallout on va definir le string qui contiendra la commande a executer par widgetdessine pro Cmd readCmd procedure field boxzoom box findalways typein typein small ssmall IF drawvecteur then Cmd Cmd vecteur u: fieldu v: fieldv IF drawover then Cmd Cmd contour fieldover IF n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints Cmd Cmd _extra mixstru ex extra portrait portrait NOERASE noerase print for i 0 n_elements Cmd 1 do print Cmd i print on complete et ou actualise la structure top_uvalue top_uvalue 1 findline top_uvalue nameprocedures numdessinout procedure top_uvalue 1 findline top_uvalue types numdessinout type top_uvalue 1 findline top_uvalue domaines numdessinout boxzoom top_uvalue 1 findline top_uvalue txtcmd numdessinout widcmd top_uvalue 1 findline top_uvalue optionsflag numdessinout flags top_uvalue 1 findline top_uvalue exextra numdessinout extra return Cmd end "); 348 a[346] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/buildreadcmd.html", "buildreadcmd.pro", "", " NAME:buildreadcmd PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION buildreadcmd base snameexp procedure type BOXZOOM boxzoom COMPLETE complete NAMEFIELD namefield cm_4cal for key_caltype get back widgets IDs vlstid widget_info base find_by_uname varlist date1id widget_info base find_by_uname calendar1 date2id widget_info base find_by_uname calendar2 domainid widget_info base find_by_uname domain optionid widget_info base find_by_uname option widget_control base get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 numdessinout extractatt top_uvalue smallout 2 1 name of the file currentfile extractatt top_uvalue currentfile filelist extractatt top_uvalue filelist filename filelist currentfile sfilename filename name of the variable if keyword_set namefield then namevar namefield ELSE namevar widget_info vlstid combobox_gettext snamevar namevar get the options options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags numdessinin xindex flags where options EQ Longitude x index 0 yindex flags where options EQ Latitude y index 0 extra extractatt top_uvalue extra if xindex NE 0 then extra create_struct extra xindex xindex if yindex NE 0 then extra create_struct extra yindex yindex exextra cw_specifie_get_value base exextra extractstru exextra min max inter lct if size exextra type EQ 8 then extra mixstru exextra extra sextra struct2string extra find date1 and date2 key_caltype extractatt top_uvalue fileparameters currentfile caltype widget_control date1id get_value date1 widget_control date2id get_value date2 if procedure EQ pltt AND date1 EQ date2 then BEGIN we redefine the dates to the begining and end of the calendar calendar extractatt top_uvalue fileparameters currentfile time_counter date1 jul2date calendar 0 date2 jul2date calendar n_elements calendar 1 widget_control date1id set_value date1 widget_control date2id set_value date2 endif fakecal extractatt top_uvalue fileparameters currentfile fakecal IF keyword_set fakecal THEN BEGIN date1 date2jul date1 fakecal date2 date2jul date2 fakecal ENDIF sdate1 strtrim date1 1 sdate2 strtrim date2 1 find boxzoom if NOT keyword_set boxzoom then widget_control domainid get_value boxzoom put boxzoom into a string box strtrim boxzoom 0 1 for i 1 n_elements boxzoom 1 3 2 strpos type z EQ 1 do box box strtrim boxzoom i 1 if strpos type z NE 1 then BEGIN common min min gdept gdepw max max box box strtrim floor min 1 strtrim ceil max 1 endif box box IF strpos type diag up NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 2 1 strtrim boxzoom 1 1 strtrim boxzoom 3 1 ENDIF IF strpos type diag dn NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 3 1 strtrim boxzoom 1 1 strtrim boxzoom 2 1 ENDIF find funclec_name readparameters meshparameters readparameters extractatt top_uvalue readparameters currentfile funclec_name readparameters funclec_name if keyword_set complete then begin sreadparameters struct2string readparameters meshparameters extractatt top_uvalue meshparameters currentfile smeshparameters struct2string meshparameters on va definir le string qui contiendra la commande a executer pour la lecture Cmd Definition of extra structure: extra sextra Definition of readparameters structure: readparameters sreadparameters Do we change of reading : dummy changeread readparameters Definition of meshparameters structure: meshparameters smeshparameters Do we change the grid : dummy changegrid meshparameters Read the data if n_elements date1in ne 0 then date1 date1in else date1 sdate1 if n_elements date2in ne 0 then date2 date2in else date2 sdate2 funclec_name snamevar date1 date2 snameexp timestep strtrim keyword_set fakecal 1 parent strtrim base 2 boxzoom box findalways filename sfilename if n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints type type Cmd Cmd _extra mixstru ex extra nostruct top_uvalue 1 findline top_uvalue varinfo numdessinout filename namevar top_uvalue 1 findline top_uvalue dates numdessinout date1 date2 ENDIF ELSE BEGIN Cmd funclec_name snamevar date1 date2 snameexp parent strtrim base 1 boxzoom box filename sfilename if n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints type type Cmd Cmd _extra mixstru ex extra nostruct ENDELSE print :::::::::::::::::::::: for i 0 n_elements Cmd 1 do print Cmd i print :::::::::::::::::::::: return cmd end"); 349 a[347] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/changefield.html", "changefield.pro", "", "PRO changefield base newfieldname BOXZOOM boxzoom widget_control base get_uvalue top_uvalue Change exextra : exextra definedefaultextra newfieldname specifieid widget_info base find_by_uname specifie widget_control specifieid set_value exextra Change the variable Do we need to change the vertical axis according to the tye of points T or W dthlv1id widget_info base find_by_uname dthlv1 widget_control dthlv1id get_uvalue dthlv1_uval oldzgridt dthlv1_uval grid_t get the type of point currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar for i 0 n_elements listvar 1 do print listvar i listgrid i indexvar where listvar EQ newfieldname indexvar 0 indexvar 0 zgridt strupcase listgrid indexvar NE W if we change the type of point if zgridt NE oldzgridt then BEGIN update dthlv1_uval grid_t dthlv1_uval grid_t zgridt widget_control dthlv1id set_uvalue dthlv1_uval update cw_domain if NOT keyword_set boxzoom THEN widget_control widget_info base find_by_uname domain get_value boxzoom widget_control widget_info base find_by_uname domain set_value boxzoom endif return end"); 350 a[348] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/changefile.html", "changefile.pro", "", "PRO changefile base newfilename BOXZOOM boxzoom DATE1 date1 DATE2 date2 FIELDNAME fieldname widget_control base hourglass widget_control base get_uvalue top_uvalue filelist extractatt top_uvalue filelist IF size newfilename type EQ 7 THEN newfile where filelist EQ newfilename 0 ELSE newfile newfilename it is already the index of the new file if newfile EQ 1 then begin nothing report invalid filename return endif oldfile extractatt top_uvalue currentfile oldfilename filelist oldfile did we really change the file if oldfile EQ newfile AND NOT keyword_set BOXZOOM OR keyword_set DATE1 OR keyword_set DATE2 OR keyword_set FIELDNAME then return widget_control base update 0 we update currentfile element of the top_uvalue top_uvalue 1 findline top_uvalue currentfile newfile Calendar oldcalendar extractatt top_uvalue fileparameters oldfile time_counter newcalendar extractatt top_uvalue fileparameters newfile time_counter Did we change the calendar if array_equal oldcalendar newcalendar NE 1 then begin cm_4cal for key_caltype key_caltype extractatt top_uvalue fileparameters newfile caltype fake or real calendar fakecal extractatt top_uvalue fileparameters newfile fakecal Which dates were selected date1id widget_info base find_by_uname calendar1 if NOT keyword_set date1 then widget_control date1id get_value date1 jdate1 date2jul date1 if where newcalendar EQ jdate1 0 EQ 1 then jdate1 newcalendar 0 date2id widget_info base find_by_uname calendar2 if NOT keyword_set date2 then widget_control date2id get_value date2 jdate2 date2jul date2 if where newcalendar EQ jdate2 0 EQ 1 then jdate2 date1 if jdate2 LT jdate1 THEN jdate2 jdate1 widget_control date1id destroy widget_control date2id destroy basecal widget_info base find_by_uname basecal rien cw_calendar basecal newcalendar jdate1 uname calendar1 FAKECAL fakecal uvalue name: calendar1 frame rien cw_calendar basecal newcalendar jdate2 uname calendar2 FAKECAL fakecal uvalue name: calendar2 frame ENDIF ELSE BEGIN if keyword_set date1 then begin date1id widget_info base find_by_uname calendar1 widget_control date1id set_value date1 endif if keyword_set date2 then begin date2id widget_info base find_by_uname calendar2 widget_control date2id set_value date2 endif ENDELSE Grid parameters and domain newgrid extractatt top_uvalue meshparameters newfile change changegrid newgrid if change OR keyword_set boxzoom then BEGIN if NOT keyword_set boxzoom then boxzoom 1 domainid widget_info base find_by_uname domain widget_control domainid set_value boxzoom endif file name IF oldfile NE newfile THEN BEGIN flstid widget_info base find_by_uname filelist widget_control flstid set_combobox_select newfile ENDIF Variables name vlstid widget_info base find_by_uname varlist oldfieldname widget_info vlstid combobox_gettext did we really change the liste of variables oldlistvar extractatt top_uvalue fileparameters oldfile listvar newlistvar extractatt top_uvalue fileparameters newfile listvar if array_equal oldlistvar newlistvar NE 1 THEN widget_control vlstid set_value newlistvar set the liste of variables to the new variable name if keyword_set fieldname then newfieldname fieldname ELSE newfieldname oldfieldname indexvar where newlistvar EQ newfieldname indexvar 0 indexvar 0 widget_control vlstid set_combobox_select indexvar newfieldname newlistvar indexvar did we change the name of the variable if newfieldname NE oldfieldname then BEGIN changefield base newfieldname BOXZOOM boxzoom ENDIF widget_control base update 1 return end"); 351 a[349] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/createhistory.html", "createhistory.pro", "", "PRO createhistory base small we save globalcommand in globaloldcommand widget_control base get_uvalue top_uvalue globalcommand extractatt top_uvalue globalcommand top_uvalue 1 findline top_uvalue globaloldcommand globalcommand portrait or landscape options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait optionsflag where options EQ Portrait Landscape 0 0 composition du text contennu ds history pro texte common if keyword_set postscript then begin noerase 1 openps infowidget infowidget portrait strtrim portrait 2 endif beginning of 1 end of 1 if small 0 small 1 GT 1 then begin for draw 1 small 0 small 1 1 do begin texte texte beginning of strtrim draw 1 2 noerase 1 end of strtrim draw 1 2 endfor ENDIF texte texte if keyword_set postscript then begin closeps infowidget infowidget printps endif the new globalcommand top_uvalue 1 findline top_uvalue globalcommand texte for i 0 n_elements texte 1 do print texte i return end"); 352 a[350] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/cutcmd.html", "cutcmd.pro", "", "PRO cutcmd widcmd toread numberofread prefix nameexp ending dummy where byte widcmd EQ byte 0 nbdblquote CASE 1 OF nbdblquote MOD 2: stop odd numbers are impossibles nbdblquote GT 0: nbdblquote EQ 0:BEGIN widcmd is an expression of type: numb1 a numb2 b numb we will change into the form numb1 a numb2 b numb in order to suits the new method of cutcmd widcmd strtrim widcmd 2 we force to start with a or case 1 of strpos widcmd EQ 0: strpos widcmd EQ 0: ELSE:widcmd widcmd ENDCASE separator strsplit widcmd extract regex other strsplit widcmd extract IF n_elements separator NE n_elements other THEN stop widcmd FOR i 0 n_elements other 1 DO BEGIN IF isnumber other i LT 1 THEN other i other i widcmd widcmd separator i other i ENDFOR print widcmd END ENDCASE cutted strsplit widcmd extract IF strpos widcmd EQ 0 THEN start 0 ELSE start 1 nameexp cutted start: :2 numberofread n_elements nameexp IF toread GE numberofread then begin dummy report toread cannot be larger than numberofread stop ENDIF other cutted 1 start: :2 make sure that we have a prefix for each nameexp IF start EQ 0 THEN other other nameexp nameexp toread prefix other toread IF n_elements other EQ numberofread 1 THEN ending other numberofread ELSE ending help prefix nameexp ending return end"); 353 a[351] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/definedefaultextra.html", "definedefaultextra.pro", "", "FUNCTION definedefaultextra nomvariable case strlowcase nomvariable of sn :BEGIN return get_extra min 31 max 37 inter 2 lct 33 nocontout END tn :BEGIN return get_extra min 20 max 31 inter 5 lct 39 END un :BEGIN return get_extra min 1 max 1 inter 1 lct 64 END vn :BEGIN return get_extra min 1 max 1 inter 1 lct 64 END ELSE: ENDCASE return get_extra min max inter lct 39 end"); 354 a[352] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/doubleclickaction.html", "doubleclickaction.pro", "", "PRO doubleclickaction event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue on active la bonne fenetre widget_control event id get_value win wset win quel est le dessin selectionne smallin extractatt top_uvalue smallin smallout extractatt top_uvalue smallout x convert_coord uval x 0 uval y 0 device to_normal 0 y convert_coord uval x 0 uval y 0 device to_normal 1 numcolonne n_elements where findgen smallin 0 smallin 0 lt x 1 numligne n_elements where findgen smallin 1 smallin 1 lt 1 y 1 numdessin numcolonne numligne smallin 0 1 choix du type d action case uval press of 1:BEGIN if top_uvalue smallin 2 NE numdessin then begin tracecadre smallin erase if total smallin EQ smallout EQ 3 then tracecadre smallout out smallin smallin 0:1 numdessin top_uvalue 1 findline top_uvalue smallin smallin tracecadre smallin p extractatt top_uvalue penvs numdessin 1 x extractatt top_uvalue xenvs numdessin 1 y extractatt top_uvalue yenvs numdessin 1 END 2:BEGIN if top_uvalue smallout 2 NE numdessin then begin tracecadre smallout erase if total smallin EQ smallout EQ 3 then tracecadre smallin smallout smallin 0:1 numdessin top_uvalue 1 findline top_uvalue smallout smallout tracecadre smallout out endif END 4:BEGIN tracecadre smallin 0:1 numdessin fill inserthistory event top beginning of strtrim numdessin 2 end of strtrim numdessin 2 remise a 0 des attributs de la uvalue concernant ce dessin: numdessin numdessin 1 top_uvalue 1 findline top_uvalue varinfo numdessin top_uvalue 1 findline top_uvalue dates numdessin 0l 0l top_uvalue 1 findline top_uvalue nameprocedures numdessin top_uvalue 1 findline top_uvalue types numdessin top_uvalue 1 findline top_uvalue domaines numdessin fltarr 6 top_uvalue 1 findline top_uvalue txtcmd numdessin if numdessin EQ smallin 2 then tracecadre smallin if numdessin EQ smallout 2 then tracecadre smallout out END ELSE: endcase updatewidget event top return end"); 355 a[353] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/extractatt.html", "extractatt.pro", "", "FUNCTION extractatt top_uvalue name taille size top_uvalue j 1 repeat BEGIN j j 1 if j EQ size top_uvalue 2 then return 1 endrep until top_uvalue 0 j EQ name return top_uvalue 1 j end"); 356 a[354] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/findline.html", "findline.pro", "", "FUNCTION findline top_uvalue name taille size top_uvalue j 1 repeat BEGIN j j 1 if j EQ size top_uvalue 2 then return 1 endrep until top_uvalue 0 j EQ name return j end"); 357 a[355] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/identifyclick.html", "identifyclick.pro", "", "FUNCTION identifyclick event widget_control event id get_uvalue uval no_copy thisEvent TAG_NAMES event Structure if thisEvent EQ WIDGET_TIMER then press 0 ELSE press event press d 0 1 t 1 0 d 2 0 long click d 1 0 t 2 0 click normal d 2 1 d 3 0 t 0 0 double click t 3 0 d 0 0 double click type inutile case 1 OF d 0 0 1er remonte thisEvent EQ WIDGET_DRAW AND uval click EQ 0 AND press EQ 0: d 0 1 1er appuie de la serie thisEvent EQ WIDGET_DRAW AND uval click EQ 0 AND press ge 1:BEGIN uval x event x 0 uval y event y 0 uval press press uval click 1 widget_control event id timer 3 END d 1 0 1er remonte thisEvent EQ WIDGET_DRAW AND uval click EQ 1 AND press EQ 0:uval click 2 d 2 0 fin long click thisEvent EQ WIDGET_DRAW AND uval click EQ 2 AND press EQ 0:BEGIN type long uval x uval x 0 event x uval x uval x sort uval x uval y uval y 0 event y uval y uval y sort uval y uval click 0 uval press event release END d 2 1 thisEvent EQ WIDGET_DRAW AND uval click EQ 2 AND press ge 1:BEGIN type double uval press press uval click 3 END d 3 0 remonte et fin de double click thisEvent EQ WIDGET_DRAW AND uval click EQ 3 AND press EQ 0:uval click 0 t 0 0 fin de double click thisEvent EQ WIDGET_TIMER AND uval click EQ 0 AND press EQ 0: t 1 0 long click thisEvent EQ WIDGET_TIMER AND uval click EQ 1 AND press EQ 0:uval click 2 t 2 0 click normal thisEvent EQ WIDGET_TIMER AND uval click EQ 2 AND press EQ 0:BEGIN type single press uval press uval click 0 END t 3 0 fin de double click thisEvent EQ WIDGET_TIMER AND uval click EQ 3 AND press EQ 0:uval click 0 cas normalement impossible: ELSE:BEGIN print thisEvent uval click press print Probleme cas normalement impossible END endcase widget_control event id set_uvalue uval no_copy return type:type end"); 358 a[356] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/inserthistory.html", "inserthistory.pro", "", "PRO inserthistory base text line1 line2 widget_control base get_uvalue top_uvalue globalcommand extractatt top_uvalue globalcommand top_uvalue 1 findline top_uvalue globaloldcommand globalcommand for i 0 n_elements globalcommand 1 do print globalcommand i we insert text between line1 and line2 index1 where globalcommand EQ line1 index1 index1 0 1 if index1 EQ 1 then begin rien report line1 n est pas trouve ds globalcommand return endif index2 where globalcommand EQ line2 index2 index2 0 if index2 EQ 1 then begin rien report line2 n est pas trouve ds globalcommand return ENDIF the new text: globalcommand globalcommand 0:index1 text globalcommand index2:n_elements globalcommand 1 the new globalcommand top_uvalue 1 findline top_uvalue globalcommand globalcommand return end"); 359 a[357] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/letsdraw.html", "letsdraw.pro", "", " NAME:widgetdessine PURPOSE: c est la procedure qui lance le dessin Si on ne le lui donne pas de commande elle appelle construitcommande pour savoir quoi tracer CATEGORY: CALLING SEQUENCE:widgetdessine base INPUTS:base: l id du widget ou appliquer le dessin KEYWORD PARAMETERS: COMMANDE: un string du style: read_data sst OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO letsdraw base COMMANDE commande _extra ex common on recupere la uvalue de base widget_control base get_uvalue top_uvalue print help top_uvalue struct help top_uvalue exextra struct if NOT keyword_set commande then commande buildcmd base _extra ex if commande 0 EQ then return on recupere la uvalue de base widget_control base hourglass widget_control base get_uvalue top_uvalue print help top_uvalue struct print help top_uvalue exextra struct help top_uvalue extra struct print print commande help mixstru top_uvalue exextra top_uvalue extra struct on recuperel id de la fenetre graphique associee au widget d id base graphid extractatt top_uvalue graphid widget_control graphid get_value win on la selectionne c est a elle que sera passe toutes les commandes concernant une fenetre wset win erase 255 on netoie la fenetre on s assure que si on travaille avec un ecran codant les couleurs sur 24 bits la couleur de fond specifiee p background est bien appliquee if d n_colors gt 256 then begin device decomposed 1 p background ffffff x plot 0 0 device decomposed 0 ENDIF smallout long extractatt top_uvalue smallout numdessinout smallout 2 1 tracecadre smallout fill options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait strtrim optionsflag where options EQ Portrait Landscape 0 1 0 createpro common noerase 1 key_portrait portrait Commande filename myuniquetmpdir xxx_oneplot pro inserthistory base Commande beginning of strtrim smallout 2 1 end of strtrim smallout 2 1 top_uvalue 1 findline top_uvalue penvs numdessinout p top_uvalue 1 findline top_uvalue xenvs numdessinout x top_uvalue 1 findline top_uvalue yenvs numdessinout y return end"); 360 a[358] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/loadgrid.html", "loadgrid.pro", "", "PRO loadgrid meshfilein _extra ex cm_4mesh ccmeshparameters filename meshfilein split the name according to delimiter meshfile strsplit meshfilein extract meshfile strtrim meshfile 2 try to find a pro file with this name filepro find meshfile 0 firstfound onlypro 0 if this is an idl batch file or a procedure if filepro NE NOT FOUND THEN BEGIN CASE protype filepro OF this is a procedure proc :listing file_basename filepro pro this is a function this case is not coded func :stop this is an IDL batch file batch :listing file_basename filepro pro ENDCASE ENDIF ELSE BEGIN filenc find meshfile 0 firstfound onlync 0 if filenc EQ NOT FOUND THEN stop listing initncdf filenc ENDELSE add the arguments and keywords if necessary IF n_elements meshfile GT 1 AND strmid listing 0 1 NE THEN BEGIN FOR i 1 filepro NE NOT FOUND n_elements meshfile 1 DO listing listing meshfile i ENDIF IF strmid listing 0 1 NE THEN listing listing strcalling meshfilein _extra ex createpro listing filename myuniquetmpdir for_createpro pro _extra ex return END "); 361 a[359] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/longclickaction.html", "longclickaction.pro", "", "PRO longclickaction event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue quel est le dessin selectionne smallout extractatt top_uvalue smallout smallin extractatt top_uvalue smallin small smallin x convert_coord uval x 0 uval y 0 device to_normal 0 y convert_coord uval x 0 uval y 0 device to_normal 1 numcolonne n_elements where findgen small 0 small 0 lt x 1 numligne n_elements where findgen small 1 small 1 lt 1 y 1 numdessin numcolonne numligne small 0 we put on numdessin as the leader plot tracecadre smallin erase if total smallin EQ smallout EQ 3 then tracecadre smallout out smallin smallin 0:1 numdessin 1 top_uvalue 1 findline top_uvalue smallin smallin tracecadre smallin p extractatt top_uvalue penvs numdessin x extractatt top_uvalue xenvs numdessin y extractatt top_uvalue yenvs numdessin Change the domain box: coor convert_coord uval x uval y device to_data x coor 0 0 coor 0 1 y coor 1 0 coor 1 1 domainid widget_info event top find_by_uname domain boxzoom x y faut il passer la boxzoom en indexes currentplot extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags currentplot changex flags where options EQ Longitude x index 0 EQ 1 changey flags where options EQ Latitude y index 0 EQ 1 if changex OR changey then begin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar domdef boxzoom gridtype vargrid grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz if changex then boxzoom 0:1 firstx lastx if changey then boxzoom 2:3 firsty lasty endif widget_control domainid set_value boxzoom actionid widget_info event top find_by_uname action type widget_info actionid combobox_gettext case uval press of 1:BEGIN nodates type EQ xt OR type EQ yt OR type EQ zt OR type EQ t updatewidget event top noboxzoom nodates nodates notype type NE plt letsdraw event top END 2:BEGIN IF type EQ plt THEN BEGIN top_uvalue 1 findline top_uvalue types smallout 2 1 pltz forcetype pltz ENDIF updatewidget event top noboxzoom letsdraw event top END 4:BEGIN IF type EQ plt THEN BEGIN top_uvalue 1 findline top_uvalue types smallout 2 1 pltt forcetype pltt ENDIF updatewidget event top noboxzoom nodates letsdraw event top forcetype forcetype END endcase return end"); 362 a[360] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/read_vermair.html", "read_vermair.pro", "", "FUNCTION read_vermair name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex common if name EQ un then name vozocrtx if name EQ vn then name vomecrty if debut EQ fin then begin res lec name debut nomexp BOXZOOM boxzoom _EXTRA ex ENDIF ELSE res lect name debut fin nomexp BOXZOOM boxzoom _EXTRA ex return tab:res grille:vargrid unite: experience:varexp nom:varname end"); 363 a[361] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/scanfile.html", "scanfile.pro", "", " liste des presupposes: 1 le fichier a lire est un fichier netcdf 2 le nom de ce fichier finit par U nc V nc W nc T nc ou F nc la lettre avant le nc designant la grille a laquelle se rapporte la champ Si tel n est pas la cas le fichier est attribue a la grille T 3 ce fichier contient une dimension infinie qui doit etre celle qui se rapporte au temps et au mois 2 autres dimensions dont les noms sont x lon xi_ et y lat ou eta_ ou bien en majuscule 4 il doit exiter ds ce fichier une unique variable n ayant qu une dimension et etant la dimension temporelle cette variable sera prise comme axe des temps Rq: si plusieurs variables verifient ces criteres on considere la premiere variable 5 Cette variable axe des temps doit contenir l attribut units qui doit etre ecrit suivant la syntaxe: seconds since 0001 01 01 00:00:00 hours since 0001 01 01 00:00:00 days since 1979 01 01 00:59:59 months since 1979 01 01 00:59:59 years since 1979 01 01 00:59:59 je crois que c est tout GRID UTVWF to specify the type of grid Defaut is 1 based on the name of the file if the file ends by GRID _ TUVFW NC not case sensible or 2 T if case 1 is not found FUNCTION scanfile namefile GRID GRID _extra ex common res 1 filename fullname isafile filename namefile IODIRECTORY iodir _extra ex open file cdfid ncdf_open fullname What contains the file infile ncdf_inquire cdfid find vargrid IF keyword_set grid THEN vargrid strupcase grid ELSE BEGIN vargrid T default definition IF finite glamu 0 EQ 1 THEN BEGIN pattern GRID GRID_ GRID UPID_ 30ID_ gdtype T U V W F fnametest strupcase fullname FOR i 0 n_elements pattern 1 DO BEGIN FOR j 0 n_elements gdtype 1 DO BEGIN substr pattern i gdtype j pos strpos fnametest substr IF pos NE 1 THEN vargrid strmid fnametest pos strlen substr 1 1 ENDFOR ENDFOR ENDIF ENDELSE name of all dimensions namedim strarr infile ndims for dimiq 0 infile ndims 1 do begin ncdf_diminq cdfid dimiq tmpname value namedim dimiq strlowcase tmpname ENDFOR we are looking for a x dimension dimidx where namedim EQ x OR strmid namedim 0 3 EQ lon OR strmid namedim 0 3 EQ xi_ OR namedim EQ xt_i7_156 dimidx dimidx 0 if dimidx EQ 1 then begin print one of the dimensions must have the name: x or lon or xi_ or xt_i7_156 stop endif we are looking for a y dimension dimidy where namedim EQ y OR strmid namedim 0 3 EQ lat OR strmid namedim 4 EQ eta_ OR namedim EQ yt_j6_75 dimidy dimidy 0 if dimidy EQ 1 then begin print one of the dimensions must have the name: y or lat or eta_ or yt_j6_75 stop endif name of all variables we keep only the variables containing at least x y and time dimension if existing namevar strarr infile nvars for varid 0 infile nvars 1 do begin invar ncdf_varinq cdfid varid what contains the variable if where invar dim EQ dimidx 0 NE 1 AND where invar dim EQ dimidy 0 NE 1 AND where invar dim EQ infile recdim 0 NE 1 OR infile recdim EQ 1 THEN namevar varid invar name ENDFOR namevar namevar where namevar NE listgrid replicate vargrid n_elements namevar time axis date0fk date2jul 19000101 IF infile recdim EQ 1 THEN BEGIN jpt 1 time date0fk fakecal 1 ENDIF ELSE BEGIN ncdf_diminq cdfid infile recdim timedimname jpt we look for the variable containing the time axis we look for the first variable having for only dimension infile recdim varid 0 repeat BEGIN invar ncdf_varinq cdfid varid varid varid 1 endrep until n_elements invar dim EQ 1 AND invar dim 0 EQ infile recdim varid varid 1 CASE 1 OF varid EQ 1:BEGIN dummy report the file fullname has no time axis C we create a fake calendar fakecal 1 time date0fk lindgen jpt END invar natts EQ 0:BEGIN dummy report the variable invar name has no attribut C we create a fake calendar fakecal 1 time date0fk lindgen jpt END ELSE:BEGIN we want to know which attributes are attached to the time variable attnames strarr invar natts for attiq 0 invar natts 1 do attnames attiq ncdf_attname cdfid varid attiq if where attnames EQ units 0 EQ 1 then BEGIN dummy report Attribut units not found for the variable varid name C we create a fake calendar fakecal 1 time date0fk lindgen jpt ENDIF ELSE BEGIN on lit l axe des temps ncdf_varget cdfid varid time time double time ncdf_attget cdfid varid units value time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 value strtrim strcompress string value 2 mots str_sep value unite mots 0 debut str_sep mots 2 now we try to find the attribut called calendar the the attribute calendar exists If no we suppose that the calendar is gregorian calendar if where attnames EQ calendar 0 NE 1 then BEGIN ncdf_attget cdfid varid calendar value value string value CASE value OF noleap :key_caltype noleap 360d :key_caltype 360d greg :IF n_elements key_caltype EQ 0 THEN key_caltype greg ELSE:BEGIN notused report Unknown calendar: value we use greg calendar key_caltype greg END ENDCASE ENDIF ELSE BEGIN notused report Unknown calendar we use key_caltype calendar IF n_elements key_caltype EQ 0 THEN key_caltype greg ENDELSE ATTENTION il faut recuperer l attribut calendar et ajuster time en consequense on passe time en jour julien d idl unite strlowcase unite IF strpos unite s strlen unite 1 NE 1 THEN unite strmid unite 0 strlen unite 1 IF strpos unite julian_ NE 1 THEN unite strmid unite 7 case unite of second :time julday debut 1 debut 2 debut 0 time 86400 d hour :time julday debut 1 debut 2 debut 0 time 24 d day :time julday debut 1 debut 2 debut 0 time month :BEGIN if total fix time NE time NE 0 then we switch to days with 30d m time julday debut 1 debut 2 debut 0 round time 30 ELSE for t 0 n_elements time 1 DO time t julday debut 1 time t debut 2 debut 0 END year :BEGIN if total fix time NE time NE 0 then we switch to days with 365d y time julday debut 1 debut 2 debut 0 round time 365 ELSE for t 0 n_elements time 1 do time t julday debut 1 debut 2 debut 0 time t END ENDCASE high frequency calendar: more than one element per day IF max histogram long time time 0 GT 1 THEN fakecal 1 ELSE fakecal 0 date0fk date2jul 19000101 IF keyword_set fakecal THEN time date0fk lindgen jpt ELSE time long time ENDELSE END ENDCASE ENDELSE ncdf_close cdfid return filename:fullname time_counter:time listvar:namevar listgrid:strupcase listgrid caltype:key_caltype fakecal:date0fk fakecal end"); 364 a[362] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/selectfile.html", "selectfile.pro", "", " PRO selectfile_event event common widget_control event id get_uvalue eventuvalue default definition of messenger when selectfile_event is called directly without calling xmanager widget_control event handler get_uvalue messenger messenger 1 IF chkstru eventuvalue name EQ 0 THEN return case eventuvalue name of cancel button Global Cancel :BEGIN widget_control event handler get_uvalue messenger messenger 1 widget_control event handler destroy END data file informations datafilename :BEGIN widget_control event id get_value filename filename isafile filename filename 0 iodir iodir onlync title data file name if size filename type NE 7 then BEGIN widget_control event id set_value return ENDIF widget_control event id set_value filename END browse datafilename :BEGIN filename isafile iodir iodir onlync title data file name if size filename type NE 7 then return widget_control widget_info event handler find_by_uname datafilename set_value filename END switch automatic by and mesh definition buttons gridload :BEGIN IF event select EQ 1 THEN BEGIN widget_control widget_info event handler find_by_uname argtxt set_value widget_control widget_info event handler find_by_uname kwdtxt set_value widget_control widget_info event handler find_by_uname kwd base sensitive 1 CASE event value OF via initnetcdf :BEGIN widget_control widget_info event handler find_by_uname meshload set_value initncdf editable 0 widget_control widget_info event handler find_by_uname arg base sensitive 0 widget_control widget_info event handler find_by_uname kwdlab set_value initncdf keywords: END via perso :BEGIN widget_control widget_info event handler find_by_uname meshload set_value editable 1 widget_control widget_info event handler find_by_uname arg base sensitive 1 widget_control widget_info event handler find_by_uname kwdlab set_value keywords of IDL procedure: END ENDCASE ENDIF END name of the procedure or batch file meshload :BEGIN widget_control event id get_value filename filename find filename 0 onlypro firstfound 0 if filename EQ NOT FOUND then begin widget_control event id set_value return endif CASE protype filename OF this is a procedure proc :BEGIN widget_control widget_info event handler find_by_uname arg base sensitive 1 widget_control widget_info event handler find_by_uname kwd base sensitive 1 widget_control widget_info event handler find_by_uname kwdlab set_value file_basename filename pro keywords: END this is a function this case is not accepted func :BEGIN widget_control event id set_value return END this is an IDL batch file batch :BEGIN widget_control widget_info event handler find_by_uname arg base sensitive 0 widget_control widget_info event handler find_by_uname kwd base sensitive 0 widget_control widget_info event handler find_by_uname kwdlab set_value no keywords: END ENDCASE widget_control widget_info event handler find_by_uname argtxt set_value widget_control widget_info event handler find_by_uname kwdtxt set_value widget_control event id set_value file_basename filename pro END browse meshload :BEGIN filename isafile iodir homedir onlypro title to load the grid file if size filename type NE 7 then return meshload_id widget_info event handler find_by_uname meshload widget_control meshload_id set_value filename selectfile_event ID:meshload_id TOP:event top HANDLER:event handler END Lets Go button Lets Go :BEGIN widget_control widget_info event handler find_by_uname datafilename get_value datafilename datafilename datafilename 0 IF datafilename EQ THEN return datafilename isafile filename datafilename iodir iodir onlync title data file name if size datafilename type NE 7 then BEGIN widget_control widget_info event handler find_by_uname datafilename set_value return ENDIF widget_control widget_info event handler find_by_uname gridload get_value gridload widget_control widget_info event handler find_by_uname argtxt get_value argtxt argtxt strtrim argtxt 0 2 IF strpos argtxt EQ 0 THEN argtxt strmid argtxt 1 widget_control widget_info event handler find_by_uname kwdtxt get_value kwdtxt kwdtxt strtrim kwdtxt 0 2 IF strpos kwdtxt EQ 0 THEN kwdtxt strmid kwdtxt 1 CASE gridload 0 OF via perso :BEGIN meshload_id widget_info event handler find_by_uname meshload widget_control meshload_id get_value meshload meshload meshload 0 IF meshload EQ THEN return meshload find meshload 0 onlypro firstfound 0 if meshload EQ NOT FOUND then begin widget_control meshload_id set_value return endif END via initnetcdf :meshload datafilename ENDCASE IF strlen argtxt NE 0 THEN meshload meshload argtxt IF strlen kwdtxt NE 0 THEN meshload meshload kwdtxt widget_control event handler get_uvalue messenger messenger create_struct datafilename datafilename meshload meshload widget_control event handler destroy END endcase return end FUNCTION selectfile datafilename idlfile argspro _extra ex common pour recuperer les reponses possees lors de l utilisation de ce widget on cree un pointeur que l on place dans la uvalue Comme ca une fois que le widget est detruit dans la procedure event pro la variable surlaquelle pointait le pointeur contenue ds la uvalue du widget n est pas detruite est on peut recuperer le resultat messenger ptr_new allocate_heap base widget_base column title selectfile align_center uvalue messenger _EXTRA ex cancel button dummyid widget_button base value Cancel uvalue name: Global Cancel data file informations basea widget_base base row align_center dummyid widget_label basea value Data file name: database widget_text basea value uvalue name: datafilename uname datafilename xsize 45 EDITABLE dummyid widget_button basea value Browse uvalue name: browse datafilename switch automatic by and mesh definition buttons baseb widget_base base row align_center gdldid cw_bgroup baseb automatic grid construction with initncdf pro grid construction with other IDL batch or procedure exclusive set_value 0 uvalue name: gridload uname gridload button_uvalue via initnetcdf via perso name of the procedure or batch file basec widget_base base row align_center uname pro base dummyid widget_label basec value IDL batch file of procedure basemeshload widget_text basec value initncdf uvalue name: meshload uname meshload xsize 45 editable 0 dummyid widget_button basec value Browse uvalue name: browse meshload arguments informations based widget_base base row align_center uname arg base sensitive 0 dummyid widget_label based value procedure arguments agrbase widget_text based value uvalue name: argtxt uname argtxt xsize 45 EDITABLE keyword informations basee widget_base base row align_center uname kwd base dummyid widget_label basee uname kwdlab value keywords of initncdf: dummyid widget_text basee value uvalue name: kwdtxt uname kwdtxt xsize 45 EDITABLE Lets Go button basego widget_button base value Lets Go uvalue name: Lets Go IF n_elements datafilename NE 0 THEN BEGIN widget_control database set_value datafilename selectfile_event ID:database TOP:base HANDLER:base ENDIF IF n_elements idlfile NE 0 THEN BEGIN widget_control basemeshload set_value idlfile selectfile_event ID:basemeshload TOP:base HANDLER:base widget_control basemeshload get_value idlfile2 IF idlfile2 0 NE THEN widget_control gdldid set_value 1 ENDIF IF n_elements argspro NE 0 THEN widget_control argbase set_value argspro IF n_elements datafilename EQ 0 THEN BEGIN widget_control base realize xmanager selectfile base event_handler selectfile_event no_block 0 ENDIF ELSE selectfile_event ID:basego TOP:base HANDLER:base get back the information from selectfile_event res messenger ptr_free messenger if size res type NE 8 then return 1 loadgrid res meshload _extra ex ccreadparameters funclec_name: read_ncdf jpidta:jpidta jpjdta:jpjdta jpkdta:jpkdta ixmindta:ixmindta ixmaxdta:ixmaxdta iymindta:iymindta iymaxdta:iymaxdta izmindta:izmindta izmaxdta:izmaxdta res3 scanfile res datafilename iodir iodir _extra ex if size res3 type NE 8 then return 1 return fileparameters:res3 readparameters:ccreadparameters meshparameters:ccmeshparameters end"); 365 a[363] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/singleclickaction.html", "singleclickaction.pro", "", "PRO singleclickaction event cm_4mesh cm_4data return widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue actionid widget_info event top find_by_uname action type widget_info actionid combobox_gettext IF type NE plt THEN return on active la bonne fenetre widget_control event id get_value win wset win choix du type d action case uval press of 1:BEGIN coor convert_coord uval x 0 uval y 0 device to_data x coor 0 y coor 1 help x y oldgrid vargrid CASE strupcase vargrid OF T :vargrid F W :vargrid F U :vargrid V V :vargrid U F :vargrid T ENDCASE grille 1 glam gphi 1 nx ny nz firstx firsty firstz lastx lasty lastz vargrid oldgrid define the corner of the cells in the clockwise direction IF keyword_set key_periodic AND nx EQ jpi THEN BEGIN x1 glam 0:ny 2 y1 gphi 0:ny 2 x2 glam 1:ny 1 y2 gphi 1:ny 1 x3 shift glam 1:ny 1 1 0 y3 shift gphi 1:ny 1 1 0 x4 shift glam 0:ny 2 1 0 y4 shift gphi 0:ny 2 1 0 ENDIF ELSE BEGIN x1 glam 0:nx 2 0:ny 2 y1 gphi 0:nx 2 0:ny 2 x2 glam 0:nx 2 1:ny 1 y2 gphi 0:nx 2 1:ny 1 x3 glam 1:nx 1 1:ny 1 y3 gphi 1:nx 1 1:ny 1 x4 glam 1:nx 1 0:ny 2 y4 gphi 1:nx 1 0:ny 2 ENDELSE glam 1 free memory gphi 1 free memory What is the longitude WHILE x GT x range 1 DO x x 360 WHILE x LT x range 0 DO x x 360 IF x GT x range 1 THEN RETURN IF y GT y range 1 THEN RETURN IF y LT y range 0 THEN RETURN cell inquad x y x1 y1 x2 y2 x3 y3 x4 y4 onsphere key_onearth x1 1 free memory y1 1 free memory x2 1 free memory y2 1 free memory x3 1 free memory y3 1 free memory x4 1 free memory y4 1 free memory IF cell 0 EQ 1 OR n_elements cell GT 1 THEN RETURN yy cell 0 nx 1 key_periodic nx EQ jpi xx cell 0 MOD nx 1 key_periodic nx EQ jpi CASE strupcase vargrid OF T :BEGIN xx xx firstx 1 yy yy firsty 1 END W :BEGIN xx xx firstx 1 yy yy firsty 1 END U :BEGIN xx xx firstx yy yy firsty 1 END V :BEGIN xx xx firstx 1 yy yy firsty END F :BEGIN xx xx firstx yy yy firsty END ENDCASE bad where xx GE jpi IF bad 0 NE 1 THEN BEGIN xx bad xx bad jpi yy bad yy bad 1 ENDIF bad where yy GE jpj IF bad 0 NE 1 THEN stop print glamt xx yy gphit xx yy cmd buildcmd event top boxzoom boxzoom END ELSE: endcase RETURN end"); 366 a[364] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/tracecadre.html", "tracecadre.pro", "", "PRO tracecadre small out out erase erase fill fill determination de la colonne et de la ligne correspondant au small en entree numdessin small 2 1 numligne numdessin small 0 numcolonne numdessin numligne small 0 determination de poscadre largeurcolonne 1 small 0 largeurligne 1 small 1 cadre numcolonne largeurcolonne 1 numligne 1 largeurligne numcolonne 1 largeurcolonne 1 numligne largeurligne decale 0 001 cadre cadre decale decale decale decale reinitplt p position 0 0 1 1 IF keyword_set fill then begin polyfill cadre 0 cadre 2 cadre 2 cadre 0 cadre 0 cadre 1 cadre 1 cadre 3 cadre 3 cadre 1 color 255 normal ENDIF ELSE BEGIN plot cadre 0 cadre 2 cadre 2 cadre 0 cadre 0 cadre 1 cadre 1 cadre 3 cadre 3 cadre 1 xrange 0 1 yrange 0 1 linestyle 2 keyword_set out noerase normal thick 2 color 0 255 keyword_set erase ENDELSE return end"); 367 a[365] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/updatewidget.html", "updatewidget.pro", "", "PRO updatewidget base NOBOXZOOM noboxzoom NODATES nodates NOTYPE notype widget_control base get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 widget_control base update 0 date1 et date2 if keyword_set nodates then begin date1 0 date2 0 ENDIF ELSE BEGIN dates extractatt top_uvalue dates numdessinin date1 dates 0 date2 dates 1 ENDELSE domain boxzoom extractatt top_uvalue domaines numdessinin if total boxzoom EQ 0 then boxzoom 1 if keyword_set noboxzoom then boxzoom 0 varinfo: filename namevar varinfo extractatt top_uvalue varinfo numdessinin filename varinfo 0 nomvar varinfo 1 if filename NE OR nomvar NE THEN BEGIN changefile base filename fieldname nomvar BOXZOOM boxzoom DATE1 date1 DATE2 date2 ENDIF ELSE BEGIN if date1 NE 0 then begin date1id widget_info base find_by_uname calendar1 widget_control date1id set_value date1 endif if date2 NE 0 then begin date2id widget_info base find_by_uname calendar2 widget_control date2id set_value date2 endif if keyword_set boxzoom then BEGIN domainid widget_info base find_by_uname domain widget_control domainid set_value boxzoom endif ENDELSE exextra if n_elements extractatt top_uvalue exextra numdessinin NE 0 then begin exextra extractatt top_uvalue exextra numdessinin specifieid widget_info base find_by_uname specifie widget_control specifieid set_value exextra endif text command txtcmd extractatt top_uvalue txtcmd numdessinin if txtcmd NE then begin txtcmdid widget_info base find_by_uname txtcmd widget_control txtcmdid set_value txtcmd endif graphtype if NOT keyword_set notype then BEGIN graphtype extractatt top_uvalue types numdessinin if graphtype NE then begin actionid widget_info base find_by_uname action widget_control actionid get_value action_value widget_control actionid set_combobox_select where action_value EQ graphtype 0 endif endif widget_control base update 1 return end"); 368 a[366] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/xcreateanim.html", "xcreateanim.pro", "", "pro xcreateanim_event event common on recupere les aguments contenus ds le widget if tag_names event structure_name NE WIDGET_BUTTON then return widget_control event id get_uvalue uval if n_elements uval EQ 0 then return if uval EQ cancel then begin widget_control event top destroy return ENDIF on va ecrire l animation widget_control event top get_uvalue local_uvalue widget_control local_uvalue parent get_uvalue top_uvalue calendar extractatt top_uvalue fileparameters local_uvalue indexfile time_counter key_caltype extractatt top_uvalue fileparameters local_uvalue indexfile caltype fakecal extractatt top_uvalue fileparameters local_uvalue indexfile fakecal widget_control widget_info event top find_by_uname Filename get_value nomfic nomfic nomfic 0 widget_control widget_info event top find_by_uname directorie get_value animdir animdir animdir 0 widget_control widget_info event top find_by_uname debut get_value vdate1 index1 where calendar eq date2jul vdate1 index1 index1 0 if index1 EQ 1 then return widget_control widget_info event handler find_by_uname fin get_value vdate2 index2 where calendar eq date2jul vdate2 index2 index2 0 if index2 EQ 1 OR index2 LE index1 then return on detruit le widget avant de creer le fichier ps widget_control event top destroy creation de la routine qui nous serviera pour faire le dessin on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript DATE1IN date1in DATE2IN date2in creation du fichier recupere le nombre d octets surlequel on code la palette device get_visual_depth depth taille de l image en nombre de pixel: xsize d x_size ysize d y_size on verifie que le nom du fichier termine bien par gif if strpos nomfic gif EQ 1 then nomfic nomfic gif current_window d window window free pixmap xsize xsize ysize ysize indication du numero de l image que l on est en train de creer base widget_base sliderid widget_slider base minimum 1 maximum index2 index1 1 value 1 title image number: widget_control base realize commencement du fichier gif ecriture d une image vide IF keyword_set fakecal THEN date index1 ELSE date jul2date calendar index1 xxx2ps noerase date1in date date2in date image tvrd true depth GT 8 If an 8 bit image was read reduce the number of colors if depth le 8 then begin tvlct red green blue get reduce_colors image index red red index green green index blue blue index endif if depth gt 8 then Convert 24 bit image to 8 bit image color_quan image 1 red green blue colors 256 get_translation translation map_all write_gif animdir nomfic image red green blue multiple wdelete d window boucle de creation et d ecriture ds le fichier IF index2 GT index1 THEN BEGIN FOR ind index1 1 index2 do BEGIN widget_control sliderid set_value ind index1 1 on bouge le slider window free pixmap xsize xsize ysize ysize IF keyword_set fakecal THEN date ind ELSE date jul2date calendar ind xxx2ps noerase date1 date date2 date image tvrd true depth GT 8 if depth gt 8 then image color_quan image 1 aaa bbb ccc colors 256 translation translation write_gif animdir nomfic image red green blue multiple wdelete d window ENDFOR ENDIF on met une derniere image blanche window free pixmap xsize xsize ysize ysize reinitplt plot 0 0 nodata image tvrd true depth GT 8 if depth gt 8 then image color_quan image 1 aaa bbb ccc colors 256 translation translation write_gif animdir nomfic image red green blue multiple wdelete d window fermeture du fichier write_gif animdir nomfic close widget_control base destroy rebascule en mode normal thisOS strupcase strmid version os_family 0 3 wset current_window si on est sous x on essaie de lancer xanim if thisOS NE MAC AND thisOS NE WIN then begin spawn which xanim result if strpos result 0 xanim EQ strlen result 0 5 then spawn xanim animdir nomfic endif return end PRO xcreateanim parent common widget_control parent get_uvalue top_uvalue on va s assurer que toutes les procedures de sont pas pltt procedures extractatt top_uvalue nameprocedures if total procedures EQ pltt NE 0 then begin nothing report Certains des plots ont un axe se rapportant au temps C Animation impossible error return ENDIF on va s assurer que toutes les figures ont le meme calendrier filelist extractatt top_uvalue filelist filenames extractatt top_uvalue varinfo 0 filenames reform filenames filenames filenames uniq filenames sort filenames if strtrim filenames 0 1 EQ then filenames filenames 1:n_elements filenames 1 indexfile where filelist EQ filenames 0 0 calendar extractatt top_uvalue fileparameters indexfile time_counter key_caltype extractatt top_uvalue fileparameters indexfile caltype fakecal extractatt top_uvalue fileparameters indexfile fakecal if n_elements filenames GT 1 then begin for i 1 n_elements filenames 1 do begin indexfilebis where filelist EQ filenames i 0 calendarbis extractatt top_uvalue fileparameters indexfilebis time_counter if n_elements calendarbis NE n_elements calendar then begin nothing report Les diffrents plots n utilisent pas le meme calendrier C Animation impossible error return ENDIF if total calendar NE calendarbis NE 0 then begin nothing report Les diffrents plots n utilisent pas le meme calendrier C Animation impossible error return endif endfor endif c est possible de faire une animation base widget_base column title animation creation uvalue parent:parent indexfile:indexfile rien widget_label base value animation name rien widget_text base value anim_idl gif uname Filename editable rien widget_label base value animation directory if n_elements animdir EQ 0 then cd current animdir rien widget_text base value animdir uname directorie editable rien widget_label base value starting date rien cw_calendar base calendar calendar 0 FAKECAL fakecal uname debut uvalue name: calendar frame rien widget_label base value ending date rien cw_calendar base calendar calendar n_elements calendar 1 FAKECAL fakecal uname fin uvalue name: calendar frame rien widget_button base value OK uvalue ok rien widget_button base value Cancel uvalue cancel widget_control base realize xmanager xcreateanim base no_block return end"); 369 a[367] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/xxxmenubar_event.html", "xxxmenubar_event.pro", "", " PRO xxxmenubar_event event common case event value of Open :begin oldmeshparams ccmeshparameters newfile selectfile if size newfile type NE 8 then return widget_control event top hourglass widget_control event top update 0 widget_control event top get_uvalue top_uvalue on s occupe de filelist filelist extractatt top_uvalue filelist filelist filelist newfile fileparameters filename currentfile n_elements filelist 1 on update le widget filelistid widget_info event top find_by_uname filelist widget_control filelistid combobox_additem file_basename newfile fileparameters filename widget_control filelistid set_combobox_select currentfile on update les elements filelist et currentfile de la top_uvalue top_uvalue 1 findline top_uvalue filelist filelist oldfile top_uvalue 1 findline top_uvalue currentfile top_uvalue 1 findline top_uvalue currentfile currentfile on s occupe du nom de la variable vlstid widget_info event top find_by_uname varlist quel etait le champ selectionne on le reselectionne fieldname widget_info vlstid combobox_gettext index where newfile fileparameters listvar EQ fieldname widget_control vlstid set_value newfile fileparameters listvar widget_control vlstid set_combobox_select 0 index 0 on s occupe du calendrier key_caltype newfile fileparameters caltype date1id widget_info event top find_by_uname calendar1 widget_control date1id get_value date1 widget_control date1id destroy jdate1 jul2date date1 if where newfile fileparameters time_counter EQ jdate1 0 EQ 1 then jdate1 newfile fileparameters time_counter 0 date2id widget_info event top find_by_uname calendar2 widget_control date2id get_value date2 widget_control date2id destroy jdate2 jul2date date2 if where newfile fileparameters time_counter EQ jdate2 0 EQ 1 then jdate2 jdate1 basecal widget_info event top find_by_uname basecal fakecal newfile fileparameters fakecal rien cw_calendar basecal newfile fileparameters time_counter jdate1 uname calendar1 FAKECAL fakecal uvalue name: calendar1 frame rien cw_calendar basecal newfile fileparameters time_counter jdate2 uname calendar2 FAKECAL fakecal uvalue name: calendar2 frame on update les elements fileparameters readparameters et meshparameters de la top_uvalue newfileparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newfileparameters i extractatt top_uvalue fileparameters i newfileparameters currentfile newfile fileparameters ptr_free extractatt top_uvalue fileparameters top_uvalue 1 findline top_uvalue fileparameters newfileparameters newreadparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newreadparameters i extractatt top_uvalue readparameters i newreadparameters currentfile newfile readparameters ptr_free extractatt top_uvalue readparameters top_uvalue 1 findline top_uvalue readparameters newreadparameters newmeshparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newmeshparameters i extractatt top_uvalue meshparameters i newmeshparameters currentfile newfile meshparameters ptr_free extractatt top_uvalue meshparameters top_uvalue 1 findline top_uvalue meshparameters newmeshparameters on actualise le widget if cmpgrid oldmeshparams then BEGIN domainid widget_info event top find_by_uname domain widget_control domainid set_value 1 endif widget_control event top update 1 end New xxx :BEGIN widget_control event top get_uvalue top_uvalue extra extractatt top_uvalue extra xxx CALLERWIDID event top _extra extra end Quit :begin widget_control event top get_uvalue top_uvalue ptr_free extractatt top_uvalue exextra ptr_free extractatt top_uvalue fileparameters ptr_free extractatt top_uvalue readparameters ptr_free extractatt top_uvalue meshparameters ptr_free top_uvalue widget_control event top destroy on ferme le widget end PostScript :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as postscript in demo mode return ENDIF widget_control event top get_uvalue top_uvalue on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand for i 0 n_elements globalcommand 1 do print globalcommand i on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape DATE1IN date1in DATE2IN date2in POSTSCRIPT END Animated gif :begin IF float strmid version release 0 3 GE 6 2 THEN xcreateanim event top end Gif :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as an image in demo mode return ENDIF widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 tracecadre smallin erase tracecadre smallout erase filename xquestion dans quelle fichier gif voulez vous sauver C l ecran de xxx xxx_image gif if rstrpos filename gif NE strlen filename 4 then filename filename gif filename isafile file filename io imagedir new saveimage filename quiet end IDL procedure :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as a idl program file in demo mode return ENDIF on recupere le nom du fichier filename xquestion dans quelle procedure IDL voulez vous sauver C la realisation de ce graph xxx_figure pro on le complete par un pro if rstrpos filename pro NE strlen filename 4 then filename filename pro filename isafile file filename io homedir new widget_control event top get_uvalue top_uvalue portrait ou landscape options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait optionsflag where options EQ Portrait Landscape 0 0 on lit les commandes pour faire un plot globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :sep : WIN :sep ELSE:sep ENDCASE poslastsep rstrpos filename sep proname strmid filename poslastsep 1 strlen filename poslastsep 1 4 globalcommand pro proname NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape DATE1IN date1in DATE2IN date2in _extra ex globalcommand return end on les ecrit dans un programme putfile filename globalcommand END RESTORE kwd of xxx :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save the widget in demo mode return ENDIF on recupere le nom du fichier filename xquestion dans quel fichier bianire voulez vous sauver le widget xxx_widget dat on le complete par un dat if rstrpos filename dat NE strlen filename 4 then filename filename dat filename isafile file filename io homedir new widget_control event top get_uvalue uvalue widget_control extractatt uvalue graphid get_value win wshow win wset win image tvrd true save uvalue image filename filename END Print to prompt :BEGIN commande getfile myuniquetmpdir xxx_oneplot pro for i 0 n_elements commande 1 do print commande i end Portrait Landscape :begin widget_control event top get_uvalue top_uvalue options extractatt top_uvalue options index where options EQ Portrait Landscape index index 0 optionsflag extractatt top_uvalue optionsflag key_portrait 1 optionsflag index 0 top_uvalue 1 findline top_uvalue optionsflag index key_portrait fenetre separee ou fenetre collee au widget if widget_info event top find_by_uname graph EQ 0 then BEGIN on tue la fenetre graphid extractatt top_uvalue graphid widget_control widget_info graphid parent destroy on la recree basegraph widget_base title xxx window group_leader event top uvalue event top uname basegraph windsize givewindowsize graphid widget_draw basegraph uname graph uvalue name: graph press:0 click:0 x: 0 0 y: 0 0 button_events retain 2 xsize windsize 0 ysize windsize 1 widget_control basegraph realize xmanager xxx basegraph no_block on redessine ce qu il y avait dedans on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape KWDUSED noerase PORTRAIT portrait on reattribue l element graphid de la top_uvalue top_uvalue 1 findline top_uvalue graphid graphid ENDIF ELSE BEGIN extra extractatt top_uvalue extra xxx CALLERWIDID event top redraw _extra extra widget_control event top destroy on ferme le widget ENDELSE end Overlay :begin widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Overlay on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag end Vecteur :BEGIN widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Vecteur on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag end Longitude x index :BEGIN widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Longitude x index on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag maintenant on va changer les sliders definissant la boxzoom domainid widget_info event top find_by_uname domain boxzoom extractatt top_uvalue domaines numdessinin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar if flag EQ 0 then BEGIN longitudes on fait un domdef pour retrouver le lon1 lon2 correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid xindex yindex flags where options EQ Latitude y index numdessinin 0 widget_control domainid set_value lon1 lon2 boxzoom 2:3 ENDIF ELSE BEGIN xindex maintenant ion veut retrouver firstx lastx correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid yindex flags where options EQ Latitude y index numdessinin 0 grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz widget_control domainid set_value firstx lastx boxzoom 2:3 ENDELSE on met a jour la top_uvalue widget_control domainid get_value boxzoom top_uvalue 1 findline top_uvalue domaines numdessinin boxzoom end Latitude y index :begin widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Latitude y index on change le flag sur Latitude y index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag maintenant on va changer les sliders definissant la boxzoom domainid widget_info event top find_by_uname domain boxzoom extractatt top_uvalue domaines numdessinin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar if flag EQ 0 then BEGIN latitudes on fait un domdef pour retrouver le lat1 lat2 correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid yindex xindex flags where options EQ Longitude x index numdessinin 0 widget_control domainid set_value boxzoom 0:1 lat1 lat2 ENDIF ELSE BEGIN yindex maintenant ion veut retrouver firsty lasty correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid xindex flags where options EQ Longitude x index numdessinin 0 grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz widget_control domainid set_value boxzoom 0:1 firsty lasty ENDELSE on met a jour la top_uvalue widget_control domainid get_value boxzoom top_uvalue 1 findline top_uvalue domaines numdessinin boxzoom END endcase return end"); 370 a[368] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_bgroup.html", "cw_bgroup.pro", "", " Id: cw_bgroup pro 69 2006 05 11 10:35:53Z smasson Copyright c 1992 2005 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: CW_BGROUP PURPOSE: CW_BGROUP is a compound widget that simplifies creating a base of buttons It handles the details of creating the proper base standard exclusive or non exclusive and filling in the desired buttons Events for the individual buttons are handled transparently and a CW_BGROUP event returned This event can return any one of the following: The Index of the button within the base The widget ID of the button The name of the button An arbitrary value taken from an array of User values CATEGORY: Compound widgets CALLING SEQUENCE: Widget CW_BGROUP Parent Names To get or set the value of a CW_BGROUP use the GET_VALUE and SET_VALUE keywords to WIDGET_CONTROL The value of a CW_BGROUP is: Type Value normal None exclusive Index of currently set button non exclusive Vector indicating the position of each button 1 set 0 unset INPUTS: Parent: The ID of the parent widget Names: A string array containing one string per button giving the name of each button KEYWORD PARAMETERS: BUTTON_UVALUE: An array of user values to be associated with each button and returned in the event structure COLUMN: Buttons will be arranged in the number of columns specified by this keyword EVENT_FUNCT: The name of an optional user supplied event function for buttons This function is called with the return value structure whenever a button is pressed and follows the conventions for user written event functions EXCLUSIVE: Buttons will be placed in an exclusive base with only one button allowed to be selected at a time FONT: The name of the font to be used for the button titles If this keyword is not specified the default font is used FRAME: Specifies the width of the frame to be drawn around the base IDS: A named variable into which the button IDs will be stored as a longword vector LABEL_LEFT: Creates a text label to the left of the buttons LABEL_TOP: Creates a text label above the buttons MAP: If set the base will be mapped when the widget is realized the default NONEXCLUSIVE: Buttons will be placed in an non exclusive base The buttons will be independent NO_RELEASE: If set button release events will not be returned RETURN_ID: If set the VALUE field of returned events will be the widget ID of the button RETURN_INDEX: If set the VALUE field of returned events will be the zero based index of the button within the base THIS IS THE DEFAULT RETURN_NAME: If set the VALUE field of returned events will be the name of the button within the base ROW: Buttons will be arranged in the number of rows specified by this keyword SCROLL: If set the base will include scroll bars to allow viewing a large base through a smaller viewport SET_VALUE: The initial value of the buttons This is equivalent to the later statement: WIDGET_CONTROL widget set_value value SPACE: The space in pixels to be left around the edges of a row or column major base This keyword is ignored if EXCLUSIVE or NONEXCLUSIVE are specified UVALUE: The user value to be associated with the widget UNAME: The user name to be associated with the widget XOFFSET: The X offset of the widget relative to its parent XPAD: The horizontal space in pixels between children of a row or column major base Ignored if EXCLUSIVE or NONEXCLUSIVE are specified XSIZE: The width of the base X_SCROLL_SIZE: The width of the viewport if SCROLL is specified YOFFSET: The Y offset of the widget relative to its parent YPAD: The vertical space in pixels between children of a row or column major base Ignored if EXCLUSIVE or NONEXCLUSIVE are specified YSIZE: The height of the base Y_SCROLL_SIZE: The height of the viewport if SCROLL is specified OUTPUTS: The ID of the created widget is returned SIDE EFFECTS: This widget generates event structures with the following definition: event ID:0L TOP:0L HANDLER:0L SELECT:0 VALUE:0 The SELECT field is passed through from the button event VALUE is either the INDEX ID NAME or BUTTON_UVALUE of the button depending on how the widget was created RESTRICTIONS: Only buttons with textual names are handled by this widget Bitmaps are not understood MODIFICATION HISTORY: 15 June 1992 AB 7 April 1993 AB Removed state caching 6 Oct 1994 KDB Font keyword is not applied to the label 10 FEB 1995 DJC fixed bad bug in event procedure getting id of stash widget 11 April 1995 AB Removed Motif special cases pro CW_BGROUP_SETV id value compile_opt hidden ON_ERROR 2 return to caller stash WIDGET_INFO id CHILD WIDGET_CONTROL stash GET_UVALUE state NO_COPY case state type of 0: message unable to set plain button group value 1: begin WIDGET_CONTROL SET_BUTTON 0 state ids state excl_pos state excl_pos value WIDGET_CONTROL SET_BUTTON state ids value end 2: begin n n_elements value 1 for i 0 n do begin state nonexcl_curpos i value i WIDGET_CONTROL state ids i SET_BUTTON value i endfor end endcase WIDGET_CONTROL stash SET_UVALUE state NO_COPY end function CW_BGROUP_GETV id value compile_opt hidden ON_ERROR 2 return to caller stash WIDGET_INFO id CHILD WIDGET_CONTROL stash GET_UVALUE state NO_COPY case state type of 0: message unable to get plain button group value 1: ret state excl_pos 1: ret state ret_arr state excl_pos 2: ret state nonexcl_curpos 2: BEGIN index where state nonexcl_curpos NE 0 if index 0 EQ 1 then begin if size state ret_arr type EQ 7 then ret ELSE ret 1 ENDIF ELSE ret state ret_arr index END endcase WIDGET_CONTROL stash SET_UVALUE state NO_COPY return ret end function CW_BGROUP_EVENT ev compile_opt hidden WIDGET_CONTROL ev handler GET_UVALUE stash WIDGET_CONTROL stash GET_UVALUE state NO_COPY WIDGET_CONTROL ev id get_uvalue uvalue ret 1 Assume we return a struct case state type of 0: 1: if ev select eq 1 then begin state excl_pos uvalue ENDIF else begin if state no_release ne 0 then ret 0 ENDELSE 2: begin Keep track of the current state state nonexcl_curpos uvalue ev select if state no_release ne 0 and ev select eq 0 then ret 0 end endcase if ret then begin Return a struct ret ID:state base TOP:ev top HANDLER:0L SELECT:ev select VALUE:state ret_arr uvalue efun state efun WIDGET_CONTROL stash SET_UVALUE state NO_COPY if efun ne then return CALL_FUNCTION efun ret else return ret endif else begin Trash the event WIDGET_CONTROL stash SET_UVALUE state NO_COPY return 0 endelse end function CW_BGROUP parent names BUTTON_UVALUE button_uvalue COLUMN column EVENT_FUNCT efun EXCLUSIVE excl FONT font FRAME frame IDS ids LABEL_TOP label_top LABEL_LEFT label_left MAP map NONEXCLUSIVE nonexcl NO_RELEASE no_release RETURN_ID return_id RETURN_INDEX return_index RETURN_NAME return_name ROW row SCROLL scroll SET_VALUE sval SPACE space TAB_MODE tab_mode UVALUE uvalue XOFFSET xoffset XPAD xpad XSIZE xsize X_SCROLL_SIZE x_scroll_size YOFFSET yoffset YPAD ypad YSIZE ysize Y_SCROLL_SIZE y_scroll_size UNAME uname IF N_PARAMS ne 2 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller Set default values for the keywords version WIDGET_INFO version if version toolkit eq OLIT then def_space_pad 4 else def_space_pad 3 IF N_ELEMENTS column eq 0 then column 0 IF N_ELEMENTS excl eq 0 then excl 0 IF N_ELEMENTS frame eq 0 then frame 0 IF N_ELEMENTS map eq 0 then map 1 IF N_ELEMENTS nonexcl eq 0 then nonexcl 0 IF N_ELEMENTS no_release eq 0 then no_release 0 IF N_ELEMENTS row eq 0 then row 0 IF N_ELEMENTS scroll eq 0 then scroll 0 IF N_ELEMENTS space eq 0 then space def_space_pad IF N_ELEMENTS uname eq 0 then uname CW_BGROUP_UNAME IF N_ELEMENTS uvalue eq 0 then uvalue 0 IF N_ELEMENTS xoffset eq 0 then xoffset 0 IF N_ELEMENTS xpad eq 0 then xpad def_space_pad IF N_ELEMENTS xsize eq 0 then xsize 0 IF N_ELEMENTS x_scroll_size eq 0 then x_scroll_size 0 IF N_ELEMENTS yoffset eq 0 then yoffset 0 IF N_ELEMENTS ypad eq 0 then ypad def_space_pad IF N_ELEMENTS ysize eq 0 then ysize 0 IF N_ELEMENTS y_scroll_size eq 0 then y_scroll_size 0 top_base 0L if n_elements label_top ne 0 then begin next_base WIDGET_BASE parent XOFFSET xoffset YOFFSET yoffset COLUMN if keyword_set font then junk WIDGET_LABEL next_base value label_top font font else junk WIDGET_LABEL next_base value label_top top_base next_base endif else next_base parent if n_elements label_left ne 0 then begin next_base WIDGET_BASE next_base XOFFSET xoffset YOFFSET yoffset ROW if keyword_set font then junk WIDGET_LABEL next_base value label_left font font else junk WIDGET_LABEL next_base value label_left if top_base eq 0L then top_base next_base endif We need some kind of outer base to hold the users UVALUE if top_base eq 0L then begin top_base WIDGET_BASE parent XOFFSET xoffset YOFFSET yoffset next_base top_base endif If top_base EQ next_base THEN next_base WIDGET_BASE top_base Xpad 1 Ypad 1 Space 1 Set top level base attributes WIDGET_CONTROL top_base MAP map FUNC_GET_VALUE CW_BGROUP_GETV PRO_SET_VALUE CW_BGROUP_SETV SET_UVALUE uvalue SET_UNAME uname Tabbing if n_elements tab_mode ne 0 then begin WIDGET_CONTROL top_base TAB_MODE tab_mode WIDGET_CONTROL next_base TAB_MODE tab_mode end The actual button holding base base WIDGET_BASE next_base COLUMN column EXCLUSIVE excl FRAME frame NONEXCLUSIVE nonexcl ROW row SCROLL scroll SPACE space XPAD xpad XSIZE xsize X_SCROLL_SIZE x_scroll_size YPAD ypad YSIZE ysize Y_SCROLL_SIZE y_scroll_size EVENT_FUNC CW_BGROUP_EVENT UVALUE WIDGET_INFO top_base child n n_elements names ids lonarr n for i 0 n 1 do begin if n_elements font eq 0 then begin ids i WIDGET_BUTTON base value names i UVALUE i UNAME uname _BUTTON STRTRIM i 2 endif else begin ids i WIDGET_BUTTON base value names i FONT font UVALUE i UNAME uname _BUTTON STRTRIM i 2 endelse endfor Keep the state info in the real inner base UVALUE Pick an event value type: 0 Return ID 1 Return INDEX 2 Return NAME ret_type 1 if KEYWORD_SET RETURN_ID then ret_type 0 if KEYWORD_SET RETURN_NAME then ret_type 2 if KEYWORD_SET BUTTON_UVALUE then ret_type 3 case ret_type of 0: ret_arr ids 1: ret_arr indgen n 2: ret_arr names 3: ret_arr button_uvalue endcase type 0 if excl ne 0 then type 1 if nonexcl ne 0 then type 2 if n_elements efun le 0 then efun state type:type 0 Standard 1 Exclusive 2 Non exclusive base: top_base cw_bgroup base ret_arr:ret_arr Vector of event values efun : efun Name of event fcn nonexcl_curpos:intarr n If non exclus tracks state excl_pos:0 If exclusive current button ids:ids Ids of buttons no_release:no_release WIDGET_CONTROL WIDGET_INFO top_base CHILD SET_UVALUE state NO_COPY if n_elements sval ne 0 then CW_BGROUP_SETV top_base sval return top_base END"); 371 a[369] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_calendar.html", "cw_calendar.pro", "", " IDL testwid julday 1 1 1980 lindgen 100 5 PRO testwid_event event ComboboxId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy set :BEGIN widget_control event id get_value value widget_control ComboboxId set_value value END get :BEGIN widget_control ComboboxId get_value value help value struct END ELSE: endcase return end PRO testwid calendar date0 _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_calendar base calendar date0 _extra ex uname c est lui uvalue c est lui print cw_calendar ID nothing nothing widget_label base value end of the test nothing widget_text base value string calendar 0 uvalue set editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return END PRO cw_calendar_set_value id value compile_opt strictarr strictarrsubs cm_4cal get back the calendar and its related informations winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid key_caltype infowid caltype high freqeuncy calendar IF keyword_set infowid fakecal THEN BEGIN value2 date2jul long value infowid fakecal IF value2 LT n_elements infowid calendar AND value2 GE 0 THEN BEGIN stepid widget_info id find_by_uname step widget_control stepid set_value combobox_select:value2 infowid date jul2date value2 infowid fakecal widget_control winfo_id set_uvalue infowid ENDIF ENDIF ELSE BEGIN value long value 0 define year month day year value 10000l month value MOD 10000L 100L day value MOD 100L make sure the values correspond to real dates if year EQ 0 then year 1 if month EQ 0 then month 6 if day EQ 0 then day 15 check that the date exists in the calendar if where infowid calendar EQ julday month day year 0 EQ 1 then return update the value of infocal infowid date value widget_control winfo_id set_uvalue infowid update the combobox if needed possiblecase day month year for name 2 0 1 do BEGIN call set_cal_combobox with out 2 to specify that the call is coming from cw_calendar_set_value if widget_info id find_by_uname possiblecase name NE 0 then set_cal_combobox handler:id out:2 possiblecase name value ENDFOR ENDELSE return end FUNCTION cw_calendar_get_value id compile_opt strictarr strictarrsubs winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid return infowid date END FUNCTION get_cal_value id winfoid compile_opt strictarr strictarrsubs winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid oldate infowid date day wid_id widget_info id find_by_uname day if wid_id NE 0 then BEGIN widget_control wid_id get_value wid_value date long wid_value combobox_gettext ENDIF ELSE date oldate MOD 100L month wid_id widget_info id find_by_uname month if wid_id NE 0 then BEGIN widget_control wid_id get_value wid_value allmonths string format C CMoA 31 indgen 12 month where allmonths EQ wid_value combobox_gettext 0 1 date date 100L long month ENDIF ELSE date date oldate MOD 10000L 100L 100L year wid_id widget_info id find_by_uname year widget_control wid_id get_value wid_value date date 10000L long wid_value combobox_gettext IF arg_present winfoid NE 0 THEN BEGIN winfoid winfo_id infowid date date return infowid ENDIF ELSE return date end redefine the value and index position of the combobox PRO set_cal_combobox event casename date0 compile_opt strictarr strictarrsubs casename: Which widget shall we move: day month or year wid_id widget_info event handler find_by_uname casename we get back the calendar winfo_id widget_info event handler find_by_uname infocal widget_control winfo_id get_uvalue infowid caldat infowid calendar monthcal daycal yearcal and the current date IF n_elements date0 EQ 0 then date0 get_cal_value event handler year0 date0 10000L month0 date0 MOD 10000L 100L day0 date0 MOD 100L index of days months years according to date0 case casename of day :BEGIN list of days corresponding to month0 and year0 index where monthcal EQ month0 AND yearcal EQ year0 current daycal index END month :BEGIN list of months corresponding to year0 index where yearcal EQ year0 current monthcal index keep only the uniq values indexbis uniq current index index indexbis current current indexbis END year :BEGIN keep only the uniq years index uniq yearcal current yearcal index END ENDCASE we update the uvalue of the widget widget_control wid_id set_uvalue name:casename for event out 0 we store the previous position of the combobox to use it as the default position IF event out EQ 0 THEN widget_control wid_id get_value oldselect we redefine the new list if casename EQ month then begin widget_control wid_id set_value string format C CMoA 31 current 1 ENDIF ELSE BEGIN widget_control wid_id set_value strtrim current 1 ENDELSE specify the index position within the new list of values widget_control wid_id get_value combobox CASE event out OF 1: we put to the biggest position 1:selected combobox combobox_number 1 0: same as the previous position is the best choice 0:selected oldselect combobox_index combobox combobox_number 1 1: we put to the smallest position 1:selected 0 2: a new date has been specified 2:BEGIN case casename of day :selected where current EQ day0 0 month :selected where current EQ month0 0 year :selected where current EQ year0 0 ENDCASE END ENDCASE widget_control wid_id set_value combobox_select:selected update the date infowid date get_cal_value event handler widget_control winfo_id set_uvalue infowid return end move cyclicly the calendar to the value 0 if event out 1 or combobox_number 1 if event out 1 PRO move event casename compile_opt strictarr strictarrsubs possiblecase day month year impossiblecase id widget_info event handler find_by_uname casename widget_control id get_value wvalue we try to move but we are already at the beginning end of the combobox wvalue combobox_index EQ wvalue combobox_number 1 and event out EQ 1 wvalue combobox_index EQ 0 and event out EQ 1 move is not called when out eq 0 whichcase where possiblecase EQ casename 0 if wvalue combobox_index EQ wvalue combobox_number 1 event out EQ 1 THEN BEGIN if widget_info event handler find_by_uname possiblecase whichcase 1 EQ 0 then begin it is impossible to move the next combobox widget_control id get_value widvalue we set to widvalue combobox_number 1 when event out EQ 1 and to 0 when event out EQ 1 selected widvalue combobox_number 1 event out EQ 1 widget_control id set_value combobox_select:selected we call move for the next combobox ENDIF ELSE move event possiblecase whichcase 1 it is possible to move from 1 ENDIF ELSE widget_control id set_value combobox_select:wvalue combobox_index event out set_cal_combobox event possiblecase whichcase 1 return end FUNCTION cw_calendar_event event cm_4cal compile_opt strictarr strictarrsubs winfo_id widget_info event handler find_by_uname infocal widget_control winfo_id get_uvalue infowid key_caltype infowid caltype widget_control event id get_uvalue uval high frequency calendar IF uval name EQ step THEN BEGIN infowid date jul2date event index infowid fakecal ENDIF ELSE BEGIN possiblecase day month year impossiblecase whichcase where possiblecase EQ uval name 0 if event out NE 0 then BEGIN we use the button and we want to go out of the combobox: to index 1 event out 1 or to index combobox_number event out 1 we try to move the combobox just right with name: possiblecase whichcase 1 if widget_info event handler find_by_uname possiblecase whichcase 1 EQ 0 then BEGIN this widget do not exist we set cyclicly the current widget to the value 0 if event out 1 or combobox_number 1 if event out 1 widget_control event id get_value widvalue selected widvalue combobox_number 1 event out EQ 1 widget_control event id set_value combobox_select:selected ENDIF ELSE move event possiblecase whichcase 1 ENDIF if we changed month year we need to update the day and month list if uval name NE day then begin event out 0 for name whichcase 1 0 1 do BEGIN if widget_info event handler find_by_uname possiblecase name NE 0 then set_cal_combobox event possiblecase name endfor ENDIF we update the date infowid get_cal_value event handler winfo_id ENDELSE widget_control winfo_id set_uvalue infowid return CW_CALENDAR ID:event handler TOP:event top HANDLER:0L VALUE:infowid date FAKECAL: infowid fakecal end FUNCTION cw_calendar parent calendar jdate0 CALTYPE CALTYPE FAKECAL fakecal UVALUE uvalue UNAME uname _extra ex cm_4cal compile_opt strictarr strictarrsubs if keyword_set caltype then key_caltype caltype months days years found in the calendar caldat calendar monthcal daycal yearcal hourcal mincal scdcal starting date if n_elements jdate0 EQ 0 then jdate0 calendar 0 if where calendar EQ jdate0 0 EQ 1 then jdate0 calendar 0 caldat jdate0 month0 day0 year0 test the type of calendar if n_elements calendar GT 1 then BEGIN each day have the same value if n_elements uniq daycal sort daycal EQ 1 then monthly 1 each month and each day have the same value if keyword_set monthly AND n_elements uniq monthcal sort monthcal EQ 1 then yearly 1 endif if NOT keyword_set uvalue then uvalue dummy: if NOT keyword_set uname then uname base0 widget_base parent ROW EVENT_FUNC cw_calendar_event FUNC_GET_VALUE cw_calendar_get_value PRO_SET_VALUE cw_calendar_set_value UVALUE uvalue UNAME uname space 0 _extra ex if n_elements fakecal eq 0 then fakecal 0 base widget_base base0 space 0 uname infocal uvalue calendar:calendar date:jul2date jdate0 fakecal:fakecal caltype: key_caltype IF keyword_set fakecal THEN BEGIN cmbbid cw_combobox_pm base UVALUE name: step UNAME step value strtrim indgen n_elements calendar 1 widget_control cmbbid set_value combobox_select: where calendar EQ jdate0 0 ENDIF ELSE BEGIN vallen widget_info base string_size m day if NOT keyword_set monthly then begin dayindex where monthcal EQ month0 AND yearcal EQ year0 currentday daycal dayindex currentday strtrim currentday 1 cmbbid cw_combobox_pm base UVALUE name: day UNAME day value currentday widget_control cmbbid set_value combobox_select: where long currentday EQ day0 0 endif month if NOT keyword_set yearly then BEGIN monthindex where yearcal EQ year0 currentmonth long monthcal monthindex we suppress the repeted months monthindexbis uniq currentmonth sort currentmonth monthindex monthindex monthindexbis currentmonth currentmonth monthindexbis xoff 34 2 vallen 0 1 keyword_set monthly cmbbid cw_combobox_pm base UVALUE name: month UNAME month value string format C CMoA 31 currentmonth 1 xoffset xoff widget_control cmbbid set_value combobox_select: where long currentmonth EQ month0 0 endif year yearindex uniq yearcal sort yearcal currentyear strtrim yearcal yearindex 1 xoff 34 2 vallen 0 1 keyword_set monthly 33 3 vallen 0 1 keyword_set yearly cmbbid cw_combobox_pm base UVALUE name: year UNAME year value currentyear xoffset xoff widget_control cmbbid set_value combobox_select: where long currentyear EQ year0 0 ENDELSE return base end"); 372 a[370] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_combobox_pm.html", "cw_combobox_pm.pro", "", " NAME: cw_combobox_pm PURPOSE: widget equivalent a WIDGET_COMBOBOX sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_combobox_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_COMBOBOX OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by Combobox Widgets Pressing the mouse button while the mouse cursor is over an element of a combobox widget causes the widget to change the label on the combobox button and to generate an event The appearance of any previously selected element is restored to normal at the same time The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_COMBOBOX_PM ID:0L TOP:0L HANDLER:0L INDEX:0L OUT:0 The first three fields are the standard fields found in every widget event INDEX returns the index of the selected item This can be used to index the array of names originally used to set the widget s value OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que l index est deja aux max rq: ds ce cas l index reste au max 1: si on appuie sur alors que l index est deja aux min rq: ds ce cas l index reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 3 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_COMBOBOX: COMBOBOX_NUMBER: the number of elements currently contained in the specified combobox widget COMBOBOX_SELECT: the zero based number of the currently selected element i e the currently displayed element in the specified combobox widget DYNAMIC_RESIZE: a True value 1 if the widget specified by Widget_ID is a button combobox or label widget that has had its DYNAMIC_RESIZE attribute set Otherwise False 0 is returned 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la combobox comme on peut le faire pour WIDGET_COMBOBOX Impose peut etre: a The contents of the list widget string or string array b une structure qui peut avoir comme elements de 1 a 3 : DYNAMIC_RESIZE:Set this keyword to activate if set to 1 or deactivate if set to 0 dynamic resizing of the specified CW_COMBOBOX_PM widget see the documentation for the DYNAMIC_RESIZE keyword to WIDGET_COMBOBOX procedure for more information about dynamic widget resizing COMBOBOX_SELECT:Set this keyword to return the zero based number of the currently selected element i e the currently displayed element in the specified combobox widget VALUE: The contents of the list widget string or string array RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 6 9 1999 testwid value strtrim indgen 10 2 PRO testwid_event event help event STRUCT ComboboxId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy dynamic_resize :BEGIN widget_control event id get_value value widget_control ComboboxId set_value dynamic_resize:value END combobox_select :BEGIN widget_control event id get_value value widget_control ComboboxId set_value combobox_select:value END value :BEGIN widget_control event id get_value value widget_control ComboboxId set_value value END get :BEGIN widget_control ComboboxId get_value value help value struct END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_combobox_pm base _extra ex uname c est lui uvalue c est lui print cw_combobox_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue dynamic_resize editable nothing widget_text base value 10 uvalue combobox_select editable nothing widget_text base value 5 uvalue value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end PRO cw_combobox_pm_set_value id value ComboboxId widget_info id find_by_uname Combobox if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of dynamic_resize :widget_control ComboboxId dynamic_resize value dynamic_resize for compatibility droplist_select :widget_control ComboboxId set_combobox_select value droplist_select combobox_select :widget_control ComboboxId set_combobox_select value combobox_select value :widget_control ComboboxId set_value value value ELSE:ras report wrong tag name in argument value of cw_combobox_pm_set_value endcase endfor ENDIF ELSE widget_control ComboboxId set_value value return end FUNCTION cw_combobox_pm_get_value id ComboboxId widget_info id find_by_uname Combobox widget_control ComboboxId get_value cmbbval cmbbtxt widget_info ComboboxId combobox_gettext cmbbnumb widget_info ComboboxId combobox_number index where cmbbval EQ cmbbtxt 0 return combobox_number:cmbbnumb combobox_gettext:cmbbtxt combobox_index:index combobox_value:cmbbval dynamic_resize:widget_info ComboboxId dynamic_resize end FUNCTION cw_combobox_pm_event event widget_control event id get_uvalue uval if uval EQ Combobox then return CW_COMBOBOX_PM ID:event handler TOP:event top HANDLER:0L INDEX:event index STR:event str OUT:0 ComboboxId widget_info event handler find_by_uname Combobox widget_control ComboboxId get_value cmbbval cmbbtxt widget_info ComboboxId combobox_gettext cmbbnumb widget_info ComboboxId combobox_number index where cmbbval EQ cmbbtxt 0 out 0 case uval OF plus :BEGIN if index LT cmbbnumb 1 then BEGIN index index 1 widget_control ComboboxId set_combobox_select index ENDIF ELSE out 1 END minus :BEGIN if index GT 0 then BEGIN index index 1 widget_control ComboboxId set_combobox_select index ENDIF ELSE out 1 END endcase return CW_COMBOBOX_PM ID:event handler TOP:event top HANDLER:0L INDEX:index STR:cmbbtxt OUT:out end FUNCTION cw_combobox_pm parent VALUE value UVALUE uvalue UNAME uname ROW row COLUMN column _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller cheking for row and column keywords row keyword_set row 1 keyword_set column column keyword_set column 1 keyword_set row keyword_set column EQ row if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 0 EVENT_FUNC cw_combobox_pm_event FUNC_GET_VALUE cw_combobox_pm_get_value PRO_SET_VALUE cw_combobox_pm_set_value UVALUE uvalue UNAME uname _extra ex vallen widget_info base string_size m vallen 35 vallen 0 1 max strlen value if keyword_set row THEN BEGIN nothing widget_button base value uvalue minus xoffset 0 yoffset 5 xsize 15 ysize 15 nothing widget_combobox base VALUE value UVALUE Combobox UNAME Combobox xoffset 13 yoffset 0 xsize vallen nothing widget_button base value uvalue plus xoffset vallen 11 yoffset 5 xsize 15 ysize 15 ENDIF ELSE BEGIN nothing widget_combobox base VALUE value UVALUE Combobox UNAME Combobox xoffset 0 yoffset 0 xsize vallen nothing widget_button base value uvalue minus xoffset vallen 2 15 yoffset 24 xsize 15 ysize 15 nothing widget_button base value uvalue plus xoffset vallen 2 yoffset 24 xsize 15 ysize 15 ENDELSE widget_control base realize return base end"); 373 a[371] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_domain.html", "cw_domain.pro", "", " IDL testwid PRO testwid_event event help event struct Id widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy set :BEGIN widget_control event id get_value value value value 0 nothing execute boxzoom value widget_control Id set_value boxzoom END get :BEGIN widget_control Id get_value value print value END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_domain base _extra ex uname c est lui uvalue c est lui print cw_domain ID nothing nothing widget_label base value end of the test nothing widget_text base value 40 100 10 10 uvalue set editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end pro cw_domain_set_value id value cm_4mesh topid findtopid id widget_control topid get_uvalue top_uvalue make sure that we have the good grid stored in the cm_4mesh common parameters currentfile extractatt top_uvalue currentfile currentgrid extractatt top_uvalue meshparameters currentfile change changegrid currentgrid quel est le type de boxzoom currentplot extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags currentplot IF flags where options EQ Longitude x index 0 EQ 0 THEN xtype geographic ELSE xtype index IF flags where options EQ Latitude y index 0 EQ 0 THEN ytype geographic ELSE ytype index comment completer la boxzoom IF xtype EQ geographic then begin lonn1 lon1 lonn2 lon2 xtitle lon ENDIF ELSE BEGIN lonn1 firstxt lonn2 lastxt xtitle x ind ENDELSE IF ytype EQ geographic then begin latt1 lat1 latt2 lat2 ytitle lat ENDIF ELSE BEGIN latt1 firstyt latt2 lastyt ytitle y ind ENDELSE vertf1 floor min gdepw 0 gdept 0 vertf2 ceil max gdepw 0 gdept 0 Case N_Elements Value OF 0:boxzoom lonn1 lonn2 latt1 latt2 vertf1 vertf2 1:BEGIN if value EQ 1 then boxzoom lonn1 lonn2 latt1 latt2 vertf1 vertf2 ELSE boxzoom lonn1 lonn2 latt1 latt2 0 value 0 END 2:boxzoom lonn1 lonn2 latt1 latt2 value 0 value 1 4:boxzoom Value 5:boxzoom Value 0:3 0 Value 4 6:boxzoom Value Else:BEGIN rien report Wrong Definition of Boxzoom END ENDCASE boxzoom 0 floor boxzoom 0 boxzoom 1 ceil boxzoom 1 boxzoom 2 floor boxzoom 2 boxzoom 3 ceil boxzoom 3 if n_elements boxzoom GE 5 then begin boxzoom 4 floor boxzoom 4 boxzoom 5 ceil boxzoom 5 endif widget_control widget_info id find_by_uname lon1 get_uvalue uvalue strict uvalue strict les longitudes min et max possible if xtype EQ geographic then BEGIN min floor min glamt glamf max max max ceil max ENDIF ELSE BEGIN min 0 max jpi 1 ENDELSE les id des widgets lon1id widget_info id find_by_uname lon1 lon2id widget_info id find_by_uname lon2 doit on changer de type d axe x: longitude index lonbase widget_info id find_by_uname lonbase widget_control lonbase get_uvalue lonbase_uvalue if lonbase_uvalue name NE xtype then BEGIN widget_control lonbase update 0 on casse tout widget_control lon1id destroy widget_control lon2id destroy on reconstruit lon1id cw_slider_pm lonbase value min boxzoom 0 boxzoom 0 keyword_set strict boxzoom 1 boxzoom 0 keyword_set strict widget_control lonbase set_uvalue name:xtype widget_control lonbase update 1 ENDIF ELSE BEGIN la nouvelle valeur qu ils vont avoir cursorvalue1 min boxzoom 0 boxzoom 0 strict boxzoom 1 boxzoom 2 boxzoom 2 keyword_set strict boxzoom 3 boxzoom 2 keyword_set strict widget_control latbase set_uvalue name:ytype widget_control latbase update 1 ENDIF ELSE BEGIN cursorvalue1 min boxzoom 2 boxzoom 2 strict boxzoom 3 indice2 1 if indice1 EQ indice2 then BEGIN if where gdep1 GE boxzoom 4 AND gdep2 LE boxzoom 5 0 EQ 1 then begin indice1 0 indice1 dthlv1_uval grid_t EQ 1 indice2 indice1 endif boxzoom 4 gdep1 indice1 boxzoom 5 boxzoom 4 1 endif maintenant que les values et les indexes sont definis proprement on peut les appliquer widget_control dthlv1id set_value combobox_select:indice1 widget_control dthlv2id set_value combobox_select:indice2 controler les min et les max des sliders if indice1 EQ 0 then min1 0 ELSE min1 gdep2 indice1 1 max1 min1 1 gdep1 indice2 widget_control depth1id set_value slider_min:min1 slider_max:max1 value:boxzoom 4 min2 gdep2 indice1 if indice2 EQ jpk 1 then BEGIN max2 max gdept gdepw max2 strtrim string max2 format e8 0 1 max2 float 1 strmid max2 1 float max2 ENDIF ELSE max2 gdep1 indice2 1 widget_control depth2id set_value slider_min:min2 slider_max:max2 value:boxzoom 5 return end FUNCTION cw_domain_get_value id box lonarr 6 possiblecase lon1 lon2 lat1 lat2 depth1 depth2 for i 0 5 do begin widget_control widget_info id find_by_uname possiblecase i get_value value box i value value endfor return box end FUNCTION cw_domain_event event common help struct event if where tag_names event EQ OUT 0 NE 1 then if event out NE 0 then return 1 widget_control event id get_uvalue uval case uval name of lon1 :widget_control widget_info event handler find_by_uname lon2 set_value slider_min:event value uval strict lon2 :widget_control widget_info event handler find_by_uname lon1 set_value slider_max:event value uval strict lat1 :widget_control widget_info event handler find_by_uname lat2 set_value slider_min:event value uval strict lat2 :widget_control widget_info event handler find_by_uname lat1 set_value slider_max:event value uval strict unzoom :BEGIN id widget_info event handler find_by_uname lon1 widget_control id get_value value widget_control id set_value slider_min:value slider_min_max 0 widget_control id set_value value slider_min_max 0 id widget_info event handler find_by_uname lat1 widget_control id get_value value widget_control id set_value slider_min:value slider_min_max 0 widget_control id set_value value slider_min_max 0 id widget_info event handler find_by_uname lon2 widget_control id get_value value widget_control id set_value slider_max:value slider_min_max 1 widget_control id set_value value slider_min_max 1 id widget_info event handler find_by_uname lat2 widget_control id get_value value widget_control id set_value slider_max:value slider_min_max 1 widget_control id set_value value slider_min_max 1 END dthlv1 :BEGIN ids depth1id widget_info event handler find_by_uname depth1 depth2id widget_info event handler find_by_uname depth2 dthlv2id widget_info event handler find_by_uname dthlv2 faut il changer dthlv2 widget_control event id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value widget_control dthlv2id get_value dthlv2_value gdep2 fix dthlv2_value combobox_value if dthlv2_value combobox_index LT event index then BEGIN on redefinie la valeur de dthlv2id widget_control dthlv2id set_value combobox_select:event index donc on redefinit la valeur et le max du slider 2 if event index EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 event index 1 1 widget_control depth2id set_value slider_max:max value:gdep2 event index du coup on redefinie donc le max du slider 1 widget_control depth1id set_value slider_max:gdep1 event index END on redefinie la valeur et le min du slider depth 1 if event index EQ 0 then min 0 ELSE min gdep1 event index 1 1 widget_control depth1id set_value slider_min:min value:gdep1 event index du coup on change aussi la valeur du min du slider depth 2 widget_control depth2id set_value slider_min:gdep1 event index 1 END dthlv2 :BEGIN ids depth1id widget_info event handler find_by_uname depth1 depth2id widget_info event handler find_by_uname depth2 dthlv1id widget_info event handler find_by_uname dthlv1 faut il changer dthlv1 widget_control dthlv1id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value widget_control event id get_value dthlv2_value gdep2 fix dthlv2_value combobox_value if dthlv1_value combobox_index GT event index then BEGIN on redefinie la valeur de dthlv1id widget_control dthlv1id set_value combobox_select:event index donc on redefinit la valeur et le min du slider 1 if event index EQ 0 then min 0 ELSE min gdep2 event index 1 widget_control depth1id set_value slider_min:min value:gdep1 event index du coup on redefinie donc le min du slider 2 widget_control depth2id set_value slider_min:gdep2 event index END on redefinie la valeur et le max du slider depth 2 if event index EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 event index 1 1 widget_control depth2id set_value slider_max:max value:gdep2 event index du coup on change aussi la valeur du max du slider depth 1 widget_control depth1id set_value slider_max:gdep2 event index 1 END depth1 :BEGIN ids depth2id widget_info event handler find_by_uname depth2 dthlv1id widget_info event handler find_by_uname dthlv1 doit on changer dthlv1 widget_control dthlv1id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value rien where gdep1 LT event value indice indice indice indice 1 if indice NE dthlv2_value combobox_index then begin on change le max de depth1 widget_control depth1id set_value slider_max:gdep2 indice 1 on redefinie la valeur de dthlv2id widget_control dthlv2id set_value combobox_select:indice donc on redefinit le max du slider 2 if indice EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 indice 1 1 widget_control event id set_value slider_max:max endif END ELSE: ENDCASE slidesliceid widget_info event top find_by_uname slide_slice if slidesliceid NE 0 then widget_control slidesliceid set_value 1 return ID:event handler TOP:event top HANDLER:0L BOX:cw_domain_get_value event handler end FUNCTION cw_domain parent BOXZOOM boxzoom STRICT strict UVALUE uvalue UNAME uname UNZOOM unzoom _extra ex cm_4mesh cm_4data def de la boxzoom Case N_Elements Boxzoom OF 0:boxzoom lon1 lon2 lat1 lat2 min gdepw 0 gdept 0 max gdepw 0 gdept 0 1:boxzoom lon1 lon2 lat1 lat2 0 boxzoom 0 2:boxzoom lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4:boxzoom Boxzoom vert1 vert2 5:boxzoom Boxzoom 0:3 0 Boxzoom 4 6: Else: return report Mauvaise Definition de Boxzoom ENDCASE IF total Boxzoom EQ 0 THEN boxzoom lon1 lon2 lat1 lat2 min gdepw 0 gdept 0 max gdepw 0 gdept 0 boxzoom 0 floor boxzoom 0 boxzoom 1 ceil boxzoom 1 boxzoom 2 floor boxzoom 2 boxzoom 3 ceil boxzoom 3 boxzoom 4 floor boxzoom 4 boxzoom 5 ceil boxzoom 5 if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent row 2 space 0 EVENT_FUNC cw_domain_event FUNC_GET_VALUE cw_domain_get_value PRO_SET_VALUE cw_domain_set_value UVALUE uvalue UNAME uname _extra ex baseh widget_base base column 1 keyword_set unzoom space 0 baseh1 widget_base baseh row 2 space 0 longitude min floor min glamt glamf max max max ceil max IF max min EQ 361 AND keyword_set key_periodic THEN max max 1 lonbase widget_base baseh1 column 2 space 0 uname lonbase uvalue name: geographic lon1id cw_slider_pm lonbase value min boxzoom 0 boxzoom 0 keyword_set strict boxzoom 1 boxzoom 0 keyword_set strict latitude min floor min gphit gphif max max max ceil max latbase widget_base baseh1 column 2 space 0 uname latbase uvalue name: geographic lat1id cw_slider_pm latbase value min boxzoom 2 boxzoom 2 keyword_set strict boxzoom 3 boxzoom 2 keyword_set strict unzoom if keyword_set unzoom then rien widget_button baseh value unzoom uvalue name: unzoom xsize 60 ysize 110 depth basez widget_base base column 3 space 0 base_align_center basezdrp widget_base basez row 2 space 0 if strupcase vargrid EQ W then gdep gdepw ELSE gdep gdept gdep1 floor gdep gdep2 ceil gdep same where gdep2 gdep1 EQ 0 if same 0 NE 1 then gdep2 same gdep2 same 1 sgdep1 strtrim gdep1 1 sgdep2 strtrim gdep2 1 dephtid cw_combobox_pm basezdrp value sgdep1 uvalue name: dthlv1 grid_t:strupcase vargrid NE W uname dthlv1 rien where gdep1 LT boxzoom 4 indice1 indice1 indice1 indice2 1 widget_control dephtid set_value combobox_select:indice2 basedepthslid widget_base base column 2 space 0 strminlen max strlen strtrim round gdept gdepw 1 if indice1 EQ 0 then min1 0 ELSE min1 gdep2 indice1 1 max1 min1 1 gdep1 indice2 rien cw_slider_pm basez value min1 boxzoom 4 boxzoom 4 boxzoom 5 max2 uvalue name: depth2 minimum min2 maximum max2 uname depth2 title z2 strminlen strminlen return base end"); 374 a[372] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_droplist_pm.html", "cw_droplist_pm.pro", "", " NAME: cw_droplist_pm PURPOSE: widget equivalent a WIDGET_DROPLIST sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_droplist_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_DROPLIST OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by Droplist Widgets Pressing the mouse button while the mouse cursor is over an element of a droplist widget causes the widget to change the label on the droplist button and to generate an event The appearance of any previously selected element is restored to normal at the same time The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_DROPLIST_PM ID:0L TOP:0L HANDLER:0L INDEX:0L OUT:0 The first three fields are the standard fields found in every widget event INDEX returns the index of the selected item This can be used to index the array of names originally used to set the widget s value OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que l index est deja aux max rq: ds ce cas l index reste au max 1: si on appuie sur alors que l index est deja aux min rq: ds ce cas l index reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 3 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_DROPLIST: DROPLIST_NUMBER: the number of elements currently contained in the specified droplist widget DROPLIST_SELECT: the zero based number of the currently selected element i e the currently displayed element in the specified droplist widget DYNAMIC_RESIZE: a True value 1 if the widget specified by Widget_ID is a button droplist or label widget that has had its DYNAMIC_RESIZE attribute set Otherwise False 0 is returned 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la droplist comme on peut le faire pour WIDGET_DROPLIST Impose peut etre: a The contents of the list widget string or string array b une structure qui peut avoir comme elements de 1 a 3 : DYNAMIC_RESIZE:Set this keyword to activate if set to 1 or deactivate if set to 0 dynamic resizing of the specified CW_DROPLIST_PM widget see the documentation for the DYNAMIC_RESIZE keyword to WIDGET_DROPLIST procedure for more information about dynamic widget resizing DROPLIST_SELECT:Set this keyword to return the zero based number of the currently selected element i e the currently displayed element in the specified droplist widget VALUE: The contents of the list widget string or string array RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 6 9 1999 PRO testwid_event event help event STRUCT DroplistId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy dynamic_resize :BEGIN widget_control event id get_value value widget_control DroplistId set_value dynamic_resize:value END droplist_select :BEGIN widget_control event id get_value value widget_control DroplistId set_value droplist_select:value END value :BEGIN widget_control event id get_value value widget_control DroplistId set_value value END get :BEGIN widget_control DroplistId get_value value help value struct END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_droplist_pm base _extra ex uname c est lui uvalue c est lui print cw_droplist_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue dynamic_resize editable nothing widget_text base value 10 uvalue droplist_select editable nothing widget_text base value 5 uvalue value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end PRO cw_droplist_pm_set_value id value DroplistId widget_info id find_by_uname Droplist if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of dynamic_resize :widget_control DroplistId dynamic_resize value dynamic_resize droplist_select :widget_control DroplistId set_droplist_select value droplist_select value :widget_control DroplistId set_value value value ELSE:ras report mauvais nom de l argument de la structure ds cw_droplist_pm_set_value endcase endfor ENDIF ELSE widget_control DroplistId set_value value return end FUNCTION cw_droplist_pm_get_value id DroplistId widget_info id find_by_uname Droplist return droplist_number:widget_info DroplistId droplist_number droplist_select:widget_info DroplistId droplist_select dynamic_resize:widget_info DroplistId dynamic_resize end FUNCTION cw_droplist_pm_event event widget_control event id get_uvalue uval if uval EQ Droplist then return CW_DROPLIST_PM ID:event handler TOP:event top HANDLER:0L INDEX:event index OUT:0 DroplistId widget_info event handler find_by_uname Droplist index widget_info DroplistId droplist_select case uval OF plus :BEGIN indexmax widget_info DroplistId droplist_number 1 if index NE indexmax then widget_control DroplistId set_droplist_select index 1 return CW_DROPLIST_PM ID:event handler TOP:event top HANDLER:0L INDEX: index 1 index 1 OUT: long index EQ 0 END endcase end FUNCTION cw_droplist_pm parent UVALUE uvalue UNAME uname ROW row COLUMN column _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller cheking for row and column keywords row keyword_set row 1 keyword_set column column keyword_set column 1 keyword_set row keyword_set column EQ row if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 1 xpad 1 ypad 1 ROW row COLUMN column EVENT_FUNC cw_droplist_pm_event FUNC_GET_VALUE cw_droplist_pm_get_value PRO_SET_VALUE cw_droplist_pm_set_value UVALUE uvalue UNAME uname _extra ex if keyword_set row THEN nothing widget_button base value uvalue minus nothing widget_droplist base UVALUE Droplist UNAME Droplist _extra ex if keyword_set column then begin base1 widget_base base row align_center space 1 xpad 1 ypad 1 nothing widget_button base1 value uvalue minus xsize 20 ysize 20 nothing widget_button base1 value uvalue plus xsize 20 ysize 20 ENDIF ELSE nothing widget_button base value uvalue plus widget_control base realize return base end"); 375 a[373] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_pagelayout.html", "cw_pagelayout.pro", "", " FUNCTION cw_pagelayout_event event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout if uval name EQ undo then begin return ID:event handler TOP:event top HANDLER:0L ENDIF ELSE BEGIN common si on ne change pas le nombre de colonnes on sort if uval name EQ column then if event index 1 EQ smallin 0 THEN return ID:event handler TOP:event top HANDLER:0L si on ne change pas le nombre de lignes on sort if uval name EQ row then if event index 1 EQ smallin 1 THEN return ID:event handler TOP:event top HANDLER:0L on efface la page graphid widget_info event top find_by_uname graph graphid extractatt top_uvalue graphid widget_control graphid get_value win wset win erase 255 case uval name of clear : column :BEGIN smallin event index 1 smallin 1 1 smallout event index 1 smallout 1 1 END row :BEGIN smallin smallin 0 event index 1 1 smallout smallout 0 event index 1 1 END endcase nbredessin smallin 0 smallin 1 on remet tout a 0 en ce qui concerne les postscripts createhistory event top smallin options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flag flags numdessinin update and reset all values of the top_uvalue top_uvalue 1 findline top_uvalue smallin smallin top_uvalue 1 findline top_uvalue smallout smallout top_uvalue 1 findline top_uvalue penvs replicate p nbredessin top_uvalue 1 findline top_uvalue xenvs replicate x nbredessin top_uvalue 1 findline top_uvalue yenvs replicate y nbredessin top_uvalue 1 findline top_uvalue nameprocedures strarr nbredessin top_uvalue 1 findline top_uvalue types strarr nbredessin top_uvalue 1 findline top_uvalue varinfo strarr 2 nbredessin top_uvalue 1 findline top_uvalue domaines fltarr 6 nbredessin top_uvalue 1 findline top_uvalue dates lonarr 2 nbredessin top_uvalue 1 findline top_uvalue txtcmd strarr nbredessin top_uvalue 1 findline top_uvalue optionsflag flag replicate 1 nbredessin ptr_free extractatt top_uvalue exextra top_uvalue 1 findline top_uvalue exextra ptrarr nbredessin allocate_heap top_uvalue 1 findline top_uvalue ENDELSE return ID:event handler TOP:event top HANDLER:0L end FUNCTION cw_pagelayout parent small UVALUE uvalue UNAME uname UNZOOM unzoom COLUMN column ROW row _extra ex row keyword_set row 1 keyword_set column if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent EVENT_FUNC cw_pagelayout_event FUNC_GET_VALUE cw_pagelayout_get_value PRO_SET_VALUE cw_pagelayout_set_value UVALUE uvalue UNAME uname space 0 _extra ex IF n_elements small eq 0 then small 1 1 1 dummy widget_label base value cln yoffset 3 id widget_combobox base value strtrim indgen 9 1 1 uvalue name: column uname column xoffset 20 xsize 40 widget_control id set_combobox_select small 0 1 IF keyword_set row THEN BEGIN xoff 60 yoff 0 ENDIF ELSE BEGIN xoff 0 yoff 20 ENDELSE dummy widget_label base value row xoffset xoff yoffset yoff 3 id widget_combobox base value strtrim indgen 9 1 1 uvalue name: row uname row xoffset xoff 20 xsize 40 yoffset yoff widget_control id set_combobox_select small 1 1 return base end "); 376 a[374] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_slide_slice.html", "cw_slide_slice.pro", "", "pro cw_slide_slice_set_value id value common topid findtopid id domainid widget_info topid find_by_uname domain widget_control domainid get_value boxzoom if boxzoom 1 boxzoom 0 LT boxzoom 3 boxzoom 2 then type y ELSE type x thickid widget_info topid find_by_uname thickness widget_control thickid get_uvalue thicknessuval widget_control thickid get_value thickness thickness thicknessuval choix thickness droplist_select sliderid widget_info topid find_by_uname slider if type EQ y then BEGIN mini floor min glamt glamf max maxi maxi ceil maxi thickness widget_control sliderid set_value slider_min:mini slider_max:maxi value:boxzoom 0 maxi value mini boxzoom 0 maxi value mini boxzoom 2 maxi column uname slider uvalue name: slider ENDELSE index where thicknessval EQ thickness index index 0 if index EQ 1 then BEGIN index 20 thicknessval 20 strtrim thickness 1 widget_control droplistid set_value thicknessval widget_control droplistid set_uvalue name: thickness choix:thicknessval endif widget_control droplistid set_value droplist_select:index if type EQ xt then begin mini floor min glamt glamf max maxi maxi ceil maxi ENDIF ELSE BEGIN mini floor min gphit gphif max maxi maxi ceil maxi ENDELSE return base end"); 377 a[375] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_slider_pm.html", "cw_slider_pm.pro", "", " NAME: cw_slider_pm PURPOSE: widget equivalent a WIDGET_SLIDER sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_slider_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_SLIDER OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by the CW_SLIDER_PM Widget Slider widgets generate events when the mouse is used to change their value The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_SLIDER_PM ID:0L TOP:0L HANDLER:0L VALUE:0L DRAG:0 OUT:0 ID is the widget ID of the button generating the event TOP is the widget ID of the top level widget containing ID HANDLER contains the widget ID of the widget associated with the handler routine VALUE returns the new value of the slider DRAG returns integer 1 if the slider event was generated as part of a drag operation or zero if the event was generated when the user had finished positioning the slider Note that the slider widget only generates events during the drag operation if the DRAG keyword is set and if the application is running under Motif When the DRAG keyword is set the DRAG field can be used to avoid computationally expensive operations until the user releases the slider OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que le slider est deja aux max rq: ds ce cas le slider reste au max 1: si on appuie sur alors que le slider est deja aux min rq: ds ce cas le slider reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 2 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_SLIDER: VALUE:the value setting of the widget SLIDER_MIN_MAX: a 2 elements array: The minimum and the maximum value of the range encompassed by the slider 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la slider bar comme on peut le faire pour WIDGET_SLIDER Impose peut etre: a un entier: donne la nouvelle position of the slider b une structure qui peut avoir comme elements de 1 a 3 : VALUE:un entier qui donne la nouvelle position of the slider SLIDER_MIN:Set to a new minimum value for the specified slider widget SLIDER_MAX:Set to a new minimum value for the specified slider widget RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 5 9 1999 PRO testwid_event event help event STRUCT SliderBarId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy slider_min :BEGIN widget_control event id get_value value widget_control SliderBarId set_value slider_min:value END slider_max :BEGIN widget_control event id get_value value widget_control SliderBarId set_value slider_max:value END slider_value :BEGIN widget_control event id get_value value widget_control SliderBarId set_value value END get :BEGIN widget_control SliderBarId get_value value help value struct print value slider_min_max END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_slider_pm base _extra ex uname c est lui uvalue c est lui print cw_slider_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue slider_min editable nothing widget_text base value 10 uvalue slider_max editable nothing widget_text base value 5 uvalue slider_value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end FUNCTION decvalue value a float value 0 return strtrim string floor a 0 1 indgen 10 format f15 1 2 end FUNCTION decind value a float value 0 return round 10 a floor a computation accuracy end PRO cw_slider_pm_set_value id value sbid widget_info id find_by_uname SliderBar dcid widget_info id find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of slider_min :BEGIN IF float value slider_min 0 LT minmax 1 THEN BEGIN minmax 0 value slider_min 0 widget_control sbid set_slider_min floor float value slider_min 0 valuedc float widget_info dcid combobox_gettext IF valuedc LT value slider_min THEN BEGIN widget_control sbid set_value floor float value slider_min 0 widget_control dcid set_value decvalue value slider_min widget_control dcid set_combobox_select decind value slider_min ENDIF ENDIF end slider_max :BEGIN IF float value slider_max 0 GT minmax 0 THEN BEGIN minmax 1 value slider_max 0 widget_control sbid set_slider_max ceil float value slider_max 0 valuedc float widget_info dcid combobox_gettext IF valuedc GT value slider_max THEN BEGIN widget_control sbid set_value ceil float value slider_max 0 widget_control dcid set_value decvalue value slider_max widget_control dcid set_combobox_select decind value slider_max ENDIF ENDIF end value :IF float value value 0 GE minmax 0 AND float value value 0 LE minmax 1 THEN value2 float value value 0 ELSE:ras report wrong tag name in argument value of cw_slider_pm_set_value endcase endfor ENDIF ELSE BEGIN IF float value 0 GE minmax 0 AND float value 0 LE minmax 1 THEN value2 float value 0 ENDELSE IF n_elements value2 NE 0 THEN BEGIN widget_control sbid set_value fix value2 widget_control dcid set_value decvalue value2 widget_control dcid set_combobox_select decind value2 ENDIF return end FUNCTION cw_slider_pm_get_value id sbid widget_info id find_by_uname SliderBar dcid widget_info id find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX value float widget_info dcid combobox_gettext return value:value slider_min_max:minmax end FUNCTION cw_slider_pm_event event widget_control event id get_uvalue uval sbid widget_info event handler find_by_uname SliderBar dcid widget_info event handler find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX IF uval EQ decimal THEN value float event str ELSE value float widget_info dcid combobox_gettext out 0 defaut case case uval OF plus : if value 1 LE minmax 1 then value2 value 1 ELSE out 1 minus :if value 1 GE minmax 0 then value2 value 1 ELSE out 1 SliderBar :if event value value floor value LE minmax 1 THEN value2 event value value floor value decimal :BEGIN CASE 1 OF value GT minmax 1 : value2 minmax 1 value LT minmax 0 : value2 minmax 0 ELSE: ENDCASE END ELSE: ENDCASE IF n_elements value2 NE 0 THEN BEGIN value value2 widget_control sbid set_value floor value widget_control dcid set_value decvalue value widget_control dcid set_combobox_select decind value ENDIF return CW_SLIDER_PM ID:event handler TOP:event top HANDLER:0L VALUE:value OUT:OUT end FUNCTION cw_slider_pm parent MAXIMUM maximum MINIMUM minimum STRMINLEN strminlen VALUE value UVALUE uvalue UNAME uname title title _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller if n_elements minimum NE 0 then minimum floor minimum ELSE minimum 0 if n_elements maximum NE 0 then maximum ceil maximum ELSE maximum 100 if NOT keyword_set title then title cheking exclusive keywords column keyword_set column 1 keyword_set row keyword_set vertical xsize lenstr max strlen strtrim minimum maximum 1 if keyword_set strminlen then lenstr strminlen lenstr xsize 35 mlen lenstr 1 3 lenstr lt 4 xsize 35 mlen lenstr 2 dummyid widget_combobox base value decvalue minimum UVALUE decimal UNAME decimal xoffset xoff yoffset 2 xsize xsize dummyid widget_slider base MAXIMUM maximum MINIMUM minimum UVALUE SliderBar UNAME SliderBar suppress_value drag yoffset 30 xsize xoff xsize if keyword_set value then cw_slider_pm_set_value base value return base end"); 378 a[376] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_specifie.html", "cw_specifie.pro", "", " PRO cw_specifie_set_value id value cm_general if size value type NE 8 then return widget_control widget_info id find_by_uname min set_value strtrim value min 2 widget_control widget_info id find_by_uname max set_value strtrim value max 2 widget_control widget_info id find_by_uname int set_value strtrim value inter 2 widget_control widget_info id find_by_uname palnum set_value strtrim value lct 2 autres extractstru value min max inter lct nothing xindex yindex if size autres type EQ 8 then BEGIN autresid widget_info id find_by_uname autres widget_control widget_info id find_by_uname autres get_value autresautres autresautres autresautres 0 if strtrim autresautres 2 NE then begin autresautres createfunc get_extra autresautres filename myuniquetmpdir for_createfunc pro autres mixstru autres autresautres endif autres strkeywd autres widget_control widget_info id find_by_uname autres set_value autres endif return end FUNCTION cw_specifie_get_value id cm_general widget_control widget_info id find_by_uname min get_value min min float min 0 widget_control widget_info id find_by_uname max get_value max max float max 0 widget_control widget_info id find_by_uname int get_value int int float int 0 widget_control widget_info id find_by_uname palnum get_value palnum palnum long palnum 0 widget_control widget_info id find_by_uname autres get_value autres autres autres 0 exextra min:min max:max inter:int lct:palnum if strtrim autres 2 NE then exextra createfunc get_extra autres _extra exextra kwdlist exextra exextra exextra exextra filename myuniquetmpdir for_createfunc pro return exextra end FUNCTION cw_specifie_event event on recuper les ID des differents widgets widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 case uval of default :BEGIN on trouve le nom de la variable: vlstid widget_info event top find_by_uname varlist fieldname widget_info vlstid combobox_gettext exextra definedefaultextra fieldname widget_control widget_info event handler find_by_uname min set_value strtrim exextra min 1 widget_control widget_info event handler find_by_uname max set_value strtrim exextra max 1 widget_control widget_info event handler find_by_uname int set_value strtrim exextra inter 1 widget_control widget_info event handler find_by_uname palnum set_value strtrim exextra lct 1 widget_control widget_info event handler find_by_uname autres set_value END palcol :BEGIN ind fix strmid event value 0 strpos event value widget_control widget_info event handler find_by_uname palnum set_value strtrim ind 1 END ELSE: endcase return ID:event handler TOP:event top HANDLER:0L OK:uval EQ ok end FUNCTION cw_specifie parent ROW row COLUMN column UVALUE uvalue UNAME uname FRAME frame FORXXX forxxx _extra ex cheking exclusive keywords column keyword_set column 1 keyword_set row row keyword_set row 1 keyword_set column keyword_set row EQ column if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 0 frame EVENT_FUNC cw_specifie_event FUNC_GET_VALUE cw_specifie_get_value PRO_SET_VALUE cw_specifie_set_value UVALUE uvalue UNAME uname _extra ex base1 base1 widget_base base rien widget_label base1 value Min xoffset 85 yoffset 15 rien widget_label base1 value Max xoffset 145 yoffset 15 rien widget_label base1 value Int xoffset 210 yoffset 15 lct get_name nomcouleur nbrligne 30 nbrlist n_elements nomcouleur nbrligne nomcouleur strtrim sindgen n_elements nomcouleur 1 nomcouleur nomcouleur 0 nomcouleur nomcouleur 1 Color nomcouleur if nbrlist GT 1 then for i 1 nbrlist do nomcouleur nomcouleur 0:nbrligne i 1 i 1 nomcouleur nbrligne i i:n_elements nomcouleur 1 rien cw_pdmenu base1 nomcouleur RETURN_NAME uvalue palcol uname palcol xoffset 250 yoffset 0 base2 base2 widget_base base column 4 keyword_set forxxx yoffset 30 if keyword_set forxxx then rien widget_button base2 value Default uvalue default frame tooltip see find definedefaultextra 0 rien widget_text base2 value editable xsize 7 uname min uvalue min rien widget_text base2 value editable xsize 7 uname max uvalue max rien widget_text base2 value editable xsize 7 uname int uvalue int if keyword_set forxxx then colvalue ELSE colvalue 39 rien widget_text base2 value colvalue editable xsize 2 uname palnum uvalue palnum widget text contennant les autres mots cles passe ds top_uvalue exextra en reste t il si oui il faut les mettres sous forme de string rien widget_text base value editable uname autres uvalue autres xsize 54 ysize 3 yoffset 65 wrap no_newline if keyword_set forxxx then cw_specifie_set_value base definedefaultextra rien_du_tout return base end "); 379 a[377] = new Array("./ToBeReviewed/WIDGET/findtopid.html", "findtopid.pro", "", " NAME: findtopid PURPOSE: retrouve a partir d un Id de widget l Id du widget qui est the top level base i e it has no parent CATEGORY: aide pour les widgets CALLING SEQUENCE: res findtopid Widget_ID INPUTS: Widget_ID: this argument should be the widget ID of the widget for which information is desired KEYWORD PARAMETERS: OUTPUTS: l Id du widget qui est the top level base COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 22 9 1999 FUNCTION findtopid identite id long identite exist widget_info id managed if exist EQ 0 then return 1 topid id topid2 id while topid2 NE 0 do begin topid topid2 topid2 widget_info topid2 parent endwhile return long topid end"); 380 a[378] = new Array("./ToBeReviewed/WIDGET/slec.html", "slec.pro", "", "FUNCTION slec name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex include common cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF case n_params of 1:tab nlec name PARENT parent BOXZOOM boxzoom _EXTRA ex 2:tab nlec name debut PARENT parent BOXZOOM boxzoom _EXTRA ex 3:tab nlec name debut fin PARENT parent BOXZOOM boxzoom _EXTRA ex 4:tab nlec name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex endcase return tab:tab grille:vargrid unite:varunit experience:varexp nom:varname end"); 381 a[379] = new Array("./ToBeReviewed/WIDGET/xnotice.html", "xnotice.pro", "", " NAME:xnotice PURPOSE:cree un widget avec du texte au milieu de la fenetre CATEGORY:information CALLING SEQUENCE:widgetid xnotice text INPUTS:text: un string ou un vecteur de string Si c est un scalaire on cherche le separateur de ligne C pour creer un texte a plusieurs lignes KEYWORD PARAMETERS:chkwidget: oblige a verifier qu il y a des widgets actif pour creer un widget sinon imprime au prompt OUTPUTS:lidentite du widget cree COMMON BLOCKS SIDE EFFECTS:ne fait pas appelle a xmanager ne cree aucun event il faut detruire ce widget a la main: widget_control widgetid destroy RESTRICTIONS: EXAMPLE: IDL id xnotice ca marche C ou pas IDL widget_control id destroy MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 3 17 FUNCTION xnotice text CHKWIDGET chkwidget on separe le text en differentes lignes separees par C si ce n est pas deja fait if n_elements text EQ 1 then text str_sep text C trim if keyword_set chkwidget then makewid widget_info managed 0 ELSE makewid 1 if makewid EQ 0 then BEGIN for i 0 n_elements text 1 do print text i noticebase 0 endif noticebase widget_base column title information align_center screensize get_screen_size widget_control noticebase tlb_set_xoffset screensize 0 2 2 tlb_set_yoffset screensize 1 2 2 nothing widget_label noticebase value for i 0 n_elements text 1 do nothing widget_label noticebase value text i nothing widget_label noticebase value widget_control noticebase realize return noticebase end"); 382 a[380] = new Array("./ToBeReviewed/WIDGET/xquestion.html", "xquestion.pro", "", " NAME:xquestion PURPOSE: a small widget who ask a question and give an answer WARNING: For a binary question with yes no answer use DIALOG_MESSAGE CATEGORY: widget CALLING SEQUENCE: answer xquestion question proposedanswer INPUTS: question: a scalar string or a array of string If this argument is set to : an array of strings: each array element is displayed as a separate line of text a scalar string: we are looking for the separate line character C proposedanswer: a string proposing a answer KEYWORD PARAMETERS: those from WIDGET_BASE and WIDGET_TEXT CHKWIDGET: active this keyword if you whant that xquestion check if managed widget are present If not xquestion do not open a widget but print the question in the IDL window OUTPUTS: answer: a string COMMON BLOCKS: none we use a false widget SIDE EFFECTS: The function does not return to its caller until the user press Enter key in the widget RESTRICTIONS: EXAMPLE: IDL help xquestion Postscript name STRING toto ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 13 10 1999 pro xquestion_event event we get the answer widget_control widget_info event top find_by_uname text get_value answer answer answer 0 now we give the answer to xquestion pro by using the pointer uvalue widget_control event top get_uvalue ptranswer ptranswer answer we destroy the widget widget_control event top destroy return end FUNCTION xquestion question proposedanswer CHKWIDGET chkwidget _extra ex is separate line a scalar we must cut it into pieces if n_elements question EQ 1 then question str_sep question C trim is a widget necessary if keyword_set chkwidget then BEGIN if widget_info managed 0 EQ 0 then BEGIN if n_elements proposedanswer EQ 0 then BEGIN proposedanswer answer complete ENDIF ELSE BEGIN answer proposedanswer complete default answer is proposedanswer ENDELSE if n_elements question GT 1 THEN for i 0 n_elements question 2 do print question i read question n_elements question 1 complete answer if keyword_set answer EQ 0 then answer proposedanswer return answer endif endif definition of the widget BaseId widget_base column title Question _extra ex screensize get_screen_size widget_control BaseId tlb_set_xoffset screensize 0 2 2 tlb_set_yoffset screensize 1 2 2 for i 0 n_elements question 1 DO trash widget_label BaseId value question i align_left if n_elements proposedanswer EQ 0 then answer ELSE answer proposedanswer trash widget_text BaseId value answer editable _extra ex uname text trash widget_button BaseId value ok ptranswer ptr_new allocate_heap widget_control BaseId set_uvalue ptranswer we realize the widget and wait for an answer widget_control BaseId realize xmanager xquestion BaseId we get the answer answer ptranswer we freeing the pointer ptr_free ptranswer return answer end"); 383 a[381] = new Array("./ToBeReviewed/WIDGET/xx.html", "xx.pro", "", " PRO xx JOUR jour MESHFILENAME meshfilename LISTVAR listvar LISTGRID listgrid FUNCLEC_NAME funclec_name CALENDAR calendar _extra ex common partie a changer nom de la fonction de lecture: if NOT keyword_set funclec_name then funclec_name slec varexp INF liste des variables if NOT keyword_set listvar then listvar tn sn un vn taux tauy hdep20 hdep28 hdep15 hturb hpycn htoth emp qn qs smltot11 smltot12 smltot13 smltot14 smltot15 smltot16 tmltot11 tmltot12 tmltot13 tmltot14 tmltot15 tmltot16 liste des grilles auxquelles elles se rapportent les variables if NOT keyword_set listgrid then BEGIN listgrid replicate T n_elements listvar listgrid 2 4 U listgrid 3 5 V ENDIF calendrier a utiliser en jours juliens d IDL if NOT keyword_set calendar then BEGIN if keyword_set jour then calendar calendriertotem julian_day ELSE calendar calendriertotem julian_day mensuel ENDIF nom du fichier se rapportant au masque if NOT keyword_set meshfilename then meshfilename usr1 com smasson IDL INIT inittotem pro meshparameters whichgrid meshfilename parameteres specifiant comment doit etre lu le champ readparameters funclec_name: funclec_name jpidta: jpidta jpjdta: jpjdta jpkdta: jpkdta ixmindta: ixmindta ixmaxdta: ixmaxdta iymindta: iymindta iymaxdta: iymaxdta izmindta: izmindta izmaxdta: izmaxdta fin de la partie a changer fileparameters filename: many time_counter: calendar listvar: listvar listgrid: strupcase listgrid multistructure fileparameters: temporary fileparameters readparameters: temporary readparameters meshparameters: temporary meshparameters xxx multistructure temporary multistructure _extra ex return end"); 384 a[382] = new Array("./ToBeReviewed/WIDGET/xxx.html", "xxx.pro", "", " NAME:xxx PURPOSE:un maximum de possibilites avec un minimum de clics CATEGORY:super widget CALLING SEQUENCE:xxx INPUTS:none KEYWORD PARAMETERS: SEPARATE: pour separer la partie boutons de la partie dessin en 2 fenetres Utile pour les petits ecrans mais attention peut saturer la memoire video de certains Tx un peu vetustes RESTORE toto dat ou toto dat est un fichier cree lors d une precedente utilisation de xxx grace a la commande Widget du menu save as OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO xxx_event event common widget_info event top find_by_uname quel est le type d evenement if event id EQ 622 then help event struct widget_control event id get_uvalue uval if tag_names event structure_name 0 EQ WIDGET_TRACKING then uval name: ActiverFenetre if keyword_set uval EQ 0 then return help event struct help uval struct case sur le type d evenement widget_control event top get_uvalue top_uvalue si on a active le mot cles separate a l appelle de xxx if size top_uvalue type EQ 3 then begin event top top_uvalue widget_control event top get_uvalue top_uvalue endif on tue le petit widget cree par notice pro si il existe noticebase extractatt top_uvalue noticebase if noticebase NE 0 then BEGIN widget_control noticebase destroy top_uvalue 1 findline top_uvalue noticebase 0l endif options extractatt top_uvalue options case uval name OF menubar :xxxmenubar_event event ok :nouveaudessin 1 specifie : action : calendar1 :BEGIN date2id widget_info event top find_by_uname calendar2 widget_control date2id get_value date2 if event value GT date2 then widget_control date2id set_value event value END calendar2 :BEGIN date1id widget_info event top find_by_uname calendar1 widget_control date1id get_value date1 if event value LT date1 then widget_control date1id set_value event value END domain : varlist :BEGIN currentfile extractatt top_uvalue currentfile listvar extractatt top_uvalue fileparameters currentfile listvar name listvar event index changefield event top name END txtcmd : filelist :BEGIN changefile event top event index END ActiverFenetre :BEGIN if event enter EQ 1 AND d name NE PS then BEGIN graphid widget_info event top find_by_uname graph graphid extractatt top_uvalue graphid widget_control graphid get_value win wset win widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 p extractatt top_uvalue penvs numdessinin x extractatt top_uvalue xenvs numdessinin y extractatt top_uvalue yenvs numdessinin endif END graph :BEGIN quelclick identifyclick event case quelclick type of inutile :return long :longclickaction event single :singleclickaction event double :doubleclickaction event endcase END endcase if keyword_set nouveaudessin then letsdraw event top return end PRO xxx datafilename idlfile argspro CALLERWIDID CallerWidId REDRAW redraw SEPARATE separate UVALUE uvalue RESTORE restore _EXTRA ex all_cm reinitialize the p x y z variables reinitplt we get back the uvalue of the widget that called xxx to create a new widget if keyword_set restore then BEGIN restore isafile filename restore iodir homedir _extra ex if size restore type NE 7 then restore 0 ELSE BEGIN restore isafile file restore iodir homedir _extra ex newgrid extractatt uvalue meshparameters 0 change changegrid newgrid ENDELSE endif if n_elements CallerWidId NE 0 THEN widget_control CallerWidId get_uvalue uvalue ELSE CallerWidId 0 liste des fichiers que l on veut regarder if keyword_set uvalue then BEGIN currentfile extractatt uvalue currentfile filelist extractatt uvalue filelist fileparameters extractatt uvalue fileparameters readparameters extractatt uvalue readparameters meshparameters extractatt uvalue meshparameters ENDIF ELSE BEGIN newfile selectfile datafilename idlfile argspro _extra ex if size newfile type NE 8 then return fileparameters ptrarr 1 allocate_heap fileparameters 0 newfile fileparameters readparameters ptrarr 1 allocate_heap readparameters 0 newfile readparameters meshparameters ptrarr 1 allocate_heap meshparameters 0 newfile meshparameters currentfile 0 filelist newfile fileparameters filename ENDELSE if keyword_set uvalue THEN BEGIN smallin extractatt uvalue smallin smallout extractatt uvalue smallout ENDIF ELSE BEGIN smallin 1 1 1 smallout 1 1 1 ENDELSE nbredessin smallin 0 smallin 1 numdessinin smallin 2 1 warning flg definition must be consistent with cw_pdmenu argument see also flag definition in cw_pagelayout if keyword_set uvalue then BEGIN flag extractatt uvalue optionsflag key_portrait flag 0 numdessinin ENDIF ELSE flag key_portrait 0 0 0 0 replicate 1 nbredessin We start the widget definition widget and screen size scrsize get_screen_size 0 95 windsize givewindowsize xxxsize windsize 0 1 keyword_set separate 350 windsize 1 The top base IF xxxsize 0 LE scrsize 0 AND xxxsize 1 LE scrsize 1 THEN BEGIN base widget_base title xxx GROUP_LEADER group tracking_events uname base space 0 ENDIF ELSE BEGIN base widget_base title xxx GROUP_LEADER group tracking_events uname base space 0 xsize xxxsize 0 ysize xxxsize 1 x_scroll_size xxxsize 0 selectact ENDIF ELSE selectfile 0 menu options xoff xoff 110 if keyword_set uvalue then begin options extractatt uvalue options ENDIF ELSE options Portrait Landscape Overlay Vecteur Longitude x index Latitude y index desc 1 File 0 Open 0 New xxx 2 Quit 1 Save as 0 PostScript 0 Animated gif 0 Gif 0 IDL procedure 0 RESTORE kwd of xxx 2 Print to prompt 1 Flag options descsuite options if n_elements descsuite GE 2 then descsuite 0:n_elements descsuite 2 0 descsuite 0:n_elements descsuite 2 descsuite n_elements descsuite 1 2 descsuite n_elements descsuite 1 desc desc descsuite menu cw_pdmenu base desc RETURN_NAME uname menubar uvalue name: menubar xoffset xoff yoffset yoff Ok button yoff yoff 37 xoff 5 boutton OK baseok widget_button base value OK uvalue name: ok uname ok button frame xoffset xoff yoffset yoff Page Layout page layout xoff xoff 65 dummyid cw_pagelayout base smallin row frame xoffset xoff yoffset yoff List of Variables xoff xoff 140 currentlistvar fileparameters currentfile listvar vlstid widget_combobox base value currentlistvar uvalue name: varlist uname varlist xoffset xoff yoffset yoff 1 if keyword_set uvalue then BEGIN selectvar extractatt uvalue varinfo 1 numdessinin selectvar where currentlistvar EQ selectvar 0 widget_control vlstid set_combobox_select 0 selectvar ENDIF ELSE selectvar 0 List of files yoff yoff 35 flstid widget_combobox base value file_basename filelist uname filelist xsize 345 yoffset yoff uvalue name: filelist if keyword_set uvalue then BEGIN selectfile extractatt uvalue varinfo 0 numdessinin selectfile where file_basename filelist EQ selectfile 0 widget_control flstid set_combobox_select 0 selectfile ENDIF ELSE selectfile 0 Text for computation yoff yoff 32 computation done on the files if keyword_set uvalue then txtvalue extractatt uvalue txtcmd numdessinin ELSE txtvalue varexp dummyid widget_text base value txtvalue uvalue name: txtcmd uname txtcmd editable yoffset yoff xsize 54 frame Calendar yoff yoff 40 currentcalendar fileparameters currentfile time_counter key_caltype fileparameters currentfile caltype fakecal fileparameters currentfile fakecal if keyword_set uvalue then begin dates extractatt uvalue dates numdessinin date1 date2jul dates 0 date2 date2jul dates 1 ENDIF basecalid widget_base base column 2 space 0 yoffset yoff uname basecal dummyid cw_calendar basecalid currentcalendar date1 FAKECAL fakecal uname calendar1 uvalue name: calendar1 frame dummyid cw_calendar basecalid currentcalendar date2 FAKECAL fakecal uname calendar2 uvalue name: calendar2 frame Domain yoff yoff 60 vargrid strupcase fileparameters currentfile listgrid selectvar IF vargrid EQ W then zgrid W ELSE zgrid T if keyword_set uvalue then boxzoom extractatt uvalue domaines numdessinin dummyid cw_domain base uname domain uvalue name: domain unzoom frame boxzoom boxzoom yoffset yoff xoffset 15 Plots specifications yoff yoff 230 speid cw_specifie base uname specifie uvalue name: specifie frame column forxxx yoffset yoff if keyword_set uvalue then BEGIN exextra extractatt uvalue exextra numdessinin IF n_elements exextra NE 0 THEN widget_control speid set_value exextra ENDIF drawing part if keyword_set separate then basegraph widget_base title xxx window group_leader base uvalue base ELSE basegraph base graphid widget_draw basegraph uname graph button_events retain 2 uvalue name: graph press:0 click:0 x: 0 0 y: 0 0 xoffset 350 1 keyword_set separate xsize windsize 0 ysize windsize 1 tooltip toto realize the widget widget_control base realize if keyword_set separate then begin widget_control basegraph realize xmanager xxx basegraph no_block endif if keyword_set uvalue then BEGIN on recopie le pointeur uvalue dans top_uvalue Attention il faut completement redefinir top_uvalue a partir des variables pointees par uvalue Sinon si on fait simplement top_uvalue uvalue qd on detruit par uvalue et les variables surlesquelles il pointe on detruit aussi les variables sur lesquelles pointent top_uvalue case 1 of keyword_set redraw :BEGIN top_uvalue uvalue widget_control base set_uvalue top_uvalue we find homedir homedir isadirectory io homedir title Bad definition of homedir on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape noerase END keyword_set restore :begin top_uvalue uvalue widget_control base set_uvalue top_uvalue widget_control graphid get_value win wshow win wset win tv image true etat des widgets updatewidget base menage END ELSE:BEGIN top_uvalue ptrarr 2 29 allocate_heap FOR i 0 28 do top_uvalue 0 i uvalue 0 i FOR i 0 14 do top_uvalue 1 i uvalue 1 i FOR i 18 27 do top_uvalue 1 i uvalue 1 i numfile n_elements extractatt uvalue filelist top_uvalue 1 15 ptrarr numfile allocate_heap top_uvalue 1 16 ptrarr numfile allocate_heap top_uvalue 1 17 ptrarr numfile allocate_heap for i 0 numfile 1 do begin top_uvalue 1 15 i uvalue 1 15 i top_uvalue 1 16 i uvalue 1 16 i top_uvalue 1 17 i uvalue 1 17 i endfor top_uvalue 1 28 ptrarr nbredessin allocate_heap for i 0 nbredessin 1 do top_uvalue 1 28 i uvalue 1 28 i widget_control base set_uvalue top_uvalue copie l ecran du widget de uvalue dans celui de top_uvalue if keyword_set CallerWidId then begin widget_control extractatt uvalue graphid get_value win wshow win wset win image tvrd true widget_control graphid get_value win wshow win wset win tv image true ENDIF END endcase top_uvalue 1 findline top_uvalue graphid graphid ENDIF ELSE BEGIN sinon on va definit tous les elements que l on acroche au widget grace a la top_uvalue qui est un tableau de pointeurs a 2 colonnes: les noms et des variables on initialie tous ces elements variables concernant le widget ds sa generalite if NOT keyword_set ex then ex nothing:0 variables se rapportant aux differents fichiers que l on peut lire variables specifiques a chaque dessin creation du pointeur que l on va attache au widget top_uvalue ptrarr 2 29 allocate_heap variables se rapportant au widget en general top_uvalue 0 0 options top_uvalue 1 0 options top_uvalue 0 1 smallin top_uvalue 1 1 smallin top_uvalue 0 2 smallout top_uvalue 1 2 smallout top_uvalue 0 3 graphid top_uvalue 1 3 graphid top_uvalue 0 4 alreadyvector top_uvalue 1 4 1 top_uvalue 0 5 alreadyover top_uvalue 1 5 1 top_uvalue 0 6 alreadyread top_uvalue 1 6 1 top_uvalue 0 7 currentreadcmd top_uvalue 1 7 top_uvalue 0 8 globalcommand top_uvalue 1 8 top_uvalue 0 9 globaloldcommand top_uvalue 1 9 top_uvalue 0 10 no more used top_uvalue 1 10 9999 top_uvalue 0 11 noticebase top_uvalue 1 11 0l top_uvalue 0 12 extra top_uvalue 1 12 ex variables se rapportant aux differents fichiers que l on peut lire top_uvalue 0 13 currentfile top_uvalue 1 13 currentfile top_uvalue 0 14 filelist top_uvalue 1 14 filelist top_uvalue 0 15 fileparameters top_uvalue 1 15 fileparameters top_uvalue 0 16 readparameters top_uvalue 1 16 readparameters top_uvalue 0 17 meshparameters top_uvalue 1 17 meshparameters variables se rapportant aux differents dessins que l on peut faire top_uvalue 0 18 penvs top_uvalue 1 18 replicate p nbredessin top_uvalue 0 19 xenvs top_uvalue 1 19 replicate x nbredessin top_uvalue 0 20 yenvs top_uvalue 1 20 replicate y nbredessin top_uvalue 0 21 nameprocedures top_uvalue 1 21 strarr nbredessin top_uvalue 0 22 types top_uvalue 1 22 strarr nbredessin top_uvalue 0 23 varinfo top_uvalue 1 23 strarr 2 nbredessin top_uvalue 0 24 domaines top_uvalue 1 24 fltarr 6 nbredessin top_uvalue 0 25 dates top_uvalue 1 25 lonarr 2 nbredessin top_uvalue 0 26 txtcmd top_uvalue 1 26 strarr nbredessin top_uvalue 0 27 optionsflag top_uvalue 1 27 flag top_uvalue 0 28 exextra top_uvalue 1 28 ptrarr nbredessin allocate_heap widget_control base set_uvalue top_uvalue createhistory base smallin ENDELSE xmanager xxx base no_block return end"); 385 a[383] = new Array("./Utilities/createfunc.html", "createfunc.pro", "", " write an idl function compile it and execute it usefull to avoid the use of execute param command in required a scalar string defining the result to be byven back by the function see examples keyword FILENAMEIN in name of the funccedure to be created for_createfunc pro by default keyword KWDLIST in a vector string to specify a list of keywords that must be included in the function definition Warning: the string must start with a for example: KWDLIST TOTO toto keyword _EXTRA used to pass your keywords to the created function SIDE EFFECTS: ends the function name with pro if needed restrictions arguments can be given only through keywords examples IDL print createfunc 3 2 filename test IDL print createfunc 3 two filename test kwdlist two two two 2 history Sebastien Masson smasson lodyc jussieu fr May 2005 FUNCTION createfunc command FILENAMEIN filenamein KWDLIST kwdlist _extra ex compile_opt idl2 hidden strictarrsubs IF n_elements command NE 1 THEN stop define filename if needed if NOT keyword_set filenamein then filename for_createfunc pro ELSE filename filenamein get the name of the function not the name of the file containing the function shortfilename file_basename filename pro check if the directory exists dirname isadirectory file_dirname filename title Redefine shortfilename pro directory IF size dirname type NE 7 THEN return 1 filename dirname shortfilename pro create the file if NOT keyword_set kwdlist then kwdlist kwdlist kwdlist _extra ex IF strmid kwdlist 0 1 NE THEN kwdlist kwdlist putfile filename function shortfilename kwdlist compile_opt idl2 hidden strictarrsubs res command return res end go in dirname directory cd dirname current old_dir compile it resolve_routine shortfilename is_function cd old_dir execute it res call_function shortfilename _extra ex return res end"); 386 a[384] = new Array("./Utilities/createpro.html", "createpro.pro", "", " write an idl procedure compile it and execute it param command in required a string array defining the procedure to be created each element will be a line of the created procedure keyword FILENAMEIN name of the procedure to be created for_createpro pro by default keyword KWDLIST a vector string to specify a list of keywords that must be included in the procedure definition Warning: the string must start with a for example: KWDLIST TOTO toto keyword _EXTRA used to pass your keywords to the created procedure SIDE EFFECTS: ends the procedure name with pro if needed restrictions is not working with functions use createfunc instead arguments can be given only through keywords examples IDL createpro print OK filename test IDL createpro if keyword_set ok then print OK else print No IDL filename test kwdlist ok ok IDL createpro if keyword_set ok then print OK else print No IDL filename test kwdlist ok ok ok history Sebastien Masson smasson lodyc jussieu fr cleaning new keywords: October 2005 Feb 2006: supress keyword kwdused and use call_procedure instead of execute PRO createpro command FILENAMEIN filenamein KWDLIST kwdlist KWDUSED kwdused _extra ex compile_opt idl2 hidden strictarrsubs IF keyword_set kwdused THEN BEGIN dummy report keyword KWDUSED has been suppressed please pass directly your keywords through _extra see exaemples in createpro header return ENDIF define filename if needed if NOT keyword_set filenamein then filename for_createpro pro ELSE filename filenamein get the name of the procedure not the name of the file containing the procedure shortfilename file_basename filename pro check if the directory exists dirname isadirectory file_dirname filename title Redefine shortfilename pro directory IF size dirname type NE 7 THEN return filename dirname shortfilename pro create the file if NOT keyword_set kwdlist then kwdlist kwdlist kwdlist _extra ex kwdlist strtrim kwdlist 2 IF strmid kwdlist 0 1 NE THEN kwdlist kwdlist for i 0 n_elements command 1 do print command i putfile filename pro shortfilename kwdlist compile_opt idl2 hidden strictarrsubs command return end go in dirname directory cd dirname current old_dir compile it resolve_routine shortfilename cd old_dir execute it call_procedure shortfilename _extra ex return end"); 387 a[385] = new Array("./Utilities/def_myuniquetmpdir.html", "def_myuniquetmpdir.pro", "", " if needed define and create myuniquetmpdir common variable from cm_general and add it to path categories utilities examples IDL def_myuniquetmpdir uses cm_general file_comments SIDE EFFECTS: see purpose history Sebastien Masson smasson lodyc jussieu fr June 2005 PRO def_myuniquetmpdir cm_general IF n_elements myuniquetmpdir EQ 0 THEN BEGIN define a new and unique directory in getenv IDL_TMPDIR by using systime 1 look for the login if we use unix system IF d name EQ X THEN spawn whoami login noshell ELSE login idl myuniquetmpdir file_search getenv IDL_TMPDIR mark_directory myuniquetmpdir myuniquetmpdir 0 login 0 strtrim long systime 1 1 create it file_mkdir myuniquetmpdir add it to path path path : expand_path myuniquetmpdir ENDIF return end"); 388 a[386] = new Array("./Utilities/demomode_compatibility.html", "demomode_compatibility.pro", "", " categories utilities PRO demomode_compatibility cm_general 1 remove all cm_demomode_used pro found in path to_rm find cm_demomode_used IF to_rm 0 NE NOT FOUND THEN file_delete to_rm 2 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro select which file should be copied to oldcm_used pro IF lmgr demo EQ 1 THEN BEGIN democm find cm_demomode file_copy democm myuniquetmpdir cm_demomode_used pro overwrite ENDIF ELSE BEGIN create an empty file close the journal if already open IF journal NE 0 THEN journal open a new one journal myuniquetmpdir cm_demomode_used pro close it it will be empty journal ENDELSE return END"); 389 a[387] = new Array("./Utilities/find.html", "find.pro", "", " based on file_search but it is possible to speficy a set of possibles names and a different set of possibles directories names By defaut look for files included in path categories find a file param filein in required A scalar or array variable of string type containing file names to match Input names specifications may contain wildcard characters enabling them to match multiple files see file_search for more informations By defaut and if necessary find is looking for filename and also for filename completed with pro keyword FIRSTFOUND activate this keyword to stop looking for the file as soon as we found one keyword IODIRECTORY A scalar or array variable of string type containing directories names where we are looking for the file by defaut we use path Different directories can be separated by path_sep search_path : on unix type machine as it is done to define path Note that if filename s dirname is different from this keyword is not taken into account keyword LOOKALLDIR activate to look for the file with a recursive search in iodir homedir path the DATA:TestsData directory if it exists keyword NOPRO activate to avoid the automatic search of filename completed with pro keyword ONLYPRO force to look only at file ending with pro keyword ONLYNC force to look only at file ending with nc keyword RECURSIVE performs recursive searching of directory hierarchies In a recursive search find looks recursively for any and all subdirectories in the file hierarchy rooted at the IODIRECTORY argument keyword REPERTOIRE obsolete keep for compatibility use directory keyword keyword UNIQUE activate to make sure that each element of the output vector is unique file_comments all file_search keywords can be used returns A scalar or array variable of string type containing the name with the full path of the matching files If no files exist with names matching the input arguments find returns the scalar string : NOT FOUND examples IDL print find loadct usr local rsi idl_6 0 lib utilities xloadct pro usr local rsi idl_6 0 lib loadct pro IDL print find loadct iodir dir recursive usr local rsi idl_6 0 lib loadct pro usr local rsi idl_6 0 lib utilities xloadct pro IDL print find loadct pro usr local rsi idl_6 0 lib utilities xloadct pro usr local rsi idl_6 0 lib loadct pro IDL print find loadct nopro NOT FOUND IDL print find loadct iodir usr local rsi idl_6 0 lib usr local rsi idl_6 0 lib loadct pro IDL print find loadct iodir usr local rsi idl_6 0 lib test_write NOT FOUND IDL print find loadct iodir usr local rsi idl_6 0 lib recursive usr local rsi idl_6 0 lib loadct pro usr local rsi idl_6 0 lib utilities xloadct pro IDL print find mesh iodirectory iodir path Users sebastie DATA ORCA2 meshmaskORCA2closea nc Users sebastie IDL meshmaskclosesea pro Users sebastie IDL meshmaskclosesea pro Users sebastie SAXO_RD Obsolete meshlec pro usr local rsi idl_6 0 lib mesh_obj pro history Sebastien Masson smasson lodyc jussieu fr 28 4 1999 6 7 1999: compatibilite mac et windows June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION find filein IODIRECTORY iodirectory RECURSIVE recursive REPERTOIRE repertoire NOPRO nopro ONLYPRO onlypro ONLYNC onlync UNIQUE unique FIRSTFOUND firstfound LOOKALLDIR LOOKALLDIR _extra ex define where we look for the file CASE 1 OF keyword_set lookalldir :BEGIN cm_general dirnames iodir homedir path tstdtadir file_dirname find find onlypro mark_directory tstdtadir file_search tstdtadir DATA TestsData 0 IF tstdtadir NE THEN dirnames tstdtadir dirnames END keyword_set iodirectory : dirnames iodirectory keyword_set repertoire : dirnames repertoire ELSE: dirnames path ENDCASE tmp dirnames dirnames dummy FOR i 0 n_elements tmp 1 DO dirnames dirnames strsplit tmp i path_sep search_path extract dirnames dirnames 1: fileout dummy FOR i 0 n_elements filein 1 DO BEGIN dir file_dirname filein i base file_basename filein i try to complete the file name with pro or nc if needed CASE 1 OF keyword_set onlypro :BEGIN promiss strpos base pro reverse_search promiss promiss strlen base 4 bad where promiss NE 0 OR strlen base LE 4 cnt IF cnt NE 0 THEN base bad base bad pro end keyword_set onlync :BEGIN ncmiss strpos base nc reverse_search ncmiss ncmiss strlen base 3 bad where ncmiss NE 0 OR strlen base LE 3 cnt IF cnt NE 0 THEN base bad base bad nc END ELSE:if strmid base 0 1 reverse_offset NE AND NOT keyword_set nopro THEN base base pro ENDCASE use dirnames only if dir eq IF dir EQ THEN BEGIN if keyword_set recursive THEN found file_search dirnames base _extra ex ELSE found file_search dirnames base _extra ex ENDIF ELSE found file_search dir base _extra ex IF found 0 NE THEN BEGIN IF keyword_set firstfound THEN BEGIN IF keyword_set unique THEN return found uniq found sort found ELSE return found ENDIF fileout fileout found ENDIF ENDFOR IF n_elements fileout EQ 1 THEN fileout NOT FOUND ELSE fileout fileout 1: IF n_elements fileout GT 1 THEN BEGIN IF keyword_set unique THEN fileout fileout uniq fileout sort fileout ENDIF ELSE fileout fileout 0 RETURN fileout END"); 390 a[388] = new Array("./Utilities/isadirectory.html", "isadirectory.pro", "", " check if a directory exists and make sure that it ends with the directory separator mark categories io param directoryin in optional a proposed directory If neither dirname input parameter of IODIRECTORY keyword are defined the ask the user to choose a directory keyword IODIRECTORY a proposed directory keyword TITLE the title of the window file_comments all dialog_pickfile keywords like filter can be used returns the directory name examples IDL print dir usr local rsi idl_6 0 IDL print isadirectory dir usr local rsi idl_6 0 IDL print isadirectory dir notgood history Sebastien Masson smasson lodyc jussieu fr June 28 2000 June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION isadirectory directoryin TITLE title IODIRECTORY iodirectory _extra ex CASE 1 OF size directoryin type 0 EQ 7:directory directoryin keyword_set iodirectory :directory iodirectory ELSE:directory directory that is not existing ENDCASE testfile file_test directory directory if directory doesn t exist we ask the user to provide a directory name IF total testfile NE n_elements directory THEN BEGIN IF NOT keyword_set title THEN title choose a directory FOR i 0 n_elements directory 1 DO BEGIN IF testfile i EQ 0 THEN BEGIN directory i dialog_pickfile directory title title must_exist _extra ex if directory i EQ THEN RETURN report check find directory canceled ENDIF ENDFOR ENDIF directory file_search directory mark_directory IF n_elements directory EQ 1 THEN RETURN directory 0 ELSE RETURN directory END"); 391 a[389] = new Array("./Utilities/isafile.html", "isafile.pro", "", " same as find pro except that as long as the file is NOT FOUND isafile calls dialog_pickfile to ask the user to select a file categories io param filein in optional a proposed name If neither filein input parameter of filename keyword are defined the ask the user to choose a file keyword FILENAME a proposed filename keyword IODIRECTORY a directory where we look for the file this keyword is taken into account only if the dirmame of filein or filename is keyword NEW to specify that filename is a new file and that we should check only its path keyword ONLYPRO force to look only at file ending with pro keyword ONLYNC force to look only at file ending with nc keyword RECURSIVE performs recursive searching of directory hierarchies In a recursive search find looks recursively for any and all subdirectories in the file hierarchy rooted at the IODIRECTORY argument file_comments all find file_search and dialog_pickfile keywords like title can be used returns the filename with its path examples IDL print isafile Users sebastie SAXO_RD Commons cm_4mesh pro Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir Users sebastie SAXO_RD Commons Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir path Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir Users sebastie SAXO_RD recursive Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir getenv HOME recursive Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile fake_file pro history Sebastien Masson smasson lodyc jussieu fr 11 2 2000 June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION isafile filein FILENAME filename IODIRECTORY iodirectory NEW new RECURSIVE RECURSIVE ONLYPRO onlypro ONLYNC onlync _extra ex CASE 1 OF size filein type 0 EQ 7:fileout filein keyword_set filename :fileout filename ELSE:fileout file that is not existing ENDCASE if size fileout type NE 7 THEN return 1 CASE 1 OF keyword_set onlypro : filter pro keyword_set onlync : filter nc else: filter ENDCASE basename file_basename fileout dirname file_dirname fileout should we redefine dirname if keyword_set iodirectory AND dirname EQ then dirname iodirectory if keyword_set new then return dirname path_sep basename fileout find basename iodirectory dirname recursive recursive unique firstfound ONLYPRO onlypro ONLYNC onlync _extra ex WHILE fileout 0 EQ NOT FOUND DO BEGIN fileout dialog_pickfile path dirname 0 filter filter _extra ex if fileout EQ THEN RETURN report check find file canceled check again everything basename file_basename fileout dirname file_dirname fileout check if the name of the dirname is ok dirname isadirectory dirname title choose a directory for the file basename if we cancel the check IF size dirname type NE 7 THEN return report check find file canceled fileout find basename iodirectory dirname recursive recursive unique firstfound ONLYPRO onlypro ONLYNC onlync _extra ex ENDWHILE RETURN fileout END"); 392 a[390] = new Array("./Utilities/protype.html", "protype.pro", "", " test is a pro file corresponds to an IDL procedure function or batch file categories utilities param file in A scalar of string type the name of the pro file to be tested if necessary the input name is completed with pro and its path found in path returns A scalar of string type: proc func or batch examples IDL print protype protype func IDL print protype protype pro func IDL print protype init batch IDL print protype plt proc history Sebastien Masson smasson lodyc jussieu fr Feb 2006 FUNCTION protype file filepro find file 0 onlypro firstfound 0 if filepro EQ NOT FOUND then return 1 name file_basename filepro pro allines getfile filepro CASE 1 OF this is a procedure max stregex allines pro name fold_case boolean :RETURN proc this is a function max stregex allines function name fold_case boolean :RETURN func this is an IDL batch file ELSE:RETURN batch ENDCASE RETURN 1 END"); 393 a[391] = new Array("./buildinit.html", "buildinit.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: OPTIONAL INPUTS: KEYWORD PARAMETERS: OUTPUTS: OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: MODIFICATION HISTORY: slightly mofified version of cw_field FUNCTION CW_FIELD2 Parent COLUMN Column ROW Row EVENT_FUNC efun FLOATING Float INTEGER Int LONG Long STRING String FONT LabelFont FRAME Frame TITLE Title UVALUE UValue VALUE TextValueIn RETURN_EVENTS ReturnEvents ALL_EVENTS AllUpdates FIELDFONT FieldFont NOEDIT NoEdit TEXT_FRAME Text_Frame XSIZE XSize YSIZE YSize UNAME uname FLOOR vmin CEILING vmax resolve_routine cw_field compile_full_file is_function Examine our keyword list and set default values for keywords that are not explicitly set Column KEYWORD_SET Column Row 1 Column AllEvents 1 KEYWORD_SET NoEdit Enum Update None All CRonly Update 0 IF KEYWORD_SET AllUpdates THEN Update 1 IF KEYWORD_SET ReturnEvents THEN Update 2 IF N_ELEMENTS efun LE 0 THEN efun IF N_ELEMENTS Title EQ 0 THEN Title Input Field: TextValue N_ELEMENTS TextValueIn gt 0 TextValueIn : Convert non string values to strings if SIZE TextValue TNAME ne STRING then TextValue STRTRIM TextValue 2 IF N_ELEMENTS YSize EQ 0 THEN YSize 1 IF N_ELEMENTS uname EQ 0 THEN uname CW_FIELD_UNAME Type 0 string is default IF KEYWORD_SET Float THEN Type 1 IF KEYWORD_SET Int THEN Type 2 IF KEYWORD_SET Long THEN Type 3 Don t allow multiline non string widgets if Type ne 0 then YSize 1 YSize YSize 1 Build Widget Base WIDGET_BASE Parent ROW Row COLUMN Column UVALUE UValue EVENT_FUNC CW_FIELD_EVENT PRO_SET_VALUE CW_FIELD_SET FUNC_GET_VALUE CW_FIELD_GET FRAME Frame UNAME uname FOR i 0 n_elements title 1 DO Label WIDGET_LABEL Base VALUE Title i FONT LabelFont UNAME uname _LABEL align_left Text WIDGET_TEXT Base VALUE TextValue XSIZE XSize YSIZE YSize FONT FieldFont ALL_EVENTS AllEvents EDITABLE AllEvents AND TYPE EQ 0 FRAME Text_Frame UNAME uname _TEXT NO_ECHO AllEvents AND TYPE NE 0 Save our internal state in the first child widget State efun: efun TextId:Text Title:Title Update:Update Type:Type WIDGET_CONTROL WIDGET_INFO Base CHILD SET_UVALUE State NO_COPY RETURN Base END PRO printerdef_event event get back the ids of the cw_field widgets widget_control event id get_uvalue cwids IF size cwids n_dimensions EQ 1 THEN cwids reform cwids 3 1 help cwids dims size cwids dimensions help dims print dims results strarr dims FOR i 0 dims 1 1 DO BEGIN widget_control cwids 0 i get_value res results 0 i res widget_control cwids 1 i get_value res results 1 i res widget_control cwids 2 i get_value res results 2 i res ENDFOR nothing where results EQ count IF count NE 0 THEN BEGIN nothing dialog_message Some of the text box are still empty dialog_parent event top information return ENDIF now we give the result to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptresult ptresult temporary results we destroy the widget widget_control event top destroy RETURN END PRO papsize_event event get back the ids of the cw_field widgets widget_control event id get_uvalue uvalue IF uvalue 0 NE ok THEN return idist widget_info event top find_by_uname list id widget_info idist list_select widget_control idist get_uvalue selected selected selected id selected strsplit selected extract now we give the result to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptresult ptresult float selected 3 float selected 4 we destroy the widget widget_control event top destroy RETURN END PRO xask_event event now we give the answer to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptranswer ptranswer event value we destroy the widget widget_control event top destroy RETURN END FUNCTION xask _extra ex base widget_base field cw_field2 base frame return_events column _extra ex ptranswer ptr_new allocate_heap we realize the widget and wait for an answer widget_control base realize set_uvalue ptranswer xmanager xask base we get the answer answer ptranswer we freeing the pointer ptr_free ptranswer RETURN answer END FUNCTION getdir title title nomark nomark nowrite nowrite REPEAT BEGIN dir dialog_pickfile directory must_exist title title make sure dir is ok check read write access and directory separator mark dir file_search dir test_directory test_read test_write 1 keyword_set nowrite mark_directory 1 keyword_set nomark dir dir 0 ENDREP UNTIL dir NE RETURN dir END PRO buildinit IF fix strmid version release 0 1 LT 6 THEN BEGIN print print ERROR print print This version of SAXO needs at least IDL version 6 0 print print ERROR print return ENDIF IF lmgr demo EQ 1 THEN BEGIN print impossible to use buildinit in demo mode return ENDIF init This is the initialisation file it defines the path and the defaut values of some of the common variables this is supposed to speed up IDL a fltarr 1000 1000 100 a 0 path definition define myIDL directory myIDL getdir title Select the home directory my IDL nomark define SAXO directory saxodir getdir title Select SAXO directory nomark nowrite define the path init init path expand_path myIDL : expand_path saxodir : expand_path dir should we keep the compatibility with the old version yes dialog_message shall we keep the compatibility with the old version question default_no yes strlowcase yes init init compatibility with the old version keep_compatibility strtrim fix yes EQ yes 2 define all the commons init init define all the commons all_cm define default directories init init define default directories homedir isadirectory myIDL title Select the default HOME directory iodir getdir title Select the default IO directory init init iodir isadirectory iodir title Select the default IO directory psdir getdir title Select the default postscripts directory init init psdir isadirectory psdir title Select the default postscripts directory imagedir getdir title Select the default images directory init init imagedir isadirectory imagedir title Select the default images directory animdir getdir title Select the default animations directory init init animdir isadirectory animdir title Select the default animations directory number of printer ptnumb xask title Number of accessible printers value 0 long define all the printer parameters init init define printer parameters IF ptnumb NE 0 THEN BEGIN base widget_base column frame cwids lonarr 3 ptnumb FOR i 0 ptnumb 1 DO BEGIN subbase widget_base base row cwids 0 i cw_field subbase string Title printer_human_names strtrim i 2 cwids 1 i cw_field subbase string Title printer_machine_names strtrim i 2 cwids 2 i cw_field subbase string value lpr P Title printer_machine_names strtrim i 2 ENDFOR trash widget_button base value ok uvalue cwids ptresult ptr_new allocate_heap we realize the widget and wait for an answer widget_control base realize set_uvalue ptresult xmanager printerdef base init init printer_human_names strarr strtrim ptnumb 2 printer_machine_names strarr strtrim ptnumb 2 print_command strarr strtrim ptnumb 2 FOR i 0 ptnumb 1 DO BEGIN init init printer_human_names strtrim i 2 ptresult 0 i printer_machine_names strtrim i 2 ptresult 1 i print_command strtrim i 2 ptresult 2 i ENDFOR we freeing the pointer ptr_free ptresult ENDIF ELSE BEGIN init init printer_human_names printer_machine_names print_command ENDELSE Colors init init colors device decomposed 0 device retain 2 default color tables loadct get_names names ntables 40 title Choose the default color table the following lines come from loadct procedure nlines ntables 2 3 of lines to print nend nlines nlines 3 ntables for i 0 nend 1 do Print each line title title string format i2 a17 3x i2 a17 3x i2 a17 i names i i nlines names i nlines i 2 nlines xask title title value 39 long xask title title value 0 long 2 init init archive_ps strtrim archive_ps 2 end of the part that should be modified by the users if needed keep compatibility with the old version updateold filename xask title name of the init file written in homedir: myIDL value init pro string journal myIDL filename FOR i 0 n_elements init 1 DO journal init i journal RETURN END"); 16 a[14] = new Array("./Documentation/xmldoc/idlfiles/init_example.html", "init_example.pro", "", ""); 17 a[15] = new Array("./ForOldVersion/keep_compatibility.html", "keep_compatibility.pro", "", " NAME: keep_compatibility PURPOSE: 1 define key_forgetold 1b keyword_set flag 2 remove all oldcm_used pro found in path 3 define and create myuniquetmpdir and add it to path 4 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro CATEGORY: compatibility with old version CALLING SEQUENCE:keep_compatibility flag INPUTS: flag: 1 or 0 to keep or forget the compatibility dir: the directory where we create oldcm_used pro if omitted is automatically defined to 1b keyword_set key_forgetold COMMON BLOCKS: cm_general SIDE EFFECTS: see purpose RESTRICTIONS: copy oldcm_full or oldcm_empty must be found in the path dir must aslo be in the path MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2005 PRO keep_compatibility flag cm_general version should be at least 6 0 IF fix strmid version release 0 1 LT 6 THEN BEGIN print print ERROR print print This version of SAXO needs at least IDL version 6 0 print print ERROR print return ENDIF IF n_elements myuniquetmpdir NE 0 THEN BEGIN path path : expand_path myuniquetmpdir return ENDIF if n_elements flag eq 0 then flag 1b keyword_set key_forgetold 1 automatic definition of key_forgetold key_forgetold 1b keyword_set flag 2 remove all oldcm_used pro found in path to_rm find oldcm_used IF to_rm 0 NE NOT FOUND THEN file_delete to_rm 3 define and create myuniquetmpdir and add it to path def_myuniquetmpdir 4 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro select which file should be copied to oldcm_used pro IF key_forgetold THEN BEGIN oldcm find oldcm_empty print We forget the compatibility with the old version ENDIF ELSE BEGIN oldcm find oldcm_full print We keep the compatibility with the old version ENDELSE oldcm oldcm 0 IF oldcm EQ NOT FOUND THEN BEGIN print Error: oldcm_full or oldcm_empty must be found in the path stop ENDIF copy file_copy oldcm myuniquetmpdir oldcm_used pro overwrite make sure we can make the plots enev if we are using the demo mode demomode_compatibility make sure that the common variables are correctly initialized IF size ccmeshparameters type NE 8 THEN BEGIN computegrid 1 1 1 1 1 1 fullcgrid cm_4data varname vargrid T vardate 0 varexp varunit valmask 1 e20 ENDIF return END"); 18 a[16] = new Array("./ForOldVersion/oldcm_empty.html", "oldcm_empty.pro", "", ""); 19 a[17] = new Array("./ForOldVersion/oldcm_full.html", "oldcm_full.pro", "", ""); 20 a[18] = new Array("./ForOldVersion/updatekwd.html", "updatekwd.pro", "", ""); 21 a[19] = new Array("./ForOldVersion/updatenew.html", "updatenew.pro", "", ""); 22 a[20] = new Array("./ForOldVersion/updateold.html", "updateold.pro", "", ""); 23 a[21] = new Array("./Grid/computegrid.html", "computegrid.pro", "", " NAME:computegrid PURPOSE:compute the grid parameters from cm_4mesh common: horizontal parameters: glam tf gphi tf e1t and e2t and if FULLCGRID keyword is defined: glam uv gphi uv e1 uvf and e2 uvf verticals parameters: gdep tw e3 tw masks: tmask and if FULLCGRID keyword is defined: uv maskred fmaskred xy triangulation: triangles_list key_ parameters: key_shift key_periodic key_zreverse key_yreverse key_stride key_onearth key_partialstep CATEGORY:grid CALLING SEQUENCE: computegrid startx starty stepx stepy nx ny computegrid startx starty stepx stepy computegrid xaxis xaxis yaxis yaxis or a suitable mix INPUTS: startx:scalar x starting point starty:scalar y starting point stepx:scalar or vector: x direction step must be 0 if vector nx is not used stepy:scalar or vector: y direction step could be 0 south to north or lon1 and lon2 lon1 le 360 key_shift will be defined automaticaly computed according to glamboundary by using the FIRST LINE of glamt but key_shift will 0 only if key_periodic 1 MASK: to specify the mask with a 2 or 3 dimension array ONEARTH 0 or 1: to force the manual definition of key_onearth to specify if the data are on earth use longitude latitude etc By default key_onearth 1 note that ONEARTH 0 forces PERIODIC 0 SHIFT 0 and is cancelling GLAMBOUNDARY PERIODIC 0 or 1: to force the manual definition of key_periodic By default key_periodic is automaticaly computed by using the first line of glamt PLAIN: force PERIODIC 0 SHIFT 0 STRIDE 1 1 1 and suppress the automatic redefinition of the domain in case of x periodicity overlap y periodicity overlap ORCA type only and mask border to 0 SHIFT scalar to force the manual definition of key_shift By debault key_shift is automaticaly computed according to glamboundary when defined by using the FIRST LINE of glamt if key_periodic 0 then in any case key_shift 0 STRCALLING: a string containing the calling command used to call computegrid this is used by xxx pro STRIDE : a 3 elements vector to specify the stride in x y z direction Default definition is 1 1 1 The resulting value will be stored in the common cm_4mesh variable key_stride XAXIS: to specify longitude1 with a 1 or 2 dimension array in this case startx stepx and nx are not used but could be necessary if the y axis is not defined with yaxis It must be possible to sort the first line of xaxis in the increasing order by shifting its elements YAXIS: to specify latitudes with a 1 or 2 dimension array in this case starty stepy and ny are not used but starty and stepy could be necessary if the x axis is not defined with xaxis It must be sorted in the increasing or deceasing order along each column if 2d array XYINDEX: activate to specify that the horizontal grid should be simply defined by using the index of the points xaxis findgen nx and yaxis findgen ny using this keyword forces key_onearth 0 XYZ MINMESH: to define the common variables i xyz minmesh used to define the grid only in a zoomed part of the original grid Defaut values are 0L max value is XYZ MAXMESH XYZ MAXMESH: to define the common variables i xyz maxmesh used to define the grid only in a zoomed part of the original grid Defaut values are jp ijk glo 1 max value is jp ijk glo 1 if XYZ MAXMESH is negative then we define i xyz maxmesh as jp ijk glo 1 XYZ MAXMESH instead of XYZ MAXMESH ZAXIS: to specify the vertical axis with a 1 dimension array Must be sorted in the increasing or deceasing order OUTPUTS: COMMON BLOCKS: cm_4mesh cm_4data cm_4cal SIDE EFFECTS: if the grid has x y periodicity orverlap and or if the mask has 0 everywhere at the border like a close sea and if we did not activate plain and xminmesh xmaxmesh yminmesh ymaxmesh keywords are defined to their default values we redefine xminmesh xmaxmesh yminmesh ymaxmesh in order to reove the overlapping part and or to open the domain avoid ti be forced to use cell_fill 1 RESTRICTIONS:FUV points definition EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 04 20 Sept 2004 several bug fixs to suit C grid type Aug 2005 rewritte almost everything PRO computegrid startx starty stepxin stepyin nxin nyin XAXIS xaxis YAXIS yaxis ZAXIS zaxis MASK mask GLAMBOUNDARY glamboundary XMINMESH xminmesh XMAXMESH xmaxmesh YMINMESH yminmesh YMAXMESH ymaxmesh ZMINMESH zminmesh ZMAXMESH zmaxmesh ONEARTH onearth PERIODIC periodic PLAIN plain SHIFT shift STRIDE stride FULLCGRID fullcgrid XYINDEX xyindex FBASE2TBASE fbase2tbase STRCALLING strcalling _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF time1 systime 1 for key_performance Check input parameters xaxis related parameters if n_elements xaxis NE 0 then BEGIN CASE size xaxis 0 OF 0:nx 1L 1:nx size xaxis 1 2:nx size xaxis 1 ENDCASE ENDIF ELSE BEGIN IF n_elements startx EQ 0 THEN BEGIN dummy report If xaxis is not given startx must be defined return ENDIF CASE n_elements stepxin OF 0:BEGIN dummy report If xaxis is not given stepxin must be defined return END 1:BEGIN IF n_elements nxin EQ 0 THEN BEGIN dummy report If xaxis is not given and stepxin has only one element nx must be defined return ENDIF ELSE nx nxin END ELSE:nx n_elements stepxin ENDCASE ENDELSE yaxis related parameters if n_elements yaxis NE 0 then BEGIN CASE size yaxis 0 OF 0:ny 1L 1:ny size yaxis 1 2:ny size yaxis 2 ENDCASE ENDIF ELSE BEGIN IF n_elements starty EQ 0 THEN BEGIN dummy report If yaxis is not given starty must be defined return ENDIF CASE n_elements stepyin OF 0:BEGIN dummy report If yaxis is not given stepyin must be defined return END 1:BEGIN IF n_elements nyin EQ 0 THEN BEGIN dummy report If yaxis is not given and stepyin has only one element ny must be defined return ENDIF ELSE ny nyin END ELSE:ny n_elements stepyin ENDCASE ENDELSE zaxis related parameters if n_elements zaxis NE 0 then BEGIN CASE size zaxis 0 OF 0:nz 1L 1:nz size zaxis 1 ELSE:BEGIN print not coded stop END ENDCASE ENDIF ELSE nz 1L Others automatic definitions jpiglo long nx jpjglo long ny jpkglo long nz impact of plain keyword: IF keyword_set plain THEN BEGIN periodic 0 shift 0 stride 1 1 1 ENDIF IF n_elements xminmesh NE 0 THEN ixminmesh long xminmesh 0 ELSE ixminmesh 0l IF n_elements xmaxmesh NE 0 THEN ixmaxmesh long xmaxmesh 0 ELSE ixmaxmesh jpiglo 1 IF n_elements yminmesh NE 0 THEN iyminmesh long yminmesh 0 ELSE iyminmesh 0l IF n_elements ymaxmesh NE 0 THEN iymaxmesh long ymaxmesh 0 ELSE iymaxmesh jpjglo 1 IF n_elements zminmesh NE 0 THEN izminmesh long zminmesh 0 ELSE izminmesh 0l IF n_elements zmaxmesh NE 0 THEN izmaxmesh long zmaxmesh 0 ELSE izmaxmesh jpkglo 1 iymaxmesh iymaxmesh keyword_set fbase2tbase IF ixmaxmesh LT 0 THEN ixmaxmesh jpiglo 1 ixmaxmesh IF iymaxmesh LT 0 THEN iymaxmesh jpjglo 1 iymaxmesh IF izmaxmesh LT 0 THEN izmaxmesh jpkglo 1 izmaxmesh avoid basics errors ixmaxmesh 0 ixmaxmesh ixminmesh iymaxmesh iyminmesh izmaxmesh izminmesh temporary glamf gphif temporary glamu gphiu temporary glamv gphiv gdept stepz 2 ENDIF ELSE BEGIN stepz 1 gdepw gdept ENDELSE e3 tw : e3t stepz IF n_elements stepz GT 1 THEN BEGIN e3w 0 5 stepz shift stepz 1 e3w 0 0 5 e3t 0 ENDIF ELSE e3w e3t Mask defaut mask eq 1 if NOT keyword_set mask then mask 1 if mask 0 NE 1 then BEGIN tmask byte mask ixminmesh:ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh tmask reform tmask jpi jpj jpk over if key_shift NE 0 then tmask shift tmask key_shift 0 0 because tmask reverse tmask 2 is not working if the 3rd dimension of tmask 1 we call reform IF jpk EQ 1 THEN tmask reform tmask over IF key_yreverse EQ 1 THEN tmask reverse tmask 2 IF jpk EQ 1 THEN tmask reform tmask jpi jpj jpk over IF key_zreverse EQ 1 THEN tmask reverse tmask 3 IF jpk EQ 1 THEN tmask reform tmask jpi jpj jpk over IF keyword_set fullcgrid THEN BEGIN IF keyword_set key_periodic THEN BEGIN msk tmask shift tmask 1 0 0 umaskred msk jpi 1 ENDIF ELSE umaskred tmask jpi 1 vmaskred tmask jpj 1 fmaskredy tmask jpi 1 fmaskredx tmask jpj 1 ENDIF ENDIF ELSE BEGIN tmask replicate 1b jpi jpj jpk IF keyword_set fullcgrid THEN BEGIN umaskred replicate 1b jpj jpk vmaskred replicate 1b jpi jpk fmaskredy replicate 1b jpj jpk fmaskredx replicate 1b jpi jpk ENDIF ENDELSE IF jpi GT 2 AND jpj GT 2 AND NOT keyword_set plain AND ixminmesh EQ 0l AND ixmaxmesh eq jpiglo 1 AND iyminmesh EQ 0l AND iymaxmesh eq jpjglo 1 AND total tmask 0 EQ 0 AND total tmask jpj 1 EQ 0 AND total tmask 0 EQ 0 AND total tmask jpi 1 EQ 0 THEN BEGIN xminmesh 1 xmaxmesh 1 yminmesh 1 ymaxmesh 1 computegrid XAXIS glamt YAXIS gphit ZAXIS zaxis MASK mask GLAMBOUNDARY glamboundary XMINMESH xminmesh XMAXMESH xmaxmesh YMINMESH yminmesh YMAXMESH ymaxmesh ZMINMESH zminmesh ZMAXMESH zmaxmesh ONEARTH onearth PERIODIC periodic PLAIN plain SHIFT shift STRIDE stride FULLCGRID fullcgrid XYINDEX xyindex FBASE2TBASE fbase2tbase STRCALLING strcalling _extra ex return ENDIF IF NOT keyword_set fullcgrid THEN BEGIN umaskred values f_nan vmaskred values f_nan fmaskredy values f_nan fmaskredx values f_nan ENDIF stride IF total key_stride GT 3 THEN BEGIN IF key_shift NE 0 THEN BEGIN for explanation see header of read_ncdf_varget pro jpiright key_shift jpileft jpi key_shift key_stride 0 1 key_shift 1 MOD key_stride 0 jpi jpiright 1 key_stride 0 1 jpileft 1 key_stride 0 1 ENDIF ELSE jpi jpi 1 key_stride 0 1 jpj jpj 1 key_stride 1 1 jpk jpk 1 key_stride 2 1 glamt temporary glamt 0: :stride 0 0: :stride 1 gphit temporary gphit 0: :stride 0 0: :stride 1 e1t temporary e1t 0: :stride 0 0: :stride 1 e2t temporary e2t 0: :stride 0 0: :stride 1 tmask temporary tmask 0: :stride 0 0: :stride 1 0: :stride 2 gdept gdept 0: :stride 2 gdepw gdepw 0: :stride 2 e3t e3t 0: :stride 2 e3w e3w 0: :stride 2 we must recompute glamf and gphif IF jpi GT 1 THEN BEGIN if keyword_set key_onearth AND keyword_set xnotsorted OR keyword_set key_periodic AND key_irregular then BEGIN stepxf glamt 720 MOD 360 stepxf shift stepxf 1 1 stepxf stepxf stepxf stepxf 360 stepxf 360 stepxf min abs stepxf dimension 3 IF NOT keyword_set key_periodic THEN stepxf jpi 1 stepxf jpi 2 ENDIF ELSE BEGIN stepxf shift glamt 1 1 glamt IF keyword_set key_periodic THEN stepxf jpi 1 360 stepxf jpi 1 ELSE stepxf jpi 1 stepxf jpi 2 ENDELSE IF jpj GT 1 THEN BEGIN stepxf jpj 1 stepxf jpj 2 stepxf jpi 1 jpj 1 stepxf jpi 2 jpj 2 ENDIF glamf glamt 0 5 stepxf ENDIF ELSE glamf glamt 0 5 IF jpj GT 1 THEN BEGIN we must compute stepyf: y distance between T i j T i 1 j 1 stepyf shift gphit 1 1 gphit stepyf jpj 1 stepyf jpj 2 IF jpi GT 1 THEN BEGIN if NOT keyword_set key_periodic THEN stepyf jpi 1 stepyf jpi 2 stepyf jpi 1 jpj 1 stepyf jpi 2 jpj 2 ENDIF gphif gphit 0 5 stepyf ENDIF ELSE gphif gphit 0 5 IF jpj EQ 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over e1t reform e1t jpi jpj over e2t reform e2t jpi jpj over ENDIF IF keyword_set fullcgrid THEN BEGIN glamu temporary glamu 0: :stride 0 0: :stride 1 gphiu temporary gphiu 0: :stride 0 0: :stride 1 e1u temporary e1u 0: :stride 0 0: :stride 1 e2u temporary e2u 0: :stride 0 0: :stride 1 glamv temporary glamv 0: :stride 0 0: :stride 1 gphiv temporary gphiv 0: :stride 0 0: :stride 1 e1v temporary e1v 0: :stride 0 0: :stride 1 e2v temporary e2v 0: :stride 0 0: :stride 1 e1f temporary e1f 0: :stride 0 0: :stride 1 e2f temporary e2f 0: :stride 0 0: :stride 1 umaskred temporary umaskred 0 0: :stride 1 0: :stride 2 vmaskred temporary vmaskred 0: :stride 0 0 0: :stride 2 fmaskredy temporary fmaskredy 0 0: :stride 1 0: :stride 2 fmaskredx temporary fmaskredx 0: :stride 0 0 0: :stride 2 IF jpj EQ 1 THEN BEGIN glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over e1u reform e1u jpi jpj over e2u reform e2u jpi jpj over glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over e1v reform e1v jpi jpj over e2v reform e2v jpi jpj over e1f reform e1f jpi jpj over e2f reform e2f jpi jpj over ENDIF ENDIF ENDIF apply all the grid parameters updateold domdef Triangulation IF total tmask EQ jpi jpj jpk AND NOT keyword_set key_irregular THEN triangles_list 1 ELSE BEGIN are we using ORCA2 IF jpiglo EQ 182 AND jpi EQ 181 AND jpjglo EQ 149 AND jpj EQ 148 THEN triangles_list triangule ELSE triangles_list triangule keep_cont ENDELSE time axis default definition IF n_elements time EQ 0 OR n_elements jpt EQ 0 THEN BEGIN jpt 1 time 0 ENDIF IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF grid parameters used by xxx IF NOT keyword_set strcalling THEN BEGIN IF n_elements ccmeshparameters EQ 0 THEN strcalling computegrid ELSE strcalling ccmeshparameters filename ENDIF IF n_elements glamt GE 2 THEN BEGIN glaminfo moment glamt IF finite glaminfo 2 EQ 0 THEN glaminfo glaminfo 0:1 gphiinfo moment gphit IF finite gphiinfo 2 EQ 0 THEN gphiinfo gphiinfo 0:1 ENDIF ELSE BEGIN glaminfo glamt gphiinfo gphit ENDELSE ccmeshparameters filename:strcalling glaminfo:float string glaminfo format E11 4 gphiinfo:float string gphiinfo format E11 4 jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift key_periodic:key_periodic key_stride:key_stride key_gridtype:key_gridtype key_yreverse:key_yreverse key_zreverse:key_zreverse key_partialstep:key_partialstep key_onearth:key_onearth ccreadparameters funclec_name: read_ncdf jpidta:jpidta jpjdta:jpjdta jpkdta:jpkdta ixmindta:ixmindta ixmaxdta:ixmaxdta iymindta:iymindta iymaxdta:iymaxdta izmindta:izmindta izmaxdta:izmaxdta IF keyword_set key_performance EQ 1 THEN print time computegrid systime 1 time1 return end "); 24 a[22] = new Array("./Grid/micromeshmask.html", "micromeshmask.pro", "", " NAME: micromeshmask pro PURPOSE: reduce the size of the NetCDF meshmask created by OPA by using bit and not byte format for the masks and the foat format for the other fields CATEGORY:for OPA meshmask files CALLING SEQUENCE: reducencmeshmask ncfilein ncfileout INPUTS: ncfilein: 1 the name of the meshmask file to be reduced In that case there is only one meshmask file OR 2 the xxx part in the names: xxx mesh_hgr nc xxx mesh_zgr nc xxx mask nc In that case the meshmask is split into 3 files ncfileout: the name of the uniq reduced meshmask file default definition is micromeshmask nc KEYWORD PARAMETERSSAT: IODIR:to define the files path OUTPUTS: no COMMON BLOCKS: no EXAMPLE: IDL meshdir d1fes2 raid2 smasson DATA ORCA05 IDL micromeshmask meshmask_ORCA_R05 nc iodir meshdir MODIFICATION HISTORY: July 2004 Sebastien Masson smasson lodyc jussieu fr PRO ncdf_transfer inid outid inname outname IF n_elements outname EQ 0 THEN outname inname ncdf_varget inid inname zzz ncdf_varput outid outname float reform zzz over RETURN END PRO micromeshmask ncfilein ncfileout IODIR iodir filein isafile FILE ncfilein IODIR iodir NEW test findfile filein 0 IF test EQ THEN BEGIN filein_hgr findfile filein mesh_hgr nc 0 filein_zgr findfile filein mesh_zgr nc 0 filein_msk findfile filein mask nc 0 IF filein_hgr EQ OR filein_zgr EQ OR filein_msk EQ THEN BEGIN print meshmask file s not found print filein does not exist print filein mesh_hgr nc does not exist print filein mesh_zgr nc does not exist print filein mask nc does not exist return ENDIF ENDIF ELSE filein test get the horizontal dimensions IF n_elements filein_hgr NE 0 THEN cdfid ncdf_open filein_hgr ELSE cdfid ncdf_open filein ncdf_diminq cdfid x name jpi ncdf_diminq cdfid y name jpj for the mask we use its byte representation its y dimension will be extended to be a multiple of 8 then it will be divided by 8 if jpj mod 8 eq 0 the jpj_m jpi 8 else jpj_m jpi 8 1 jpj_m jpj 7 8 get the vertical dimensions IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpk ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpk ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth return ENDELSE ENDELSE get the variables list related to the partial steps varlist_ps ncdf_listvars cdfid varlist_ps strtrim strlowcase varlist_ps 2 define the output file IF n_elements ncfileout EQ 0 THEN ncfileout micromeshmask nc cdfidout ncdf_create isafile FILE ncfileout IODIR iodir NEW clobber ncdf_control cdfidout nofill dimension dimidx ncdf_dimdef cdfidout x jpi dimidy ncdf_dimdef cdfidout y jpj dimidy_m ncdf_dimdef cdfidout y_m jpj_m dimidz ncdf_dimdef cdfidout z jpk global attributs ncdf_attput cdfidout IDL_Program_Name micromeshmask pro GLOBAL ncdf_attput cdfidout Creation_Date systime GLOBAL declaration des variables varid lonarr 20 horizontal variables hgrlist glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f FOR h 0 n_elements hgrlist 1 DO varid h ncdf_vardef cdfidout hgrlist h dimidx dimidy float vertical variables zgrlist e3t e3w gdept gdepw FOR z 0 n_elements zgrlist 1 DO varid 16 z ncdf_vardef cdfidout zgrlist z dimidz float variables related to the partial steps IF where varlist_ps EQ hdept 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdept dimidx dimidy float IF where varlist_ps EQ hdepw 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdepw dimidx dimidy float old variable name keep for compatibility with old run Change e3tp to e3t_ps IF where varlist_ps EQ e3tp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float old variable name keep for compatibility with old run Change e3wp to e3w_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3t_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float IF where varlist_ps EQ e3w_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3u_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3u_ps dimidx dimidy float IF where varlist_ps EQ e3v_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3v_ps dimidx dimidy float mask variable msklist tmask umask vmask fmask FOR m 0 n_elements msklist 1 DO BEGIN varid varid ncdf_vardef cdfidout msklist m dimidx dimidy_m dimidz byte ncdf_attput cdfidout varid n_elements varid 1 Comment the mask is stored as bit You must use the binary representation of the byte to get back the data ENDFOR ncdf_control cdfidout endef get the horizontal variables IF n_elements filein_hgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_hgr ENDIF FOR h 0 n_elements hgrlist 1 DO ncdf_transfer cdfid cdfidout hgrlist h get the vertical variables IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF FOR z 0 n_elements zgrlist 1 DO ncdf_transfer cdfid cdfidout zgrlist z partial step variables IF where varlist_ps EQ hdept 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdept IF where varlist_ps EQ hdepw 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdepw IF where varlist_ps EQ e3tp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3tp e3t_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3wp e3w_ps IF where varlist_ps EQ e3t_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3t_ps IF where varlist_ps EQ e3w_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3w_ps IF where varlist_ps EQ e3u_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3u_ps IF where varlist_ps EQ e3v_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3v_ps mask IF n_elements filein_msk NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_msk ENDIF loop on the vertical levels to limit the memory use FOR k 0 jpk 1 DO BEGIN FOR m 0 3 DO BEGIN CASE ncdf_varinq cdfid msklist m ndims OF 3:ncdf_varget cdfid msklist m zzz offset 0 0 k count jpi jpj 1 4:ncdf_varget cdfid msklist m zzz offset 0 0 k 0 count jpi jpj 1 1 ENDCASE zzz byte temporary zzz zzz must contain only 0 or 1 zzz temporary zzz MOD 2 we transpose zzz because we need to work with the y dimension as the first dimension zzz transpose temporary zzz extend jpj to be a multiple of 8 jpjadd jpj_m 8 jpj IF jpjadd NE 0 THEN zzz temporary zzz bytarr jpjadd jpi reform zzz to look like output of binary pro zzz reform zzz 8 1 jpj_m jpi over convert into its byte form zzz inverse_binary temporary zzz ncdf_varput cdfidout msklist m transpose temporary zzz offset 0 0 k count jpi jpj_m 1 ENDFOR ENDFOR ncdf_close cdfid ncdf_close cdfidout RETURN END"); 25 a[23] = new Array("./Grid/n128gaussian.html", "n128gaussian.pro", "", " NAME:n128gaussian PURPOSE:compute the latitudes of the n128 gaussian grid See: http: www ecmwf int products data technical gaussian n128FIS html CATEGORY:grid CALLING SEQUENCE:lat n128gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n128gaussian latitude reduced regular latitude number points points n128 1 18 512 89 46282 2 25 512 88 76695 3 36 512 88 06697 4 40 512 87 36606 5 45 512 86 66480 6 50 512 85 96337 7 60 512 85 26184 8 64 512 84 56026 9 72 512 83 85863 10 72 512 83 15698 11 80 512 82 45531 12 90 512 81 75363 13 90 512 81 05194 14 100 512 80 35023 15 108 512 79 64852 16 120 512 78 94681 17 120 512 78 24509 18 125 512 77 54336 19 128 512 76 84163 20 144 512 76 13990 21 144 512 75 43817 22 150 512 74 73644 23 160 512 74 03470 24 160 512 73 33296 25 180 512 72 63123 26 180 512 71 92949 27 180 512 71 22774 28 192 512 70 52600 29 192 512 69 82426 30 200 512 69 12252 31 216 512 68 42077 32 216 512 67 71903 33 216 512 67 01728 34 225 512 66 31554 35 240 512 65 61379 36 240 512 64 91204 37 240 512 64 21030 38 250 512 63 50855 39 250 512 62 80680 40 256 512 62 10505 41 270 512 61 40330 42 270 512 60 70156 43 288 512 59 99981 44 288 512 59 29806 45 288 512 58 59631 46 300 512 57 89456 47 300 512 57 19281 48 320 512 56 49106 49 320 512 55 78931 50 320 512 55 08756 51 320 512 54 38581 52 324 512 53 68406 53 360 512 52 98231 54 360 512 52 28056 55 360 512 51 57881 56 360 512 50 87705 57 360 512 50 17530 58 360 512 49 47355 59 360 512 48 77180 60 375 512 48 07005 61 375 512 47 36830 62 375 512 46 66655 63 375 512 45 96479 64 384 512 45 26304 65 384 512 44 56129 66 400 512 43 85954 67 400 512 43 15779 68 400 512 42 45604 69 400 512 41 75428 70 405 512 41 05253 71 432 512 40 35078 72 432 512 39 64903 73 432 512 38 94728 74 432 512 38 24552 75 432 512 37 54377 76 432 512 36 84202 77 432 512 36 14027 78 450 512 35 43851 79 450 512 34 73676 80 450 512 34 03501 n128 n128 81 450 512 33 33326 82 450 512 32 63150 83 480 512 31 92975 84 480 512 31 22800 85 480 512 30 52625 86 480 512 29 82449 87 480 512 29 12274 88 480 512 28 42099 89 480 512 27 71924 90 480 512 27 01748 91 480 512 26 31573 92 480 512 25 61398 93 486 512 24 91223 94 486 512 24 21047 95 486 512 23 50872 96 500 512 22 80697 97 500 512 22 10521 98 500 512 21 40346 99 500 512 20 70171 100 500 512 19 99996 101 500 512 19 29820 102 500 512 18 59645 103 512 512 17 89470 104 512 512 17 19294 105 512 512 16 49119 106 512 512 15 78944 107 512 512 15 08768 108 512 512 14 38593 109 512 512 13 68418 110 512 512 12 98243 111 512 512 12 28067 112 512 512 11 57892 113 512 512 10 87717 114 512 512 10 17541 115 512 512 9 47366 116 512 512 8 77191 117 512 512 8 07016 118 512 512 7 36840 119 512 512 6 66665 120 512 512 5 96490 121 512 512 5 26314 122 512 512 4 56139 123 512 512 3 85964 124 512 512 3 15788 125 512 512 2 45613 126 512 512 1 75438 127 512 512 1 05262 128 512 512 0 35087 n128 reform n128 4 128 over n128 reform n128 3 over n128 n128 reverse n128 return n128 end"); 26 a[24] = new Array("./Grid/n160gaussian.html", "n160gaussian.pro", "", " NAME:n160gaussian PURPOSE:compute the latitudes of the n160 gaussian grid See: http: www ecmwf int products data technical gaussian n160FIS html CATEGORY:grid CALLING SEQUENCE:lat n160gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n160gaussian latitude reduced regular latitude number points points n160 1 18 640 89 57009 2 25 640 89 01318 3 36 640 88 45297 4 40 640 87 89203 5 45 640 87 33080 6 50 640 86 76944 7 60 640 86 20800 8 64 640 85 64651 9 72 640 85 08499 10 72 640 84 52345 11 80 640 83 96190 12 90 640 83 40033 13 90 640 82 83876 14 96 640 82 27718 15 108 640 81 71559 16 120 640 81 15400 17 120 640 80 59240 18 125 640 80 03080 19 128 640 79 46920 20 135 640 78 90760 21 144 640 78 34600 22 150 640 77 78439 23 160 640 77 22278 24 160 640 76 66117 25 180 640 76 09956 26 180 640 75 53795 27 180 640 74 97634 28 192 640 74 41473 29 192 640 73 85311 30 200 640 73 29150 31 216 640 72 72988 32 216 640 72 16827 33 225 640 71 60665 34 225 640 71 04504 35 240 640 70 48342 36 240 640 69 92181 37 243 640 69 36019 38 250 640 68 79857 39 256 640 68 23695 40 270 640 67 67534 41 270 640 67 11372 42 288 640 66 55210 43 288 640 65 99048 44 288 640 65 42886 45 300 640 64 86725 46 300 640 64 30563 47 320 640 63 74401 48 320 640 63 18239 49 320 640 62 62077 50 320 640 62 05915 51 324 640 61 49753 52 360 640 60 93591 53 360 640 60 37429 54 360 640 59 81267 55 360 640 59 25105 56 360 640 58 68943 57 360 640 58 12781 58 375 640 57 56619 59 375 640 57 00457 60 375 640 56 44295 61 384 640 55 88133 62 384 640 55 31971 63 400 640 54 75809 64 400 640 54 19647 65 400 640 53 63485 66 405 640 53 07323 67 432 640 52 51161 68 432 640 51 94999 69 432 640 51 38837 70 432 640 50 82675 71 432 640 50 26513 72 450 640 49 70351 73 450 640 49 14189 74 450 640 48 58026 75 450 640 48 01864 76 480 640 47 45702 77 480 640 46 89540 78 480 640 46 33378 79 480 640 45 77216 80 480 640 45 21054 n160 n160 81 480 640 44 64892 82 480 640 44 08730 83 500 640 43 52567 84 500 640 42 96405 85 500 640 42 40243 86 500 640 41 84081 87 500 640 41 27919 88 512 640 40 71757 89 512 640 40 15595 90 540 640 39 59433 91 540 640 39 03270 92 540 640 38 47108 93 540 640 37 90946 94 540 640 37 34784 95 540 640 36 78622 96 540 640 36 22460 97 540 640 35 66298 98 576 640 35 10136 99 576 640 34 53973 100 576 640 33 97811 101 576 640 33 41649 102 576 640 32 85487 103 576 640 32 29325 104 576 640 31 73163 105 576 640 31 17000 106 576 640 30 60838 107 576 640 30 04676 108 600 640 29 48514 109 600 640 28 92352 110 600 640 28 36190 111 600 640 27 80028 112 600 640 27 23865 113 600 640 26 67703 114 600 640 26 11541 115 600 640 25 55379 116 600 640 24 99217 117 640 640 24 43055 118 640 640 23 86892 119 640 640 23 30730 120 640 640 22 74568 121 640 640 22 18406 122 640 640 21 62244 123 640 640 21 06082 124 640 640 20 49919 125 640 640 19 93757 126 640 640 19 37595 127 640 640 18 81433 128 640 640 18 25271 129 640 640 17 69109 130 640 640 17 12946 131 640 640 16 56784 132 640 640 16 00622 133 640 640 15 44460 134 640 640 14 88298 135 640 640 14 32136 136 640 640 13 75973 137 640 640 13 19811 138 640 640 12 63649 139 640 640 12 07487 140 640 640 11 51325 141 640 640 10 95162 142 640 640 10 39000 143 640 640 9 82838 144 640 640 9 26676 145 640 640 8 70514 146 640 640 8 14352 147 640 640 7 58189 148 640 640 7 02027 149 640 640 6 45865 150 640 640 5 89703 151 640 640 5 33541 152 640 640 4 77379 153 640 640 4 21216 154 640 640 3 65054 155 640 640 3 08892 156 640 640 2 52730 157 640 640 1 96568 158 640 640 1 40405 159 640 640 0 84243 160 640 640 0 28081 n160 reform n160 4 160 over n160 reform n160 3 over n160 n160 reverse n160 return n160 end"); 27 a[25] = new Array("./Grid/n256gaussian.html", "n256gaussian.pro", "", " NAME:n256gaussian PURPOSE:compute the latitudes of the n256 gaussian grid See: http: www ecmwf int products data technical gaussian n256FIS html CATEGORY:grid CALLING SEQUENCE:lat n256gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n256gaussian latitude reduced regular latitude number points points n256 1 18 1024 89 73115 2 25 1024 89 38287 3 32 1024 89 03254 4 40 1024 88 68175 5 45 1024 88 33077 6 50 1024 87 97972 7 60 1024 87 62861 8 64 1024 87 27748 9 72 1024 86 92632 10 72 1024 86 57515 11 75 1024 86 22398 12 81 1024 85 87279 13 90 1024 85 52160 14 96 1024 85 17041 15 100 1024 84 81921 16 108 1024 84 46801 17 120 1024 84 11681 18 120 1024 83 76560 19 125 1024 83 41440 20 135 1024 83 06319 21 144 1024 82 71198 22 150 1024 82 36077 23 160 1024 82 00956 24 160 1024 81 65835 25 180 1024 81 30714 26 180 1024 80 95593 27 180 1024 80 60471 28 192 1024 80 25350 29 192 1024 79 90229 30 200 1024 79 55107 31 216 1024 79 19986 32 216 1024 78 84864 33 216 1024 78 49743 34 225 1024 78 14621 35 240 1024 77 79500 36 240 1024 77 44378 37 243 1024 77 09256 38 250 1024 76 74135 39 256 1024 76 39013 40 270 1024 76 03891 41 270 1024 75 68770 42 288 1024 75 33648 43 288 1024 74 98526 44 288 1024 74 63405 45 300 1024 74 28283 46 300 1024 73 93161 47 320 1024 73 58040 48 320 1024 73 22918 49 320 1024 72 87796 50 324 1024 72 52674 51 360 1024 72 17552 52 360 1024 71 82431 53 360 1024 71 47309 54 360 1024 71 12187 55 360 1024 70 77065 56 360 1024 70 41944 57 375 1024 70 06822 58 375 1024 69 71700 59 384 1024 69 36578 60 384 1024 69 01456 61 400 1024 68 66334 62 400 1024 68 31213 63 400 1024 67 96091 64 432 1024 67 60969 65 432 1024 67 25847 66 432 1024 66 90725 67 432 1024 66 55603 68 432 1024 66 20482 69 450 1024 65 85360 70 450 1024 65 50238 71 450 1024 65 15116 72 480 1024 64 79994 73 480 1024 64 44872 74 480 1024 64 09750 75 480 1024 63 74629 76 480 1024 63 39507 77 486 1024 63 04385 78 500 1024 62 69263 79 500 1024 62 34141 80 500 1024 61 99019 n256 n256 81 512 1024 61 63897 82 512 1024 61 28776 83 540 1024 60 93654 84 540 1024 60 58532 85 540 1024 60 23410 86 540 1024 59 88288 87 540 1024 59 53166 88 576 1024 59 18044 89 576 1024 58 82922 90 576 1024 58 47800 91 576 1024 58 12679 92 576 1024 57 77557 93 576 1024 57 42435 94 600 1024 57 07313 95 600 1024 56 72191 96 600 1024 56 37069 97 600 1024 56 01947 98 600 1024 55 66825 99 640 1024 55 31703 100 640 1024 54 96581 101 640 1024 54 61460 102 640 1024 54 26338 103 640 1024 53 91216 104 640 1024 53 56094 105 640 1024 53 20972 106 640 1024 52 85850 107 648 1024 52 50728 108 675 1024 52 15606 109 675 1024 51 80484 110 675 1024 51 45362 111 675 1024 51 10241 112 675 1024 50 75119 113 675 1024 50 39997 114 720 1024 50 04875 115 720 1024 49 69753 116 720 1024 49 34631 117 720 1024 48 99509 118 720 1024 48 64387 119 720 1024 48 29265 120 720 1024 47 94143 121 720 1024 47 59021 122 720 1024 47 23899 123 729 1024 46 88778 124 729 1024 46 53656 125 750 1024 46 18534 126 750 1024 45 83412 127 750 1024 45 48290 128 750 1024 45 13168 129 750 1024 44 78046 130 768 1024 44 42924 131 768 1024 44 07802 132 768 1024 43 72680 133 768 1024 43 37558 134 800 1024 43 02436 135 800 1024 42 67315 136 800 1024 42 32193 137 800 1024 41 97071 138 800 1024 41 61949 139 800 1024 41 26827 140 800 1024 40 91705 141 800 1024 40 56583 142 810 1024 40 21461 143 810 1024 39 86339 144 864 1024 39 51217 145 864 1024 39 16095 146 864 1024 38 80973 147 864 1024 38 45851 148 864 1024 38 10730 149 864 1024 37 75608 150 864 1024 37 40486 151 864 1024 37 05364 152 864 1024 36 70242 153 864 1024 36 35120 154 864 1024 35 99998 155 864 1024 35 64876 156 864 1024 35 29754 157 864 1024 34 94632 158 900 1024 34 59510 159 900 1024 34 24388 160 900 1024 33 89266 n256 n256 161 900 1024 33 54145 162 900 1024 33 19023 163 900 1024 32 83901 164 900 1024 32 48779 165 900 1024 32 13657 166 900 1024 31 78535 167 900 1024 31 43413 168 900 1024 31 08291 169 960 1024 30 73169 170 960 1024 30 38047 171 960 1024 30 02925 172 960 1024 29 67803 173 960 1024 29 32681 174 960 1024 28 97559 175 960 1024 28 62438 176 960 1024 28 27316 177 960 1024 27 92194 178 960 1024 27 57072 179 960 1024 27 21950 180 960 1024 26 86828 181 960 1024 26 51706 182 960 1024 26 16584 183 960 1024 25 81462 184 960 1024 25 46340 185 960 1024 25 11218 186 960 1024 24 76096 187 960 1024 24 40974 188 960 1024 24 05852 189 960 1024 23 70731 190 960 1024 23 35609 191 972 1024 23 00487 192 972 1024 22 65365 193 972 1024 22 30243 194 972 1024 21 95121 195 972 1024 21 59999 196 1000 1024 21 24877 197 1000 1024 20 89755 198 1000 1024 20 54633 199 1000 1024 20 19511 200 1000 1024 19 84389 201 1000 1024 19 49267 202 1000 1024 19 14145 203 1000 1024 18 79023 204 1000 1024 18 43902 205 1000 1024 18 08780 206 1000 1024 17 73658 207 1000 1024 17 38536 208 1000 1024 17 03414 209 1000 1024 16 68292 210 1000 1024 16 33170 211 1000 1024 15 98048 212 1024 1024 15 62926 213 1024 1024 15 27804 214 1024 1024 14 92682 215 1024 1024 14 57560 216 1024 1024 14 22438 217 1024 1024 13 87316 218 1024 1024 13 52194 219 1024 1024 13 17073 220 1024 1024 12 81951 221 1024 1024 12 46829 222 1024 1024 12 11707 223 1024 1024 11 76585 224 1024 1024 11 41463 225 1024 1024 11 06341 226 1024 1024 10 71219 227 1024 1024 10 36097 228 1024 1024 10 00975 229 1024 1024 9 65853 230 1024 1024 9 30731 231 1024 1024 8 95609 232 1024 1024 8 60487 233 1024 1024 8 25365 234 1024 1024 7 90244 235 1024 1024 7 55122 236 1024 1024 7 20000 237 1024 1024 6 84878 238 1024 1024 6 49756 239 1024 1024 6 14634 240 1024 1024 5 79512 n256 n256 241 1024 1024 5 44390 242 1024 1024 5 09268 243 1024 1024 4 74146 244 1024 1024 4 39024 245 1024 1024 4 03902 246 1024 1024 3 68780 247 1024 1024 3 33658 248 1024 1024 2 98536 249 1024 1024 2 63415 250 1024 1024 2 28293 251 1024 1024 1 93171 252 1024 1024 1 58049 253 1024 1024 1 22927 254 1024 1024 0 87805 255 1024 1024 0 52683 256 1024 1024 0 17561 n256 reform n256 4 256 over n256 reform n256 3 over n256 n256 reverse n256 return n256 end"); 28 a[26] = new Array("./Grid/n48gaussian.html", "n48gaussian.pro", "", " NAME:n48gaussian PURPOSE:compute the latitudes of the n48 gaussian grid See: http: www ecmwf int products data technical gaussian n48FIS html CATEGORY:grid CALLING SEQUENCE:lat n48gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n48gaussian latitude reduced regular latitude number points points n48 1 20 192 88 57216 2 25 192 86 72253 3 36 192 84 86197 4 40 192 82 99894 5 45 192 81 13497 6 50 192 79 27055 7 60 192 77 40588 8 60 192 75 54106 9 72 192 73 67613 10 75 192 71 81113 11 80 192 69 94608 12 90 192 68 08099 13 96 192 66 21587 14 100 192 64 35073 15 108 192 62 48557 16 120 192 60 62039 17 120 192 58 75520 18 120 192 56 89001 19 128 192 55 02480 20 135 192 53 15959 21 144 192 51 29437 22 144 192 49 42915 23 160 192 47 56392 24 160 192 45 69869 25 160 192 43 83345 26 160 192 41 96822 27 160 192 40 10297 28 180 192 38 23773 29 180 192 36 37249 30 180 192 34 50724 31 180 192 32 64199 32 180 192 30 77674 33 192 192 28 91149 34 192 192 27 04623 35 192 192 25 18098 36 192 192 23 31573 37 192 192 21 45047 38 192 192 19 58521 39 192 192 17 71996 40 192 192 15 85470 41 192 192 13 98944 42 192 192 12 12418 43 192 192 10 25892 44 192 192 8 39366 45 192 192 6 52840 46 192 192 4 66314 47 192 192 2 79788 48 192 192 0 93262 n48 reform n48 4 48 over n48 reform n48 3 over n48 n48 reverse n48 return n48 end"); 29 a[27] = new Array("./Grid/n80gaussian.html", "n80gaussian.pro", "", " NAME:n80gaussian PURPOSE:compute the latitudes of the n80 gaussian grid See: http: www ecmwf int products data technical gaussian n80FIS html CATEGORY:grid CALLING SEQUENCE:lat n80gaussian INPUTS:None KEYWORD PARAMETERS:None OUTPUTS:a 1d array COMMON BLOCKS:None SIDE EFFECTS:None RESTRICTIONS:None EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr June 2004 FUNCTION n80gaussian latitude reduced regular latitude number points points n80 1 18 320 89 14152 2 25 320 88 02943 3 36 320 86 91077 4 40 320 85 79063 5 45 320 84 66992 6 54 320 83 54895 7 60 320 82 42782 8 64 320 81 30659 9 72 320 80 18531 10 72 320 79 06398 11 80 320 77 94262 12 90 320 76 82124 13 96 320 75 69984 14 100 320 74 57843 15 108 320 73 45701 16 120 320 72 33558 17 120 320 71 21414 18 128 320 70 09269 19 135 320 68 97124 20 144 320 67 84978 21 144 320 66 72833 22 150 320 65 60686 23 160 320 64 48540 24 160 320 63 36393 25 180 320 62 24246 26 180 320 61 12099 27 180 320 59 99952 28 192 320 58 87804 29 192 320 57 75657 30 200 320 56 63509 31 200 320 55 51361 32 216 320 54 39214 33 216 320 53 27066 34 216 320 52 14917 35 225 320 51 02769 36 225 320 49 90621 37 240 320 48 78473 38 240 320 47 66325 39 240 320 46 54176 40 256 320 45 42028 41 256 320 44 29879 42 256 320 43 17731 43 256 320 42 05582 44 288 320 40 93434 45 288 320 39 81285 46 288 320 38 69137 47 288 320 37 56988 48 288 320 36 44839 49 288 320 35 32691 50 288 320 34 20542 51 288 320 33 08393 52 288 320 31 96244 53 300 320 30 84096 54 300 320 29 71947 55 300 320 28 59798 56 300 320 27 47649 57 320 320 26 35500 58 320 320 25 23351 59 320 320 24 11203 60 320 320 22 99054 61 320 320 21 86905 62 320 320 20 74756 63 320 320 19 62607 64 320 320 18 50458 65 320 320 17 38309 66 320 320 16 26160 67 320 320 15 14011 68 320 320 14 01862 69 320 320 12 89713 70 320 320 11 77564 71 320 320 10 65415 72 320 320 9 53266 73 320 320 8 41117 74 320 320 7 28968 75 320 320 6 16819 76 320 320 5 04670 77 320 320 3 92521 78 320 320 2 80372 79 320 320 1 68223 80 320 320 0 56074 n80 reform n80 4 80 over n80 reform n80 3 over n80 n80 reverse n80 return n80 end"); 30 a[28] = new Array("./Grid/ncdf_meshread.html", "ncdf_meshread.pro", "", " NAME:ncdf_meshread PURPOSE:read NetCDF meshmask file created by OPA CATEGORY:grid reading CALLING SEQUENCE:ncdf_meshread filename INPUTS: filename: the name of the meshmask file to read Default is meshmask nc if this name does not contain any and if iodirectory keyword is not specify then the common variable iodir will be use to define the mesh file path KEYWORD PARAMETERS: GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be automaticaly defined according to GLAMBOUNDARY CHECKDAT: Suppressed Use micromeshmask pro to create an appropriate meshmask ONEARTH 0 or 1: to force the manual definition of key_onearth to specify if the data are on earth use longitude latitude etc By default key_onearth 1 note that ONEARTH 0 forces PERIODIC 0 SHIFT 0 and is cancelling GLAMBOUNDARY PERIODIC 0 or 1: to force the manual definition of key_periodic By default key_periodic is automaticaly computed by using the first line of glamt SHIFT : to force the manual definition of key_shift By debault key_shift is automaticaly computed according to the glamboundary when defined by using the first line of glamt if key_periodic 0 then in any case key_shift 0 STRCALLING: a string containing the calling command used to call computegrid this is used by xxx pro STRIDE : a 3 elements vector to specify the stride in x y z direction Default definition is key_stride The resulting value will be stored in the common cm_4mesh variable key_stride OUTPUTS:none COMMON BLOCKS: cm_4mesh cm_4data cm_4cal SIDE EFFECTS: define and or use common variables from cm_4mesh cm_4data cm_4cal RESTRICTIONS: ixminmesh ixmaxmesh iyminmesh iymaxmesh izminmesh izmaxmesh must be defined febore calling ncdf_meshread if some of those value are equal to 1 they will be automatically defined EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 12 1999 July 2004 Sebastien Masson: Several modifications micromeshmask clean partial steps clean use of key_stride automatic definition of key_shift Oct 2004 Sebastien Masson: add PERIODIC and SHIFT Aug 2005 Sebastien Masson: some cleaning english PRO ncdf_meshread filename GLAMBOUNDARY glamboundary CHECKDAT checkdat ONEARTH onearth GETDIMENSIONS getdimensions PERIODIC periodic SHIFT shift STRIDE stride STRCALLING strcalling _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 for key_performance IF keyword_set CHECKDAT THEN BEGIN print The keyword CHECKDAT has been suppressed it could create bugs print Remove it from the call of ncdf_meshread print Please use smallmeshmask pro or micromeshmask pro to create a print meshmask that has manageable size return ENDIF find meshfile name and open it def de filename par defaut IF n_params EQ 0 then filename meshmask nc meshname isafile file filename iodirectory iodir _EXTRA ex meshname meshname 0 noticebase xnotice Reading file C meshname C if the meshmask is on tape archive get it back IF version OS_FAMILY EQ unix THEN spawn file meshname dev null cdfid ncdf_open meshname contient ncdf_inquire cdfid dimensions ncdf_diminq cdfid x name jpiglo ncdf_diminq cdfid y name jpjglo listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpkglo ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpkglo ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth stop ENDELSE ENDELSE if keyword_set getdimensions then begin widget_control noticebase bad_id nothing destroy ncdf_close cdfid return endif check that all i xyz min ax mesh are well defined if n_elements ixminmesh EQ 0 THEN ixminmesh 0 if n_elements ixmaxmesh EQ 0 then ixmaxmesh jpiglo 1 if ixminmesh EQ 1 THEN ixminmesh 0 IF ixmaxmesh EQ 1 then ixmaxmesh jpiglo 1 if n_elements iyminmesh EQ 0 THEN iyminmesh 0 IF n_elements iymaxmesh EQ 0 then iymaxmesh jpjglo 1 if iyminmesh EQ 1 THEN iyminmesh 0 IF iymaxmesh EQ 1 then iymaxmesh jpjglo 1 if n_elements izminmesh EQ 0 THEN izminmesh 0 IF n_elements izmaxmesh EQ 0 then izmaxmesh jpkglo 1 if izminmesh EQ 1 THEN izminmesh 0 IF izmaxmesh EQ 1 then izmaxmesh jpkglo 1 definition of jpi jpj jpj jpi long ixmaxmesh ixminmesh 1 jpj long iymaxmesh iyminmesh 1 jpk long izmaxmesh izminmesh 1 check onearth and its consequences IF n_elements onearth EQ 0 THEN key_onearth 1 ELSE key_onearth keyword_set onearth IF NOT key_onearth THEN BEGIN periodic 0 shift 0 ENDIF automatic definition of key_periodic IF n_elements periodic EQ 0 THEN BEGIN IF jpi GT 1 THEN BEGIN varinq ncdf_varinq cdfid glamt CASE varinq ndims OF 2:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh count jpi 1 3:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 count jpi 1 1 4:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 0 count jpi 1 1 1 ENDCASE xaxis xaxis 720 MOD 360 xaxis xaxis sort xaxis key_periodic xaxis jpi 1 2 xaxis jpi 1 xaxis jpi 2 GE xaxis 0 360 ENDIF ELSE key_periodic 0 ENDIF ELSE key_periodic keyword_set periodic automatic definition of key_shift IF n_elements shift EQ 0 THEN BEGIN key_shift long testvar var key_shift key_shift will be defined according to the first line of glamt if keyword_set glamboundary AND jpi GT 1 AND key_periodic EQ 1 THEN BEGIN varinq ncdf_varinq cdfid glamt CASE varinq ndims OF 2:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh count jpi 1 3:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 count jpi 1 1 4:ncdf_varget cdfid glamt xaxis offset ixminmesh iyminmesh 0 0 count jpi 1 1 1 ENDCASE xaxis between glamboundary 0 and glamboundary 1 xaxis xaxis MOD 360 smaller where xaxis LT glamboundary 0 if smaller 0 NE 1 then xaxis smaller xaxis smaller 360 bigger where xaxis GE glamboundary 1 if bigger 0 NE 1 then xaxis bigger xaxis bigger 360 key_shift where xaxis EQ min xaxis 0 IF key_shift NE 0 THEN BEGIN key_shift jpi key_shift xaxis shift xaxis key_shift ENDIF IF array_equal sort xaxis lindgen jpi NE 1 THEN BEGIN print the x axis 1st line of glamt is not sorted in the inceasing order after the automatic definition of key_shift print please use the keyword shift and periodic to suppress the automatic definition of key_shift and key_periodic and define by hand a more suitable value widget_control noticebase bad_id nothing destroy return ENDIF ENDIF ELSE key_shift 0 ENDIF ELSE key_shift long shift key_periodic EQ 1 check key_stride and related things if n_elements stride eq 3 then key_stride stride if n_elements key_stride LE 2 then key_stride 1 1 1 key_stride 1l long key_stride IF total key_stride NE 3 THEN BEGIN IF key_shift NE 0 THEN BEGIN for explanation see header of read_ncdf_varget pro jpiright key_shift jpileft jpi key_shift key_stride 0 1 key_shift 1 MOD key_stride 0 jpi jpiright 1 key_stride 0 1 jpileft 1 key_stride 0 1 ENDIF ELSE jpi jpi 1 key_stride 0 1 jpj jpj 1 key_stride 1 1 jpk jpk 1 key_stride 2 1 ENDIF default definitions to be able to use read_ncdf_varget default definitions to be able to use read_ncdf_varget ixmindtasauve testvar var ixmindta iymindtasauve testvar var iymindta izmindtasauve testvar var izmindta ixmindta 0l iymindta 0l izmindta 0l jpt 1 time 1 firsttps 0 firstx 0 lastx jpi 1 firsty 0 lasty jpj 1 firstz 0 lastz jpk 1 nx jpi ny jpj nz 1 izminmeshsauve izminmesh izminmesh 0 2d arrays: list the 2d variables that must be read namevar glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f for the variables related to the partial steps allvarname ncdf_listvars cdfid IF where allvarname EQ hdept 0 NE 1 THEN BEGIN key_partialstep 1 namevar namevar hdept hdepw ENDIF ELSE BEGIN key_partialstep 0 hdept 1 hdepw 1 ENDELSE for compatibility with old versions of meshmask partial steps IF where allvarname EQ e3tp 0 NE 1 THEN namevar namevar e3tp e3wp ELSE BEGIN e3t_ps 1 e3w_ps 1 ENDELSE IF where allvarname EQ e3t_ps 0 NE 1 THEN namevar namevar e3t_ps e3w_ps ELSE BEGIN e3t_ps 1 e3w_ps 1 ENDELSE IF where allvarname EQ e3u_ps 0 NE 1 THEN namevar namevar e3u_ps e3v_ps ELSE BEGIN e3u_ps 1 e3v_ps 1 ENDELSE read all the 2d variables for i 0 n_elements namevar 1 do begin varcontient ncdf_varinq cdfid namevar i name varcontient name read_ncdf_varget commande namevar i float res rien execute commande ENDFOR for compatibility with old versions of meshmask partial steps change e3 tw p to e3 tw _ps IF n_elements e3tp NE 0 THEN e3t_ps temporary e3tp IF n_elements e3wp NE 0 THEN e3w_ps temporary e3wp in the kase of key_stride ne 1 1 1 redefine f points coordinates: they must be in the middle of 3 T points if key_stride 0 NE 1 OR key_stride 1 NE 1 then BEGIN we must recompute glamf and gphif IF jpi GT 1 THEN BEGIN if keyword_set key_onearth AND keyword_set xnotsorted OR keyword_set key_periodic AND key_irregular then BEGIN stepxf glamt 720 MOD 360 stepxf shift stepxf 1 1 stepxf stepxf stepxf stepxf 360 stepxf 360 stepxf min abs stepxf dimension 3 IF NOT keyword_set key_periodic THEN stepxf jpi 1 stepxf jpi 2 ENDIF ELSE BEGIN stepxf shift glamt 1 1 glamt IF keyword_set key_periodic THEN stepxf jpi 1 360 stepxf jpi 1 ELSE stepxf jpi 1 stepxf jpi 2 ENDELSE IF jpj GT 1 THEN BEGIN stepxf jpj 1 stepxf jpj 2 stepxf jpi 1 jpj 1 stepxf jpi 2 jpj 2 ENDIF glamf glamt 0 5 stepxf ENDIF ELSE glamf glamt 0 5 IF jpj GT 1 THEN BEGIN we must compute stepyf: y distance between T i j T i 1 j 1 stepyf shift gphit 1 1 gphit stepyf jpj 1 stepyf jpj 2 IF jpi GT 1 THEN BEGIN if NOT keyword_set key_periodic THEN stepyf jpi 1 stepyf jpi 2 stepyf jpi 1 jpj 1 stepyf jpi 2 jpj 2 ENDIF gphif gphit 0 5 stepyf ENDIF ELSE gphif gphit 0 5 ENDIF 3d arrays: nz jpk izminmesh izminmeshsauve listdims ncdf_listdims cdfid micromask where listdims EQ y_m 0 varcontient ncdf_varinq cdfid tmask name varcontient name IF micromask NE 1 THEN BEGIN keep original values iyminmeshtrue iyminmesh key_stridetrue key_stride yyy1 firsty key_stridetrue 1 iyminmeshtrue yyy2 lasty key_stridetrue 1 iyminmeshtrue the mask is stored as the bit values of the byte array along the y dimension see micromeshmask pro we must modify several parameters iyminmesh 0L firsty yyy1 8 lasty yyy2 8 ny lasty firsty 1 key_stride key_stride 0 1 key_stride 2 read_ncdf_varget tmask bytarr jpi jpj jpk now we must get back the mask loop on the level to save memory the loop is short and thus should be fast enough FOR k 0 jpk 1 DO BEGIN zzz transpose res k zzz reform binary zzz 8 ny nx over zzz transpose temporary zzz zzz zzz yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN BEGIN IF float strmid version release 0 3 LT 5 6 THEN BEGIN nnny size zzz 2 yind key_stridetrue 1 lindgen nnny 1 key_stridetrue 1 1 tmask k temporary zzz yind ENDIF ELSE tmask k temporary zzz 0: :key_stridetrue 1 ENDIF ELSE tmask k temporary zzz ENDFOR ENDIF ELSE BEGIN read_ncdf_varget tmask byte res ENDELSE boudary conditions used to compute umask varcontient ncdf_varinq cdfid umask name varcontient name nx 1L firstx jpi 1 lastx jpi 1 IF micromask NE 1 THEN BEGIN read_ncdf_varget umaskred reform binary res 8 ny jpk over umaskred umaskred yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN umaskred temporary umaskred yind ENDIF ELSE BEGIN read_ncdf_varget umaskred reform byte res over ENDELSE boudary conditions used to compute fmask 1 varcontient ncdf_varinq cdfid fmask name varcontient name IF micromask NE 1 THEN BEGIN read_ncdf_varget fmaskredy reform binary res 8 ny jpk over fmaskredy fmaskredy yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 IF key_stridetrue 1 NE 1 THEN fmaskredy temporary fmaskredy yind ENDIF ELSE BEGIN read_ncdf_varget fmaskredy reform byte res over fmaskredy temporary fmaskredy MOD 2 ENDELSE boudary conditions used to compute vmask varcontient ncdf_varinq cdfid vmask name varcontient name nx jpi firstx 0L lastx jpi 1L ny 1L firsty jpj 1 lasty jpj 1 IF micromask NE 1 THEN BEGIN yyy1 firsty key_stridetrue 1 iyminmeshtrue yyy2 lasty key_stridetrue 1 iyminmeshtrue iyminmesh 0L firsty yyy1 8 lasty yyy2 8 ny lasty firsty 1 read_ncdf_varget vmaskred transpose temporary res 1 0 2 vmaskred reform binary vmaskred 8 ny nx nz over vmaskred transpose temporary vmaskred 1 0 2 vmaskred reform vmaskred yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 ENDIF ELSE BEGIN read_ncdf_varget vmaskred reform byte res over ENDELSE boudary conditions used to compute fmask 2 varcontient ncdf_varinq cdfid fmask name varcontient name IF micromask NE 1 THEN BEGIN read_ncdf_varget fmaskredx transpose temporary res 1 0 2 fmaskredx reform binary fmaskredx 8 ny nx nz over fmaskredx transpose temporary fmaskredx 1 0 2 fmaskredx reform fmaskredx yyy1 MOD 8: 8 ny 8 yyy2 MOD 8 iyminmesh iyminmeshtrue key_stride key_stridetrue ENDIF ELSE BEGIN read_ncdf_varget fmaskredx reform byte res over fmaskredx fmaskredx MOD 2 ENDELSE 1d arrays namevar e3t e3w gdept gdepw for i 0 n_elements namevar 1 do begin varcontient ncdf_varinq cdfid namevar i CASE n_elements varcontient dim OF 4:BEGIN commande ncdf_varget cdfid namevar i namevar i offset 0 0 izminmesh 0 count 1 1 jpk 1 if key_stride 2 NE 1 then commande commande stride 1 1 key_stride 2 1 END 2:BEGIN commande ncdf_varget cdfid namevar i namevar i offset izminmesh 0 count jpk 1 if key_stride 2 NE 1 then commande commande stride key_stride 2 END 1:BEGIN commande ncdf_varget cdfid namevar i namevar i offset izminmesh count jpk if key_stride 2 NE 1 then commande commande stride key_stride 2 END ENDCASE rien execute commande commande namevar i float namevar i rien execute commande commande if size namevar i n_dimension gt 0 then namevar i reform namevar i over rien execute commande ENDFOR ncdf_close cdfid Apply Glamboudary if keyword_set glamboundary AND key_onearth then BEGIN if glamboundary 0 NE glamboundary 1 then BEGIN glamt glamt MOD 360 smaller where glamt LT glamboundary 0 if smaller 0 NE 1 then glamt smaller glamt smaller 360 bigger where glamt GE glamboundary 1 if bigger 0 NE 1 then glamt bigger glamt bigger 360 glamu glamu MOD 360 smaller where glamu LT glamboundary 0 if smaller 0 NE 1 then glamu smaller glamu smaller 360 bigger where glamu GE glamboundary 1 if bigger 0 NE 1 then glamu bigger glamu bigger 360 glamv glamv MOD 360 smaller where glamv LT glamboundary 0 if smaller 0 NE 1 then glamv smaller glamv smaller 360 bigger where glamv GE glamboundary 1 if bigger 0 NE 1 then glamv bigger glamv bigger 360 glamf glamf MOD 360 smaller where glamf LT glamboundary 0 if smaller 0 NE 1 then glamf smaller glamf smaller 360 bigger where glamf GE glamboundary 1 if bigger 0 NE 1 then glamf bigger glamf bigger 360 toosmall where glamu EQ glamboundary 0 IF toosmall 0 NE 1 THEN glamu toosmall glamu toosmall 360 toosmall where glamf EQ glamboundary 0 IF toosmall 0 NE 1 THEN glamf toosmall glamf toosmall 360 endif endif make sure we do have 2d arrays when jpj eq 1 IF jpj EQ 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over e1t reform e1t jpi jpj over e2t reform e2t jpi jpj over glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over e1u reform e1u jpi jpj over e2u reform e2u jpi jpj over glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over e1v reform e1v jpi jpj over e2v reform e2v jpi jpj over glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over e1f reform e1f jpi jpj over e2f reform e2f jpi jpj over IF keyword_set key_partialstep THEN BEGIN hdept reform hdept jpi jpj over hdepw reform hdepw jpi jpj over e3t_ps reform e3t_ps jpi jpj over e3w_ps reform e3w_ps jpi jpj over ENDIF ENDIF ixmindta ixmindtasauve iymindta iymindtasauve izmindta izmindtasauve widget_control noticebase bad_id nothing destroy key_yreverse 0 key_zreverse 0 key_gridtype c grid parameters used by xxx IF NOT keyword_set strcalling THEN BEGIN IF n_elements ccmeshparameters EQ 0 THEN strcalling ncdf_meshread ELSE strcalling ccmeshparameters filename ENDIF IF n_elements glamt GE 2 THEN BEGIN glaminfo moment glamt IF finite glaminfo 2 EQ 0 THEN glaminfo glaminfo 0:1 gphiinfo moment gphit IF finite gphiinfo 2 EQ 0 THEN gphiinfo gphiinfo 0:1 ENDIF ELSE BEGIN glaminfo glamt gphiinfo gphit ENDELSE ccmeshparameters filename:strcalling glaminfo:float string glaminfo format E11 4 gphiinfo:float string gphiinfo format E11 4 jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift key_periodic:key_periodic key_stride:key_stride key_gridtype:key_gridtype key_yreverse:key_yreverse key_zreverse:key_zreverse key_partialstep:key_partialstep key_onearth:key_onearth if keyword_set key_performance THEN print time ncdf_meshread systime 1 tempsun updateold return end"); 31 a[29] = new Array("./Grid/restoreboxparam.html", "restoreboxparam.pro", "", " NAME: restoreboxparam PURPOSE: restore all the zoom parameters defined by calling domdef perviously defined by saveboxparam CATEGORY: CALLING SEQUENCE: restoreboxparam filename INPUTS: filename a scalar string defining the file name KEYWORD PARAMETERS: none OUTPUTS:none COMMON BLOCKS: cm_4mesh and cm_demomode_used if we are in demo mode SIDE EFFECTS: call def_myuniquetmpdir if myuniquetmpdir is undefined: define create and add it to path RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 2005 PRO restoreboxparam filename cm_4mesh IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used lon1 boxzoomparam bound 0 lon2 boxzoomparam bound 1 lat1 boxzoomparam bound 2 lat2 boxzoomparam bound 3 vert1 boxzoomparam bound 4 vert2 boxzoomparam bound 5 firstxt boxzoomparam indexes 0 lastxt boxzoomparam indexes 1 firstyt boxzoomparam indexes 2 lastyt boxzoomparam indexes 3 firstxu boxzoomparam indexes 4 lastxu boxzoomparam indexes 5 firstyu boxzoomparam indexes 6 lastyu boxzoomparam indexes 7 firstxv boxzoomparam indexes 8 lastxv boxzoomparam indexes 9 firstyv boxzoomparam indexes 10 lastyv boxzoomparam indexes 11 firstxf boxzoomparam indexes 12 lastxf boxzoomparam indexes 13 firstyf boxzoomparam indexes 14 lastyf boxzoomparam indexes 15 firstzt boxzoomparam indexes 16 lastzt boxzoomparam indexes 17 firstzw boxzoomparam indexes 18 lastzw boxzoomparam indexes 19 nxt boxzoomparam indexes 20 nyt boxzoomparam indexes 21 nxu boxzoomparam indexes 22 nyu boxzoomparam indexes 23 nxv boxzoomparam indexes 24 nyv boxzoomparam indexes 25 nxf boxzoomparam indexes 26 nyf boxzoomparam indexes 27 nzt boxzoomparam indexes 28 nzw boxzoomparam indexes 29 key_irregular boxzoomparam key boxzoomparam 1 ENDIF ELSE BEGIN restore myuniquetmpdir filename file_delete myuniquetmpdir filename ENDELSE updateold return end "); 32 a[30] = new Array("./Grid/saveboxparam.html", "saveboxparam.pro", "", " NAME: saveboxparam PURPOSE: save all the zoom parameters defined by calling domdef in a file using save command located in myuniquetmpdir common variable defined by def_myuniquetmpdir CATEGORY: CALLING SEQUENCE: saveboxparam filename INPUTS: filename a scalar string defining the file name KEYWORD PARAMETERS: none OUTPUTS:none COMMON BLOCKS: cm_4mesh and cm_demomode_used if we are in demo mode SIDE EFFECTS: call def_myuniquetmpdir if myuniquetmpdir is undefined: define create and add it to path RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2005 PRO saveboxparam filename cm_4mesh def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used boxzoomparam bound: lon1 lon2 lat1 lat2 vert1 vert2 indexes: firstxt lastxt firstyt lastyt firstxu lastxu firstyu lastyu firstxv lastxv firstyv lastyv firstxf lastxf firstyf lastyf firstzt lastzt firstzw lastzw nxt nyt nxu nyu nxv nyv nxf nyf nzt nzw key:key_irregular ENDIF ELSE BEGIN save lon1 lon2 lat1 lat2 vert1 vert2 firstxt lastxt firstyt lastyt firstxu lastxu firstyu lastyu firstxv lastxv firstyv lastyv firstxf lastxf firstyf lastyf firstzt lastzt firstzw lastzw nxt nyt nxu nyu nxv nyv nxf nyf nzt nzw key_irregular filename myuniquetmpdir filename ENDELSE return end"); 33 a[31] = new Array("./Grid/smallmeshmask.html", "smallmeshmask.pro", "", " NAME: smallmeshmask pro PURPOSE: reduce the size of the NetCDF meshmask created by OPA by using byte format for the masks and the foat format for the other fields CATEGORY:for OPA meshmask files CALLING SEQUENCE: smallmeshmask ncfilein ncfileout INPUTS: ncfilein: 1 the name of the meshmask file to be reduced In that case there is only one meshmask file OR 2 the xxx part in the names: xxx mesh_hgr nc xxx mesh_zgr nc xxx mask nc In that case the meshmask is split into 3 files ncfileout: the name of the reduced meshmask file default definition is smallmeshmask nc KEYWORD PARAMETERS: IODIR:to define the files path OUTPUTS: no COMMON BLOCKS: no EXAMPLE: IDL meshdir d1fes2 raid2 smasson DATA ORCA05 IDL smallmeshmask meshmask_ORCA_R05 nc iodir meshdir MODIFICATION HISTORY: July 2004 Sebastien Masson smasson lodyc jussieu fr PRO ncdf_transfer inid outid inname outname IF n_elements outname EQ 0 THEN outname inname ncdf_varget inid inname zzz ncdf_varput outid outname float reform zzz over RETURN END PRO smallmeshmask ncfilein ncfileout IODIR iodir filein isafile FILE ncfilein IODIR iodir NEW test findfile filein 0 IF test EQ THEN BEGIN filein_hgr findfile filein mesh_hgr nc 0 filein_zgr findfile filein mesh_zgr nc 0 filein_msk findfile filein mask nc 0 IF filein_hgr EQ OR filein_zgr EQ OR filein_msk EQ THEN BEGIN print meshmask file s not found print filein does not exist print filein mesh_hgr nc does not exist print filein mesh_zgr nc does not exist print filein mask nc does not exist return ENDIF ENDIF ELSE filein test get the horizontal dimensions IF n_elements filein_hgr NE 0 THEN cdfid ncdf_open filein_hgr ELSE cdfid ncdf_open filein ncdf_diminq cdfid x name jpi ncdf_diminq cdfid y name jpj get the vertical dimensions IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF listdims strlowcase ncdf_listdims cdfid IF where listdims EQ z 0 NE 1 THEN ncdf_diminq cdfid z name jpk ELSE BEGIN dimid where strmid listdims 0 5 EQ depth 0 IF dimid NE 1 THEN ncdf_diminq cdfid dimid name jpk ELSE BEGIN report We could not find the vertical dimension its name must be z or start with depth return ENDELSE ENDELSE get the variables list related to the partial steps varlist_ps ncdf_listvars cdfid varlist_ps strtrim strlowcase varlist_ps 2 define the output file IF n_elements ncfileout EQ 0 THEN ncfileout smallmeshmask nc cdfidout ncdf_create isafile FILE ncfileout IODIR iodir NEW clobber ncdf_control cdfidout nofill dimension dimidx ncdf_dimdef cdfidout x jpi dimidy ncdf_dimdef cdfidout y jpj dimidz ncdf_dimdef cdfidout z jpk global attributs ncdf_attput cdfidout IDL_Program_Name smallmeshmask pro GLOBAL ncdf_attput cdfidout Creation_Date systime GLOBAL declaration des variables varid lonarr 20 horizontal variables hgrlist glamt glamu glamv glamf gphit gphiu gphiv gphif e1t e1u e1v e1f e2t e2u e2v e2f FOR h 0 n_elements hgrlist 1 DO varid h ncdf_vardef cdfidout hgrlist h dimidx dimidy float vertical variables zgrlist e3t e3w gdept gdepw FOR z 0 n_elements zgrlist 1 DO varid 16 z ncdf_vardef cdfidout zgrlist z dimidz float variables related to the partial steps IF where varlist_ps EQ hdept 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdept dimidx dimidy float IF where varlist_ps EQ hdepw 0 NE 1 THEN varid varid ncdf_vardef cdfidout hdepw dimidx dimidy float old variable name keep for compatibility with old run Change e3tp to e3t_ps IF where varlist_ps EQ e3tp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float old variable name keep for compatibility with old run Change e3wp to e3w_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3t_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3t_ps dimidx dimidy float IF where varlist_ps EQ e3w_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3w_ps dimidx dimidy float IF where varlist_ps EQ e3u_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3u_ps dimidx dimidy float IF where varlist_ps EQ e3v_ps 0 NE 1 THEN varid varid ncdf_vardef cdfidout e3v_ps dimidx dimidy float mask variable msklist tmask umask vmask fmask FOR m 0 n_elements msklist 1 DO varid varid ncdf_vardef cdfidout msklist m dimidx dimidy dimidz byte ncdf_control cdfidout endef get the horizontal variables IF n_elements filein_hgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_hgr ENDIF FOR h 0 n_elements hgrlist 1 DO ncdf_transfer cdfid cdfidout hgrlist h get the vertical variables IF n_elements filein_zgr NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_zgr ENDIF FOR z 0 n_elements zgrlist 1 DO ncdf_transfer cdfid cdfidout zgrlist z partial step variables IF where varlist_ps EQ hdept 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdept IF where varlist_ps EQ hdepw 0 NE 1 THEN ncdf_transfer cdfid cdfidout hdepw IF where varlist_ps EQ e3tp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3tp e3t_ps IF where varlist_ps EQ e3wp 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3wp e3w_ps IF where varlist_ps EQ e3t_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3t_ps IF where varlist_ps EQ e3w_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3w_ps IF where varlist_ps EQ e3u_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3u_ps IF where varlist_ps EQ e3v_ps 0 NE 1 THEN ncdf_transfer cdfid cdfidout e3v_ps mask IF n_elements filein_msk NE 0 THEN BEGIN ncdf_close cdfid cdfid ncdf_open filein_msk ENDIF loop on the vertical levels to limit the memory use FOR k 0 jpk 1 DO BEGIN FOR m 0 3 DO BEGIN CASE ncdf_varinq cdfid msklist m ndims OF 3:ncdf_varget cdfid msklist m zzz offset 0 0 k count jpi jpj 1 4:ncdf_varget cdfid msklist m zzz offset 0 0 k 0 count jpi jpj 1 1 ENDCASE ncdf_varput cdfidout msklist m byte temporary zzz offset 0 0 k count jpi jpj 1 ENDFOR ENDFOR ncdf_close cdfid ncdf_close cdfidout RETURN END"); 34 a[32] = new Array("./Interpolation/angle.html", "angle.pro", "", " NAME:angle pro fom angle F v 2 2 in OPA8 2 PURPOSE:Compute angles between grid lines and direction of the North CALLING SEQUENCE: angle fileocemesh gcosu gsinu gcosv gsinv gcost gsint INPUTS: fileocemesh a netcdf file that contains at least : glamu gphiu: longitudes and latitudes at U points glamv gphiv: longitudes and latitudes at V points glamf gphif: longitudes and latitudes at F points KEYWORD PARAMETERS: IODIRECTORY: the directory path where is located fileocemesh DOUBLE: use double precision default is float OUTPUTS: gsinu gcosu : sinus and cosinus of the angle gsinv gcosv between north south direction gsint gcost and the j direction of the mesh RESTRICTIONS: to compute the lateral boundary conditions we assume that: 1 the first line is similar to the second line gcosu 0 gcosu 1 gsinu 0 gsinu 1 2 the grid follows OPA x periodicity rule first column is equal to the next to last column gcosv 0 gcosv jpj 2 gsinv 0 gsinv jpj 2 MODIFICATION HISTORY: Original : 96 07 O Marti 98 06 G Madec Feb 2005: IDL adaptation S Masson fsnspp: north stereographic polar projection FUNCTION fsnspp plam pphi DOUBLE double IF keyword_set double THEN BEGIN a 2 d tan dpi 4 d dpi 180 d pphi 2 d x cos dpi 180 d plam a y sin dpi 180 d plam a ENDIF ELSE BEGIN a 2 tan pi 4 pi 180 float pphi 2 x cos pi 180 float plam a y sin pi 180 float plam a ENDELSE RETURN x:x y:y END PRO angle fileocemesh gcosu gsinu gcosv gsinv gcost gsint IODIRECTORY iodirectory DOUBLE double 0 read oceanic grid parameters IF keyword_set IODIRECTORY THEN BEGIN IF strpos iodirectory reverse_search NE strlen iodirectory 1 THEN iodirectory iodirectory ENDIF ELSE iodirectory fileoce iodirectory fileocemesh fileoce findfile fileoce count okfile IF okfile NE 1 THEN BEGIN print the file fileoce is not found we stop stop ENDIF cdfido ncdf_open fileoce 0 ncdf_varget cdfido glamt glamt ncdf_varget cdfido glamu glamu ncdf_varget cdfido glamv glamv ncdf_varget cdfido glamf glamf ncdf_varget cdfido gphit gphit ncdf_varget cdfido gphiu gphiu ncdf_varget cdfido gphiv gphiv ncdf_varget cdfido gphif gphif ncdf_close cdfido glamt reform glamt over glamu reform glamu over glamv reform glamv over glamf reform glamf over gphit reform gphit over gphiu reform gphiu over gphiv reform gphiv over gphif reform gphif over jpj size glamf dimension 1 I Compute the cosinus and sinus computation done on the north stereographic polar plan north pole direction modulous at t point znpt fsnspp glamt gphit DOUBLE double glamt 1 gphit 1 free memory znpt x znpt x znpt y znpt y znnpt znpt x znpt x znpt y znpt y north pole direction modulous at u point znpu fsnspp glamu gphiu DOUBLE double glamu 1 gphiu 1 free memory znpu x znpu x znpu y znpu y znnpu znpu x znpu x znpu y znpu y north pole direction modulous at v point znpv fsnspp glamv gphiv DOUBLE double znpv00 znpv znpv01 fsnspp shift glamv 0 1 shift gphiv 0 1 DOUBLE double glamv 1 gphiv 1 free memory znpv x znpv x znpv y znpv y znnpv znpv x znpv x znpv y znpv y f point znpf00 fsnspp glamf gphif DOUBLE double znpf01 fsnspp shift glamf 0 1 shift gphif 0 1 DOUBLE double znpf10 fsnspp shift glamf 1 0 shift gphif 1 0 DOUBLE double glamf 1 gphif 1 free memory j direction: v point segment direction t point zxvvt znpv00 x znpv01 x zyvvt znpv00 y znpv01 y zmnpvt sqrt temporary znnpt zxvvt zxvvt zyvvt zyvvt znpv00 1 free memory znpv01 1 free memory IF keyword_set double THEN zmnpvt 1 e 14 zmnpvt ELSE zmnpvt 1 e 6 zmnpvt j direction: f point segment direction u point zxffu znpf00 x znpf01 x zyffu znpf00 y znpf01 y zmnpfu sqrt temporary znnpu zxffu zxffu zyffu zyffu znpf01 1 free memory IF keyword_set double THEN zmnpfu 1 e 14 zmnpfu ELSE zmnpfu 1 e 6 zmnpfu i direction: f point segment direction v point zxffv znpf00 x znpf10 x zyffv znpf00 y znpf10 y znpf00 1 znpf10 1 free memory zmnpfv sqrt temporary znnpv zxffv zxffv zyffv zyffv IF keyword_set double THEN zmnpfv 1 e 14 zmnpfv ELSE zmnpfv 1 e 6 zmnpfv cosinus and sinus using scalar and vectorial products gsint znpt x zyvvt znpt y zxvvt zmnpvt gcost znpt x zxvvt znpt y zyvvt zmnpvt cosinus and sinus using scalar and vectorial products gsinu znpu x zyffu znpu y zxffu zmnpfu gcosu znpu x zxffu znpu y zyffu zmnpfu cosinus and sinus using scalar and vectorial products caution rotation of 90 degres gsinv znpv x zxffv znpv y zyffv zmnpfv gcosv znpv x zyffv znpv y zxffv zmnpfv II Geographic mesh bad where abs glamf shift glamf 0 1 LT 1 e 8 IF bad 0 NE 1 THEN BEGIN gcosu bad 1 gsinu bad 0 ENDIF bad where abs gphif shift gphif 1 0 LT 1 e 8 IF bad 0 NE 1 THEN BEGIN gcosv bad 1 gsinv bad 0 ENDIF III Lateral boundary conditions gcost 0 gcost 1 gsint 0 gsint 1 gcosu 0 gcosu 1 gsinu 0 gsinu 1 gcosv 0 gcosv jpj 2 gsinv 0 gsinv jpj 2 RETURN END"); 35 a[33] = new Array("./Interpolation/clickincell.html", "clickincell.pro", "", " NAME:clickincell PURPOSE: click on a map and find in which cell the click was CATEGORY:finding where is a point on a grid CALLING SEQUENCE: res clickincell Click with the left button to select a cell Clicking one more time in the same cell remove the cell from the selection Click on the right button to quit INPUTS:None KEYWORD PARAMETERS: CELLTYPE T W U V or F : This this the type of point that is located in the center of the cell which the click is located default is T type of cell with corner defined by F points DRAWCELL: to draw the cell in which we clicked COLOR the color used to draw the cells Clicking one more time in the same cell will draw the cell with the white color ORIGINAL: to get the position of the cell regarding the original grid with no key_shift ixminmesh iyminmesh IJ: see outpus _EXTRA: to pass extra keywords to inquad and plot when drawcell OUTPUTS: the the index of the selected cells regarding to the grid which is in memory in the variable of the common If ij keyword is activated give 2D array 2 n which are the i j position of the n selected cells COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL plt findgen jpi jpj nodata map 90 0 0 ortho IDL print clickincell draw color 150 xy MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 FUNCTION clickincell CELLTYPE celltype DRAWCELL drawcell COLOR color ORIGINAL original IJ ij _EXTRA extra common initialization cellnum 1L selected 0 Cell list get the grid parameter according to celltype oldgrid vargrid IF NOT keyword_set celltype THEN celltype T CASE strupcase celltype OF T :vargrid F W :vargrid F U :vargrid V V :vargrid U F :vargrid T ENDCASE grille 1 glam gphi 1 nx ny nz firstx firsty firstz lastx lasty lastz vargrid oldgrid define the corner of the cells in the clockwise direction IF keyword_set key_periodic AND nx EQ jpi THEN BEGIN x1 glam 0:ny 2 y1 gphi 0:ny 2 x2 glam 1:ny 1 y2 gphi 1:ny 1 x3 shift glam 1:ny 1 1 0 y3 shift gphi 1:ny 1 1 0 x4 shift glam 0:ny 2 1 0 y4 shift gphi 0:ny 2 1 0 ENDIF ELSE BEGIN x1 glam 0:nx 2 0:ny 2 y1 gphi 0:nx 2 0:ny 2 x2 glam 0:nx 2 1:ny 1 y2 gphi 0:nx 2 1:ny 1 x3 glam 1:nx 1 1:ny 1 y3 gphi 1:nx 1 1:ny 1 x4 glam 1:nx 1 0:ny 2 y4 gphi 1:nx 1 0:ny 2 ENDELSE glam 1 free memory gphi 1 free memory get mousse position on the reference map cursor x y data up while mouse button ne 4 do BEGIN IF finite x finite x EQ 0 THEN GOTO outwhile case mouse button of 1:BEGIN What is the longitude WHILE x GT x range 1 DO x x 360 WHILE x LT x range 0 DO x x 360 IF x GT x range 1 THEN GOTO outwhile IF y GT y range 1 THEN GOTO outwhile IF y LT y range 0 THEN GOTO outwhile cell inquad x y x1 y1 x2 y2 x3 y3 x4 y4 onsphere _extra extra IF cell 0 EQ 1 OR n_elements cell GT 1 THEN GOTO outwhile cell cell 0 already where cellnum EQ cell 0 IF already EQ 1 THEN BEGIN cellnum cellnum cell selected selected 1 already n_elements selected 1 ENDIF ELSE selected already 1 selected already IF keyword_set drawcell THEN BEGIN oplot x1 cell x2 cell x3 cell x4 cell x1 cell y1 cell y2 cell y3 cell y4 cell y1 cell color color selected already d n_colors 255 1 selected already _extra extra ENDIF END 2: middle button ELSE: ENDCASE get mousse position on the reference map outwhile: cursor x y data up ENDWHILE good where selected NE 0 IF good 0 EQ 1 THEN RETURN 1 cellnum cellnum good yy cellnum nx 1 key_periodic nx EQ jpi xx cellnum MOD nx 1 key_periodic nx EQ jpi CASE strupcase celltype OF T :BEGIN xx xx firstx 1 yy yy firsty 1 END W :BEGIN xx xx firstx 1 yy yy firsty 1 END U :BEGIN xx xx firstx yy yy firsty 1 END V :BEGIN xx xx firstx 1 yy yy firsty END F :BEGIN xx xx firstx yy yy firsty END ENDCASE bad where xx GE jpi IF bad 0 NE 1 THEN BEGIN xx bad xx bad jpi yy bad yy bad 1 ENDIF bad where yy GE jpj IF bad 0 NE 1 THEN stop IF keyword_set original THEN BEGIN xx xx key_shift bad where xx LT 0 IF bad 0 NE 1 THEN xx bad xx bad jpi xx xx MOD jpi xx xx ixminmesh yy yy iyminmesh ENDIF ncell n_elements xx IF keyword_set ij THEN RETURN reform xx 1 ncell over reform yy 1 ncell over IF keyword_set original THEN RETURN xx jpiglo yy ELSE RETURN xx jpi yy END "); 36 a[34] = new Array("./Interpolation/compute_fromreg_bilinear_weigaddr.html", "compute_fromreg_bilinear_weigaddr.pro", "", " NAME: compute_fromreg_bilinear_weigaddr PURPOSE: compute the weight and address neede to interpolate data from a regular grid to any grid using the bilinear method CATEGORY:interpolation CALLING SEQUENCE: compute_fromreg_bilinear_weigaddr alon alat olon olat weig addr INPUTS: lonin and latin: longitude latitude of the input data lonout and latout: longitude latitude of the output data KEYWORD PARAMETERS: NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: weig addr: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: the input grid must be a regular grid defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude We supposed the data are located on a sphere with a periodicity along the longitude points located out of the southern and northern boundaries are interpolated using a linear interpolation only along the longitudinal direction EXAMPLE: MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr PRO compute_fromreg_bilinear_weigaddr alonin alatin olonin olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs alon alonin alat alatin olon olonin jpia n_elements alon jpja n_elements alat jpio size olon dimensions 0 jpjo size olon dimensions 1 alon minalon min alon max maxalon IF maxalon minalon GE 360 THEN stop alon must be monotonically increasing IF array_equal sort alon lindgen jpia NE 1 THEN BEGIN shiftx where alon EQ min alon 0 alon shift alon shiftx IF array_equal sort alon lindgen jpia NE 1 THEN stop ENDIF ELSE shiftx 0 for longitude periodic bondary condition we add the fist column on the right side of the array and alon alon alon 0 360 jpia jpia 1L alat revy alat 0 GT alat 1 IF revy THEN alat reverse alat alat must be monotonically increasing IF array_equal sort alat lindgen jpja NE 1 THEN stop if keyword_set nonorthernline then BEGIN jpja jpja 1L alat alat 0: jpja 1L ENDIF if keyword_set nosouthernline then BEGIN alat alat 1: jpja 1L jpja jpja 1L ENDIF olon between minalon et minalon 360 out where olon LT minalon WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon LT minalon ENDWHILE out where olon GE minalon 360 WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon GE minalon 360 ENDWHILE make sure that all values of olon are located within values of alon IF min olon max ma LT minalon THEN stop IF ma GE minalon 360 THEN stop we want to do biliear interpolation for each ocean point we must find in which atm cell it is located if the ocean point is out of the atm grid we use closest neighbor interpolation for each T point of oce grid we find in which armospheric cell it is located As the atmospheric grid is regular we can use inrecgrid instead of inquad pos inrecgrid olon olat alon 0:jpia 2L alat 0:jpja 2L checkout alon jpia 1L alat jpja 1L output2d checks for longitude each ocean points must be located in atm cell IF where pos 0 EQ 1 0 NE 1 THEN stop no ocean point should be located westward of the left bondary of the atm cell in which it is supposed to be located IF total olon LT alon pos 0 NE 0 THEN stop no ocean point should be located eastward of the right bondary of the atm cell in which it is supposed to be located IF total olon GT alon pos 0 1 NE 0 THEN stop we use bilinear interpolation we change the coordinates of each ocean points to fit into a rectangle defined by: y2 y1 x1 x2 X x x1 x2 x1 Y y y1 y2 y1 indx pos 0 indy temporary pos 1 points located out of the atmospheric grid too much northward or southward bad where indy EQ 1 indy 0 indy IF max indx GT jpia 2 THEN stop checks IF max indy GT jpja 2 THEN stop checks x coordinates of the atm cell x1 alon indx x2 alon indx 1 new x coordinates of the ocean points in each cell divi temporary x2 x1 glamnew olon x1 temporary divi x1 1 free memory olon 1 free memory y coordinates of the atm cell y1 alat indy y2 alat indy 1 new y coordinates of the ocean points in each cell divi temporary y2 y1 zero where divi EQ 0 IF zero 0 NE 1 THEN divi zero 1 gphinew olat y1 temporary divi y1 1 free memory checks IF min glamnew LT 0 THEN stop IF max glamnew GT 1 THEN stop weight and address array used for bilinear interpolation xaddr lonarr 4 jpio jpjo xaddr 0 indx xaddr 1 indx 1L xaddr 2 indx 1L xaddr 3 indx yaddr lonarr 4 jpio jpjo yaddr 0 indy yaddr 1 indy yaddr 2 indy 1L yaddr 3 indy 1L compute the weight for the bilinear interpolation weig fltarr 4 jpio jpjo weig 0 1 glamnew 1 gphinew weig 1 glamnew 1 gphinew weig 2 glamnew gphinew weig 3 1 glamnew gphinew free memory gphinew 1 IF bad 0 EQ 1 THEN glamnew 1 ELSE glamnew temporary glamnew bad we work now on the bad points linear interpolation only along the longitudinal direction IF bad 0 NE 1 THEN BEGIN ybad olat bad the ocean points that are not located into an atm cell should be located northward of the northern boudary of the atm grid or southward of the southern boudary of the atm grid IF total ybad GE min alat AND ybad LE max alat GE 1 THEN stop weig 0 bad 1 glamnew weig 1 bad temporary glamnew weig 2 bad 0 weig 3 bad 0 south where ybad LT alat 0 IF south 0 NE 1 THEN yaddr bad temporary south 0L north where ybad GT alat jpja 1 IF north 0 NE 1 THEN yaddr bad temporary north 0L ybad 1 bad 1 free memory ENDIF check totalweight 1 totalweig abs 1 total weig 1 IF where temporary totalweig GE 1 e 5 0 NE 1 THEN stop come back to the original atm grid without longitudinal overlap jpia jpia 1L xaddr temporary xaddr MOD jpia take into account shiftx if needed IF shiftx NE 0 THEN xaddr temporary xaddr shiftx MOD jpia take into account nosouthernline and nonorthernline if keyword_set nosouthernline then BEGIN yaddr temporary yaddr 1L jpja jpja 1L ENDIF if keyword_set nonorthernline then jpja jpja 1L take into account revy if needed IF revy EQ 1 THEN yaddr jpja 1L temporary yaddr addr temporary yaddr jpia temporary xaddr return end "); 37 a[35] = new Array("./Interpolation/compute_fromreg_imoms3_weigaddr.html", "compute_fromreg_imoms3_weigaddr.pro", "", " NAME: compute_fromreg_imoms3_weigaddr PURPOSE: compute the weight and address neede to interpolate data from a regular grid to any grid using the imoms3 method CATEGORY:interpolation CALLING SEQUENCE: compute_fromreg_imoms3_weigaddr alon alat olon olat weig addr INPUTS: lonin and latin: longitude latitude of the input data lonout and latout: longitude latitude of the output data KEYWORD PARAMETERS: NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: weig addr: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: the input grid must be a regular rectangular grid defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude We supposed the data are located on a sphere with a periodicity along the longitude points located between the first last 2 lines are interpolated using a imoms3 interpolation along the longitudinal direction and linear interpolation along the latitudinal direction points located out of the southern and northern boundaries are interpolated using a imoms3 interpolation only along the longitudinal direction EXAMPLE: MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr March 2006: works for rectangular grids PRO compute_fromreg_imoms3_weigaddr alonin alatin olonin olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs alon alonin alat alatin olon olonin jpia n_elements alon jpja n_elements alat jpio size olon dimensions 0 jpjo size olon dimensions 1 alon minalon min alon max maxalon IF maxalon minalon GE 360 THEN stop alon must be monotonically increasing IF array_equal sort alon lindgen jpia NE 1 THEN BEGIN shiftx where alon EQ min alon 0 alon shift alon shiftx IF array_equal sort alon lindgen jpia NE 1 THEN stop ENDIF ELSE shiftx 0 alon is it regularly spaced step alon shift alon 1 step 0 step 0 360 IF total step step 0 GE 1 e 6 NE 0 THEN noregx 1 we extend the longitude range of alon easy interpolation even near minalon et maxalon toadd 10 jpia 360 1 alon alon jpia toadd:jpia 1 360 alon alon 0:toadd 1 360 jpia jpia 2 toadd alat revy alat 0 GT alat 1 IF revy THEN alat reverse alat alat must be monotonically increasing IF array_equal sort alat lindgen jpja NE 1 THEN stop alat is it regularly spaced step alat shift alat 1 step step 1:jpja 1L IF total step step 0 GE 1 e 6 NE 0 THEN noregy 1 if keyword_set nonorthernline then BEGIN jpja jpja 1L alat alat 0: jpja 1L ENDIF if keyword_set nosouthernline then BEGIN alat alat 1: jpja 1L jpja jpja 1L ENDIF olon between minalon et minalon 360 out where olon LT minalon WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon LT minalon ENDWHILE out where olon GE minalon 360 WHILE out 0 NE 1 DO BEGIN olon out olon out 360 out where olon GE minalon 360 ENDWHILE make sure that all values of olon are located within values of alon IF min olon max ma LT minalon THEN stop IF ma GE minalon 360 THEN stop xaddr lonarr 16 jpio jpjo yaddr lonarr 16 jpio jpjo weig fltarr 16 jpio jpjo indexlon value_locate alon olon IF total alon indexlon GT olon NE 0 THEN stop IF total alon indexlon 1L LE olon NE 0 THEN stop IF where indexlon LE 1L 0 NE 1 THEN stop IF where indexlon GE jpia 3L 0 NE 1 THEN stop indexlat value_locate alat olat for the ocean points located below the atm line jpja 2 and above the line 1 for those points we can always find 16 neighbors imoms interpolation along longitude and latitude short where indexlat LT jpja 2L AND indexlat GE 1L ilon indexlon short ilat indexlat short IF NOT keyword_set noregy THEN BEGIN delta alat ilat 1L alat ilat IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alat ilat 1L olat short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wy0 imoms3 temporary d0 d1 alat ilat olat short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wy1 imoms3 temporary d1 d2 alat ilat 1L olat short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wy2 imoms3 temporary d2 d3 alat ilat 2L olat short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wy3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wy0 fltarr nele wy1 fltarr nele wy2 fltarr nele wy3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlat spl_incr alat ilat i 1L:ilat i 2L 1 0 1 2 olat short i IF newlat LE 0 THEN stop IF newlat GT 1 THEN stop wy0 i imoms3 newlat 1 wy1 i imoms3 newlat wy2 i imoms3 1 newlat wy3 i imoms3 2 newlat ENDFOR ENDELSE mi min wy0 wy1 wy2 wy3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 0 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0 short ilat 1L yaddr 1 short yaddr 0 short yaddr 2 short yaddr 0 short yaddr 3 short yaddr 0 short weig 0 short wx0 wy0 weig 1 short wx1 wy0 weig 2 short wx2 wy0 weig 3 short wx3 wy0 line 1 xaddr 4 short ilon 1L xaddr 5 short ilon xaddr 6 short ilon 1L xaddr 7 short ilon 2L yaddr 4 short ilat yaddr 5 short ilat yaddr 6 short ilat yaddr 7 short ilat weig 4 short wx0 wy1 weig 5 short wx1 wy1 weig 6 short wx2 wy1 weig 7 short wx3 wy1 line 2 xaddr 8 short ilon 1L xaddr 9 short ilon xaddr 10 short ilon 1L xaddr 11 short ilon 2L yaddr 8 short ilat 1L yaddr 9 short yaddr 8 short yaddr 10 short yaddr 8 short yaddr 11 short yaddr 8 short weig 8 short wx0 wy2 weig 9 short wx1 wy2 weig 10 short wx2 wy2 weig 11 short wx3 wy2 line 3 xaddr 12 short ilon 1L xaddr 13 short ilon xaddr 14 short ilon 1L xaddr 15 short ilon 2L yaddr 12 short ilat 2L yaddr 13 short yaddr 12 short yaddr 14 short yaddr 12 short yaddr 15 short yaddr 12 short weig 12 short wx0 wy3 weig 13 short wx1 wy3 weig 14 short wx2 wy3 weig 15 short wx3 wy3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop for the ocean points located between the atm lines jpja 2 and jpja 1 or between the atm lines 0 and 1 linear interpolation between line 1 and line 2 short where indexlat EQ jpja 2L OR indexlat EQ 0 IF short 0 NE 1 THEN BEGIN ilon indexlon short ilat indexlat short delta alat ilat 1L alat ilat IF NOT keyword_set noregy THEN BEGIN IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 ENDIF d1 alat ilat olat short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wy1 1 temporary d1 d2 alat ilat 1L olat short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wy2 1 temporary d2 mi min wy1 wy2 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop but imoms3 along the longitude IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0 short ilat yaddr 1 short ilat yaddr 2 short ilat yaddr 3 short ilat weig 0 short wx0 wy1 weig 1 short wx1 wy1 weig 2 short wx2 wy1 weig 3 short wx3 wy1 line 2 xaddr 4 short ilon 1L xaddr 5 short ilon xaddr 6 short ilon 1L xaddr 7 short ilon 2L yaddr 4 short ilat 1L yaddr 5 short yaddr 4 short yaddr 6 short yaddr 4 short yaddr 7 short yaddr 4 short weig 4 short wx0 wy2 weig 5 short wx1 wy2 weig 6 short wx2 wy2 weig 7 short wx3 wy2 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF for the ocean points located below the line 0 Interpolation only along the longitude short where indexlat EQ 1 IF short 0 NE 1 THEN BEGIN ilon indexlon short IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0:3 short 0 weig 0 short wx0 weig 1 short wx1 weig 2 short wx2 weig 3 short wx3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF for the ocean points located above jpia 1 Interpolation only along the longitude short where indexlat EQ jpja 1L IF short 0 NE 1 THEN BEGIN ilon indexlon short IF NOT keyword_set noregx THEN BEGIN delta alon ilon alon ilon 1L IF max abs delta delta 0 GE 1 e 6 THEN stop delta delta 0 d0 alon ilon 1L olon short delta IF min d0 max ma LE 2 THEN stop IF ma GT 1 THEN stop wx0 imoms3 temporary d0 d1 alon ilon olon short delta IF min d1 max ma LE 1 THEN stop IF ma GT 0 THEN stop wx1 imoms3 temporary d1 d2 alon ilon 1L olon short delta IF min d2 max ma LE 0 THEN stop IF ma GT 1 THEN stop wx2 imoms3 temporary d2 d3 alon ilon 2L olon short delta IF min d3 max ma LE 1 THEN stop IF ma GT 2 THEN stop wx3 imoms3 temporary d3 ENDIF ELSE BEGIN nele n_elements short wx0 fltarr nele wx1 fltarr nele wx2 fltarr nele wx3 fltarr nele FOR i 0L nele 1 DO BEGIN IF i MOD 10000 EQ 0 THEN print i newlon spl_incr alon ilon i 1L:ilon i 2L 1 0 1 2 olon short i IF newlon LE 0 THEN stop IF newlon GT 1 THEN stop wx0 i imoms3 newlon 1 wx1 i imoms3 newlon wx2 i imoms3 1 newlon wx3 i imoms3 2 newlon ENDFOR ENDELSE mi min wx0 wx1 wx2 wx3 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop line 1 xaddr 0 short ilon 1L xaddr 1 short ilon xaddr 2 short ilon 1L xaddr 3 short ilon 2L yaddr 0:3 short jpja 1L weig 0 short wx0 weig 1 short wx1 weig 2 short wx2 weig 3 short wx3 mi min total weig short 1 max ma IF abs mi 1 GE 1 e 6 THEN stop IF abs ma 1 GE 1 e 6 THEN stop ENDIF Come back to the original index of atm grid without longitudinal overlap xaddr temporary xaddr toadd jpia jpia 2 toadd make sure all values are ge 0 xaddr temporary xaddr jpia range the values between 0 and jpia 1 xaddr temporary xaddr mod jpia take into account shiftx if needed IF shiftx NE 0 THEN xaddr temporary xaddr shiftx MOD jpia take into account nosouthernline and nonorthernline if keyword_set nosouthernline then BEGIN yaddr temporary yaddr 1L jpja jpja 1L ENDIF if keyword_set nonorthernline then jpja jpja 1L take into account revy if needed IF revy EQ 1 THEN yaddr jpja 1L temporary yaddr addr temporary yaddr jpia temporary xaddr RETURN END"); 38 a[36] = new Array("./Interpolation/cutpar.html", "cutpar.pro", "", " NAME: cutpar PURPOSE: cut p parallelogram s into p n 2 parallelograms CATEGORY: basic work CALLING SEQUENCE:res cutpar x0 y0 x1 y1 x2 y2 x3 y3 n INPUTS: x0 y0 1d arrays of p elements giving the edge positions The edges must be given as in plot to traw the parallelogram see example n: each parallelogram will be cutted in n 2 pieces KEYWORD PARAMETERS: endpoints: see outputs onsphere: to specify that the points are located on a sphere In this case x and y corresponds to longitude and latitude in degrees OUTPUTS: defaut: 3d array 2 n 2 p giving the center position of each piece of the parallelograms endpoints: 3d array 2 n 1 2 p giving the edge positions of each piece of the parallelograms COMMON BLOCKS: no SIDE EFFECTS: need cutsegment pro RESTRICTIONS: EXAMPLE: x0 2 6 2 y0 0 2 6 x1 3 8 4 y1 4 4 6 x2 1 6 4 y2 5 6 8 x3 0 4 2 y3 1 4 8 n 4 splot 0 10 0 10 xstyle 1 ystyle 1 nodata for i 0 2 do oplot x0 i x1 i x2 i x3 i x0 i y0 i y1 i y2 i y3 i y0 i res cutpar x0 y0 x1 y1 x2 y2 x3 y3 n for i 0 2 do oplot res 0 i res 1 i color 20 10 i psym 1 thick 3 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 5th 2002 FUNCTION cutpar x0 y0 x1 y1 x2 y2 x3 y3 n endpoints endpoints onsphere onsphere is it a parallelogram eps 1e 4 IF total abs x0 x2 2 x1 x3 2 GE eps GT 0 OR total abs y0 y2 2 y1 y3 2 GE eps GT 0 THEN stop print NOT a parallelogram x0 npar npar n_elements x0 firstborder 2 n keyword_set endpoints npar firstborder cutsegment x0 y0 x1 y1 n endpoints endpoints onsphere onsphere thirdborder cutsegment x3 y3 x2 y2 n endpoints endpoints onsphere onsphere res 2 n keyword_set endpoints n keyword_set endpoints npar res cutsegment firstborder 0 firstborder 1 thirdborder 0 thirdborder 1 n endpoints endpoints onsphere onsphere free memory firstborder 1 thirdborder 1 reform the result res reform res 2 n keyword_set endpoints 2 npar overwrite RETURN res END"); 39 a[37] = new Array("./Interpolation/cutsegment.html", "cutsegment.pro", "", " NAME: cutsegment PURPOSE: cut p segments into p n equal parts CATEGORY: basic work CALLING SEQUENCE: res cutsegment x0 y0 x1 y1 n INPUTS: x0 y0 and x1 y1 1d arrays of p elements the coordinates of the endpoints of the p segmements n: the number of pieces we want to cut each segment KEYWORD PARAMETERS: endpoints: see ouputs onsphere: to specify that the points are located on a sphere In this case x and y corresponds to longitude and latitude in degrees OUTPUTS: defaut: a 3d array 2 n p that gives the coordinates of the middle of the cutted segments if endpoints a 3d array 2 n 1 p that gives the coordinates of the endpoints of the cutted segments COMMON BLOCKS: no SIDE EFFECTS: no RESTRICTIONS: EXAMPLE: IDL x0 2 5 IDL y0 5 1 IDL x1 9 3 IDL y1 1 8 IDL res cutsegment x0 y0 x1 y1 10 IDL splot 0 10 0 10 xstyle 1 ystyle 1 nodata IDL oplot x0 0 x1 0 y0 0 y1 0 IDL oplot res 0 0 res 1 0 color 20 psym 1 thick 3 IDL oplot x0 1 x1 1 y0 1 y1 1 IDL oplot res 0 1 res 1 1 color 40 psym 1 thick 3 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 5th 2002 FUNCTION cutsegment x0 y0 x1 y1 n endpoints endpoints onsphere onsphere number of segment nseg n_elements x0 number of point to find on each segment n2find n keyword_set endpoints IF keyword_set onsphere THEN BEGIN save the inputs arrays x0in temporary x0 y0in temporary y0 x1in temporary x1 y1in temporary y1 sp_cood transpose x0in transpose y0in replicate 1 1 nseg rect_coord CV_COORD FROM_SPHERE temporary sp_cood TO_RECT DEGREES x0 rect_coord 0 y0 rect_coord 1 z0 rect_coord 2 rect_coord 1 free memory sp_cood transpose x1in transpose y1in replicate 1 1 nseg rect_coord CV_COORD FROM_SPHERE temporary sp_cood TO_RECT DEGREES x1 rect_coord 0 y1 rect_coord 1 z1 rect_coord 2 rect_coord 1 free memory ENDIF resx replicate 1 n2find x0 resx temporary resx 1 n findgen n2find 5 1 keyword_set endpoints x1 x0 resx temporary resx resy replicate 1 n2find y0 resy temporary resy 1 n findgen n2find 5 1 keyword_set endpoints y1 y0 resy temporary resy IF keyword_set onsphere THEN BEGIN resz replicate 1 n2find z0 resz temporary resz 1 n findgen n2find 5 1 keyword_set endpoints z1 z0 resz temporary resz rec_cood transpose temporary resx transpose temporary resy transpose temporary resz res CV_COORD FROM_RECT temporary rec_cood TO_SPHERE DEGREES restore the input arrays x0 temporary x0in y0 temporary y0in x1 temporary x1in y1 temporary y1in ENDIF ELSE res transpose temporary resx transpose temporary resy res reform res 0:1 2 n2find nseg overwrite RETURN res END"); 40 a[38] = new Array("./Interpolation/extrapolate.html", "extrapolate.pro", "", "FUNCTION extrapolate zinput maskinput nb_iteration x_periodic x_periodic MINVAL minval MAXVAL maxval compile_opt strictarr strictarrsubs extrapolate data zinput where maskinput eq 0 by filling step by step the coastline points with the mean value of the 8 neighbourgs check the number of iteration used in the extrapolation IF n_elements nb_iteration EQ 0 THEN nb_iteration 10 E20 IF nb_iteration EQ 0 THEN return zinput nx size zinput 1 ny size zinput 2 take care of the boundary conditions for the x direction we put 2 additional columns at the left and right side of the array for the y direction we put 2 additional lines at the bottom and top side of the array These changes allow us to use shift function without taking care of the x and y periodicity ztmp bytarr nx 2 ny 2 ztmp 1:nx 1:ny byte maskinput msk temporary ztmp ztmp replicate 1 e20 nx 2 ny 2 ztmp 1:nx 1:ny zinput if keyword_set x_periodic then begin ztmp 0 1:ny zinput nx 1 ztmp nx 1 1:ny zinput 0 ENDIF remove NaN points if there is some nan where finite ztmp EQ 0 cnt_nan IF cnt_nan NE 0 THEN ztmp temporary nan 1 e20 z temporary ztmp nx2 nx 2 ny2 ny 2 extrapolation sqrtinv 1 sqrt 2 cnt 1 When we look for the coast line we don t whant to select the borderlines of the array we force the value of the mask for those lines msk 0 1b msk nx 1 1b msk 0 1b msk ny 1 1b find the land points land where msk EQ 0 cnt_land WHILE cnt LE nb_iteration AND cnt_land NE 0 DO BEGIN find the coast line points Once the land points list has been found we change back the the mask values for the boundary conditions msk 0 0b msk nx 1 0b msk 0 0b msk ny 1 0b if keyword_set x_periodic then begin msk 0 msk nx msk nx 1 msk 1 endif we compute the weighted number of sea neighbourgs those 4 neighbours have a weight of 1: those 4 neighbours have a weight of 1 sqrt 2 : As we make sure that none of the land points are located on the border of the array we can compute the weight without shift faster weight msk land 1 msk land 1 msk land nx2 msk land nx2 sqrtinv msk land nx2 1 msk land nx2 1 msk land nx2 1 msk land nx2 1 list all the points that have sea neighbourgs ok where weight GT 0 the coastline points coast land ok their weighted number of sea neighbourgs weight weight temporary ok fill the coastine points z temporary z msk zcoast z 1 coast z 1 coast z nx2 coast z nx2 coast 1 sqrt 2 z nx2 1 coast z nx2 1 coast z nx2 1 coast z nx2 1 coast IF n_elements minval NE 0 THEN zcoast minval temporary zcoast IF n_elements maxval NE 0 THEN zcoast temporary zcoast we force the value of the mask for those lines msk 0 1b msk nx 1 1b msk 0 1b msk ny 1 1b find the land points land where msk EQ 0 cnt_land ENDWHILE we return the original size of the array return z 1:nx 1:ny END "); 41 a[39] = new Array("./Interpolation/fromreg.html", "fromreg.pro", "", " NAME: fromreg PURPOSE: interpolate data from a regular rectangular grid to any grid 2 metods availables: bilinear and imoms3 A regular rectangular grid is defined as a grid for which each lontitudes lines have the same latitude and each latitudes columns have the same longitude CATEGORY:interpolation CALLING SEQUENCE: dataout fromreg method datain lonin latin lonout latout INPUTS: method: a string defining the interpolation method must be bilinear or imoms3 datain: a 2D array the input data to interpolate lonin and latin: longitude latitude of the input data optionals if WEIG and ADDR keywords used lonout and latout: longitude latitude of the output data optionals if WEIG and ADDR keywords used KEYWORD PARAMETERS: WEIG ADDR: 2D arrays weig and addr are the weight and addresses used to perform the interpolation: dataout total weig datain addr 1 dataout reform dataout jpio jpjo over Those keywords can be set to named variables into which the values will be copied when the current routine exits Next they can be used to perform the interpolation whithout computing again those 2 parameters In that case lonin latin lonout and latout are not necessary NONORTHERNLINE and NOSOUTHERNLINE: activate if you don t whant to take into account the northen southern line of the input data when perfoming the interpolation OUTPUTS: 2D array: the interpolated data COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS:We supposed the data are located on a sphere with a periodicity along the longitude EXAMPLE: topa fromreg bilinear tncep xncep yncep glamt gphit or t1opa fromreg bilinear t1ncep xncep yncep glamt gphit WEIG a ADDR b help a b t2opa fromreg bilinear t2ncep xncep WEIG a ADDR b MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr FUNCTION fromreg method datain lonin latin lonout latout WEIG weig ADDR addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline compile_opt strictarr strictarrsubs IF NOT keyword_set weig AND keyword_set addr THEN BEGIN atmospheric grid parameters alon lonin alat latin get_gridparams alon alat jpia jpja 1 double Oceanic grid parameters olon lonout olat latout get_gridparams olon olat jpio jpjo 2 double Compute weight and address CASE method OF bilinear :compute_fromreg_bilinear_weigaddr alon alat olon olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline imoms3 : compute_fromreg_imoms3_weigaddr alon alat olon olat weig addr NONORTHERNLINE nonorthernline NOSOUTHERNLINE nosouthernline ELSE:BEGIN print unknown interpolation method we stop stop ENDELSE ENDCASE ENDIF dataout total weig datain addr 1 dataout reform dataout jpio jpjo over RETURN dataout END"); 42 a[40] = new Array("./Interpolation/get_gridparams.html", "get_gridparams.pro", "", " NAME: get_gridparams PURPOSE: 1 extract from a NetCDF file the longitude latidude and their dimensions and make sure it is 1D or 2D arrays or 2 given longitude and latitude arrays get their dimensions and make sure they are 1D or 2D arrays CATEGORY:for interpolations tools CALLING SEQUENCE: 1 get_gridparams file lonname latname lon lat jpi jpj n_dimensions or 2 get_gridparams lon lat jpi jpj n_dimensions INPUTS: 1 file: the name of the netcdf file loname: the name of the variable that contains the longitude in the NetCDF file latname: the name of the variable that contains the latitude in the NetCDF file or 2 lon and lat: 1d or 2D arrays defining longitudes and latitudes Note that these arrays are also outputs and can therefore be modified KEYWORD PARAMETERS: none OUTPUTS: lon the variable that will contain the longitudes lat the variable that will contain the latitudes jpi the number of points in the longitudinal direction jpj the number of points in the latitudinal direction n_dimensions: 1 or 2 to specify if lon and lat should be 1D jpi or jpj arrays or 2D arrays jpi jpj Note that of n_dimensions 1 then the grid must be regular each longitudes must be the same for all latitudes and each latitudes should be the sae for all longitudes COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: EXAMPLE: 1 ncdf_get_gridparams coordinates_ORCA_R05 nc glamt gphit olon olat jpio jpjo 2 2 ncdf_get_gridparams olon olat jpio jpjo 2 MODIFICATION HISTORY: November 2005: Sebastien Masson smasson lodyc jussieu fr PRO get_gridparams in1 in2 in3 in4 in5 in6 in7 in8 DOUBLE double file lonname latname lon lat jpi jpj n_dimensions lon lat jpi jpj n_dimensions CASE n_params OF 8:BEGIN get longitude and latitude IF file_test in1 EQ 0 THEN BEGIN print file in1 does not exist stop ENDIF cdfido ncdf_open in1 ncdf_varget cdfido in2 lon ncdf_varget cdfido in3 lat ncdf_close cdfido n_dimensions in8 END 5:BEGIN lon temporary in1 lat temporary in2 n_dimensions in5 END ELSE:BEGIN print Bad nimber of input parameters stop end ENDCASE sizelon size lon sizelat size lat CASE 1 OF lon and lat are 1D arrays sizelon 0 EQ 1 AND sizelat 0 EQ 1:BEGIN get jpi and jpj jpi sizelon 1 jpj sizelat 1 make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1: 2:BEGIN make lon and lat 2D arrays lon temporary lon replicate 1 jpj lat replicate 1 jpi temporary lat END ELSE:stop ENDCASE END lon is 2D array and lat is 1D array sizelon 0 EQ 2 AND sizelat 0 EQ 1:BEGIN get jpi and jpj jpi sizelon 1 jpj sizelon 2 IF jpj NE n_elements lat THEN stop make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lon lon 0 replicate 1 jpj NE 1 THEN BEGIN print Longitudes are not the same for all latitudes imposible to extract a 1D array of the longitudes stop ENDIF lon lon 0 END 2:lat replicate 1 jpi temporary lat ELSE:stop ENDCASE END lon is 1D array and lat is 2D array sizelon 0 EQ 1 AND sizelat 0 EQ 2:BEGIN get jpi and jpj jpi sizelat 1 jpj sizelat 2 IF jpi NE n_elements lon THEN stop make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lat replicate 1 jpi lat 0 NE 1 THEN BEGIN print Latitudes are not the same for all longitudes imposible to extract a 1D array of the latitudes stop ENDIF lat reform lat 0 END 2:lon temporary lon replicate 1 jpj ELSE:stop ENDCASE END lon and lat are 2D arrays sizelon 0 EQ 2 AND sizelat 0 EQ 2:BEGIN get jpi and jpj IF array_equal sizelon 1:2 sizelat 1:2 NE 1 THEN stop jpi sizelon 1 jpj sizelon 2 make sure that lon and lat have the good number of dimensions CASE n_dimensions OF 1:BEGIN IF array_equal lon lon 0 replicate 1 jpj NE 1 THEN BEGIN print Longitudes are not the same for all latitudes imposible to extract a 1D array of the longitudes stop ENDIF lon lon 0 IF array_equal lat replicate 1 jpi reform lat 0 NE 1 THEN BEGIN print Latitudes are not the same for all longitudes imposible to extract a 1D array of the latitudes stop ENDIF lat reform lat 0 END 2: ELSE:stop ENDCASE END lon and lat are not 1D and or 2D arrays ELSE:stop ENDCASE double keyword if keyword_set double then BEGIN lon double temporary lon lat double temporary lat ENDIF give back the right outparameters CASE n_params OF 8:BEGIN in4 temporary lon in5 temporary lat in6 temporary jpi in7 temporary jpj END 5:BEGIN in1 temporary lon in2 temporary lat in3 temporary jpi in4 temporary jpj END ENDCASE return END"); 43 a[41] = new Array("./Interpolation/imoms3.html", "imoms3.pro", "", "FUNCTION imoms3 xin x abs xin y fltarr n_elements x test1 where x LT 1 IF test1 0 NE 1 THEN BEGIN xtmp x test1 y test1 0 5 xtmp xtmp xtmp xtmp xtmp 0 5 xtmp 1 ENDIF test1 where x LT 2 AND x GE 1 IF test1 0 NE 1 THEN BEGIN xtmp x test1 y test1 1 6 xtmp xtmp xtmp xtmp xtmp 11 6 xtmp 1 ENDIF RETURN y END"); 44 a[42] = new Array("./Interpolation/inquad.html", "inquad.pro", "", " NAME:inquad PURPOSE: to find if an x y point is in a quadrilateral x1 x2 x3 x4 CATEGORY:grid manipulation CALLING SEQUENCE: res inquad x y x1 y1 x2 y2 x3 y3 x4 y4 INPUTS: x y: the coordinates of the point we want to know where it is Must be a scalar if onsphere activated else can be scalar or array x1 y1 x2 y2 x3 y3 x4 y4: the coordinates of the quadrilateral given in the CLOCKWISE order Scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation ONSPHERE: to specify that the quadilateral are on a sphere and that teir coordinates are longitude latitude coordinates In this case est west periodicity poles singularity and other pbs related to longitude latitude coordinates are managed automatically ZOOMRADIUS:the zoom circle centred on the x y with a radius of zoomradius degree where we look for the the quadrilateral which contains the x y point used for the satellite projection when onsphere is activated Default is 4 and seems to be the minimum which can be used Can be increase if the cell size is larger than 5 degrees NOPRINT: to suppress the print messages OUTPUTS: res a n element vector Where n is the number of elements of x res i j means that the point number i is located in the quadrilateral number j with 0 j n_elements x0 1 COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: x 1 1 2 6 7 3 y 1 1 3 3 4 7 x1 1 0 4 2 y1 1 1 4 8 x2 1 1 6 4 y2 1 5 6 8 x3 1 3 8 4 y3 1 4 4 6 x4 1 2 6 2 y4 1 0 2 6 splot 0 10 0 10 xstyle 1 ystyle 1 nodata for i 0 2 do oplot x4 i x1 i x2 i x3 i x4 i y4 i y1 i y2 i y3 i y4 i oplot x y color 20 psym 1 thick 2 print inquad x y x1 y1 x2 y2 x3 y3 x4 y4 On a sphere see clickincell pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Convert_clic_ij pro written by Gurvan Madec FUNCTION inquad x y x1 y1 x2 y2 x3 y3 x4 y4 ONSPHERE onsphere DOUBLE double ZOOMRADIUS zoomradius NOPRINT noprint NEWCOORD newcoord ntofind n_elements x nquad n_elements x2 IF keyword_set onsphere THEN BEGIN save the inputs parameters xin x yin y x1in x1 y1in y1 x2in x2 y2in y2 x3in x3 y3in y3 x4in x4 y4in y4 for map_set x x MOD 360 x1 x1 MOD 360 x2 x2 MOD 360 x3 x3 MOD 360 x4 x4 MOD 360 save map save map: map x: x y: y z: z p: p do a satellite projection IF NOT keyword_set zoomradius THEN zoomradius 4 map_set y 0 x 0 0 satellite sat_p 1 zoomradius 20 6371 229 0 0 noerase iso noborder use normal coordinates to reject cells which are out of the projection tmp convert_coord x y DATA TO_NORMAL DOUBLE double tmp1 convert_coord x1 y1 DATA TO_NORMAL DOUBLE double tmp2 convert_coord x2 y2 DATA TO_NORMAL DOUBLE double tmp3 convert_coord x3 y3 DATA TO_NORMAL DOUBLE double tmp4 convert_coord x4 y4 DATA TO_NORMAL DOUBLE double remove cell which have one corner with coordinates equal to NaN test finite tmp1 0 tmp1 1 tmp2 0 tmp2 1 tmp3 0 tmp3 1 tmp4 0 tmp4 1 good where temporary test EQ 1 IF good 0 EQ 1 THEN BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p RETURN 1 ENDIF x tmp 0 y tmp 1 x1 tmp1 0 good y1 tmp1 1 good x2 tmp2 0 good y2 tmp2 1 good x3 tmp3 0 good y3 tmp3 1 good x4 tmp4 0 good y4 tmp4 1 good tmp1 1 tmp2 1 tmp3 1 tmp4 1 remove cells which are obviously bad test x1 GT x AND x2 GT x AND x3 GT x AND x4 GT x OR x1 LT x AND x2 LT x AND x3 LT x AND x4 LT x OR y1 GT y AND y2 GT y AND y3 GT y AND y4 GT y OR y1 LT y AND y2 LT y AND y3 LT y AND y4 LT y good2 where temporary test EQ 0 IF good2 0 EQ 1 THEN BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p RETURN 1 ENDIF nquad n_elements good2 x1 x1 good2 y1 y1 good2 x2 x2 good2 y2 y2 good2 x3 x3 good2 y3 y3 good2 x4 x4 good2 y4 y4 good2 ENDIF the point is inside the quadilateral if test eq 1 with test equal to: test x x1 y2 y1 GE x2 x1 y y1 x x2 y3 y2 GT x3 x2 y y2 x x3 y4 y3 GT x4 x3 y y3 x x4 y1 y4 GE x1 x4 y y4 computation of test without any do loop for ntofind points x y and nquad quadilateral x1 x2 x3 x4 y1 y2 y3 y4 test dimensions are ntofind nquad column i of test corresponds to the intersection of point i with all quadirlateral row j of test corresponds to all the points localized in cell j test x x1 x replicate 1 nquad replicate 1 ntofind x1 y2 y1 replicate 1 ntofind y2 y1 GE x2 x1 GE replicate 1 ntofind x2 x1 y y1 y replicate 1 nquad replicate 1 ntofind y1 test temporary test x x2 x replicate 1 nquad replicate 1 ntofind x2 y3 y2 replicate 1 ntofind y3 y2 GE x3 x2 GE replicate 1 ntofind x3 x2 y y2 y replicate 1 nquad replicate 1 ntofind y2 test temporary test x x3 x replicate 1 nquad replicate 1 ntofind x3 y4 y3 replicate 1 ntofind y4 y3 GE x4 x3 GE replicate 1 ntofind x4 x3 y y3 y replicate 1 nquad replicate 1 ntofind y3 test temporary test x x4 x replicate 1 nquad replicate 1 ntofind x4 y1 y4 replicate 1 ntofind y1 y4 GE x1 x4 GE replicate 1 ntofind x1 x4 y y4 y replicate 1 nquad replicate 1 ntofind y4 check test if ntofind gt 1 if ntofind gt 1 each point must be localised in one uniq cell IF ntofind GT 1 THEN BEGIN each column of test must have only 1 position equal to one chtest total test 2 points out of the cells IF where chtest EQ 0 0 NE 1 THEN BEGIN IF NOT keyword_set noprint THEN print Points number strjoin strtrim where chtest EQ 0 1 are out of the grid stop ENDIF points in more than one cell IF where chtest GT 1 0 NE 1 THEN BEGIN IF NOT keyword_set noprint THEN print Points number strjoin strtrim where chtest GT 1 1 are in more than one cell stop ENDIF ENDIF find the points for which test eq 1 found where temporary test EQ 1 if ntofind eq 1 the point may be localised in more than one grid cell ou may also be out of the cells IF ntofind EQ 1 THEN BEGIN CASE 1 OF found 0 EQ 1:BEGIN IF NOT keyword_set noprint THEN print The point is out of the cells IF keyword_set onsphere THEN BEGIN restore old map map save map x save x y save y z save z p save p ENDIF return 1 END n_elements found GT ntofind:BEGIN IF NOT keyword_set noprint THEN print The point is in more than one cell END ELSE: ENDCASE ENDIF ELSE BEGIN if ntofind GT 1 found must be sorted i position of found this corresponds to one x y point forsort found MOD ntofind j position of found this corresponds to cell in which is one x y point found temporary found ntofind found must be sorted accordind to forsort found found sort forsort ENDELSE IF keyword_set onsphere THEN BEGIN IF arg_present newcoord THEN BEGIN newcoord x1 found y1 found x2 found y2 found x3 found y3 found x4 found y4 found x y ENDIF found good good2 found restore the input parameters x temporary xin y temporary yin x1 temporary x1in y1 temporary y1in x2 temporary x2in y2 temporary y2in x3 temporary x3in y3 temporary y3in x4 temporary x4in y4 temporary y4in restore old map map save map x save x y save y z save z p save p ENDIF RETURN found END"); 45 a[43] = new Array("./Interpolation/inrecgrid.html", "inrecgrid.pro", "", " NAME: inrecgrid PURPOSE: given a list of points x y position the x and y limits of a rectangular grid find in which cell is located each given point CATEGORY: no DO loop use the wonderfull value_locate function CALLING SEQUENCE:res inrecgrid xin yin left bottom INPUTS: x1d: a 1d array the x position on the points y1d: a 1d array the y position on the points left: a 1d monotonically increasing array the position of the left border of each cell bottom: a 1d monotonically increasing array the position of the bottom border of each cell OPTIONAL INPUTS: KEYWORD PARAMETERS: output2d: to get the output as a 2d array 2 n_elements x1d with res 0 the x index accoring to the 1d array defined by left and res 1 the y index accoring to the 1d array defined by bottom checkout rbgrid ubgrid specify the right and upper bondaries of the grid and check if some points are out OUTPUTS:the index on the cell accoring to the 2d array defined by left and bottom OPTIONAL OUTPUTS: COMMON BLOCKS: no SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: IDL a indgen 5 IDL b indgen 7 IDL r inrecgrid 0 25 3 25 2 4 25 2 8 1 4 a b IDL print r 20 13 7 IDL r inrecgrid 0 25 3 25 2 4 25 2 8 1 4 a a 1 b b 1 output2d IDL print r 0 00000 4 00000 3 00000 2 00000 2 00000 1 00000 MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 3rd 2002 October 3rd 2003: use value_locate FUNCTION inrecgrid x1d y1d left bottom output2d output2d checkout checkout ncellx n_elements left ncelly n_elements bottom xpos value_locate left x1d ypos value_locate bottom y1d IF n_elements checkout EQ 2 THEN BEGIN out where x1d GT checkout 0 IF out 0 NE 1 THEN xpos out 1 out where y1d GT checkout 1 IF out 0 NE 1 THEN ypos out 1 ENDIF IF keyword_set output2d THEN return transpose xpos transpose ypos IF NOT keyword_set checkout THEN RETURN xpos ncellx ypos res xpos ncellx ypos out where xpos EQ 1 OR ypos EQ 1 IF out 0 NE 1 THEN res out 1 RETURN res END"); 46 a[44] = new Array("./Interpolation/ll_narcs_distances.html", "ll_narcs_distances.pro", "", " NAME: LL_NARCS_DISTANCES PURPOSE: This function returns the longitude and latitude lon lat of a point a given arc distance pi lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi two_by_two IDL earthradius 6378206 4d0 IDL res ll_narcs_distances lon0 lat0 dist earthradius azi degrees IDL print reform res 0 10 000000 60 000000 280 00000 IDL print reform res 1 1 1999280e 15 10 000000 45 000000 MODIFICATION HISTORY: Based on the IDL function ll_arc_distance pro v 1 11 2003 02 03 Sebastien Masson smasson lodyc jussieu fr August 2005 Return the lon lat of the point a given arc distance pi arc_dist pi and azimuth az from lon_lat0 FUNCTION LL_NARCS_DISTANCES lon0 lat0 arc_dist az DEGREES degs IF n_elements lon0 NE n_elements lat0 OR n_elements lon0 NE n_elements arc_dist OR n_elements lon0 NE n_elements az THEN return 1 cdist cos arc_dist Arc_Dist is always in radians sdist sin arc_dist if keyword_set degs then s dpi 180 0 else s 1 0d0 ll lat0 s To radians sinll1 sin ll cosll1 cos ll azs az s phi asin sinll1 cdist cosll1 sdist cos azs ll lon0 s To radians lam ll atan sdist sin azs cosll1 cdist sinll1 sdist cos azs zero where arc_dist eq 0 count IF count NE 0 THEN BEGIN lam zero lon0 zero phi zero lat0 zero ENDIF if keyword_set degs then return transpose lam phi s ELSE return transpose lam phi end "); 47 a[45] = new Array("./Interpolation/map_npoints.html", "map_npoints.pro", "", " NAME: Map_nPoints PURPOSE: Return the distance in meter between all np0 points P0 and all np1 points P1 on a sphere If keyword TWO_BY_TWO is given then returns the distances between number n of P0 points and number n of P1 points in that case np0 and np1 must be equal Same as map_2points with the meter parameter but for n points without do loop CATEGORY: Maps CALLING SEQUENCE: Result Map_nPoints lon0 lat0 lon1 lat1 INPUTS: Lon0 Lat0 np0 elements vector longitudes and latitudes of np0 points P0 Lon1 Lat1 np1 elements vector longitude and latitude of np1 points P1 KEYWORD PARAMETERS: AZIMUTH: A named variable that will receive the azimuth of the great circle connecting the two points P0 to P1 MIDDLE: to get the longitude latitude of the middle point betwen P0 and P1 RADIANS if set inputs and angular outputs are in radians otherwise degrees RADIUS: If given return the distance between the two points calculated using the given radius Default value is the earth radius : 6378206 4d0 TWO_BY_TWO:If given then Map_nPoints returns the distances between number n of P0 points and number n of P1 points in that case np0 and np1 must be equal OUTPUTS: An np0 np1 array giving the distance in meter between np0 points P0 and np1 points P1 Element i j of the ouput is the distance between element P0 i and P1 j If keyword TWO_BY_TWO is given then Map_nPoints returns an np element vector giving the distance in meter between P0 i and P1 i in that case we have np0 np1 np if MIDDLE see this keyword EXAMPLES: IDL print map_npoints 105 15 1 40 02 1 0 07 100 50 51 30 20 0 7551369 3 5600334 8 12864354 10921254 14919237 5455558 8 IDL lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi IDL help dist azi DIST DOUBLE Array 3 3 AZI DOUBLE Array 3 3 IDL print dist 4 lindgen 3 azi 4 lindgen 3 2226414 0 4957944 5 10018863 90 000000 64 494450 4 9615627e 15 IDL dist map_npoints lon0 lat0 lon1 lat1 azimuth azi two_by_two IDL help dist azi DIST DOUBLE Array 3 AZI DOUBLE Array 3 IDL print dist azi 2226414 0 4957944 5 10018863 90 000000 64 494450 4 9615627e 15 IDL print map_2points lon0 0 lat0 0 lon1 0 lat1 0 20 000000 90 000000 IDL print map_npoints lon0 0 lat0 0 lon1 0 lat1 0 azi azi 6378206 4d0 dtor azi 20 000000 90 000000 IDL lon0 10 20 100 IDL lat0 0 10 45 IDL lon1 10 60 280 IDL lat1 0 10 45 IDL mid map_npoints lon0 lat0 lon1 lat1 middle two_by_two IDL print reform mid 0 reform mid 1 0 0000000 40 000000 190 00000 0 0000000 1 5902773e 15 90 000000 IDL print map_2points lon0 0 lat0 0 lon1 0 lat1 0 npath 3 1 0 0000000 0 0000000 IDL print map_2points lon0 1 lat0 1 lon1 1 lat1 1 npath 3 1 40 000000 1 5902773e 15 IDL print map_2points lon0 2 lat0 2 lon1 2 lat1 2 npath 3 1 190 00000 90 000000 MODIFICATION HISTORY: Based on the IDL function map_2points pro v 1 6 2001 01 15 Sebastien Masson smasson lodyc jussieu fr October 2003 Function Map_npoints lon0 lat0 lon1 lat1 azimuth azimuth RADIANS radians RADIUS radius MIDDLE middle TWO_BY_TWO two_by_two COMPILE_OPT idl2 ON_ERROR 2 return to caller IF N_PARAMS LT 4 THEN MESSAGE Incorrect number of arguments np0 n_elements lon0 IF n_elements lat0 NE np0 THEN MESSAGE lon0 and lat0 must have the same number of elements np1 n_elements lon1 IF n_elements lat1 NE np1 THEN MESSAGE lon1 and lat1 must have the same number of elements if keyword_set two_by_two AND np0 NE np1 then MESSAGE When using two_by_two keyword P0 and P1 must have the same number of elements mx MAX ABS lat0 lat1 pi2 dpi 2 IF mx GT KEYWORD_SET radians pi2 : 90 THEN MESSAGE Value of Latitude is out of allowed range k KEYWORD_SET radians 1 0d0 : dpi 180 0 Earth equatorial radius meters Clarke 1866 ellipsoid r_sphere n_elements RADIUS NE 0 RADIUS : 6378206 4d0 coslt1 cos k lat1 sinlt1 sin k lat1 coslt0 cos k lat0 sinlt0 sin k lat0 IF np0 EQ np1 AND np1 EQ 1 THEN two_by_two 1 if NOT keyword_set two_by_two THEN BEGIN coslt1 replicate 1 0d0 np0 temporary coslt1 sinlt1 replicate 1 0d0 np0 temporary sinlt1 coslt0 temporary coslt0 replicate 1 0d0 np1 sinlt0 temporary sinlt0 replicate 1 0d0 np1 ENDIF if keyword_set two_by_two THEN BEGIN cosl0l1 cos k lon1 lon0 sinl0l1 sin k lon1 lon0 ENDIF ELSE BEGIN cosl0l1 cos k replicate 1 0d0 np0 lon1 lon0 replicate 1 0d0 np1 sinl0l1 sin k replicate 1 0d0 np0 lon1 lon0 replicate 1 0d0 np1 ENDELSE cosc sinlt0 sinlt1 coslt0 coslt1 cosl0l1 Cos of angle between pnts Avoid roundoff problems by clamping cosine range to 1 1 cosc 1 0d0 cosc 1 0d0 if arg_present azimuth OR keyword_set middle then begin sinc sqrt 1 0d0 cosc cosc bad where abs sinc le 1 0e 7 IF bad 0 NE 1 THEN sinc bad 1 cosaz coslt0 sinlt1 sinlt0 coslt1 cosl0l1 sinc sinaz sinl0l1 coslt1 sinc IF bad 0 NE 1 THEN BEGIN sinc bad 0 0d0 sinaz bad 0 0d0 cosaz bad 1 0d0 ENDIF ENDIF IF keyword_set middle then BEGIN s0 0 5d0 acos cosc coss cos s0 sins sin s0 lats asin sinlt0 coss coslt0 sins cosaz k lons atan sins sinaz coslt0 coss sinlt0 sins cosaz k if keyword_set two_by_two THEN BEGIN return transpose lon0 lons lats ENDIF ELSE BEGIN return lon0 replicate 1 0d0 np1 lons lats ENDELSE ENDIF if arg_present azimuth then begin azimuth atan sinaz cosaz IF k NE 1 0d0 THEN azimuth temporary azimuth k ENDIF return acos cosc r_sphere end"); 48 a[46] = new Array("./Interpolation/neighbor.html", "neighbor.pro", "", " NAME: neighbor PURPOSE: find the closetest point of P0 within a list of np1 points P1 Which can be on a sphere CATEGORY: Maps CALLING SEQUENCE: Result neighbor lon0 lat0 lon1 lat1 INPUTS: Lon0 Lat0 scalar longitudes and latitudes of point P0 Lon1 Lat1 np1 elements vector longitude and latitude of np1 points P1 KEYWORD PARAMETERS: RADIANS if set inputs and angular outputs are in radians otherwise degrees DISTANCE dis to get back the distances between P0 and the np1 points P1 in the variable dis SPHERE to activate if points are located on a sphere OUTPUTS: index giving the P1 index point that is the closetest point of P0 EXAMPLES: IDL print neighbor 105 15 40 02 0 07 100 50 51 30 20 0 distance dis 0 IDL print dis 105 684 206 125 160 228 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr October 2003 FUNCTION neighbor p0lon p0lat neighlon neighlat sphere sphere distance distance radians radians somme checks IF n_elements p0lon NE 1 THEN MESSAGE Sorry p0lon must be a scalar p0lon p0lon 0 IF n_elements p0lat NE 1 THEN MESSAGE Sorry p0lat must be a scalar p0lat p0lat 0 nneig n_elements neighlon IF n_elements neighlat NE nneig THEN MESSAGE neighlon and neighlat must have the same number of elements distance between P0 and the others points IF keyword_set sphere THEN BEGIN IF sphere NE 1 THEN radius sphere distance Map_nPoints p0lon p0lat neighlon neighlat radius radius radians radians ENDIF ELSE BEGIN distance neighlon p0lon 2 neighlat p0lat 2 IF arg_present distance THEN distance sqrt distance ENDELSE RETURN where distance EQ min distance END"); 49 a[47] = new Array("./Interpolation/quadrilateral2square.html", "quadrilateral2square.pro", "", " NAME:quadrilateral2square PURPOSE:warm or map an arbitrary quadrilateral onto a unit square according to the 4 point correspondences: x0 y0 0 0 x1 y1 1 0 x2 y2 1 1 x3 y3 0 1 This is the inverse function of square2quadrilateral pro The mapping is done using perspective transformation which preserve lines in all orientations and permit quadrilateral to quadrilateral mappings see ref bellow CATEGORY:image grid manipulation CALLING SEQUENCE: res square2quadrilateral x0 y0 x1 y1 x2 y2 x3 y3 xin yin INPUTS: x0 y0 x1 y1 x2 y2 x3 y3 the coordinates of the quadrilateral see above for correspondance with the unit square Can be scalar or array x0 y0 x1 y1 x2 y2 and x3 y3 are given in the anticlockwise order xin yin:the coordinates of the point s for which we want to do the mapping Can be scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation OUTPUTS: 2 n array: the new coodinates xout yout of the xin yin point s after mapping If xin is a scalar then n is equal to the number of elements of x0 If xin is an array then n is equal to the number of elements of xin COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: IDL splot 0 5 0 3 nodata xstyle 1 ystyle 1 IDL tracegrille findgen 11 1 findgen 11 1 color indgen 12 20 IDL xin findgen 11 1 replicate 1 11 IDL yin replicate 1 11 findgen 11 1 IDL out square2quadrilateral 2 1 3 0 5 1 2 3 xin yin IDL tracegrille reform out 0 11 11 reform out 1 11 11 color indgen 12 20 IDL inorg quadrilateral2square 2 1 3 0 5 1 2 3 out 0 out 1 IDL tracegrille reform inorg 0 11 11 reform inorg 1 11 11 color indgen 12 20 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Digital Image Warping by G Wolberg IEEE Computer Society Press Los Alamitos California Chapter 3 see p 52 56 FUNCTION quadrilateral2square x0in y0in x1in y1in x2in y2in x3in y3in xxin yyin PERF perf tempsone systime 1 Warning wrong definition of x2 y2 and x3 y3 at the bottom of page 54 of Wolberg s book see figure 3 7 page 56 for the good definition IF keyword_set double THEN BEGIN x0 double x0in x1 double x1in x2 double x2in x3 double x3in y0 double y0in y1 double y1in y2 double y2in y3 double y3in xin double xxin yin double yyin ENDIF ELSE BEGIN x0 float x0in x1 float x1in x2 float x2in x3 float x3in y0 float y0in y1 float y1in y2 float y2in y3 float y3in xin float xxin yin float yyin ENDELSE get the matrix A a square2quadrilateral x0in y0in x1in y1in x2in y2in x3in y3in compute the adjoint matrix IF keyword_set double THEN adj dblarr 9 n_elements x0 ELSE adj fltarr 9 n_elements x0 adj 0 a 4 a 7 a 5 adj 1 a 7 a 2 a 1 adj 2 a 1 a 5 a 4 a 2 adj 3 a 6 a 5 a 3 adj 4 a 0 a 6 a 2 adj 5 a 3 a 2 a 0 a 5 adj 6 a 3 a 7 a 6 a 4 adj 7 a 6 a 1 a 0 a 7 adj 8 a 0 a 4 a 3 a 1 IF n_elements xin EQ 1 THEN BEGIN xin replicate xin n_elements x0 yin replicate yin n_elements x0 ENDIF compute xprime yprime and wprime IF n_elements x0 EQ 1 THEN BEGIN wpr 1 adj 6 xin adj 7 yin adj 8 ENDIF ELSE BEGIN wpr 1 adj 6 xin adj 7 yin adj 8 ENDELSE xpr xin wpr ypr yin wpr IF keyword_set double THEN res dblarr 2 n_elements xin ELSE res fltarr 2 n_elements xin IF n_elements x0 EQ 1 THEN BEGIN res 0 xpr adj 0 ypr adj 1 wpr adj 2 res 1 xpr adj 3 ypr adj 4 wpr adj 5 ENDIF ELSE BEGIN res 0 xpr adj 0 ypr adj 1 wpr adj 2 res 1 xpr adj 3 ypr adj 4 wpr adj 5 ENDELSE IF keyword_set perf THEN print time quadrilateral2square systime 1 tempsone RETURN res END"); 50 a[48] = new Array("./Interpolation/spl_fstdrv.html", "spl_fstdrv.pro", "", " NAME:spl_fstdrv PURPOSE: SPL_FSTDRV returns the values of the first derivative of the interpolating function at the points X2i it is a double precision array Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that interpolated value are also in ascending order CATEGORY: CALLING SEQUENCE: y2 spl_fstdrv x y yscd x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in ascending order y: f x y An n element input vector that specifies the values of the tabulated function F Xi corresponding to Xi yscd: The output from SPL_INIT for the specified X and Y x2: The input values for which the first derivative values are desired X can be scalar or an array of values KEYWORD PARAMETERS: none OUTPUTS: y2: f x2 y2 COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May 2005 FUNCTION spl_fstdrv x y yscd x2 compute the first derivative of the spline function nx n_elements x ny n_elements y x must have at least 2 elements IF nx LT 2 THEN stop y must have the same number of elements than x IF nx NE ny THEN stop define loc in a way that if loc i eq 1 : x2 i x nx 1 else : x loc i extrapolation use x nx 2 and x nx 1 even if x2 i x nx 1 extrapolation loc 0 temporary loc nx 2 distance between to consecutive x deltax x loc 1 x loc distance between to consecutive y deltay y loc 1 y loc relative distance between x2 i and x loc i 1 a x loc 1 x2 deltax relative distance between x2 i and x loc i b 1 0d a compute the first derivative on x see numerical recipes Chap 3 3 yfrst temporary deltay deltax 1 0d 6 0d 3 0d a a 1 0d deltax yscd loc 1 0d 6 0d 3 0d b b 1 0d deltax yscd loc 1 beware of the computation precision force near zero values to be exactly 0 0 zero where abs yfrst LT 1 e 10 IF zero 0 NE 1 THEN yfrst zero 0 0d RETURN yfrst END "); 51 a[49] = new Array("./Interpolation/spl_incr.html", "spl_incr.pro", "", " NAME:spl_incr PURPOSE: Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that interpolated values are also monotonically increasing CATEGORY: CALLING SEQUENCE: y2 spl_incr x y x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in a strict ascending order y: f x y An n element input vector that specifies the values of the tabulated function F Xi corresponding to Xi As f is supposed to be monotonically increasing y values must be monotonically increasing y can have equal consecutive values x2: The input values for which the interpolated values are desired Its values must be strictly monotonically increasing KEYWORD PARAMETERS: YP0: The first derivative of the interpolating function at the point X0 If YP0 is omitted the second derivative at the boundary is set to zero resulting in a natural spline YPN_1: The first derivative of the interpolating function at the point Xn 1 If YPN_1 is omitted the second derivative at the boundary is set to zero resulting in a natural spline OUTPUTS: y2: f x2 y2 Double precision array COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: It might be possible that y2 i 1 y2 i has very small negative values amplitude smaller than 1 e 6 EXAMPLE: n 100L x dindgen n 2 y abs randomn 0 n y n 2:n 2 1 0 y n n 3 0 y n n 6:n n 6 5 0 y total y cumulative double x2 dindgen n 1 2 n2 n_elements x2 print min y 1:n 1 y 0:n 2 LT 0 y2 spl_incr x y x2 splot x y xstyle 1 ystyle 1 ysurx 25 petit 1 2 1 land oplot x2 y2 color 100 c y2 1:n2 1 y2 0:n2 2 print min c LT 0 print min c max ma ma splot c xstyle 1 ystyle 1 yrange 01 05 ysurx 25 petit 1 2 2 noerase oplot 0 n_elements c 0 0 linestyle 1 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May Dec 2005 FUNCTION pure_concave x1 x2 y1 y2 der2 x X n type xx double x double x1 double x2 double x1 f double x2 double x1 double y2 double y1 n der2 temporary f res xx n IF check_math GT 0 THEN BEGIN zero where abs res LT 1 e 10 IF zero 0 NE 1 THEN res zero 0 0d END res temporary res double y2 double y1 y1 IF array_equal sort res lindgen n_elements res NE 1 THEN stop RETURN res END FUNCTION pure_convex x1 x2 y1 y2 der2 x 1 1 X n type xx 1 0d double x double x1 double x2 double x1 f double x2 double x1 double y2 double y1 n der2 temporary f res xx n IF check_math GT 0 THEN BEGIN zero where abs res LT 1 e 10 IF zero 0 NE 1 THEN res zero 0 0d END res 1 0d temporary res res temporary res y2 y1 y1 IF array_equal sort res lindgen n_elements res NE 1 THEN stop RETURN res END FUNCTION spl_incr x y x2 YP0 yp0 YPN_1 ypn_1 check and initialisation nx n_elements x ny n_elements y nx2 n_elements x2 x must have at least 2 elements IF nx LT 2 THEN stop y must have the same number of elements than x IF nx NE ny THEN stop x be monotonically increasing IF min x 1:nx 1 x 0:nx 2 LE 0 THEN stop x2 be monotonically increasing IF N_ELEMENTS X2 GE 2 THEN IF min x2 1:nx2 1 x2 0:nx2 2 LE 0 THEN stop y be monotonically increasing IF min y 1:ny 1 y 0:ny 2 LT 0 THEN stop first check: check if two consecutive values are equal bad where y 1:ny 1 y 0:ny 2 EQ 0 cntbad IF cntbad NE 0 THEN BEGIN define the results: y2 y2 dblarr nx2 define xinx2: see help of value_locate if xinx2 i eq 1 : x bad i x2 nx2 1 else : x2 xinx2 i x2 nx2 1 else : x2 xinx2 i we have middle pieces for which we force yp0 0 0d and ypn_1 0 0d IF cntbad GT 1 THEN BEGIN we take care of the piece located wetween bad ib 1 and bad ib FOR ib 1 cntbad 1 DO BEGIN if there is x2 values smaller that x bad ib then the x2 values located between bad ib 1 and bad ib are xinx2 ib 1 1:xinx2 ib IF xinx2 ib NE 1 THEN begin y2 xinx2 ib 1 1 0 y i 1 y i 2 y reach its minimum value between x i and x i 1 0 y i 1 0 y i we do a first selection by looking for those points loc lindgen nx 1 maybebad where yscd loc LE 0 0d AND yscd loc 1 GE 0 0d cntbad IF cntbad NE 0 THEN BEGIN mbbloc loc maybebad aaa yscd mbbloc 1 yscd mbbloc 6 0d x mbbloc 1 x mbbloc bbb 0 5d yscd mbbloc ccc yifrst mbbloc ddd y mbbloc definitive selection: y can become negative if and only if 2b 2 4 3a c 0 y can become negative if and only if b 2 3a c 0 delta bbb bbb 3 0d aaa ccc bad where delta GT 0 cntbad IF cntbad NE 0 THEN BEGIN delta delta bad aaa aaa bad bbb bbb bad ccc ccc bad ddd ddd bad bad maybebad bad define xinx2_1: see help of value_locate if xinx2_1 i eq 1 : x bad i x2 nx2 1 else : x2 xinx2_1 i x2 nx2 1 else : x2 xinx2_2 i y bad ib 1 then we cannot applay the method we want to apply we use then convex concave case by changing by hand the value of yinfl and xinfl IF yzero GT y bad ib 1 THEN BEGIN yinfl 0 5d y bad ib 1 y bad ib xinfl 0 5d x bad ib 1 x bad ib GOTO convexconcave ENDIF define xinx2_3: see help of value_locate if xinx2_3 ib eq 1 : x bad ib xzero x2 nx2 1 else : x2 xinx2_3 we use then convex concave case by changing by hand the value of yinfl and xinfl IF yzero lt y bad ib THEN BEGIN yinfl 0 5d y bad ib 1 y bad ib xinfl 0 5d x bad ib 1 x bad ib GOTO convexconcave ENDIF define xinx2_3: see help of value_locate if xinx2_3 ib eq 1 : x bad ib xzero x2 nx2 1 else : x2 xinx2_3 x2 nx2 1 else : x2 xinx2_3 x bad ib xzero x2 xinx3_2 1 xinx2_3 value_locate x2 x bad ib xinfl IF xinx2_3 ge xinx2_1 ib 1 THEN BEGIN y2 xinx2_1 ib 1:xinx2_3 pure_convex x bad ib x bad ib xinfl y bad ib yinfl yifrst bad ib x2 xinx2_1 ib 1:xinx2_3 ENDIF IF xinx2_2 ib GE xinx2_3 1 THEN BEGIN y2 xinx2_3 1:xinx2_2 ib pure_concave x bad ib xinfl x bad ib 1 yinfl y bad ib 1 yifrst bad ib 1 x2 xinx2_3 1:xinx2_2 ib ENDIF END ENDCASE END ENDCASE ENDIF ENDFOR ENDIF ENDIF RETURN y2 END"); 52 a[50] = new Array("./Interpolation/spl_keep_mean.html", "spl_keep_mean.pro", "", " NAME:spl_keep_mean PURPOSE: Given the arrays X and Y which tabulate a function with the X i AND Y i in ascending order and given an input value X2 the SPL_INCR function returns an interpolated value for the given values of X2 The interpolation method is based on cubic spline corrected in a way that integral of the interpolated values is the same as the integral of the input values for exemple to build daily data from monthly mean and keep the monthly mean of the computed daily data equa to the original values CATEGORY: CALLING SEQUENCE: y2 spl_keep_mean x y x2 INPUTS: x: An n element at least 2 input vector that specifies the tabulate points in a strict ascending order y: an array with one element less than x y i represents the mean value between x i and x i 1 if GE0 is activated y must have positive values x2: The input values for which the interpolated values are desired Its values must be strictly monotonically increasing KEYWORD PARAMETERS: GE0: to force that y2 is always GE than 0 In that case y must also be GE than 0 YP0: The first derivative of the interpolating function at the point X0 If YP0 is omitted the second derivative at the boundary is set to zero resulting in a natural spline YPN_1: The first derivative of the interpolating function at the point Xn 1 If YPN_1 is omitted the second derivative at the boundary is set to zero resulting in a natural spline OUTPUTS: y2: the meean value between two consecutive values of x2 This array has one element less than y2 y2 has double precision COMMON BLOCKS: none SIDE EFFECTS: RESTRICTIONS: It might be possible that y2 has very small negative values amplitude smaller than 1 e 6 EXAMPLE: 12 monthly values of precipitations into daily values: yr1 1990 yr2 1992 nyr yr2 yr1 1 n1 12 nyr 1 x julday 1 findgen n1 replicate 1 n1 replicate yr1 n1 fltarr n1 n2 365 nyr total leapyr yr1 indgen nyr 1 x2 julday replicate 1 n2 1 findgen n2 replicate yr1 n2 fltarr n2 y abs randomn 0 n1 1 y2 spl_keep_mean x y x2 ge0 print min x max ma ma print min x2 max ma ma print vairdate min x max ma ma print total y x 1:n1 1 x 0:n1 2 print total y2 x2 1:n2 1 x2 0:n2 2 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr : May 2005 FUNCTION spl_keep_mean x yin x2 YP0 yp0 YPN_1 ypn_1 GE0 ge0 check and initialisation nx n_elements x ny n_elements yin nx2 n_elements x2 x must have at least 2 elements IF nx LT 2 THEN stop x2 must have at least 2 elements IF nx2 LT 2 THEN stop x be monotonically increasing IF min x 1:nx 1 x 0:nx 2 LE 0 THEN stop x2 be monotonically increasing IF min x2 1:nx2 1 x2 0:nx2 2 LE 0 THEN stop compute the integral of y if spl_keep_mean is called by the user and not by itself we must compute the integral of y yin must have one element less than x IF nx NE ny 1 THEN stop y double yin double x 1:nx 1 x 0:nx 2 y 0 0d temporary y y total temporary y cumulative double compute the spline interpolation IF keyword_set ge0 THEN BEGIN if the want that the interpolated values are always 0 we must have yin 0 0d IF min yin LT 0 THEN stop call spl_incr y2 spl_incr x temporary y x2 yp0 yp0 ypn_1 ypn_1 ENDIF ELSE BEGIN yscd spl_init x y yp0 yp0 ypn_1 ypn_1 double y2 spl_interp x y temporary yscd x2 double ENDELSE Compute the derivative of y yfrst y2 1:nx2 1 y2 0:nx2 2 x2 1:nx2 1 x2 0:nx2 2 it can happen that we have very small negative values 1 e 6 for ex yfrst 0 0d temporary yfrst RETURN yfrst END"); 53 a[51] = new Array("./Interpolation/square2quadrilateral.html", "square2quadrilateral.pro", "", " NAME:square2quadrilateral PURPOSE:warm or map a unit square onto an arbitrary quadrilateral according to the 4 point correspondences: 0 0 x0 y0 1 0 x1 y1 1 1 x2 y2 0 1 x3 y3 The mapping is done using perspective transformation which preserve lines in all orientations and permit quadrilateral to quadrilateral mappings see ref bellow CATEGORY:image grid manipulation CALLING SEQUENCE: res square2quadrilateral x0 y0 x1 y1 x2 y2 x3 y3 xin yin INPUTS: x0 y0 x1 y1 x2 y2 x3 y3 the coordinates of the quadrilateral see above for correspondance with the unit square Can be scalar or array x0 y0 x1 y1 x2 y2 and x3 y3 are given in the anticlockwise order xin yin:the coordinates of the point s for which we want to do the mapping Can be scalar or array KEYWORD PARAMETERS: DOUBLE: use double precision to perform the computation OUTPUTS: 2 n array: the new coodinates xout yout of the xin yin point s after mapping If xin is a scalar then n is equal to the number of elements of x0 If xin is an array then n is equal to the number of elements of xin If xin and yin are omited square2quadrilateral returns the matrix A which is used for the inverse transformation COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS: I think degenerated quadrilateral e g flat of twisted is not work This has to be tested EXAMPLE: IDL splot 0 5 0 3 nodata xstyle 1 ystyle 1 IDL tracegrille findgen 11 1 findgen 11 1 color indgen 12 20 IDL xin findgen 11 1 replicate 1 11 IDL yin replicate 1 11 findgen 11 1 IDL out square2quadrilateral 2 1 3 0 5 1 2 3 xin yin IDL tracegrille reform out 0 11 11 reform out 1 11 11 color indgen 12 20 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr August 2003 Based on Digital Image Warping by G Wolberg IEEE Computer Society Press Los Alamitos California Chapter 3 see p 52 56 FUNCTION square2quadrilateral x0in y0in x1in y1in x2in y2in x3in y3in xxin yyin Warning wrong definition of x2 y2 and x3 y3 at the bottom of page 54 of Wolberg s book see figure 3 7 page 56 for the good definition IF keyword_set double THEN BEGIN x0 double x0in x1 double x1in x2 double x2in x3 double x3in y0 double y0in y1 double y1in y2 double y2in y3 double y3in IF arg_present xxin THEN BEGIN xin double xxin yin double yyin ENDIF ENDIF ELSE BEGIN x0 float x0in x1 float x1in x2 float x2in x3 float x3in y0 float y0in y1 float y1in y2 float y2in y3 float y3in IF arg_present xxin THEN BEGIN xin float xxin yin float yyin ENDIF ENDELSE IF keyword_set double THEN a dlbarr 8 n_elements x0 ELSE a fltarr 8 n_elements x0 delx3 x0 x1 x2 x3 dely3 y0 y1 y2 y3 affinemap where delx3 EQ 0 AND dely3 EQ 0 IF affinemap 0 NE 1 THEN BEGIN xx0 x0 affinemap xx1 x1 affinemap xx2 x2 affinemap yy0 y0 affinemap yy1 y1 affinemap yy2 y2 affinemap a 0 affinemap xx1 xx0 a 1 affinemap xx2 xx1 a 2 affinemap xx0 a 3 affinemap yy1 yy0 a 4 affinemap yy2 yy1 a 5 affinemap yy0 a 6 affinemap 0 a 7 affinemap 0 ENDIF projectivemap where delx3 NE 0 OR dely3 NE 0 IF projectivemap 0 NE 1 THEN BEGIN xx0 x0 projectivemap xx1 x1 projectivemap xx2 x2 projectivemap xx3 x3 projectivemap yy0 y0 projectivemap yy1 y1 projectivemap yy2 y2 projectivemap yy3 y3 projectivemap delx1 xx1 xx2 dely1 yy1 yy2 delx2 xx3 xx2 dely2 yy3 yy2 delx3 delx3 projectivemap dely3 dely3 projectivemap div delx1 dely2 dely1 delx2 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF a13 delx3 dely2 dely3 delx2 div a23 delx1 dely3 dely1 delx3 div a 0 projectivemap xx1 xx0 a13 xx1 a 1 projectivemap xx3 xx0 a23 xx3 a 2 projectivemap xx0 a 3 projectivemap yy1 yy0 a13 yy1 a 4 projectivemap yy3 yy0 a23 yy3 a 5 projectivemap yy0 a 6 projectivemap a13 a 7 projectivemap a23 ENDIF IF NOT arg_present xxin THEN return a IF n_elements xin EQ 1 THEN BEGIN xin replicate xin n_elements x0 yin replicate yin n_elements x0 ENDIF IF keyword_set double THEN res dblarr 2 n_elements xin ELSE res fltarr 2 n_elements xin IF n_elements x0 EQ 1 THEN BEGIN div a 6 xin a 7 yin 1 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF res 0 a 0 xin a 1 yin a 2 div res 1 a 3 xin a 4 yin a 5 div ENDIF ELSE BEGIN div a 6 xin a 7 yin 1 zero where div EQ 0 IF zero 0 NE 1 THEN BEGIN stop ENDIF res 0 a 0 xin a 1 yin a 2 div res 1 a 3 xin a 4 yin a 5 div ENDELSE RETURN res END"); 54 a[52] = new Array("./Interpolation/testinterp.html", "testinterp.pro", "", "PRO testinterp method bilinear method imoms3 jpia 300L jpja 200L torg findgen jpia jpja xorg 20 d 360 d jpia dindgen jpia yorg 89 d 178 d jpja 1 dindgen jpja jpio 400L jpjo 150L xnew 0 d 360 d jpio dindgen jpio ynew 89 5d 179 d jpjo 1 dindgen jpjo outnorth where ynew GT yorg jpja 2 noutn outsouth where ynew LT yorg 1 nouts t2 fromreg method torg xorg yorg xnew ynew t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok1 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok2 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok3 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift t3 fromreg method torg2 xorg2 yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok4 xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew IF array_equal t2 t3 EQ 0 THEN stop ELSE print ok5 t3 fromreg method torg xorg yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok6 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok7 i t3 fromreg method torg xorg yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok8 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok9 i t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok10 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok11 i t3 fromreg method reverse torg 2 xorg reverse yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok12 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok13 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok14 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok15 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method torg2 xorg2 yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok16 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok17 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew nonorthernline IF array_equal t2 0:jpjo 1 noutn t3 0:jpjo 1 noutn EQ 0 THEN stop ELSE print ok18 FOR i 1 noutn 1 DO if array_equal t3 jpjo 1 t3 jpjo 1 i EQ 0 THEN stop ELSE print ok19 i xshift 20 torg2 shift torg xshift 0 xorg2 shift xorg xshift xorg2 0: xshift 1 xorg2 0: xshift 1 360 IF array_equal sort xorg2 lindgen n_elements xorg2 EQ 0 THEN stop t3 fromreg method reverse torg2 2 xorg2 reverse yorg xnew ynew nosouthernline IF array_equal t2 nouts: t3 nouts: EQ 0 THEN stop ELSE print ok20 FOR i 1 nouts 1 DO if array_equal t3 0 t3 i EQ 0 THEN stop ELSE print ok21 i return end"); 55 a[53] = new Array("./Obsolete/common.html", "common.pro", "", ""); 56 a[54] = new Array("./Obsolete/cp.html", "cp.pro", "", " file_comments copy files obsolete file_comments file_copy should be used instead history June 2005: Sebastien Masson obsolete routine PRO cp filenamein filenameout _extra ex file_copy filenamein filenameout _extra ex RETURN END"); 57 a[55] = new Array("./Obsolete/ficdate.html", "ficdate.pro", "", " file_comments sets s_fichier to name of the vairmer file associated to the given date in vairmer format yymmdd obsolete param vdate in date vairmer ex:930124 param dim in so ou vo par defaut so est choisi param nomexp in nom de l experience en trois lettres par defaut prefix returns le nom du fichier vairmer depuis iodir uses common pro example IDL fic ficdate 930124 history Jerome Vialard jv lodyc jussieu fr 1 7 98 function ficdate vdate dim nomexp common case n_params of 1: dim SO 2: dim strupcase dim 3: begin prefix nomexp dim strupcase dim end endcase constitution de l adresse ou aller chercher le fichier date yymmdd vdate sets month year and day to the good value : rien juldate vdate constitution de la date yymmdd case 1 of year lt 10: s_year 0 string format i1 year year ge 10 and year lt 100:s_year string format i2 year year ge 100:BEGIN year year 1900 if year LT 10 then s_year 0 string format i1 year ELSE s_year string format i2 year end endcase if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day case dim of SO : begin case 1 of year eq 0 and month eq 0 : s_fichier iodir prefix O EX SO year eq 0 and month ne 0 and day eq 0 : s_fichier iodir prefix O SE SO s_month year ne 0 and month eq 0 : s_fichier iodir prefix O AN SO s_year year ne 0 and day eq 0 : s_fichier iodir prefix O MO SO s_year s_month else: s_fichier iodir prefix O SO s_year s_month s_day endcase end VO : begin case 1 of year eq 0 and month eq 0 : s_fichier iodir prefix O EX VO year eq 0 and month ne 0 and day eq 0 : s_fichier iodir prefix O SE VO s_month year ne 0 and month eq 0 : s_fichier iodir prefix O AN VO s_year year ne 0 and day eq 0 : s_fichier iodir prefix O MO VO s_year s_month else: s_fichier iodir prefix O VO s_year s_month s_day endcase end else: return report le fichier doit etre VO ou SO endcase print print adresse du fichier: fichier return s_fichier end "); 58 a[56] = new Array("./Obsolete/fictype.html", "fictype.pro", "", " file_comments gives fictype DA MO AN SE EX corresponding to the given date in vairmer format yymmdd uses common pro exammples IDL fictype fictype 930124 history Jerome Vialard jv lodyc jussieu fr 2 7 98 function fictype vdate dim common constitution de l adresse ou aller chercher le fichier date yymmdd vdate jul juldate vdate case 1 of year eq 0 and month eq 0 : return EX year eq 0 and month ne 0 and day eq 0 : return SE year ne 0 and month eq 0 : return AN year ne 0 and day eq 0 : return MO else : return DA endcase fini: return 1 end "); 59 a[57] = new Array("./Obsolete/imprime.html", "imprime.pro", "", " file_comments use printps instead obsolete history June 2005: Sebastien Masson english version PRO imprime filename TRANS trans NB nb this is working only with unix linux osX machines thisOS strupcase strmid version os_family 0 3 CASE thisOS OF MAC :return WIN :return ELSE: ENDCASE call printps CASE N_PARAMS OF 0:printps 1:printps filename ELSE: BEGIN ras report imprime accept only one element: psfilename return END ENDCASE return END "); 60 a[58] = new Array("./Obsolete/jourdsmois.html", "jourdsmois.pro", "", " file_comments used daysinmonth instead obsolete history Sebastien Masson smasson lodyc jussieu fr June 2005: Sebastien Masson english version function jourdsmois mois annee case n_params OF 0:return daysinmonth 1:return daysinmonth mois 2:return daysinmonth mois annee endcase end"); 61 a[59] = new Array("./Obsolete/juldate.html", "juldate.pro", "", " file_comments you better use date2jul obsolete file_comments gives julian date equivalent of a date in vairmer yymmdd or yyyymmdd format sets month day and year to the corresp values categories calendar param vvdate in date de la forme yymmdd ou yyyymmdd keyword VRAIDATE pour ne pas transformer l annnee 01 en 1901 keyword GRADS if 1 le year le 49 then year 2000 year if 50 le year le 99 then year 1900 year uses common pro vraidate returns date en jour julien l annee 0 n existant pas qd year est nulle on calcule le jour julien de l annee 1 COMPATIBLE AVEC L AN 2000 : une date de la forme yymmdd est donvertit sous la forme yyyymmdd a l aide de vraidate Attention les variables globales year month day sont attribuees examples IDL date juldate 930124 history Jerome Vialard jv lodyc jussieu fr 2 7 98 function juldate vvdate _EXTRA ex vdate vvdate vdate vraidate vdate _EXTRA ex common year vdate 10000 month vdate 100 year 100 day abs vdate year 10000 month 100 month abs month mm month dd day yy year ndate n_elements vdate if total mm EQ 0 EQ ndate then mm 6 if total dd EQ 0 EQ ndate then dd 15 if total yy EQ 0 EQ ndate THEN yy 1 return julday mm dd yy _EXTRA ex return 1 end "); 62 a[60] = new Array("./Obsolete/lec.html", "lec.pro", "", " file_comments lit les fichiers Vairmer en sort: un tableau 2d ou 3d en fonction de nomchamp qui est le nom du champ a extaire 2d s il commence par SO et 3d s il commence par VO cette fonction modifie aussi les variables globales: varname: trois lettres: nom de l experience vargrid: nom de la grille vardate: date yy yymmdd varexp: nom Vairmer du champ a tarcer obsolete categories Graphics lecture de fichier Vaimer examples IDL resultat lec nom_Vairmer date nom_experience param nomchamp in required 2 choix possibles: 1 nom de champ Vairmer chaine de 8 caracteres en majuscule ou minuscule commencant par vo ou so Dans cette methode on saute directement d en tete en en tete jusqu a trouver le bon fichier 2 chaine de characteres commencant par vo ou so suivit du numero de champ a aller chercher par ex vo5 Cette methode est un peu plus rapide car elle va directement chercher le fichier qui nous interesse param date in optional nombres de 6 ou 8 chiffres anneemoisjour par ex:19980507 param nomexp in optional trois lettres designant le nom de l experience keyword ANOM in type du fichier vairmer par rapport auquel on doit calculer l anomalie EX AN SE MO keyword ECRIT in permet d imprimer tous les noms vairmer que contient le fichier ds ce cas en input on met seulement vo ou so la fonction retourne le nombre de fichiers lus keyword EXPANOM in si on calcule l anom par rapport a une exper differente keyword FILENAME string pour passer directement le nom du champ sans utiliser les inputs: nom_Vairmer date nom_experience Rq si ces inputs sont qd meme donnes ils ne sont pas modifies par filename keyword GRID lorsque ce mot clef est active lec retourne la liste des types de grilles T U auxquelles se rapportent les variables ds ce cas en input on met seulement vo ou so keyword NAME lorsque ce mot clef est active lec retourne la liste des noms des variables ds ce cas en input on met seulement vo ou so keyword TOUT oblige lec a lire le champ sur tout le domaine qui a etait selectionne pour la cession en cours jpi jpj jpk returns un tableau 2 ou 3d sans le mot cle TOUT sa taille est celle du sous domaine definit par domdef nx ny nz avec TOUT le champ a la taille du domaine qui a etait selectionne pour la cession en cours jpi jpj jpk pour les sous domaines cf: http: www ipsl jussieu fr smlod sousdomaine html Retourne 1 en cas d erreur uses common pro isnumber pro fivardate pro history Sebastien Masson smasson lodyc jussieu fr 26 5 98 Jerome Vialard : adaptation au format vairmer keyword anom et expanom 1 7 98 Sebastien Masson masque des terres 14 8 98 Sebastien Masson decoupe pour les sous domaines 2 99 function lec nomchamp date nomexp ECRIT ecrit ANOM anom BOITE boite EXPANOM expanom TOUT tout GRID grid NAME name filename FILENAME common tempsun systime 1 pour key_performance z 1 if keyword_set filename then BEGIN CASE strupcase strmid version os_family 0 3 of MAC :sep : WIN :sep ELSE:sep ENDCASE fname strmid filename rstrpos filename sep 1 if n_elements nomchamp EQ 0 then nomchamp strmid fname 6 2 if n_elements date EQ 0 then date long strmid fname 8 if n_elements nomexp EQ 0 then nomexp strmid fname 0 3 endif nomchamp strupcase nomchamp dim string format a2 nomchamp print nom de l experience: nomchamp specification de la date et de l experience case n_params OF 0:BEGIN if keyword_set filename then begin rien juldate date prefix nomexp ENDIF ELSE return report Donnez un argument en entree ou utilisez le mot clef FILENAME END 1:date long day long month 100 long year 10000 2:rien juldate date 3:begin rien juldate date prefix nomexp end endcase verification de la dim du fichier if dim ne SO and dim ne VO then return report le nom du champ doit commencer par VO ou SO constitution de l adresse ou aller chercher le fichier s_fichier ficdate date dim ouverture du fichier a l adresse s_fichier openr numlec s_fichier get_lun ERROR err swap_if_little_endian if err ne 0 then begin print err_string return 1 endif taille en octet du fichier infofichier fstat numlec definition de la taille du fichier a aller chercher: jpidta jpjdta jpkdta if n_elements jpidta EQ 0 THEN BEGIN if n_elements ixmindta EQ 0 OR n_elements ixmaxdta EQ 0 then jpidta jpiglo else jpidta ixmaxdta ixmindta 1 endif if n_elements jpjdta EQ 0 THEN BEGIN if n_elements iymindta EQ 0 OR n_elements iymaxdta EQ 0 then jpjdta jpjglo else jpjdta iymaxdta iymindta 1 endif if n_elements jpkdta EQ 0 THEN BEGIN if n_elements izmindta EQ 0 OR n_elements izmaxdta EQ 0 then jpkdta jpkglo else jpkdta izmaxdta izmindta 1 endif lecture des champs directement vers le champ ou l en tete que l on recherche il faut savoir que: le fortran ajoute au debut et a la fin de chaque write 4 octets de controle les reels du model sont codes sur 4 octets un charactere fait 1 octet 4 chaines de 8 characteres un tableau de reels 4 trucs de controle pour les 2 write : if dim eq VO then taillebloc 4 8 long jpidta jpjdta jpkdta 4 4 4 else taillebloc 4 8 long jpidta jpjdta 4 4 4 choix du type de lecture typelec strmid nomchamp 2 strlen nomchamp test isnumber typelec numerochamp if test eq 0 then begin 1 LECTURE DIRECTE D EN TETE en EN TETE numerochamp 1 lecture des noms de champ resname resgrid while numerochamp taillebloc le infofichier size do begin offset numerochamp 1 taillebloc 4 a assoc numlec bytarr 8 nozero offset varname string a 0 if keyword_set ecrit OR keyword_set name OR keyword_set grid then begin vargrid a 1 vargrid string vargrid 7 vardate strtrim long string a 2 2 varexp strtrim a 3 2 if keyword_set ecrit THEN print numerochamp varname vargrid vardate varexp resname resname varname resgrid resgrid vargrid endif if nomchamp eq varname then begin vargrid a 1 vargrid string vargrid 7 vardate strtrim long string a 2 2 varexp strtrim a 3 2 goto sortieboucle endif numerochamp numerochamp 1 ENDWHILE free_lun numlec close numlec case 1 of keyword_set ecrit :return numerochamp 1 keyword_set name :return resname 1:numerochamp 1 keyword_set grid : return strmid resgrid 1:numerochamp 1 0 strlen resgrid 0 2 ELSE:return report Ce nom Vairmer de champ n existe pas ds le fichier: infofichier name endcase endif else begin 2 LECTURE DIRECTEMENT DU CHAMP QUE L ON VEUT test pour savoir si numero de champ est accessible if taillebloc numerochamp gt infofichier size then return report Ce numero de champ n exite pas Le fichier infofichier name ne contient que infofichier size taillebloc champs lecture de l en tete numero numerochamp offset numerochamp 1 taillebloc 4 a assoc numlec bytarr 8 nozero offset varname string a 0 vargrid a 1 vargrid string vargrid 7 vardate string a 2 varexp string a 3 endelse sortieboucle: lecture du champ lui meme offset numerochamp 1 taillebloc 8 4 8 4 if dim eq VO then a assoc numlec fltarr jpidta jpjdta jpkdta nozero offset else a assoc numlec fltarr jpidta jpjdta nozero offset z a 0 on initialise les ixmindta iymindta au besoin if n_elements ixmindta EQ 0 OR n_elements ixmaxdta EQ 0 then BEGIN ixmindta 0 ixmaxdta jpidta 1 endif if n_elements iymindta EQ 0 OR n_elements iymaxdta EQ 0 then BEGIN iymindta 0 iymaxdta jpjdta 1 endif if n_elements izmin EQ 0 OR n_elements izmax EQ 0 then BEGIN izmindta 0 izmaxdta jpkdta 1 endif on reduit z selon les valeurs de ixmindta iymindta if dim EQ SO then z z ixminmesh ixmindta:ixmaxmesh ixmindta iyminmesh iymindta:iymaxmesh iymindta ELSE z z ixminmesh ixmindta:ixmaxmesh ixmindta iyminmesh iymindta:iymaxmesh iymindta izminmesh izmindta:izmaxmesh izmindta on shift z si key_shift est defininit if n_elements key_shift NE 0 THEN BEGIN if dim EQ SO then z shift z key_shift 0 ELSE z shift z key_shift 0 0 endif si TOUT n est pas active on coupe z pour q il soit a la taille du zoom: nx ny nz if NOT keyword_set tout then BEGIN changement de domaine if keyword_set boite then BEGIN Case 1 Of N_Elements Boite Eq 1:bte lon1 lon2 lat1 lat2 0 boite 0 N_Elements Boite Eq 2:bte lon1 lon2 lat1 lat2 boite 0 boite 1 N_Elements Boite Eq 4:bte Boite prof1 prof2 N_Elements Boite Eq 5:bte Boite 0:3 0 Boite 4 N_Elements Boite Eq 6:bte Boite Else: return report Mauvaise Definition de Boite endcase oldboite lon1 lon2 lat1 lat2 prof1 prof2 domdef bte GRILLE vargrid ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then mask reform mask nx ny nz over if dim EQ SO then z z premierx:dernierx premiery:derniery ELSE z z premierx:dernierx premiery:derniery premierz:dernierz ENDIF ELSE BEGIN case vargrid OF on recupere le mask en entier ds le cas ou TOUT U :mask umask n est pas active et on le choisit en fontion T :mask tmask de la valeur de vargrid W :mask tmask V :mask vmask F :mask fmask ENDCASE ENDELSE calcul d une anomalie si le keyword anom est active if keyword_set anom then begin case anom of EX : adate 0 AN : adate floor date 10000 10000 SE : adate floor date floor date 10000 10000 100 100 MO : adate floor date 100 100 DA : adate date floor date 10000 10000 : adate date floor date 10000 10000 else : return report Anom doit etre egal a EX AN SE MO DA endcase if keyword_set expanom then nomexpa expanom else nomexpa nomexp if keyword_set bavard THEN print nomchamp adate nomexpa z z lec nomchamp adate nomexpa TOUT tout endif on masque les terres par valmask IF n_elements valmask EQ 0 THEN valmask 1e20 if dim EQ SO then BEGIN terre where mask 0 EQ 0 if terre 0 NE 1 then z terre valmask ENDIF ELSE BEGIN terre where mask 0 EQ 0 if terre 0 NE 1 then z where mask EQ 0 valmask ENDELSE free_lun numlec close numlec if n_elements oldboite NE 0 then domdef oldboite IF keyword_set key_performance EQ 1 THEN print temps lec systime 1 tempsun return reform z end "); 63 a[61] = new Array("./Obsolete/lect.html", "lect.pro", "", " file_comments lit les fichiers Vairmer de date1 a date2 et en sort un tableau 1D 2D ou 3D qui peut etre reutilise pour une courbe hov animation cette fonction modifie aussi les variables globales: varname: huit lettres: nom Vairmer du champ a tracer vargrid:1 lettre : nom de la grille varexp: trois lettres :nom de l experience obsolete categories Graphics lecture de fichier Vaimer examples IDL resultat lec nom_Vairmer date1 date2 nomexp direc BOITE boite param nomchamp in required nom de champ Vairmer chaine de 8 caracteres commencant par VO ou SO param date1 in required date de depart de la serie temporelle a param date2 in required date de fin date2 de la serie temporelle a extraire param nomexp in required nom de l experience a lire prefix pardefaut param direc in required x y z xy xz yz xyz xt yt zt xyt xzt yzt xyzt directions selon lesquelles effectuer les moyennes si rien n est donne on n effectue pas de moyenne keyword boite in boite sur laquelle integrer par defaut tt le domaine keyword anom in type de fichiers SE AN a relire pour calc une anomalie keyword expanom in experience pour laquelle on veut calculer une anomalie par defaut la meme que nomexp uses common vraidate juldate history Jerome Vialard jv lodyc jussieu fr 2 7 98 1 2 3 4 5 function lect nomchamp date1 date2 nomexp direc BOITE boite ANOM anom EXPANOM expanom REPEAT repeat common tempsun systime 1 pour key_performance nomchamp strupcase nomchamp date1 vraidate date1 date2 vraidate date2 dim string format a2 nomchamp specification de la date et de l experience if fictype date1 ne fictype date2 then return report Les deux dates doivent correspondre au meme type de fic vairmer fictyp fictype date1 creation du nom du fichier if n_elements nomexp EQ 0 then nomexp prefix ficname iodir nomchamp strcompress date1 remove_all ficname ficname fictyp strcompress date2 remove_all nomexp if keyword_set anom then ficname ficname anom if keyword_set expanom then ficname ficname expanom case n_elements boite of 4 : box strcompress string format i4 _ i4 _ i4 _ i4 boite remove_all 6 : box strcompress string format i4 _ i4 _ i4 _ i4 _ i4 _ i4 boite remove_all else: box strcompress string format i4 _ i4 _ i4 _ i4 _ i4 _ i4 lon1 lon2 lat1 lat2 prof1 prof2 remove_all ENDCASE if n_elements direc EQ 0 then direc ficname ficname box direc hovdat Est ce que le fichier de hovmoller existe structure du fichier : jpt valeur de la dim temporelle dimtableau dimension du tableau dimttab 0 dimttab 1 valeur des dim time axe des tps ttab tableau a lire def du domaine lon1 lon2 prof1 prof2 get_lun numlec openr numlec ficname get_lun ERROR err swap_if_little_endian if err eq 0 then begin jpt long 1 dimtableau long 1 readu numlec jpt dimtableau case dimtableau of 1 : begin n1 long 1 readu numlec n1 ttab fltarr n1 end 2 : begin n1 long 1 n2 long 1 readu numlec n1 n2 ttab fltarr n1 n2 end 3 : begin n1 long 1 n2 long 1 n3 long 1 readu numlec n1 n2 n3 ttab fltarr n1 n2 n3 end endcase time lonarr jpt lecture axe des tps et du tableau readu numlec time ttab newboite fltarr 6 lecture du domaine readu numlec newboite domdef newboite lecture info complementaire : nom du champs de l experience varname aaaaaaaa readu numlec varname vargrid a readu numlec vargrid varexp aaa readu numlec varexp close numlec free_lun numlec return ttab ENDIF close numlec free_lun numlec changement de domaine if keyword_set boite then BEGIN Case 1 Of N_Elements Boite Eq 1:bte lon1 lon2 lat1 lat2 0 boite 0 N_Elements Boite Eq 2:bte lon1 lon2 lat1 lat2 boite 0 boite 1 N_Elements Boite Eq 4:bte Boite prof1 prof2 N_Elements Boite Eq 5:bte Boite 0:3 0 Boite 4 N_Elements Boite Eq 6:bte Boite Else: return report Mauvaise Definition de Boite endcase oldboite lon1 lon2 lat1 lat2 prof1 prof2 domdef bte ENDIF Boucle de lecture des fichiers case fictyp of DA : dec 0 MO : dec 14 SE : dec 14 AN : dec 182 endcase initialisation des variables associees au tps time lonarr jptmax jpt 0 vdat date1 debut de la boucle while vdat le date2 do begin lecture du fichier a la date vdat vairmer tab lec nomchamp vdat nomexp ANOM anom EXPANOM expanom attribution du mask et des tableaux de longitude et latitude if jpt EQ 0 THEN grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz if n_elements tab eq 1 and tab 0 eq 1 then begin goto incrdate endif else begin jpt jpt 1 if jpt gt jptmax then return report lect : augmenter jptmax endelse Moyenne du champs tab IF n_params EQ 5 THEN if direc NE then BEGIN if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN BEGIN if string format a2 nomchamp EQ SO then tab reform tab nx ny over ELSE tab reform tab nx ny nz over ENDIF tab moyenne tab direc endif if jpt eq 1 then begin ttab tab endif else BEGIN ttab colle ttab tab size tab 0 1 endelse time jpt 1 juldate vdat dec Incrementation de la date incrdate : case fictyp of DA : caldat juldate vdat 1 month day year MO : begin caldat julday month 1 year jourdsmois month day year day 0 end SE : month month 1 AN : year year 1 endcase Fin de boucle de lecture des fichiers vdat long 10000 year long 100 month day ENDWHILE if ttab 0 EQ 1 then return report Aucun fichier n a ete lu Ecriture du fichier get_lun numlec openw numlec ficname get_lun swap_if_little_endian taille size ttab writeu numlec long jpt long taille 0 case taille 0 of 1 : writeu numlec long taille 1 2 : writeu numlec long taille 1 long taille 2 3 : writeu numlec long taille 1 long taille 2 long taille 3 endcase writeu numlec long time 0:jpt 1 ttab writeu numlec float lon1 lon2 lat1 lat2 prof1 prof2 ecriture info complementaire : nom du champs de l experience writeu numlec strmid varname 0 8 writeu numlec strmid vargrid 0 1 writeu numlec strmid varexp 0 3 close numlec free_lun numlec if keyword_set repeat then begin jpt jpt repeat if jpt gt jptmax then begin print lect : augmenter jptmax goto fini endif tabadd ttab ti endif if n_elements oldboite NE 0 then domdef oldboite close all IF keyword_set key_performance THEN print temps lect systime 1 tempsun return ttab end "); 64 a[62] = new Array("./Obsolete/meshlec.html", "meshlec.pro", "", " file_comments lecture du mask de des sorties d OPA les sources se trouvent ds les repertoires sur maia du type: nom_exp RESTARTS obsolete examples IDL meshmask nomfich param nomfich in required string c est le nom du fichier a lire Par defaut c est meshmask keyword GLAMBOUNDARY in un vecteur de 2 elements specifaint le min et le max qui doivent etre imposes en longitude obligatoire si le tableau depasse 360 degres keyword pasblabla in pour suprimer les blablas keyword DOUBLE in pour forcer a lire les tableaux en double precision ce Mot clef est maintenant active automatiquement uses common pro restrictions La definition de ixminmesh ixmaxmesh iyminmesh iymaxmesh izminmesh izmaxmesh doit etre faite avant l entree dans cette routine pour attribuer automatiquement ces valeurs au maximum possible les mettre toutes a 1 et meshlec les calculera history Sebastien Masson smasson lodyc jussieu fr Marina Levy : lecture en double precision cas calcul sur shine pro meshlec nomfich PASBLABLA pasblabla DOUBLE double GLAMBOUNDARY glamboundary GETDIMENSIONS GETDIMENSIONS common tempsun systime 1 pour key_performance jpiglo 0L jpjglo 0L jpkglo 0L tab aaaaa definition du domaine de la grille surlequel sont effectuees les sorties les indices des tableaux commencant a 1: cf le fichier wrivr2 F ds WKOPA sur le cray LECTURE DU MASK trouve ds les fichiers restart constitution de l adresse s_fichier et ouverture du fichier a l adresse s_fichier IF n_params EQ 0 then nomfich meshmask s_fichier isafile file nomfich iodir iodir if not keyword_set pasblabla then print if not keyword_set pasblabla then print adresse du fichier: s_fichier openr numlec s_fichier get_lun f77_unformatted swap_if_little_endian filepamameters fstat numlec lecture readu numlec jpiglo jpjglo jpkglo if not keyword_set pasblabla then print taille de la grille d origine: jpiglo jpjglo jpkglo if keyword_set getdimensions then begin free_lun numlec close numlec return endif on determine si le fichier a ete ecrit en double precision on non sizenumber 8l sizefile8 4l 3l 4l 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo jpkglo sizenumber 4l 1l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpkglo sizenumber 4l if filepamameters size GE sizefile8 THEN double 1 sizenumber 4l sizefile4 4l 3l 4l 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpiglo jpjglo jpkglo sizenumber 4l 1l 4l jpiglo jpjglo sizenumber 4l 4l 4l jpkglo sizenumber 4l print filepamameters size sizefile4 sizefile8 case filepamameters size of sizefile8:double 1 sizefile4:double 0 ELSE:BEGIN nothing report The OPA Mesh file as not the good size free_lun numlec close numlec return END endcase if n_elements ixminmesh EQ 0 THEN ixminmesh 0 if n_elements ixmaxmesh EQ 0 then ixmaxmesh jpiglo 1 if ixminmesh EQ 1 THEN ixminmesh 0 IF ixmaxmesh EQ 1 then ixmaxmesh jpiglo 1 if n_elements iyminmesh EQ 0 THEN iyminmesh 0 IF n_elements iymaxmesh EQ 0 then iymaxmesh jpjglo 1 if iyminmesh EQ 1 THEN iyminmesh 0 IF iymaxmesh EQ 1 then iymaxmesh jpjglo 1 if n_elements izminmesh EQ 0 THEN izminmesh 0 IF n_elements izmaxmesh EQ 0 then izmaxmesh jpkglo 1 if izminmesh EQ 1 THEN izminmesh 0 IF izmaxmesh EQ 1 then izmaxmesh jpkglo 1 jpi long ixmaxmesh ixminmesh 1 jpj long iymaxmesh iyminmesh 1 jpk long izmaxmesh izminmesh 1 doit on reellement lire la grille meshparameters jpiglo:jpiglo jpjglo:jpjglo jpkglo:jpkglo jpi:jpi jpj:jpj jpk:jpk ixminmesh:ixminmesh ixmaxmesh:ixmaxmesh iyminmesh:iyminmesh iymaxmesh:iymaxmesh izminmesh:izminmesh izmaxmesh:izmaxmesh key_shift:key_shift noticebase xnotice Lecture du fichier C s_fichier C IF NOT keyword_set double THEN BEGIN z3d fltarr jpiglo jpjglo jpkglo z2d fltarr jpiglo jpjglo z1d fltarr jpkglo ENDIF ELSE BEGIN z3d dblarr jpiglo jpjglo jpkglo z2d dblarr jpiglo jpjglo z1d dblarr jpkglo ENDELSE if not keyword_set pasblabla then print readu numlec tab z2d GLAMT float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMT 25 31 : GLAMT 25 31 readu numlec tab z2d GLAMU float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMU 25 31 : GLAMU 25 31 readu numlec tab z2d GLAMV float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMV 25 31 : GLAMV 25 31 readu numlec tab z2d GLAMF float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GLAMF 25 31 : z2d 25 31 if not keyword_set pasblabla then print readu numlec tab z2d GPHIT float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIT 25 31 : GPHIT 25 31 readu numlec tab z2d GPHIU float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIU 25 31 : GPHIU 25 31 readu numlec tab z2d GPHIV float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIV 25 31 : GPHIV 25 31 readu numlec tab z2d GPHIF float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GPHIF 25 31 : z2d 25 31 if not keyword_set pasblabla then print readu numlec tab z2d E1T float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1T 25 5 : z2d 25 5 readu numlec tab z2d E1U float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1U 25 5 : z2d 25 5 readu numlec tab z2d E1V float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1V 25 5 : z2d 25 5 readu numlec tab z2d E1F float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E1F 25 5 : z2d 25 5 if not keyword_set pasblabla then print readu numlec tab z2d E2T float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2T 25 5 : z2d 25 5 readu numlec tab z2d E2U float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2U 25 5 : z2d 25 5 readu numlec tab z2d E2V float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2V 25 5 : z2d 25 5 readu numlec tab z2d E2F float z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E2F 25 5 : z2d 25 5 if not keyword_set pasblabla then print readu numlec tab z3d TMASK byte z3d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur TMASK 25 5 0 : TMASK 25 5 0 readu numlec tab z3d UMASKred byte z3d ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh umaskred reform umaskred if not keyword_set pasblabla then print tableau: tab exemple de valeur UMASK 25 5 0 : z3d 25 5 0 readu numlec tab z3d VMASKred byte z3d ixminmesh:ixmaxmesh iymaxmesh izminmesh:izmaxmesh vmaskred reform vmaskred if not keyword_set pasblabla then print tableau: tab exemple de valeur VMASK 25 5 0 : z3d 25 5 0 readu numlec tab z3d fmaskredy byte z3d ixmaxmesh iyminmesh:iymaxmesh izminmesh:izmaxmesh coast where fmaskredy NE 0 and fmaskredy NE 1 IF coast 0 NE 1 THEN fmaskredy coast 0b fmaskredx byte z3d ixminmesh:ixmaxmesh iymaxmesh izminmesh:izmaxmesh coast where fmaskredx NE 0 and fmaskredx NE 1 IF coast 0 NE 1 THEN fmaskredx coast 0b fmaskredx reform fmaskredx fmaskredy reform fmaskredy if not keyword_set pasblabla then print tableau: tab exemple de valeur FMASK 25 5 0 : z3d 25 5 0 if not keyword_set pasblabla then print readu numlec tab z2d FF z2d ixminmesh:ixmaxmesh iyminmesh:iymaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur FF 25 5 : z2d 25 5 readu numlec tab z1d GDEPT float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GDEPT 1 : GDEPT 1 readu numlec tab z1d GDEPW float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur GDEPW 1 : GDEPW 1 readu numlec tab z1d E3T float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E3T 3 : E3T 3 readu numlec tab z1d E3W float z1d izminmesh:izmaxmesh if not keyword_set pasblabla then print tableau: tab exemple de valeur E3W 3 : E3W 3 free_lun numlec close numlec bornes de glam qui ne doivent pas depasser 360 degres minglam min glamt max maxglam if maxglam minglam GE 360 AND NOT keyword_set glamboundary then nothing execute glamboundary xquestion What are the longitudes boundary 180 180 chkwidget if keyword_set glamboundary then begin if glamboundary 0 NE glamboundary 1 then begin glamt glamt MOD 360 smaller where glamt LT glamboundary 0 if smaller 0 NE 1 then glamt smaller glamt smaller 360 bigger where glamt GE glamboundary 1 if bigger 0 NE 1 then glamt bigger glamt bigger 360 glamu glamu MOD 360 smaller where glamu LT glamboundary 0 if smaller 0 NE 1 then glamu smaller glamu smaller 360 bigger where glamu GE glamboundary 1 if bigger 0 NE 1 then glamu bigger glamu bigger 360 glamv glamv MOD 360 smaller where glamv LT glamboundary 0 if smaller 0 NE 1 then glamv smaller glamv smaller 360 bigger where glamv GE glamboundary 1 if bigger 0 NE 1 then glamv bigger glamv bigger 360 glamf glamf MOD 360 smaller where glamf LT glamboundary 0 if smaller 0 NE 1 then glamf smaller glamf smaller 360 bigger where glamf GE glamboundary 1 if bigger 0 NE 1 then glamf bigger glamf bigger 360 endif endif shift en x if keyword_set key_shift AND jpi NE 1 then begin glamt shift glamt key_shift 0 gphit shift gphit key_shift 0 e1t shift e1t key_shift 0 e2t shift e2t key_shift 0 glamu shift glamu key_shift 0 gphiu shift gphiu key_shift 0 e1u shift e1u key_shift 0 e2u shift e2u key_shift 0 glamv shift glamv key_shift 0 gphiv shift gphiv key_shift 0 e1v shift e1v key_shift 0 e2v shift e2v key_shift 0 glamf shift glamf key_shift 0 gphif shift gphif key_shift 0 e1f shift e1f key_shift 0 e2f shift e2f key_shift 0 if jpk EQ 1 then begin tmask shift tmask key_shift 0 vmaskred shift vmaskred key_shift fmaskredx shift fmaskredx key_shift ENDIF ELSE BEGIN tmask shift tmask key_shift 0 0 vmaskred shift vmaskred key_shift 0 fmaskredx shift fmaskredx key_shift 0 ENDELSE endif key_yreverse 0 key_zreverse 0 key_partialstep 0 key_stride 1 1 1 key_gridtype c if not keyword_set pasblabla then print lecture nomfich finie widget_control noticebase bad_id toto destroy if keyword_set key_performance THEN print temps meshlec systime 1 tempsun return end "); 65 a[63] = new Array("./Obsolete/ncdf_meshlec.html", "ncdf_meshlec.pro", "", " file_comments use ncdf_meshread instead obsolete history Aug 2005 Sebastien Masson: switch to ncdf_meshread PRO ncdf_meshlec filename _EXTRA ex CASE n_params OF 0:ncdf_meshread _EXTRA ex 1:ncdf_meshread filename _EXTRA ex ENDCASE return END"); 66 a[64] = new Array("./Obsolete/nlec.html", "nlec.pro", "", " file_comments lit les fichiers Net Cdf de l experience TOTEM ECMWF qui sont sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete param name in required nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var param debut in nombres de 6 ou 8 chiffres anneemoisjour par ex:19980507 param fin in nombres de 6 ou 8 chiffres anneemoisjour par ex:19980507 param nomexperience in optional trois lettres designant le nom de l experience keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword DIREC: x y z xy xz yz xyz directions selon lesquelles effectuer les moyennes si rien n est donne on n effectue pas de moyenne keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef uses common pro vraidate juldate nlec5j nlecserie history Sebastien Masson smasson lodyc jussieu fr 14 8 98 REF 07 790101 grid T nc REF 07 790101 grid U nc REF 07 790101 grid V nc REF 07 790101 grid W nc function nlec name debut fin nomexperience BOITE boite DIREC direc GRILLE grille TOUT tout STRUCTURE structure SEUILMIN seuilmin SEUILMAX seuilmax NAN nan _EXTRA ex common tempsun systime 1 pour key_performance nom strlowcase name specification de la date et de l experience case n_params of 1:BEGIN year year 1900 year ne 0 and year ne 1 and year lt 100 date day 100 month 10000 year end 2:BEGIN if size debut tname EQ STRING then begin prefix strupcase debut year year 1900 year ne 0 and year ne 1 and year lt 100 date day 100 month 10000 year ENDIF ELSE BEGIN date debut rien juldate date ENDELSE end 3:begin date debut rien juldate date if size fin tname EQ STRING then begin prefix strupcase fin ENDIF ELSE BEGIN date2 vraidate fin year2 date2 10000 month2 date2 100 year2 100 day2 date2 year2 10000 month2 100 ENDELSE end 4:BEGIN date debut rien juldate date if size nomexperience tname EQ STRING then begin prefix strupcase nomexperience date2 fin ENDIF ELSE BEGIN prefix strupcase fin date2 nomexperience ENDELSE date2 vraidate date2 year2 date2 10000 month2 date2 100 year2 100 day2 date2 year2 10000 month2 100 end endcase date long date if n_elements date2 NE 0 then date2 long date2 if n_elements date2 NE 0 then if date2 eq date then tempvar SIZE TEMPORARY date2 verification de la coherence des dates if n_elements date2 ne 0 then begin if day EQ 0 AND day2 NE 0 OR month EQ 0 AND month2 NE 0 OR year EQ 0 AND year2 NE 0 or day2 EQ 0 AND day NE 0 OR month2 EQ 0 AND month NE 0 OR year2 EQ 0 AND year NE 0 then return report verifier la coherence des dates if date2 le date then return report date2 doit etre posterieure a date endif case sur le type de fichiers que l on veut lire determination ds chaque cas de numsortie et nbretps if day NE 0 then begin SORTIES A 5 JOURS numsortie testjour: numsortie 1 julday month day year julday 1 1 year 5 0 if numsortie ne floor numsortie then begin if n_elements date2 ne 0 then begin caldat julday month day 1 year month day year goto testjour endif return 1 ENDIF numsortie long numsortie determination du nombre de pas de tps a extraire pour la serie temporelle entiere: nbretps if n_elements date2 ne 0 then begin testjour2: numsortie2 1 julday month2 day2 year2 julday 1 1 year2 5 if numsortie2 ne floor numsortie2 then begin caldat julday month2 day2 1 year2 month2 day2 year2 goto testjour2 endif if year eq year2 then nbretps numsortie2 numsortie 1 else nbretps 73 numsortie 1 year2 year 1 73 numsortie2 numsortie2 long numsortie2 endif else nbretps 1 nbretps long nbretps si on fait une serie temporelle on cherche a lire plutot un fichier contenant deja une serie temporelle par contre pour une sortie unique on cherche d abord a lire un fichier contenant toutes les variables IF n_elements date2 ne 0 THEN BEGIN serie: IF n_elements dejaserie eq 1 then return 1 datejul 5 numsortie 1 julday 1 1 year if n_elements date2 ne 0 then date2jul 5 numsortie2 1 julday 1 1 year2 ELSE date2jul datejul res nlecserie nom datejul date2jul BOITE boite GRILLE grille TOUT tout _EXTRA ex IF res 0 EQ 1 THEN BEGIN dejaserie 1 GOTO passerie ENDIF ENDIF ELSE BEGIN passerie: IF n_elements dejapasserie eq 1 then return 1 res nlec5j nom numsortie nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex IF res 0 EQ 1 THEN BEGIN dejapasserie 1 GOTO serie ENDIF endelse ENDIF ELSE BEGIN CASE 1 of month NE 0 AND year NE 0:BEGIN SORTIES MENSUELLES numsortie79 year 1979 12 month if n_elements date2 ne 0 then nbretps month2 month 1 12 year2 year ELSE nbretps 1 res nlecmois nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month EQ 0 AND year NE 0:BEGIN SORTIES ANNUELLES numsortie79 year 1978 if n_elements date2 ne 0 then nbretps year2 year 1 ELSE nbretps 1 res nlecan nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month NE 0 AND year EQ 0:BEGIN SORTIES SAISONNIERES numsortie79 month if n_elements date2 ne 0 then nbretps month2 month 1 ELSE nbretps 1 res nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end month EQ 0 AND year EQ 0:BEGIN SORTIES CLIMATOLOGIQUE numsortie79 13 nbretps 1 res nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex end endcase endelse seuil if n_elements seuilmin NE 0 then BEGIN if n_elements valmask EQ 0 then valmask 1e20 terre where res GT valmask 10 res seuilmin res if terre 0 NE 1 then res terre valmask undefine terre endif if n_elements seuilmax NE 0 then begin if n_elements valmask EQ 0 then valmask 1e20 terre where res GT valmask 10 res res seuilmax if terre 0 NE 1 then res terre valmask undefine terre endif points a metre a nan if n_elements nan NE 0 then BEGIN if n_elements valmask EQ 0 then valmask 1e20 if abs valmask LT 1e6 then terre where abs res GT abs valmask 10 ELSE terre where res EQ valmask if abs nan LT 1e6 then notan where res EQ nan ELSE notan where abs res GT abs nan if notan 0 NE 1 then res notan values f_nan notan notan 0 NE 1 if terre 0 NE 1 then res terre valmask undefine terre endif ajustement de niveau pour les tableau 2d simples if jpt EQ 1 then begin taille size res IF taille 0 EQ 2 THEN niveau 1 endif moyenne eventuelle IF keyword_set direc THEN BEGIN IF jpt EQ 1 THEN res moyenne res direc BOITE boite nan notan ELSE res grossemoyenne res direc BOITE boite nan notan ENDIF mise en placer des parametres pour le trace if keyword_set boite then legende_pltt boite ELSE legende_pltt lon1 lon2 lat1 lat2 IF n_elements res NE 1 THEN res reform res over IF NOT keyword_set direc THEN domdef lon1 lon2 lat1 lat2 prof1 prof2 _extra ex grille vargrid ELSE if direc eq t then domdef lon1 lon2 lat1 lat2 prof1 prof2 _extra ex grille vargrid if keyword_set structure then res tab:res grille:vargrid unite:varunit experience:varexp nom:varname if keyword_set key_performance THEN print temps nlec systime 1 tempsun time time 2l return res end "); 67 a[65] = new Array("./Obsolete/nlec5j.html", "nlec5j.pro", "", " file_comments lit les fichiers Net Cdf de l experience TOTEM ECMWF qui contiennent les sorties a 5j regroupees par type de grille par paquets de 6 mois sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete categories lecture de NETCDF examples IDL res nlec5j nom numsortie nbretps param nom in required nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var param numsortie in required le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de year param nbretps in required nombre de pas de temps a extraire keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef returns tableau 2d qd on ne demande pas de serie ou 3d ou 4d ds le cas dune serie uses common pro restriction appele par nlec history Sebastien Masson smasson lodyc jussieu fr function nlec5j nom numsortie nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom du fichier if numsortie le 36 then BEGIN mmdd 0101 numsort numsortie ENDIF else BEGIN if leapyr year then mmdd 0629 else mmdd 0630 numsort numsortie 36 endelse case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 year LT 2000 endcase numfich year anneedepart 2 7 mmdd ne 0101 s_date s_year mmdd if numfich lt 10 then numfich 0 string format i1 numfich else numfich string format i2 numfich gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix numfich s_date grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix numfich s_date grid IF quelsfichiers 0 EQ THEN BEGIN liste vide if keyword_set bavard then ras report LES FICHIERS: iodir prefix numfich s_date grid n existe pas return 1 ENDIF for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor if keyword_set bavard then ras report La variable nom n existe pas ds les fichiers iodir prefix numfich s_date grid return 1 endelse grilletrouvee: lecture de certains attributs ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day vardate s_year s_month s_day ncdf_attget cdfid file_name value global varexp string value 0: where value EQ byte 0 0 1 extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else: return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz dernierx derniery dernierz ENDELSE determination du nombre de pas de tps a extraire ds ce fichier if nbretps gt 36 1 mmdd ne 0101 numsort 1 then nt 36 1 mmdd ne 0101 numsort 1 else nt nbretps if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsort 1 count nx ny nt else ncdf_varget cdfid nom res offset premierx premiery premierz numsort 1 count nx ny nz nt rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers pour constituer la serie temporelle if nbretps gt 36 1 mmdd ne 0101 numsort 1 then begin if mmdd ne 0101 then year year 1 if varcontient ndims eq 3 then res res nlec5j nom 1 36 mmdd eq 0101 nbretps nt tout tout GRILLE vargrid BOITE boite ELSE BEGIN res res nlec5j nom 1 36 mmdd eq 0101 nbretps nt tout tout GRILLE vargrid BOITE boite res reform res nx ny nz nbretps over ENDELSE ncdf_varget cdfid time_counter temps offset numsort 1 count nt time long temps julday 1 5 1979 time jpt nt jpt endif else BEGIN ncdf_varget cdfid time_counter temps offset numsort 1 count nt time long temps julday 1 5 1979 jpt nt endelse ncdf_close cdfid return res end"); 68 a[66] = new Array("./Obsolete/nlecan.html", "nlecan.pro", "", " file_comments lit les moyennes annuelles sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete categories lecture de NETCDF examples IDL res nlecan nom numsortie79 nbretps param nom in required nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var param numsortie79 in required le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de 79 param nbretps in required nombre de pas de temps a extraire keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef returns tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d uses common pro restrictions appele par nlec history Sebastien Masson smasson lodyc jussieu fr REF moyenne annuelle grid T nc function nlecan nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix moyenne annuelle grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix moyenne annuelle grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix moyenne annuelle grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix moyenne annuelle grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix lecture de l axe des temps ncdf_varget cdfid time_counter time offset numsortie79 1 count nbretps time long time julday 12 31 1978 jpt nbretps IF jpt EQ 1 THEN BEGIN caldat time 0 month day year case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 endcase vardate annee: s_year endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk glam 1 gphi 1 gdep 1 premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie79 1 count nx ny nbretps else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie79 1 count nx ny nz nbretps ncdf_close cdfid return res end"); 69 a[67] = new Array("./Obsolete/nlecmois.html", "nlecmois.pro", "", " file_comments lit les fichiers Net Cdf de moyenne mensuel de l experience TOTEM ECMWF qui sont sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef uses common pro history Sebastien Masson smasson lodyc jussieu fr REF moyenne mensuelle 79 81 grid T nc function nlecmois nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 annee du nom du 1er fichier annee floor floor numsortie79 1 12 3 3 79 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix moyenne mensuelle strtrim annee 1 strtrim annee 2 1 grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE determination du nombre de pas de tps a extraire ds ce fichier numsortie numsortie79 12 annee 79 if nbretps numsortie 1 gt 36 then nt 36 numsortie 1 else nt nbretps numsortie numsortie79 12 annee 79 if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie 1 count nx ny nt else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie 1 count nx ny nz nt rappel en boucle de nlec si il faut ouvrir de nouveaux fichiers pour constituer la serie temporelle if nbretps gt 36 numsortie 1 then begin if varcontient ndims eq 3 then res res nlecmois nom numsortie79 nt nbretps nt tout tout GRILLE vargrid BOITE boite else BEGIN res res nlecmois nom numsortie79 nt nbretps nt tout tout GRILLE vargrid BOITE boite res reform res nx ny nz nbretps over ENDELSE ncdf_varget cdfid time_counter temps offset numsortie 1 count nt time long temps julday 12 31 1978 time jpt nt jpt endif else BEGIN ncdf_varget cdfid time_counter temps offset numsortie 1 count nt time long temps julday 12 31 1978 jpt nt endelse ncdf_close cdfid IF n_elements time EQ 1 THEN BEGIN caldat time m d y if m lt 10 then m 0 string format i1 m else m string format i2 m if n_elements langage EQ 0 then langage non definit if langage EQ gb then vardate strtrim y 1 string format C CMoA 31 m 1 ELSE vardate string format C CMoA 31 m 1 strtrim y 1 endif return res end"); 70 a[68] = new Array("./Obsolete/nlecsaison.html", "nlecsaison.pro", "", " file_comments lit les moyennes annuelles sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete categories lecture de NETCDF examples IDL res nlecsaison nom numsortie79 nbretps param nom in required nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var param numsortie79 in required le numero du pas de temps que l on veut sortir du fichier compte a partir de 1 a partir de 79 param nbretps in required nombre de pas de temps a extraire keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef returns tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d uses common pro restrictions appele par nlec history Sebastien Masson smasson lodyc jussieu fr REF saisonnier climato grid T nc function nlecsaison nom numsortie79 nbretps BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille en testant les differentes possibilites et ouverture du fichier if keyword_set grille then begin vargrid grille nomfich prefix saisonnier climato grid vargrid nc IF version OS_FAMILY EQ unix THEN spawn file iodir nomfich dev null cdfid ncdf_open iodir nomfich varcontient ncdf_varinq cdfid nom endif else begin liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix saisonnier climato grid IF quelsfichiers 0 EQ THEN liste vide return report LES FICHIERS: iodir prefix saisonnier climato grid n existe pas for i 0 n_elements quelsfichiers 1 do begin IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers i dev null cdfid ncdf_open quelsfichiers i contient ncdf_inquire cdfid for varid 0 contient nvars 1 do BEGIN ds les fichiers existants on varcontient ncdf_varinq cdfid varid cherche le nom des variables if varcontient name eq nom then BEGIN vargrid strmid quelsfichiers i strpos quelsfichiers i grid 5 1 nom de grille goto grilletrouvee ENDIF endfor ncdf_close cdfid endfor return report La variable nom n existe pas ds les fichiers iodir prefix saisonnier climato grid endelse grilletrouvee: lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit varexp prefix lecture de l axe des temps ncdf_varget cdfid time_counter time offset numsortie79 1 count nbretps time long time julday 12 31 1978 jpt nbretps IF jpt EQ 1 THEN BEGIN IF numsortie79 EQ 13 THEN vardate CLIMATOLOGIE prefix ELSE begin vardate climato mensuelle strtrim numsortie79 1 endelse endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk glam 1 gphi 1 gdep 1 premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN CASE N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery premierz ENDELSE if varcontient ndims eq 3 then ncdf_varget cdfid nom res offset premierx premiery numsortie79 1 count nx ny nbretps else ncdf_varget cdfid nom res offset premierx premiery premierz numsortie79 1 count nx ny nz nbretps ncdf_close cdfid return res end"); 71 a[69] = new Array("./Obsolete/nlecserie.html", "nlecserie.pro", "", " file_comments lit les series temporelles se rapportant a une variable sur maia: u rech eee reee217 TOTEM REF OUTPUTS obsolete categories lecture de NETCDF examples IDL res nlecserie nom date1 date2 param nom in required nom du tableau contenant le champ que l on veut le trouver avec ncdflec fichier var param date1 date2 in required les dates vermairs qui delimitent la serie temporelle keyword BOITE boite sur laquelle integrer par defaut tt le domaine keyword GRILLE impose la grille a laquelle est rapporte le champ rq permet d aller plus vite ds la lecture keyword TOUT oblige a lire le tableau entier en non pas celui reduit a domdef returns tableau 2d qd la serie ne fait que 1 pas de temps ou 3d valable ds 1 premier tps que pour les tableaux 2d uses common pro restrictions appele par nlec history Sebastien Masson smasson lodyc jussieu fr REF sss grid T nc function nlecserie nom date1 date2 BOITE boite GRILLE grille TOUT tout _EXTRA ex common res 1 anneedepart 1979 gestion du nom de la grille et ouverture du fichier liste des fichiers pouvant convenir quelsfichiers findfile iodir prefix nom grid IF quelsfichiers 0 EQ THEN BEGIN liste vide print LES FICHIERS: iodir prefix nom grid n existe pas return 1 ENDIF ELSE BEGIN vargrid strmid quelsfichiers 0 strpos quelsfichiers 0 grid 5 1 nom de grille IF version OS_FAMILY EQ unix THEN spawn file quelsfichiers 0 dev null cdfid ncdf_open quelsfichiers 0 ENDELSE lecture de certains attributs et de l axe des temps ncdf_attget cdfid nom title value varname string value ncdf_attget cdfid nom units value varunit string value if rstrpos varname eq 1 then varname varname varunit ncdf_attget cdfid file_name value global varexp string value varexp strmid varexp 0 strpos varexp lecture de l axe des temps en entier on ja reperer la place des dates debut et fin pour faire l extraction temporelle ncdf_varget cdfid time_counter time time long time julday 1 5 1979 debut where time EQ juldate date1 fin where time EQ juldate date2 debut where time EQ date1 fin where time EQ date2 if debut 0 EQ 1 then return report l axe des temps ne contient pas la date de debut strtrim date1 1 if fin 0 EQ 1 then return report l axe des temps ne contient pas la date de fin strtrim date2 1 time time debut 0 :fin 0 jpt fin 0 debut 0 1 IF jpt EQ 1 THEN BEGIN caldat time 0 month day year case 1 of year lt 10: s_year 0 string format i1 year year lt 100 and year ge 10 :s_year string format i2 year year ge 100: s_year string format i2 year 1900 endcase if month lt 10 then s_month 0 string format i1 month else s_month string format i2 month if day lt 10 then s_day 0 string format i1 day else s_day string format i2 day vardate s_year s_month s_day endif extraction du tableau qui nous interesse determination du domaine geographique if keyword_set tout then begin nx jpi ny jpj nz jpk premierx 0 premiery 0 premierz 0 endif else BEGIN redefinition eventuelle du domaine ajuste a boite a 6 elements on recupere la dim du no9uveau domaine if keyword_set boite then BEGIN Case N_Elements Boite Of 1:Domdef lon1 lon2 lat1 lat2 0 boite 0 GRILLE vargrid _EXTRA ex 2:Domdef lon1 lon2 lat1 lat2 boite 0 boite 1 GRILLE vargrid _EXTRA ex 4:Domdef Boite prof1 prof2 GRILLE vargrid _EXTRA ex 5:Domdef Boite 0:3 0 Boite 4 GRILLE vargrid _EXTRA ex 6:Domdef Boite GRILLE vargrid _EXTRA ex Else:return report Mauvaise Definition de Boite endcase ENDIF grille mask glam gphi gdep nx ny nz premierx premiery ENDELSE ncdf_varget cdfid nom res offset premierx premiery debut 0 count nx ny fin 0 debut 0 1 ncdf_close cdfid return res end"); 72 a[70] = new Array("./Obsolete/vairdate.html", "vairdate.pro", "", " file_comments gives vairmer date equivalent of a date in julian format sets month day and year to the corresp values obsolete file_comments you better use jul2date examples IDL vdate vairdate 1755087 param jdate in required date en jours juliens keyword MENSUEL a activer si on veut pour que les dates dont le jour est 15 deviennent avec un jour egale a 0 par ex: 19990115 19990100 keyword ANNUEL a activer si on veut pour que les dates dont le mois est 6 et dont le jour est 1 deviennent avec un mois et jour egale a 0 par ex: 19990601 19990000 returns vdate date vairmer plus year month et day uses common pro history Jerome Vialard jv lodyc jussieu fr 2 7 98 13 9 1999 Sebastien Masson smasson lodyc jussieu fr ANNUEL MENSUEL _EXTRA et possibilite d utiliser vairdate avec des scalaire ou des tableaux function vairdate jdate ANNUEL annuel MENSUEL mensuel _EXTRA ex common caldat jdate month day year _EXTRA ex index where year eq 1 if index 0 NE 1 then year index 0 if keyword_set mensuel THEN BEGIN index where day EQ 15 if index 0 NE 1 then day index 0 endif if keyword_set annuel THEN BEGIN index where day EQ 1 AND month EQ 6 if index 0 NE 1 then BEGIN day index 0 month index 0 endif endif return 10000L year 100L month day end "); 73 a[71] = new Array("./Obsolete/vraidate.html", "vraidate.pro", "", " file_comments donne la date en long obsolete param date in required une date du type yyyymmdd keyword GRADS if 1 le year le 49 then year 2000 year if 50 le year le 99 then year 1900 year returns une date vairmer du type yyyymmdd si year est nulle ou egale a 1 ne change rien examples IDL res vraidate date IDL vraidate 980703 donne 19980703 qui est un long history Sebastien Masson smasson lodyc jussieu fr 3 7 98 remove automatic change from year 1 to 1901 Aug 2004 function vraidate date GRADS grads _EXTRA ex IF NOT keyword_set GRADS THEN return long date date long date annee date 10000 return date 19000000L annee GE 50 and date lt 1000000 20000000L annee LT 50 and date lt 1000000 end"); 74 a[72] = new Array("./Postscript/closeps.html", "closeps.pro", "", " NAME: closeps PURPOSE: Close the Postscript mode CALLING SEQUENCE: closeps KEYWORD PARAMETERS: INFOWIDGET: A long integer giving the id of the information widget created by openps that we have de destroy at the end of closeps when the postscript is done COMMON BLOCKS: cm_4ps SIDE EFFECTS: when archive_ps ne 0 we add the name and the date at the bottom left corner of the postcript page If the postscript is called idl ps we change its name to number ps number automatically found to be 1 larger that any of the existing ps file MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 June 2005: Sebastien Masson english version with new commons PRO closeps INFOWIDGET infowidget IF lmgr demo EQ 1 THEN return include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF d name NE PS THEN GOTO last_part if archive_ps 0 we will add its name and the date at the bottom left corner of the page in case if the postscript will be archived in printps IF keyword_set archive_ps THEN BEGIN we get the name of the latest created postscript psdir isadirectory psdir title Select psdir nameps file_search psdir ps test_regular test_write nosort dates file_info nameps mtime lastdate reverse sort temporary dates 0 nameps nameps lastdate nameps file_basename nameps ps If this name is idl ps then we change it to the number ps IF nameps EQ idl then BEGIN get the name of all the ps or ps gz files available in psdir allps file_search psdir ps ps gz pdf test_regular nosort allps file_basename file_basename allps gz ps allps file_basename allps pdf find which of these names corresponds to numbers get ascii codes of the names testnumb byte allps longest name maxstrlen size testnumb dimensions 0 ascii codes can be 0 or between byte 0 and byte 9 testnumb testnumb EQ 0 OR testnumb GE byte 0 0 AND testnumb LE byte 9 0 testnumb where total testnumb 1 EQ maxstrlen count IF count NE 0 THEN BEGIN get the largest number psnumber fix allps testnumb psnumber psnumber reverse sort psnumber 0 1 ENDIF ELSE psnumber 0 nameps strtrim psnumber 2 ENDIF we annote the postscript date byte systime 0 we get the date xyouts d x_px_cm d y_px_cm nameps string date 4:10 string date 20:23 device charsize 75 ENDIF close the postcript mode device close last_part: thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE def_myuniquetmpdir colorfile myuniquetmpdir original_colors dat IF file_test colorfile regular THEN BEGIN restore colorfile file_delete colorfile quiet reload the original colors tvlct red green blue ENDIF p font 1 force background color to the last color white p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x if keyword_set infowidget then widget_control long infowidget bad_id toto destroy return end"); 75 a[73] = new Array("./Postscript/openps.html", "openps.pro", "", " NAME:openps PURPOSE:switch to postcript mode and define it CALLING SEQUENCE:openps nameps OPTIONAL INPUT: nameps: name of the postscript file Extension ps is added if missing It will be stored in the psdir directory KEYWORD PARAMETERS: FILENAME: to define the name of the postcript file through a keyword rather than with nameps inut argument in this case the keyword can be pass through different routines via _extra keyword INFOWIDGET: If INFOWIDGET is present it specifies a named variable into which the id of the widget giving informations about the postscript creation is stored as a long integer This id is needed by close ps to kill the information widget KEEP_PFONT: activate to suppress the modification of p font by defaut we force p font 0 to make smaller postscripts KEEPPFONT: same as keep_pfont LIGHTNESS: a scalar used to change the Lightness of the color palette to be abble to adjust according to the printer we use the media paper or slide lightness 1 to get darker colors _EXTRA: used to pass any keyword to device procedure COMMON BLOCKS: cm_4ps MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 1 2 98: ajout de nameps en input 1 9 1999: ajout du mot cle FILENAME et du widget June 2005: Sebastien Masson cleaning english version with new commons pro openps namepsin FILENAME filename INFOWIDGET infowidget KEEPPFONT keeppfont KEEP_PFONT keep_pfont PORTRAIT portrait LANDSCAPE landscape LIGHTNESS Lightness _extra ex IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to create a PS in demo mode return ENDIF include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF close the postcript device if we are already in postcsrit mode IF d name EQ PS THEN device close switch to postscript mode set_plot ps if we use keyword Lightness save the actual color palette in a temporary file to be restored when calling closeps IF n_elements Lightness NE 0 THEN BEGIN IF Lightness NE 1 THEN BEGIN tvlct red green blue get def_myuniquetmpdir save red green blue filename myuniquetmpdir original_colors dat palit Lightness red green blue ENDIF ENDIF we define the name of the file CASE 1 OF n_params EQ 1:nameps namepsin keyword_set filename : nameps filename ELSE:nameps xquestion Name of the postscript file idl ps chkwid ENDCASE make sure that nameps ends with ps nameps file_dirname nameps mark_directory file_basename nameps ps ps add path psdir and check that nameps is ok nameps isafile nameps iodir psdir new we define xsize ysize xoffset et yoffset IF n_elements portrait NE 0 OR n_elements landscape NE 0 THEN key_portrait keyword_set portrait 1 keyword_set landscape if key_portrait EQ 1 then begin xs min page_size ys max page_size xoff 0 yoff 0 ENDIF ELSE BEGIN xs max page_size ys min page_size xoff 0 yoff max page_size ENDELSE We define the device of the postscript mode device color palatino filename strcompress nameps remove_all LANDSCAPE 1 key_portrait PORTRAIT key_portrait xsize xs ysize ys xoffset xoff yoffset yoff bits_per_pixel 8 _extra ex to make smaller postcripts IF NOT keyword_set keeppfont OR keyword_set keep_pfont THEN p font 0 show some informations IF arg_present infowidget THEN infowidget xnotice Postcript file is currently processed RETURN END "); 76 a[74] = new Array("./Postscript/printps.html", "printps.pro", "", " NAME: printps PURPOSE: postscript visualisation archiving printing CATEGORY: for the postscripts CALLING SEQUENCE: imprime psfilename INPUTS: psfilename: the name of the postscript file we want to visualize and or print and or archive It can also refer to a gzipped postscript file If needed this name will be completed by ps and or gz KEYWORD PARAMETERS: None COMMON BLOCKS: cm_4ps SIDE EFFECTS: archiving possibilities if archive_ps common variable of cm_4ps ne 0 then the postscript can be saved for archiving if it is printed or if the button archive ps is pressed if it is printed and archive_ps 1 then the archiving is done automatically whereas we ask if the postscript file must be archived or not If the postcript name is idl ps default name then this name will be changed to number ps number automatically found to be 1 larger that any of the existing ps file RESTRICTIONS: 1 this is working only with unix linux osX machines 2 definition of the printing command the printing command is defined by the common variable print_command in cm_4ps This command must be defind build in a way that it the instruction: print_command i printer_machine_names i file ps or print_command printer_machine_names i file ps is working default definition is lpr P EXAMPLE: IDL printps MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 21 12 98 25 8 19999 utilisation des widgets 8 9 1999 utilisation de cw_bgroup June 2005: Sebastien Masson: cleaning english version with new commons PRO printps_event event include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF What kind of event do we have widget_control event id get_uvalue uval case on the event CASE uval name OF visualize case : postscript visualization visualize :BEGIN paper orientation if key_portrait EQ 1 then ori portrait ELSE ori seascape paper format CASE round 10 total page_size OF round 10 83 9611 118 816 : papsize a0 round 10 59 4078 83 9611 : papsize a1 round 10 41 9806 59 4078 : papsize a2 round 10 29 7039 41 9806 : papsize a3 round 10 20 9903 29 7039 : papsize a4 round 10 14 8519 20 9903 : papsize a5 round 10 10 4775 14 8519 : papsize a6 round 10 7 40833 10 4775 : papsize a7 round 10 5 22111 7 40833 : papsize a8 round 10 3 70417 5 22111 : papsize a9 round 10 2 61056 3 70417 : papsize a10 round 10 100 048 141 393 : papsize b0 round 10 70 6967 100 048 : papsize b1 round 10 50 0239 70 6967 : papsize b2 round 10 35 3483 50 0239 : papsize b3 round 10 25 0119 35 3483 : papsize b4 round 10 17 6742 25 0119 : papsize b5 round 10 22 86 30 48 : papsize archA round 10 30 48 45 72 : papsize archB round 10 45 72 60 96 : papsize archC round 10 60 96 91 44 : papsize archD round 10 91 44 121 92 : papsize archE round 10 21 59 33 02 : papsize flsa round 10 21 59 33 02 : papsize flse round 10 13 97 21 59 : papsize halfletter round 10 19 05 25 4 : papsize note round 10 21 59 27 94 : papsize letter round 10 21 59 35 56 : papsize legal round 10 27 94 43 18 : papsize 11x17 round 10 43 18 27 94 : papsize ledger ELSE:papsize a4 ENDCASE call the viewers CASE event value OF Ghostview :spawn ghostview papsize quiet ori uval nameps Ghostscript :spawn gs sPAPERSIZE papsize q uval nameps Kghostview :spawn kghostview uval nameps ENDCASE return END print case: print and archive the file if needed print :BEGIN printer selection printer printer_machine_names event value print CASE n_elements print_command OF 0:ptcmd lpr P 1:ptcmd print_command 0 n_elements printer_machine_names :ptcmd print_command event value ELSE:BEGIN ng report bad definition of print_command common variable of cm_4ps C we did not print the postscript file simple return END ENDCASE spawn ptcmd printer uval nameps printing informations spawn lpq P imprimante l info display them xdisplayfile nothing text info title Printing Info file_basename uval nameps height n_elements info 24 END ELSE: ENDCASE we destroy the widget widget_control event top destroy if the file was originaly gzipped then we re gzip it and exit IF uval gzip THEN BEGIN spawn gzip uval nameps return ENDIF archiving IF uval name EQ print OR uval name EQ archive AND keyword_set archive_ps THEN BEGIN IF archive_ps NE 1 AND uval name EQ print then begin wesave report Shall we archive the postcript defaul_no question IF wesave EQ 0 THEN RETURN ENDIF if the name of the postscript is idl ps then we change it IF file_basename uval nameps EQ idl ps then BEGIN get the name of all the ps or ps gz files available in psdir allps file_search psdir ps ps gz pdf test_regular nosort allps file_basename file_basename allps gz ps allps file_basename allps pdf find which of these names corresponds to numbers get ascii codes of the names testnumb byte allps longest name maxstrlen size testnumb dimensions 0 ascii codes can be 0 or between byte 0 and byte 9 testnumb testnumb EQ 0 OR testnumb GE byte 0 0 AND testnumb LE byte 9 0 testnumb where total testnumb 1 EQ maxstrlen count IF count NE 0 THEN BEGIN get the largest number psnumber fix allps testnumb psnumber psnumber reverse sort psnumber 0 1 ENDIF ELSE psnumber 0 update uval nameps dirname file_dirname uval nameps mark_directory uval nameps dirname strtrim psnumber 2 ps change the name of the file file_move dirname idl ps uval nameps ENDIF spawn gzip uval nameps ENDIF return end pro printps psfilename this is working only with unix linux osX machines thisOS strupcase strmid version os_family 0 3 CASE thisOS OF MAC :return WIN :return ELSE: ENDCASE include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF we get the name of the latest created postscript psdir isadirectory psdir title Select psdir CASE N_PARAMS OF 0: BEGIN nameps file_search psdir ps test_regular nosort IF nameps 0 EQ THEN BEGIN ras report no postsrcipt file ending with ps found in : psdir RETURN ENDIF dates file_info nameps mtime lastdate reverse sort temporary dates 0 nameps nameps lastdate END 1: nameps psfilename ELSE: BEGIN ras report printps accept only one element: psfilename RETURN END ENDCASE we check if the file is exist in psdir if necessary we complete its name with ps and or gz nameps find nameps ps gz iodir psdir nopro IF nameps EQ NOT FOUND THEN BEGIN ng report file nameps ps gz does not exist return ENDIF gzipped strpos nameps gz if the file is gzipped we call gunzip et change its name IF gzipped NE 1 THEN BEGIN spawn gunzip nameps nameps strmid nameps 0 gzipped endif build the widget base widget_base row title Postscript file: file_basename nameps ps viewers grouped button psviewers no psviewers found IF file_which getenv PATH ghostview NE THEN psviewers psviewers Ghostview IF file_which getenv PATH gs NE THEN psviewers psviewers Ghostscript IF file_which getenv PATH kghostview NE THEN psviewers psviewers Kghostview if at least one of viewer was found we define these buttons IF n_elements psviewers GT 1 THEN BEGIN psviewers psviewers 1: notused cw_bgroup base psviewers frame label_top Visualize uvalue name: visualize nameps:nameps column return_name ENDIF printers list grouped buttons are the common variables printer_human_names and printer_human_names defined in a proper way CASE 1 OF n_elements printer_human_names eq 0: noting report the cm_4ps variable printer_human_names is not defined CWe could not propose any printer simple n_elements printer_human_names NE n_elements printer_machine_names : noting report the cm_4ps variables printer_human_names and Cprinter_machine_names do not have the same number of arguments CWe could not propose any printer simple printer_human_names 0 EQ : ELSE:notused cw_bgroup base printer_human_names frame column label_top Select printer uvalue name: print nameps:nameps gzip:gzipped NE 1 ENDCASE archive ps button can be created only if archive_ps ne 0 IF keyword_set archive_ps THEN notused widget_button base value archive ps uvalue name: archive nameps:nameps gzip:gzipped NE 1 quit button notused widget_button base value quit uvalue name: quit nameps:nameps gzip:gzipped NE 1 widget_control base realize xmanager printps base no_block return end "); 77 a[75] = new Array("./ReadWrite/idl-NetCDF/ncdf_listdims.html", "ncdf_listdims.pro", "", "FUNCTION ncdf_listdims ncid n ncdf_inquire ncid ndims names strarr n for i 0 n 1 do begin ncdf_diminq ncid i name size names i name endfor return names end"); 78 a[76] = new Array("./ReadWrite/idl-NetCDF/ncdf_listvars.html", "ncdf_listvars.pro", "", "FUNCTION ncdf_listvars ncid n ncdf_inquire ncid nvars names strarr n for i 0 n 1 do begin names i ncdf_varinq ncid i name endfor return names end"); 79 a[77] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickread/ncdf_quickread.html", "ncdf_quickread.pro", "", ""); 80 a[78] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickread/ncdf_quickread_helper.html", "ncdf_quickread_helper.pro", "", " ncdf_quickread_helper pro This file contains IDL functions to read netCDF data files into IDL variables Adapted from CDF2IDL pro This file contains the following functions and procedures: functions: ncdf_quickread_getfile strips the directory and optionally any suffixes from the path file ncdf_quickread_getdir returns the directory from the full path file ncdf_quickread_validatename validates the name that will be used as a netCDF variable procedures: ncdf_quickread_helper1 construct commands which when executed at the top level will read netCDF variables into IDL History: Date Name Action 06 Jun 97 S Rupert Created 09 Jun 97 S Rupert Fully tested 10 Jun 97 S Rupert Modified keyword usage 03 Feb 98 S Rupert Added additional error checking and warning to output script 17 Feb 98 S Rupert Corrected validation routine to handle instance of name strating with a number and containing a dash 05 Jul 00 A M Iwi Added keyword PREFIX on CDF2IDL Supplied string gets prepended to all variable names 19 Jun 01 A M Iwi Added keyword REFORM on CDF2IDL REFORM function is used to remove dimensions of size 1 02 Oct 03 A M Iwi Change into helper routine for ncdf_quickread 11 Aug 04 A M Iwi Add fields option to read only certain fields Also only stringify attributes of type CHAR function ncdf_quickread_getFile fullpath suffix suffix on_error 2 compile_opt hidden func_description This function returns the filename name from the full path Inputs: fullpath full directory file path Keyword: suffix: include inptu suffix in output file name Outputs: file filename Example Call: file ncdf_quickread_getfile fullpath Retrieve the postion at which the first character occurs from the end of the string dirlen rstrpos fullpath Retrieve the full length of the original string len strlen fullpath Retrieve the filename fullfile strmid fullpath dirlen 1 len Retrieve the position at which the first character occurs from the end of the string len 1 if not keyword_set suffix then len rstrpos fullfile if len EQ 1 then len strlen fullfile Retrieve the file file strmid fullfile 0 len Return the file name return file End function end function ncdf_quickread_getDir fullpath on_error 2 compile_opt hidden func_description This function returns the directory name from the full path Inputs: fullpath full directory file path Outputs: dir directory path Example Call: dir ncdf_quickread_getdir fullpath Retrieve the postion at which the first character occurs from the end of the string len rstrpos fullpath Retrieve the filename if len EQ 1 then dir else dir strmid fullpath 0 len 1 Return the file name return dir End function end function ncdf_quickread_validateName varname on_error 2 compile_opt hidden func_description This routine ensures that the given name does not start with a number nor contain a dash IDL cannot accept a variable starting with a number or containing a dash If the name starts with a number an underscore is prepended to the name and if it contains a dash the dash is replaced with an underscore Initialize the name name varname If the name starts with a number prepend it with an underscore if strpos varname 0 EQ 0 then name strcompress _ varname if strpos varname 1 EQ 0 then name strcompress _ varname if strpos varname 2 EQ 0 then name strcompress _ varname if strpos varname 3 EQ 0 then name strcompress _ varname if strpos varname 4 EQ 0 then name strcompress _ varname if strpos varname 5 EQ 0 then name strcompress _ varname if strpos varname 6 EQ 0 then name strcompress _ varname if strpos varname 7 EQ 0 then name strcompress _ varname if strpos varname 8 EQ 0 then name strcompress _ varname if strpos varname 9 EQ 0 then name strcompress _ varname If the name contains a dash replace it with an underscore if strpos name NE 1 then begin pieces str_sep name n_pieces n_elements pieces name pieces 0 for i 1 n_pieces 1 do begin name strcompress name _ pieces i endfor endif Return the file name return name End function end function ncdf_quickread_helper infile verbose verbose prefix prefix fields fields reform reform on_error 2 compile_opt hidden This procedure creates a script to read the data in a given netCDF file into IDL The default output file is the name of the netCDF file with idl replacing any existing suffix The default output is variable data only Inputs: infile full path to netCDF file of interest Optional Inputs: verbose includes extractions of all input file attributes in idl script prefix reform see changelog above Return value: array of commands to run at top level Ensure that the netCDF format is supported on the current platform if not ncdf_exists then message The Network Common Data Format is not supported on this platform Open the netcdf file for reading ncid NCDF_OPEN strcompress infile remove_all if ncid EQ 1 then message The file infile could not be opened please check the path Retrieve general information about this netCDF file ncidinfo NCDF_INQUIRE ncid command to write file header commands __ncid NCDF_OPEN infile subset 0 if n_elements fields ne 0 then begin if fields ne then begin subset 1 subfields strsplit fields extract endif endif Place the desired variables in local arrays for i 0 ncidinfo Nvars 1 do begin vardata NCDF_VARINQ ncid i if not subset then begin wanted 1 endif else begin match where subfields eq vardata Name nmatch wanted nmatch ne 0 endelse if wanted then begin varname ncdf_quickread_validatename vardata Name if keyword_set prefix then varname prefix varname commands commands NCDF_VARGET __ncid strcompress string i varname if keyword_set reform and vardata ndims ge 2 then commands commands varname reform varname if keyword_set verbose then begin for j 0 vardata Natts 1 do begin att NCDF_ATTNAME ncid i j attname strcompress varname _ strcompress att REMOVE_ALL commands commands NCDF_ATTGET __ncid strcompress string i att attname attinfo ncdf_attinq ncid i att if attinfo datatype eq CHAR then commands commands attname STRING attname endfor endif endif endfor if keyword_set verbose then begin for i 0 ncidinfo Ngatts 1 do begin name NCDF_ATTNAME ncid GLOBAL i attname ncdf_quickread_validatename name if keyword_set prefix then attname prefix attname commands commands NCDF_ATTGET __ncid GLOBAL name attname attinfo ncdf_attinq ncid global name if attinfo datatype eq CHAR then commands commands attname STRING attname endfor endif ncdf_close ncid commands commands NCDF_CLOSE __ncid Return commands to the caller return commands End procedure end"); 81 a[79] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite.html", "ncdf_quickwrite.pro", "", ""); 82 a[80] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper1.html", "ncdf_quickwrite_helper1.pro", "", "pro ncdf_quickwrite_helper1 ncvarstring ncdfstruct structname Parses the variable string so as to create the main structure on_error 2 compile_opt hidden ncdfstruct ncommands: 1 split string to extract IDL global attribute variable name bits strsplit ncvarstring extract case n_elements bits of 1: begin no attributes globattflag 0B globattnameidl end 2: begin globattflag 1B globattnameidl bits 1 end else: begin message Parse error: more than one sign in ncvarstring noname end endcase allvarspec bits 0 vars strsplit strcompress allvarspec remove_all extract nvar n_elements vars varnames strarr nvar varnamesidl strarr nvar nvardims intarr nvar vardims ptrarr nvar varattflags bytarr nvar varattnamesidl strarr nvar at start no dimensions known ndim 0 dimnames dimunlim 1 for ivar 0 nvar 1 do begin varandattspec vars ivar split into IDL attribute variable name and full variable specification bits strsplit varandattspec : extract case n_elements bits of 1: no variable attributes 2: begin varattflags ivar 1B varattnamesidl ivar bits 1 end else: begin message Parse error: more than one : sign in varandattspec noname end endcase fullvarspec bits 0 split full variable specification into variable specification and IDL variable name bits strsplit fullvarspec extract case n_elements bits of 1: varnameidl fill this in later 2: varnameidl bits 1 else: begin message Parse error: more than one sign in fullvarspec noname end endcase varspec bits 0 split variable specification into name and dimension specification bits strsplit varspec extract varname bits 0 case n_elements bits of 1: begin scalar nvardims ivar 0 end 2: begin dimspec bits 1 test for and strip trailing len strlen dimspec if strmid dimspec len 1 1 ne then begin message Parse error: dimension specification dimspec for variable varname should end with noname endif dimspec strmid dimspec 0 len 1 if dimspec eq then begin dimensions not specified assume 1d array with same name for dimension as for variable vardimnames varname endif else if dimspec eq then begin dimensions not specified but given as above again assume same name for dimension as for variable but with parsed below as meaning UNLIMITED vardimnames varname endif else begin vardimnames strsplit dimspec extract endelse now for each dimension name see if it already exists and if not then add it as a new name nvardim n_elements vardimnames nvardims ivar nvardim thisvardims intarr nvardim for i 0 nvardim 1 do begin dimname vardimnames i first see if dimname has leading if so strip it but record the fact that UNLIMITED is wanted unlimited strmid dimname 0 1 eq if unlimited then dimname strmid dimname 1 if ndim gt 0 then begin match where dimnames eq dimname nmatch case nmatch of 0: begin no match append to array dimnames dimnames dimname vardim ndim ndim ndim 1 end 1: begin match found point to it vardim match 0 end else: stop Duplicate match: BUG in NCDF_QUICK_HELPER1 endcase endif else begin no dimensions known this is the first ndim 1 dimnames dimname vardim 0 for completeness endelse if unlimited then begin if dimunlim ge 0 and dimunlim ne vardim then begin message NCDF dimensions dimnames dimunlim and dimnames vardim cannot both be of UNLIMITED size noname endif dimunlim vardim endif thisvardims i vardim endfor vardims ivar ptr_new thisvardims end else: message Parse error: variable specification varspec has stray noname endcase if varnameidl eq then varnameidl varname varnames ivar varname varnamesidl ivar varnameidl endfor now construct some commands which when executed at the top level will put IDL variable size information into the structure commands structname varsizes string indgen nvar ptr_new size varnamesidl now some more commands to tell the main level to copy the attributes into a heap location where the next helper routine will see them if globattflag then commands commands structname globatts ptr_new globattnameidl for ivar 0 nvar 1 do begin if varattflags ivar then begin commands commands structname varatts string ivar ptr_new varattnamesidl ivar endif endfor second argument comes back with a structure which contains all the information and also some variables to be used by next helper routine ncdfstruct ncommands: n_elements commands commands: ptr_new commands nvar: nvar varnames: varnames varids: intarr nvar nvardims: nvardims vardims: vardims varnamesidl: varnamesidl varsizes: ptrarr nvar varatts: ptrarr 1 nvar varattflags: varattflags varattnamesidl: varattnamesidl globatts: ptr_new globattflag: globattflag globattnameidl: globattnameidl ndim: ndim dimnames: dimnames dimids: intarr ndim 1 dimunlim: dimunlim fileid: 0 end"); 83 a[81] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper2.html", "ncdf_quickwrite_helper2.pro", "", " HELPER2 Constructs the commands which are actually needed to write the NetCDF file this file contains: STR ncdf_quickwrite_typename ncdf_quickwrite_helper2 compile_opt hidden _STR like STRING but with no whitespace we use this function enough to give it a short name but the underscore is to make it unlikely to conflict with a user s function function _str string return strcompress string remove_all end function ncdf_quickwrite_typename num name on_error 2 translate type number returned from size function into name usable by ncdf routines if not valid type throw an error and use name in informational message if set case num of usable types 1: type byte 2: type short 3: type long 4: type float 5: type double other types: set to something appropriate 7: type char string 12: type long unsigned 13: type long unsigned long 14: type float 64 bit integer 15: type float 64 bit integer else: begin if num eq 0 then gripe undefined else gripe not of valid type for a NetCDF file if n_params eq 1 then name Data item message name is gripe noname end endcase return type end pro ncdf_quickwrite_helper2 ncfilename s sname on_error 2 compile_opt hidden NB main structure is called s we use it so much that anything longer could get tedious start with no commands in fact 1 is an error condition s ncommands 1 free commands written by helper1 from heap ptr_free s commands dimsize lonarr s ndim 1 1 stops error if all fields scalar types strarr s nvar first of all work out dimension sizes for ivar 0 s nvar 1 do begin nvardim s nvardims ivar sizeinfo s varsizes ivar ntype sizeinfo sizeinfo 0 1 types ivar ncdf_quickwrite_typename ntype IDL expression s varnamesidl ivar for NCDF variable s varnames ivar if nvardim ne sizeinfo 0 then message NCDF variable s varnames ivar is defined with _str s nvardims ivar dimension s but corresponding IDL expression s varnamesidl ivar has _str sizeinfo 0 dimension s noname if nvardim ne 0 then begin not scalar for ivardim 0 nvardim 1 do begin idim s vardims ivar ivardim wanted sizeinfo 1 ivardim previous dimsize idim if previous ne 0 and previous ne wanted then message NCDF dimension s dimnames idim is multiply used but with conflicting sizes: _str previous and _str wanted noname dimsize idim wanted endfor endif endfor make commands to write the file to open the file if n_elements ncfilename eq 0 then ncfilename idl nc if strmid ncfilename 0 1 eq then begin ncfilename1 strmid ncfilename 1 clobstr clobber endif else begin ncfilename1 ncfilename clobstr endelse commands sname fileid ncdf_create ncfilename1 clobstr to do the dimensions for idim 0 s ndim 1 do begin if idim eq s dimunlim then sizestr unlimited else sizestr _str dimsize idim commands commands sname dimids _str idim ncdf_dimdef sname fileid s dimnames idim sizestr endfor to do the variables for ivar 0 s nvar 1 do begin if s nvardims ivar eq 0 then dimstr else dimstr sname dimids strjoin _str s vardims ivar commands commands sname varids _str ivar ncdf_vardef sname fileid s varnames ivar dimstr types ivar endfor to do the global attributes if s globattflag then begin tags tag_names s globatts ntags n_elements tags for itag 0 ntags 1 do begin sizeinfo size s globatts itag type ncdf_quickwrite_typename sizeinfo sizeinfo 0 1 commands commands ncdf_attput sname fileid global strlowcase tags itag s globattnameidl tags itag type endfor endif to do the variable attributes for ivar 0 s nvar 1 do begin if s varattflags ivar then begin tags tag_names s varatts ivar ntags n_elements tags for itag 0 ntags 1 do begin sizeinfo size s varatts ivar itag type ncdf_quickwrite_typename sizeinfo sizeinfo 0 1 commands commands ncdf_attput sname fileid sname varids _str ivar strlowcase tags itag s varattnamesidl ivar tags itag type endfor endif endfor to end the definition section commands commands ncdf_control sname fileid endef to write the data for ivar 0 s nvar 1 do begin commands commands ncdf_varput sname fileid sname varids _str ivar s varnamesidl ivar endfor close the file commands commands ncdf_close sname fileid make commands available to main level s ncommands n_elements commands s commands ptr_new commands end "); 84 a[82] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_helper3.html", "ncdf_quickwrite_helper3.pro", "", "pro ncdf_quickwrite_helper3 s Frees the variables in heap memory on_error 2 compile_opt hidden s is our ncdf structure ptr_free s globatts ptr_free s varatts ptr_free s commands ptr_free s vardims ptr_free s varsizes ptr_free s varatts end"); 85 a[83] = new Array("./ReadWrite/idl-NetCDF/ncdf_quickwrite/ncdf_quickwrite_verbose.html", "ncdf_quickwrite_verbose.pro", "", ""); 86 a[84] = new Array("./ReadWrite/idl-NetCDF/ncdf_read.html", "ncdf_read.pro", "", "PRO ncdf_read filename info dinfo vinfo gatts vatts data general info data dimension info variable attributes variable info global attributes read a NetCDF file NB The data is read into a rather nasty combination of structures arrays and pointers which is unfortunately necessary in order to cope with the full generality of the data format Here is the sort of syntax you might use to get at elements of the returned data cumbersome because IDL doesn t support C type a b shorthand for a b INFO NDIMS INFO NVARS INFO NGATTS INFO RECDIM DINFO idim NAME DINFO idim SIZE VINFO ivar NAME VINFO ivar NAME VINFO ivar DATATYPE VINFO ivar NDIMS VINFO ivar NATTS VINFO ivar DIM ivdim GATTS NAME GATTS DATATYPE GATTS LENGTH GATTS VALUES or maybe STRING GATTS VALUES VATTS ivar iatt NAME VATTS ivar iatt DATATYPE VATTS ivar iatt LENGTH VATTS ivar iatt VALUES or maybe STRING VATTS ivar iatt VALUES DATA ivar or maybe DATA ivar idim1 idim2 idim3 open file id ncdf_open filename info info ncdf_inquire id dimension info dinfo replicate name: size:0L info ndims for idim 0 info ndims 1 do begin ncdf_diminq id idim name size dinfo idim name name dinfo idim size size endfor variable info vinfo replicate name: datatype: ndims:0l natts:0l dim:lonarr info ndims info nvars for ivar 0 info nvars 1 do begin var ncdf_varinq id ivar vinfo ivar name var name vinfo ivar datatype var datatype vinfo ivar ndims var ndims vinfo ivar natts var natts vinfo ivar dim var dim endfor global attributes if info ngatts gt 0 then begin gatts replicate name: datatype: length:0L values:ptr_new info ngatts for iatt 0 info ngatts 1 do begin name ncdf_attname id iatt global gatts iatt name name att ncdf_attinq id name global gatts iatt length att length gatts iatt datatype att datatype ncdf_attget id name vals global gatts iatt values ptr_new vals endfor endif else begin arbitary scalar value an empty list would be sensible but IDL doesn t support it gatts 1 endelse variable attributes vatts replicate ptr_new info nvars for ivar 0 info nvars 1 do begin if vinfo ivar natts gt 0 then begin vatts ivar ptr_new replicate name: datatype: length:0L values:ptr_new vinfo ivar natts for iatt 0 vinfo ivar natts 1 do begin name ncdf_attname id ivar iatt vatts ivar iatt name name att ncdf_attinq id ivar name vatts ivar iatt length att length vatts ivar iatt datatype att datatype ncdf_attget id ivar name vals vatts ivar iatt values ptr_new vals endfor endif else begin vatts ivar ptr_new 1 Pointer to arbitrary scalar analogous to case of lack of global attributes above We could put a here instead but try to be friendlier to code that might try to dereference it endelse endfor data data replicate ptr_new info nvars for ivar 0 info nvars 1 do begin ncdf_varget id ivar val data ivar ptr_new val endfor end"); 87 a[85] = new Array("./ReadWrite/idl-NetCDF/ncdf_struct.html", "ncdf_struct.pro", "", "FUNCTION ncdf_struct filename nodata nodata noattributes noattributes Read entire netcdf file into a structure Structure contains metadata actual array contents are on heap with pointers contained in the structure Heap variables not created if nodata specified Use ncdf_struct_free to free heap memory Some data is duplicated for ease of access in particular if there is a variable name matching a dimension name then a pointer to the variable contents is accessible via the substructures corresponding to the dimension and every other variable that uses it Alan Iwi 27 6 02 id ncdf_open filename g ncdf_inquire id ndim g ndims nvar g nvars natt g ngatts if ndim gt 0 then begin dnames strarr ndim dsizes lonarr ndim for idim 0 ndim 1 do begin ncdf_diminq id idim dname dsize dnames idim dname dsizes idim dsize endfor endif if natt gt 0 and not keyword_set noattributes then begin anames strarr natt for iatt 0 natt 1 do begin aname ncdf_attname id global iatt ainq ncdf_attinq id global aname ncdf_attget id global aname aval if ainq datatype eq CHAR then aval string aval if iatt eq 0 then begin atts create_struct aname aval endif else begin atts create_struct atts aname aval endelse anames iatt aname endfor g create_struct g gatts atts gattnames anames endif if nvar gt 0 then begin vnames strarr nvar for ivar 0 nvar 1 do begin v ncdf_varinq id ivar vname v name vndim v ndims vnatt v natts vname v name if vnatt gt 0 and not keyword_set noattributes then begin vanames strarr vnatt for iatt 0 vnatt 1 do begin aname ncdf_attname id ivar iatt ainq ncdf_attinq id ivar aname ncdf_attget id ivar aname aval if ainq datatype eq CHAR then aval string aval if iatt eq 0 then begin atts create_struct aname aval endif else begin atts create_struct atts aname aval endelse vanames iatt aname endfor v create_struct v atts atts attnames anames endif vdnames dnames v dim vdsizes dsizes v dim v create_struct v dimnames vdnames dimsizes vdsizes if not keyword_set nodata then begin ncdf_varget id ivar vdata v create_struct v data ptr_new vdata dimdata replicate ptr_new vndim endif if ivar eq 0 then begin vars create_struct vname v endif else begin vars create_struct vars vname v endelse vnames ivar vname endfor endif if ndim gt 0 then begin for idim 0 ndim 1 do begin dname dnames idim d name:dname size:dsizes idim if not keyword_set nodata and nvar gt 0 then begin matchvar 1 for ivar 0 nvar 1 do begin if vnames ivar eq dname then matchvar ivar endfor if matchvar ne 1 then d create_struct d data vars matchvar data endif if idim eq 0 then begin dims create_struct dname d endif else begin dims create_struct dims dname d endelse endfor g create_struct g dims dims dimnames dnames dimsizes dsizes endif if nvar gt 0 then begin if not keyword_set nodata then begin for ivar 0 nvar 1 do begin for idim 0 vars ivar ndims 1 do begin vars ivar dimdata idim dims vars ivar dim idim data endfor endfor endif g create_struct g vars vars varnames vnames endif ncdf_close id return g end"); 88 a[86] = new Array("./ReadWrite/idl-NetCDF/ncdf_struct_free.html", "ncdf_struct_free.pro", "", "PRO ncdf_struct_free s free heap memory associated with struct returned by ncdf_struct for i 0 s nvars 1 do ptr_free s vars i data end"); 89 a[87] = new Array("./ReadWrite/ncdf_timeget.html", "ncdf_timeget.pro", "", " NAME: ncdf_timeget PURPOSE: get the time axis fom a netcdf_file and transforms it in julian days of IDL CATEGORY: reading ncdf_file CALLING SEQUENCE: time ncdf_timeget cdfid timeid INPUTS:cdfid: the ID of the ncdf_file which is already open timeid: the ID or the name of the variable which describe the calendar KEYWORD PARAMETERS: YYYYMMDD: active to obtain the date as a longinterger with the format YearYearYearYearMonthMonthDayDay the keyword parameters of ncdf_varget OUTPUTS:a long array of IDL julian days COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: the calendar variable must have the units attribute folowing the syntaxe bellow: time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2001 FUNCTION ncdf_timeget cdfid timeid YYYYMMDD yyyymmdd _extra ex insidetime ncdf_varinq cdfid timeid if insidetime natts NE 0 then begin attnames strarr insidetime natts for attiq 0 insidetime natts 1 do attnames attiq strlowcase ncdf_attname cdfid timeid attiq ENDIF ELSE return report the variable timeid must have the units attribut reading of the time axis ncdf_varget cdfid timeid time _extra ex time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 if where attnames EQ units 0 NE 1 then begin ncdf_attget cdfid timeid units value value strtrim strcompress string value 2 words str_sep value unite words 0 start str_sep words 2 case strlowcase unite of seconds :time julday start 1 start 2 start 0 time long 24 3600 hours :time julday start 1 start 2 start 0 time long 24 days :time julday start 1 start 2 start 0 time months :BEGIN for t 0 n_elements time 1 do begin time t julday start 1 time t start 2 start 0 endfor END years :BEGIN for t 0 n_elements time 1 do begin time t julday start 1 start 2 start 0 time t endfor END ELSE:return report bad syntax of the units attribut of the variable timeid ENDCASE ENDIF ELSE return report the variable timeid must have the units attribut if keyword_set yyyymmdd then time jul2date time return time end"); 90 a[88] = new Array("./ReadWrite/read_grads.html", "read_grads.pro", "", " NAME:read_grads PURPOSE:reading grads file except data type station or grib from the grads control file even if there is multiple data files CATEGORY:reading function CALLING SEQUENCE: res read_grads var date1 date2 FILENAME filename INPUTS: var: the variable name date1: date of the beginning yyyymmdd if TIMESTEP is not activate date2: last date Optionnal if not scpecified date2 date1 KEYWORD PARAMETERS: FILENAME: the grads control file name: xxxx ctl GLAMBOUNDARY via computegrid pro :a 2 elements vector lon1 lon2 giving the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 eq 360 key_shift will be automatically defined according to GLAMBOUNDARY TIMESTEP: to specify that the dates are time steps instead of true calendar IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir NOT yet available BOX: a 4 or 6 elements 1d array lon1 lon2 lat1 lat2 depth1 depth2 that specifies the area where data must be read EVERYTHING NOSTRUCTURE OUTPUTS: an array COMMON BLOCKS:common pro SIDE EFFECTS:define all the grid parameters defined in common pro associated to the data RESTRICTIONS: this function call the procedure scanfile that use the unix commands grep and sed EXAMPLE: IDL a read_grads sst 19900101 19900131 filename outputs ctl IDL plt a MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION read_grads var date1 date2 FILENAME filename BOX box TIMESTEP timestep EVERYTHING everything NOSTRUCT nostruct _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF we find the filename filename isafile FILENAME filename IODIRECTORY iodir _EXTRA ex if size filename type NE 7 then return report read_ncdf cancelled we scan the control file called filename scanctl filename filesname jpt1file varsname varslev swapbytes bigendian littleendian f77sequential fileheader theader xyheader VARFMT varfmt _EXTRA ex if n_elements varfmt EQ 0 then varfmt float check date1 and date2 and found the starting index t1 and the ending index t2 that corresponds to the time series specified by date1 and date2 for the time axis defined in the ctl file if n_elements date1 EQ 0 then begin t0 0 t1 0 ENDIF if n_elements date2 EQ 0 then date2 date1 if keyword_set timestep then BEGIN if date1 GT date2 then begin print date2 must be larger than date1 return 1 endif t1 0 long date1 long date2 date2jul date2 grads if jdate1 GT jdate2 then begin print date2 must be larger than date1 return 1 endif t1 where time GE jdate1 0 tmp where time LE jdate2 t2 t2 t2 1 ENDELSE if t2 LT t1 then begin print There is no date between date1 and date2 return 1 endif jpt2read t2 t1 1 index of the variable varid where strlowcase varsname EQ strlowcase var varid varid 0 if varid EQ 1 then begin print var not found in the variable liste of filename return 1 ENDIF varname var if varslev varid EQ 1 then res fltarr jpi jpj jpt2read nozero ELSE res fltarr jpi jpj varslev varid jpt2read nozero find the first file to be read according to the lile list the number of time step in each file and t1 and t2 indf2read t1 jpt1file startread t1 indf2read jpt1file alreadyread 0 readagain: jpt2read1file min jpt1file startread jpt2read f2read filesname indf2read opening check the existance of the file f2read isafile filename f2read iodirectory iodir _EXTRA ex if the file is stored on tape if version os_family EQ unix then spawn file f2read dev null open the file openr unit f2read get_lun error err swap_if_little_endian bigendian swap_if_big_endian littleendian swap_endian swapbytes if err ne 0 then begin print err_string return 1 endif case varfmt of byte :fmtsz 1l uint :fmtsz 2l int :fmtsz 2l long :fmtsz 4l float :fmtsz 4l endcase check its size addf77sec long 4 2 f77sequential xyblocsize xyheader addf77sec xyheader NE 0 jpi jpj fmtsz addf77sec nxybloc long total varslev filesize fileheader addf77sec fileheader NE 0 theader addf77sec theader NE 0 nxybloc xyblocsize jpt1file infof2read fstat unit if infof2read size NE filesize then begin print According to filename the file size must be strtrim filesize 1 instead of strtrim infof2read size 1 print jpi: strtrim jpi 2 print jpj: strtrim jpj 2 print jpt: strtrim jpt 2 print format size in byte: strtrim fmtsz 2 print number of xy arrays: strtrim nxybloc 2 return 1 endif reading loop on the time steps to be read in one file for i 0 jpt2read1file 1 do begin computing the offset offset fileheader addf77sec fileheader NE 0 theader addf77sec theader NE 0 nxybloc xyblocsize startread i theader addf77sec theader NE 0 if varid NE 0 THEN offset offset long total varslev 0:varid 1 xyblocsize if there is only one level IF varslev varid EQ 1 then begin case varfmt of byte :a assoc unit bytarr jpi jpj nozero offset 4 f77sequential uint :a assoc unit uintarr jpi jpj nozero offset 4 f77sequential int :a assoc unit intarr jpi jpj nozero offset 4 f77sequential long :a assoc unit lonarr jpi jpj nozero offset 4 f77sequential float :a assoc unit fltarr jpi jpj nozero offset 4 f77sequential endcase res i alreadyread a 0 ENDIF ELSE BEGIN more than 1 level to be read if f77sequential then BEGIN sequential access case varfmt of byte :a assoc unit bytarr jpi jpj 8 varslev varid nozero offset uint :a assoc unit uintarr jpi jpj 4 varslev varid nozero offset int :a assoc unit intarr jpi jpj 4 varslev varid nozero offset long :a assoc unit lonarr jpi jpj 2 varslev varid nozero offset float :a assoc unit fltarr jpi jpj 2 varslev varid nozero offset endcase tmp a 0 case varfmt OF we cut the headers and tailers of f77 write byte : tmp tmp 4:jpi jpj 3 uint : tmp tmp 2:jpi jpj 1 int : tmp tmp 2:jpi jpj 1 long : tmp tmp 1:jpi jpj 0 float :tmp tmp 1:jpi jpj 0 endcase if keyword_set key_zreverse then res i alreadyread reverse reform tmp jpi jpj varslev varid over 3 ELSE res i alreadyread reform tmp jpi jpj varslev varid over ENDIF ELSE BEGIN direct acces case varfmt of byte :a assoc unit bytarr jpi jpj varslev varid nozero offset uint :a assoc unit uintarr jpi jpj varslev varid nozero offset int :a assoc unit intarr jpi jpj varslev varid nozero offset long :a assoc unit lonarr jpi jpj varslev varid nozero offset float :a assoc unit fltarr jpi jpj varslev varid nozero offset endcase if keyword_set key_zreverse then res i alreadyread reverse a 0 3 ELSE res i alreadyread a 0 ENDELSE ENDELSE endfor close the file free_lun unit close unit do we need to read a new file to complete the time series if jpt2read1file NE jpt2read then BEGIN indf2read indf2read 1 startread 0 alreadyread alreadyread jpt2read1file jpt2read jpt2read jpt2read1file GOTO readagain ENDIF post processing if keyword_set key_yreverse then res reverse res 2 if keyword_set key_shift then begin case size res 0 of 2:res shift res key_shift 0 3:res shift res key_shift 0 0 4:res shift res key_shift 0 0 0 endcase endif mask IF varslev varid EQ 1 then begin if abs valmask LE 1e5 then notgood where res 0 EQ valmask ELSE notgood where abs res 0 GE abs valmask 10 if notgood 0 NE 1 then tmask notgood 0b ENDIF ELSE BEGIN if abs valmask LE 1e5 then notgood where res 0 EQ valmask ELSE notgood where abs res 0 GE abs valmask 10 if notgood 0 NE 1 then tmask notgood 0b ENDELSE if abs valmask LE 1e5 then notgood where res EQ valmask ELSE notgood where abs res GE abs valmask 10 if notgood 0 NE 1 THEN res notgood values f_nan valmask 1e20 if abs valmask LE 1e5 then notgood where res EQ valmask ELSE notgood where abs res GE abs valmask 10 if notgood 0 NE 1 THEN res notgood 1e20 valmask 1e20 triangles_list triangule subdomain extration time aguments time time t1:t2 jpt t2 t1 1 if keyword_set timestep then vardate strtrim time 0 2 ELSE vardate date2string vairdate time 0 updateold return res end"); 91 a[89] = new Array("./ReadWrite/read_oasis.html", "read_oasis.pro", "", " NAME:read_oasis PURPOSE:read the f77 unformated files used in Oasis version a read_oasis grids_orca_t106 a106 lon 320 160 IDL m read_oasis masks_orca_t106 or1t msk 182 149 i4 see also IDL scanoasis grids_orca_t106 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 FUNCTION read_oasis filename varname jpi jpj I2 I4 i4 I8 i8 R4 r4 openr unit filename f77_unformatted get_lun swap_if_little_endian error err if err ne 0 then begin print err_string return 1 endif char8 12345678 readu unit char8 print char8 found char8 EQ varname WHILE NOT EOF unit AND found NE 1 DO BEGIN readu unit if EOF unit then begin print varname not found in filename return 1 endif readu unit char8 print char8 found char8 EQ varname ENDWHILE case 1 of keyword_set i2 :res intarr jpi jpj keyword_set i4 :res lonarr jpi jpj keyword_set i8 :res lon64arr jpi jpj keyword_set r4 :res fltarr jpi jpj ELSE:res dblarr jpi jpj endcase readu unit res free_lun unit return res end"); 92 a[90] = new Array("./ReadWrite/readbat.html", "readbat.pro", "", " NAME: readbat PURPOSE: reading the bathymetry ASCII file of OPA CATEGORY: for OPA CALLING SEQUENCE: bat readbat filename INPUTS: filename: a string containing the filename KEYWORD PARAMETERS: ZERO: to put 0 on land instead of negatives values for the islands OUTPUTS: a 2d array COMMON BLOCKS:no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr May 31 2002 based on batlec2 pro written by Maurice Imbard March 17 1998 FUNCTION readbat filename ZERO zero lecture de la bathymetrie iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return 1 ENDIF ELSE iname_file iname_file 0 openr iunit iname_file get_lun readf iunit FORMAT 16x 2i8 iim ijm iim long iim ijm long ijm tmp readf iunit tmp tmp strsplit tmp extract iim long tmp n_elements tmp 2 ijm long tmp n_elements tmp 1 print iim ijm ifreq 40L ifin iim ifreq 1 irest iim ifin 1 ifreq print ifin irest ifreq zbati intarr ifreq zbati2 intarr irest zbat intarr iim ijm readf iunit FORMAT readf iunit FORMAT il1 0 FOR jn 1 ifin 1 DO BEGIN readf iunit FORMAT readf iunit FORMAT il2 min iim 1 il1 ifreq 1 readf iunit FORMAT readf iunit FORMAT readf iunit FORMAT il3 il2 jn 1 ifreq iformat string il3 2 i3 print jn il1 il2 il3 ifreq 1 FOR jj ijm 1 0 1 DO BEGIN readf iunit FORMAT iformat ij zbati zbat il1:il2 jj zbati ENDFOR il1 il1 ifreq ENDFOR readf iunit FORMAT readf iunit FORMAT il2 min iim 1 il1 ifreq 1 readf iunit FORMAT readf iunit FORMAT readf iunit FORMAT il3 il2 ifin 1 ifreq iformat string il3 2 i3 print irest 1 il1 il2 il3 FOR jj ijm 1 0 1 DO BEGIN readf iunit FORMAT iformat ij zbati2 zbat il1:il2 jj zbati2 ENDFOR close iunit free_lun iunit if keyword_set zero then zbat 0 zbat return zbat end"); 93 a[91] = new Array("./ReadWrite/readoldopadistcoast.html", "readoldopadistcoast.pro", "", " NAME:readoldopadistcoast PURPOSE: read the old binary direct access file that contains the distance to the coast in OPA based on the OPA subroutines dtacof and parctl CATEGORY:for OPA before NetCDF CALLING SEQUENCE:res readoldopadistcoast filename INPUTS: filename with the whole path if necessary jpiglo jpjglo jpk: dimensions of the opa grid KEYWORD PARAMETERS: IBLOC: ibloc size default: ibloc 4096L JPBYT: jpbyt size defalut: jpbyt 8L NUMREC: number of records in the file defalut: numrec 19L jpk OUTPUTS: a structure that contains two elements: tdistcoast the distance for the t points and fdiscoast the distance for the f points COMMON BLOCKS: no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2002 FUNCTION read3fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo params jpk nozero offset b a 0 return b end FUNCTION readoldopadistcoast filename jpiglo jpjglo jpk IBLOC ibloc JPBYT jpbyt NUMREC numrec iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return 1 ENDIF ELSE iname_file iname_file 0 open the file openr numcost iname_file get_lun swap_if_little_endian check the size of the file filepamameters fstat numcost defaut parameter definition for ORCA2 IF keyword_set ibloc THEN ibloc long ibloc ELSE ibloc 4096L jpiglo long jpiglo jpjglo long jpjglo jpk long jpk IF keyword_set jpbyt THEN jpbyt long jpbyt ELSE jpbyt 8L record length computation reclen ibloc jpiglo jpjglo jpbyt 1 ibloc 1 number of records IF keyword_set numrec THEN numrec long numrec ELSE numrec 3L jpk difference between the record length and the size of the contened array toomuch reclen jpiglo jpjglo jpbyt expected size computation size numrec reclen toomuch if size NE filepamameters size then begin print The size of the file is not the expected one print Check your file or the values of ibloc jpiglo print jpjglo jpk jpbyt numrec in this program return 1 endif first record: six 64 bit integer to read default definition iimlu long64 999 ijmlu long64 999 ikmlu long64 999 read readu numcost iimlu ijmlu ikmlu if iimlu NE jpiglo then begin print iimlu strtrim iimlu 1 differs from jpiglo strtrim jpiglo 1 return 1 endif if ijmlu NE jpjglo then begin print ijmlu strtrim ijmlu 1 differs from jpjglo strtrim jpjglo 1 return 1 endif if ikmlu NE jpk then begin print ikmlu strtrim ikmlu 1 differs from jpk strtrim jpk 1 return 1 endif other records params jpiglo:jpiglo jpjglo:jpjglo jpk:jpk reclen:reclen tdistcoast read3fromopa numcost params 2 fdistcoast read3fromopa numcost params 3 close numcost free_lun numcost return tdistcoast:tdistcoast fdistcoast:fdistcoast end"); 94 a[92] = new Array("./ReadWrite/readoldoparestart.html", "readoldoparestart.pro", "", " NAME:readoldoparestart based on the OPA subroutine dtrlec included at the end of the file PURPOSE:read the old restart files of OPA before NetCDF CATEGORY:for OPA before NetCDF CALLING SEQUENCE:readoldoparestart filename jpiglo jpjglo jpk INPUTS: filename: with the whole path if necessary jpiglo jpjglo jpk: dimensions of the opa grid KEYWORD PARAMETERS: IBLOC: ibloc size default: ibloc 4096L JPBYT: jpbyt size defalut: jpbyt 8L NUMREC: number of records in the file defalut: numrec 19L jpk UB VB TB SB ROTB HDIVB UN VN TN SN ROTN HDIVN GCX GCXB ETAB TAN BSFB BSFN BSFD EN: the variable we want to read OUTPUTS:according to the given keywords COMMON BLOCKS:none SIDE EFFECTS: RESTRICTIONS:bug for etab and etan written on the same record EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2002 FUNCTION read2fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo nozero offset return a 0 end FUNCTION read3fromopa unit params num offset params reclen params jpk num 1L a assoc unit dblarr params jpiglo params jpjglo params jpk nozero offset return a 0 end PRO readoldoparestart filename jpiglo jpjglo jpk IBLOC ibloc JPBYT jpbyt NUMREC numrec ub ub vb vb tb tb sb sb rotb rotb hdivb hdivb un un vn vn tn tn sn sn rotn rotn hdivn hdivn gcx gcx gcxb gcxb etab etab etan etan bsfb bsfb bsfn bsfn bsfd bsfd en en iname_file findfile filename if iname_file 0 EQ then begin print Bad file name return ENDIF ELSE iname_file iname_file 0 open the file openr numrst iname_file get_lun swap_if_little_endian check the size of the file filepamameters fstat numrst parameter definition IF keyword_set ibloc THEN ibloc long ibloc ELSE ibloc 4096L jpiglo long jpiglo jpjglo long jpjglo jpk long jpk IF keyword_set jpbyt THEN jpbyt long jpbyt ELSE jpbyt 8L record length computation reclen ibloc jpiglo jpjglo jpbyt 1 ibloc 1 IF keyword_set numrec THEN numrec long numrec ELSE numrec 19L jpk toomuch reclen jpiglo jpjglo jpbyt expected size computation size numrec reclen toomuch if size NE filepamameters size then begin print The size of the file is not the expected one print Check your file or the values of ibloc jpiglo print jpjglo jpk jpbyt numrec in this program return endif first record: six 64 bit integer to read default definition ino1 long64 9999 it1 long64 9999 isor1 long64 9999 ipcg1 long64 9999 itke1 long64 9999 idast1 long64 9999 read readu numrst ino1 it1 isor1 ipcg1 itke1 idast1 print ino1 it1 isor1 ipcg1 itke1 idast1 other records params jpiglo:jpiglo jpjglo:jpjglo jpk:jpk reclen:reclen CALL read3 numrst ub 2 IF arg_present ub THEN ub read3fromopa numrst params 2 CALL read3 numrst vb 3 IF arg_present vb THEN vb read3fromopa numrst params 3 CALL read3 numrst tb 5 IF arg_present tb THEN tb read3fromopa numrst params 5 CALL read3 numrst sb 6 IF arg_present sb THEN sb read3fromopa numrst params 6 CALL read3 numrst rotb 7 IF arg_present rotb THEN rotb read3fromopa numrst params 7 CALL read3 numrst hdivb 8 IF arg_present hdivb THEN hdivb read3fromopa numrst params 8 CALL read3 numrst un 9 IF arg_present un THEN un read3fromopa numrst params 9 CALL read3 numrst vn 10 IF arg_present vn THEN vn read3fromopa numrst params 10 CALL read3 numrst tn 12 IF arg_present tn THEN tn read3fromopa numrst params 12 CALL read3 numrst sn 13 IF arg_present sn THEN sn read3fromopa numrst params 13 CALL read3 numrst rotn 14 IF arg_present rotn THEN rotn read3fromopa numrst params 14 CALL read3 numrst hdivn 15 IF arg_present hdivn THEN hdivn read3fromopa numrst params 15 C C Read elliptic solver arrays C CALL read2 numrst gcx jpk 17 IF arg_present gcx THEN gcx read2fromopa numrst params 17 CALL read2 numrst gcxb jpk 18 IF arg_present gcxb THEN gcxb read2fromopa numrst params 18 C ifdef key_freesurf_cstvol C C free surface formulation eta C CALL read2 numrst etab jpk 4 IF arg_present etab THEN etab read2fromopa numrst params 4 CALL read2 numrst etan jpk 4 IF arg_present etan THEN etan read2fromopa numrst params 4 else C C Rigid lid formulation bsf C CALL read2 numrst bsfb jpk 4 IF arg_present bsfb THEN bsfb read2fromopa numrst params 4 CALL read2 numrst bsfn jpk 11 IF arg_present bsfn THEN bsfn read2fromopa numrst params 11 CALL read2 numrst bsfd jpk 16 IF arg_present bsfd THEN bsfd read2fromopa numrst params 16 endif ifdef key_zdftke CALL read3 numrst en 19 IF arg_present en THEN en read3fromopa numrst params 19 close numrst free_lun numrst return end CDIR LIST SUBROUTINE dtrlec CCC CCC CCC ROUTINE dtrlec CCC CCC CCC Purpose : CCC CCC Read files for restart CCC CC Method : CC CC Read the previous fields on the file numrst CC the first record indicates previous characterics CC after control with the present run we read : CC prognostic variables on the second record CC elliptic solver arrays CC barotropic stream function arrays default option CC or free surface arrays key_freesurf_cstvol defined CC tke arrays key_zdftke defined CC for this last three records the previous characteristics CC could be different with those used in the present run CC CC Input : CC CC common CC comrst : restart parameter CC comctl : parameters for the control CC CC Output : CC CC common CC combef : previous fields before CC comnow : present fields now CC combsf : barotropic stream function CC comspg : surface pressure CC comsol : diagonal preconditioned conjugate CC CC Modifications : CC CC original : 91 03 CC additions : 92 01 M Imbard CC : 92 06 correction restart file M Imbard CC : 98 02 M Guyon FETI method CC addition : 98 05 G Roullet free surface CC CC parameters and commons CC CDIR NOLIST include parameter h include common h CDIR LIST CC CC local declarations CC INTEGER ji jj jk jl INTEGER ino0 it0 ipcg0 isor0 itke0 INTEGER ino1 it1 isor1 ipcg1 itke1 idast1 CC CC statement functions CC CDIR NOLIST include stafun h CDIR LIST CCC CCC OPA8 LODYC 1997 CCC C C C 0 Initialisations C C ino0 no it0 nit000 ipcg0 0 isor0 0 itke0 0 isor0 nsolv 1 ipcg0 2 nsolv ifdef key_zdftke itke0 1 endif C FETI method IF nsolv EQ 3 THEN isor0 2 ipcg0 2 ENDIF C IF lwp THEN WRITE numout WRITE numout dtrlec: beginning of restart WRITE numout WRITE numout the present run : WRITE numout job number : no WRITE numout with nit000 : nit000 WRITE numout with pcg option ipcg0 : ipcg0 WRITE numout with sor option isor0 : isor0 WRITE numout with FETI solver option ipcg0 isor0 : ipcg0 isor0 WRITE numout with tke option itke0 : itke0 ENDIF C C 1 Read numrst C C C First record C READ numrst REC 1 ino1 it1 isor1 ipcg1 itke1 idast1 C IF lwp THEN WRITE numout WRITE numout READ numrst with WRITE numout job number : ino1 WRITE numout with time step it : it1 WRITE numout with pcg option ipcg1 : ipcg1 WRITE numout with sor option isor1 : isor1 WRITE numout with tke option itke1 : itke1 WRITE numout with FETI solver option ipcg1 isor1 : ipcg1 isor1 WRITE numout ENDIF C C Control of date C IF it0 it1 NE 1 AND abs nrstdt EQ 1 THEN IF lwp THEN WRITE numout : problem with nit000 for the restart WRITE numout WRITE numout we stop verify the file WRITE numout or rerun with the value 0 for the WRITE numout control of time parameter nrstdt WRITE numout ENDIF STOP dtrlec ENDIF IF nrstdt EQ 1 ndate0 idast1 C C Read prognostic variables C CALL read3 numrst ub 2 CALL read3 numrst vb 3 CALL read3 numrst tb 5 CALL read3 numrst sb 6 CALL read3 numrst rotb 7 CALL read3 numrst hdivb 8 CALL read3 numrst un 9 CALL read3 numrst vn 10 CALL read3 numrst tn 12 CALL read3 numrst sn 13 CALL read3 numrst rotn 14 CALL read3 numrst hdivn 15 C C Read elliptic solver arrays C CALL read2 numrst gcx jpk 17 CALL read2 numrst gcxb jpk 18 C ifdef key_freesurf_cstvol C C free surface formulation eta C CALL read2 numrst etab jpk 4 CALL read2 numrst etan jpk 4 else C C Rigid lid formulation bsf C CALL read2 numrst bsfb jpk 4 CALL read2 numrst bsfn jpk 11 CALL read2 numrst bsfd jpk 16 endif C ifdef key_zdftke C C Read tke arrays C IF itke1 eq 1 THEN CALL read3 numrst en 19 ELSE IF lwp THEN WRITE numout : the previous restart file didnt used tke scheme WRITE numout ENDIF nrstdt 2 ENDIF endif C C RETURN END"); 95 a[93] = new Array("./ReadWrite/scanctl.html", "scanctl.pro", "", " GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be defined according to GLAMBOUNDARY PRO scanctl filename filesname jpt1file varsname varslev swapbytes bigendian littleendian f77sequential fileheader theader xyheader VARFMT varfmt _EXTRA ex common time1 systime 1 for key_performance DTYPE spawn grep i DTYPE filename notgood if keyword_set notgood then begin print This program is not adapted to data type station or grib Sorry stop endif UNDEF define valmask spawn grep i UNDEF filename valmask valmask strtrim valmask 2 valmask strsplit valmask 0 extract valmask float valmask 1 Headers spawn grep i FILEHEADER filename fileheader fileheader strtrim fileheader 2 if keyword_set fileheader then BEGIN fileheader strsplit fileheader 0 extract fileheader long fileheader 1 ENDIF ELSE fileheader 0L spawn grep i THEADER filename theader theader strtrim theader 2 if keyword_set theader then BEGIN theader strsplit theader 0 extract theader long theader 1 ENDIF ELSE theader 0L spawn grep i XYHEADER filename xyheader xyheader strtrim xyheader 2 if keyword_set xyheader then BEGIN xyheader strsplit xyheader 0 extract xyheader long xyheader 1 ENDIF ELSE xyheader 0L find the x axis spawn sed n e d e Xx Dd Ee Ff Yy Dd Ee Ff p filename xdef if xdef 0 EQ then BEGIN print Bad definition of xdef or ydef stop ENDIF xdef xdef 0:n_elements xdef 2 if n_elements xdef NE 1 then begin xdef byte xdef replicate byte 1 n_elements xdef xdef xdef where xdef NE 0 xdef string xdef endif xdef strtrim xdef 0 2 xdef strsplit xdef extract jpi long xdef 1 case strupcase xdef 2 of LINEAR :xaxis float xdef 3 findgen jpi float xdef 4 LEVELS :xaxis float xdef 3:n_elements xdef 1 ENDCASE find the y axis spawn sed n e d e Yy Dd Ee Ff Zz Dd Ee Ff p filename ydef if ydef 0 EQ then BEGIN print Bad definition of ydef or zdef stop ENDIF ydef ydef 0:n_elements ydef 2 if n_elements ydef NE 1 then begin ydef byte ydef replicate byte 1 n_elements ydef ydef ydef where ydef NE 0 ydef string ydef endif ydef strtrim ydef 0 2 ydef strsplit ydef extract jpj long ydef 1 case strupcase ydef 2 of LINEAR :yaxis float ydef 3 findgen jpj float ydef 4 LEVELS :yaxis float ydef 3:n_elements ydef 1 GAUST62 :BEGIN print Not yet coded stop END GAUSR15 :BEGIN print Not yet coded stop END GAUSR20 :BEGIN print Not yet coded stop END GAUSR30 :BEGIN print Not yet coded stop END GAUSR40 :BEGIN print Not yet coded stop END ELSE:BEGIN print Not yet coded stop END endcase find the z axis spawn sed n e d e Zz Dd Ee Ff Tt Dd Ee Ff p filename zdef if zdef 0 EQ then BEGIN print Bad definition of zdef or tdef stop ENDIF zdef zdef 0:n_elements zdef 2 if n_elements zdef NE 1 then begin zdef byte zdef replicate byte 1 n_elements zdef zdef zdef where zdef NE 0 zdef string zdef endif zdef strtrim zdef 0 2 zdef strsplit zdef extract jpk long zdef 1 case strupcase zdef 2 of LINEAR :zaxis float zdef 3 findgen jpk float zdef 4 LEVELS :zaxis float zdef 3:n_elements zdef 1 ENDCASE compute the grid computegrid xaxis xaxis yaxis yaxis zaxis zaxis _EXTRA ex domdef find the time axis spawn grep i TDEF filename timedef timedef strupcase strtrim timedef 2 timedef strsplit timedef 0 extract jpt long timedef 1 initial date: y0 m0 d0 h0 mn0 julian day of IDL: julady m0 d0 y0 h0 mn0 00 t0 timedef 3 monthsname string format C CMOA 31 indgen 12 case 1 OF h h :mmZd d mmmyy yy strpos t0 : NE 1:BEGIN pp strpos t0 : h0 long strmid t0 0 pp mn0 long strmid t0 pp 1 2 pp strpos t0 Z dd byte strmid t0 pp 2 1 LT byte A d0 long strmid t0 pp 1 1 dd m0 where monthsname EQ strmid t0 pp 2 dd 3 0 1 y0 long strmid t0 pp 5 dd END m m Zd d mmmyy yy strpos t0 Z NE 1:BEGIN h0 0 12 pp strpos t0 Z mn0 long strmid t0 0 pp dd byte strmid t0 pp 2 1 LT byte A d0 long strmid t0 pp 1 1 dd m0 where monthsname EQ strmid t0 pp 2 dd 3 0 1 y0 long strmid t0 pp 5 dd END d d mmmyy yy byte strmid t0 0 1 LT byte A 0 :BEGIN h0 0 12 mn0 0 dd byte strmid t0 1 1 LT byte A d0 long strmid t0 0 1 dd m0 where monthsname EQ strmid t0 1 dd 3 0 1 y0 long strmid t0 4 dd END mmmyy yy ELSE:BEGIN h0 0 12 mn0 0 d0 1 m0 where monthsname EQ strmid t0 0 3 0 1 y0 long strmid t0 3 END ENDCASE if y0 is a two digit integer between 1950 and 2049 case 1 of y0 LE 49:y0 2000 y0 y0 LE 99:y0 1900 y0 ELSE: ENDCASE increment date and definition of the calendar with IDL julian days tstep timedef 4 tsval long strmid tstep 0 strlen tstep 2 case strlowcase strmid tstep 1 reverse of mn :time julday m0 d0 y0 h0 mn0 lindgen jpt tsval 0 hr :time julday m0 d0 y0 h0 lindgen jpt tsval mn0 0 dy :time julday m0 d0 lindgen jpt tsval y0 h0 mn0 0 mo :time julday m0 lindgen jpt tsval d0 y0 h0 mn0 0 yr :time julday m0 d0 y0 lindgen jpt tsval h0 mn0 0 ENDCASE shit the calendar to correspond to the time step case strlowcase strmid tstep 1 reverse of dy :time long time mo :time long time 14L yr :time long time 365L 2 ELSE: endcase OPTIONS spawn grep i OPTIONS filename options options strtrim options 2 options strlowcase options 0 key_yreverse strpos options yrev NE 1 key_zreverse strpos options zrev EQ 1 multifiles strpos options template NE 1 f77sequential strpos options sequential NE 1 swapbytes strpos options byteswapped NE 1 bigendian strpos options big_endian NE 1 littleendian strpos options little_endian NE 1 cray strpos options cray_32bit_ieee NE 1 IF cray THEN BEGIN print cray_32bit_ieee Not yet coded stop ENDIF cal365 strpos options 365_day_calendar NE 1 IF cal365 THEN BEGIN print 365_day_calenda Not yet coded stop ENDIF building the filesname spawn grep i DSET filename files files strtrim files 0 2 files strsplit files extract if n_elements files NE 2 then begin print Bad definition of the filename There shoud be 2 elements: print DEST and 1 filename that may define many files stop endif files files 1 files strmid files 0 strpos files 0 reverse_search 1 filesname files if keyword_set multifiles then begin minutes if stregex files i n2 0 NE 1 then begin filetsep mn mnend long mn0 jpt 1 tmp strarr hend h0 1 for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i n2 extract regex string mn0 i format i2 2 filesname strjoin tmp endif hours if stregex files i hf 123 0 NE 1 then begin filetsep hr case strlowcase strmid tstep 1 reverse of mn :hend long h0 jpt mn0 1 1 60 hr :hend long h0 jpt 1 endcase tmp strarr hend h0 1 case 1 of stregex files i h1 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i h1 extract regex strtrim h0 i 1 stregex files i h2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i h2 extract regex string h0 i format i2 2 stregex files f2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname f2 extract regex string h0 i format i3 2 stregex files i hf 3 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i hf 3 extract regex string h0 i format i3 3 endcase filesname strjoin tmp endif days if stregex files i d 12 0 NE 1 then begin filetsep dy case strlowcase strmid tstep 1 reverse of mn :dend long d0 jpt mn0 1 1 1440 hr :dend long d0 jpt h0 1 1 24 dy :dend long d0 jpt 1 endcase tmp strarr dend d0 1 case 1 of stregex files i d1 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i d1 extract regex strtrim d0 i 1 stregex files i d2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i d2 extract regex string d0 i format i2 2 endcase filesname strjoin tmp endif months if stregex files i m 12c 0 NE 1 then begin filetsep mo tmp strarr 12 case 1 of stregex files i m1 NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i m1 extract regex strtrim i 1 stregex files i m2 NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i m2 extract regex string i format i2 2 stregex files i mc NE 1:for i 1 12 do tmp i 1 strjoin strsplit filesname i mc extract regex monthsname i 1 endcase filesname strjoin tmp endif years if stregex files i y 24 0 NE 1 then begin case strlowcase strmid tstep 1 reverse of dy :yend long y0 jpt d0 1 1 365 mo :yend long y0 jpt m0 1 1 12 yr :yend long y0 jpt 1 ELSE:yend y0 endcase tmp strarr yend y0 1 case 1 of stregex files i y2 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i y2 extract regex string y0 i 100 y0 i 100 format i2 2 stregex files i y4 NE 1:for i 0 n_elements tmp 1 do tmp i strjoin strsplit filesname i y 4 extract regex string y0 i format i4 4 endcase filesname strjoin tmp endif filesname strsplit filesname extract time step unit of each file: case 1 of stregex files i n2 0 NE 1:filetsep mn stregex files i hf 123 0 NE 1:filetsep hr stregex files i d 12 0 NE 1:filetsep dy stregex files i m 12c 0 NE 1: filetsep mo stregex files i y 24 0 NE 1:filetsep yr ENDCASE number of time steps for each files case strlowcase strmid tstep 1 reverse of mn :BEGIN case filetsep of yr :jpt1file 60L 24L 365L mo :jpt1file 60L 24L 30L dy :jpt1file 60L 24L hr :jpt1file 60L mn :jpt1file 1L endcase END hr :BEGIN case filetsep of yr :jpt1file 24L 365L mo :jpt1file 24L 30L dy :jpt1file 24L hr :jpt1file 1L endcase END dy :BEGIN case filetsep of yr :jpt1file 365L mo :jpt1file 30L dy :jpt1file 1L endcase END mo :BEGIN case filetsep of yr :jpt1file 12L mo :jpt1file 1L endcase END yr :jpt1file 1L endcase number of files nof ceil jpt 1 jpt1file filesname filesname 0:nof 1 ENDIF ELSE BEGIN nof 1 jpt1file jpt ENDELSE first character if stregex files GE 0 THEN BEGIN iodir strmid filename 0 strpos filename reverse_search 1 for i 0 nof 1 do filesname i iodir strmid filesname i 1 ENDIF extracting the variables spawn grep i VARS filename nvars nvars strtrim nvars 2 nvars strsplit nvars 0 extract nvars long nvars 1 spawn sed n e d e Vv Aa Rr Ss Ee Nn Dd Vv Aa Rr Ss p filename varlist if n_elements varlist LE 2 then begin print No lines between vars and endvars stop endif varlist varlist 1:n_elements varlist 2 if n_elements varlist NE nvars then begin print Number of variables indicated by VARS strtrim nvars 1 differs from number of lines without at the beginning located between VARS and ENDVARS: strtrim n_elements varlist 1 stop ENDIF varsname strarr nvars varsdes strarr nvars varslev lonarr nvars for i 0 nvars 1 do BEGIN varlist i strtrim varlist i 2 tmp strsplit varlist i extract if strmid tmp 2 0 2 EQ 1 then BEGIN case long strmid tmp 2 3 2 of 10:BEGIN print Special data formats units 1 10 Not yet coded stop END 20:BEGIN print Special data formats units 1 20 Not yet coded stop END 30:BEGIN print Special data formats units 1 30 Not yet coded stop END 40:BEGIN case long strmid tmp 2 6 of 1:varfmt byte 2:varfmt uint 2:varfmt int 4:varfmt long ELSE:BEGIN print Bad definition of the special data formats: print long strmid tmp 2 6 should be equal to 1 2 2 or 4 stop END endcase END ELSE:BEGIN print Special data formats units 1 Not yet coded stop END endcase endif varsname i tmp 0 varsdes i strjoin tmp 3:n_elements tmp 1 varslev i long tmp 1 ENDFOR varslev 1 varslev ccmeshparameters filename filename ccmeshparameters filename Grads IF keyword_set key_performance EQ 1 THEN print time scanctl systime 1 time1 return end "); 96 a[94] = new Array("./ReadWrite/scanoasis.html", "scanoasis.pro", "", " NAME:scanoasis PURPOSE:scan an Oasis file version scanoasis grids_orca_t106 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 PRO scanoasis filename openr unit filename F77_UNFORMATTED GET_LUN SWAP_IF_LITTLE_ENDIAN error err if err ne 0 then begin print err_string return endif char8 12345678 WHILE NOT EOF unit DO BEGIN readu unit char8 print char8 readu unit ENDWHILE free_lun unit return end"); 97 a[95] = new Array("./ReadWrite/write_oasis.html", "write_oasis.pro", "", " NAME:write_oasis PURPOSE:write an Oasis file version 2 5 CATEGORY: CALLING SEQUENCE:write_oasis filename varname z2d INPUTS: filename:the filename varname: the name of the variable to be written z2d: the variable 2D array to be written KEYWORD PARAMETERS: I2 I4 I8 R4: to change the defaut format R8 of the data to be written APPEND: to open the file with the file pointer at the end of the file ready for data to be appended OUTPUTS: COMMON BLOCKS: SIDE EFFECTS:varname is automatically written as a charactere 8 by defaut z2d is written as an R8 array RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr July 01 2002 PRO write_oasis filename varname z2d I2 I4 i4 I8 i8 R4 r4 APPEND append openw unit filename F77_UNFORMATTED GET_LUN SWAP_IF_LITTLE_ENDIAN error err APPEND append if err ne 0 then begin print err_string return endif writeu unit string varname format a8 case 1 of keyword_set i2 :writeu unit fix z2d keyword_set i4 :writeu unit long z2d keyword_set i8 :writeu unit long64 z2d keyword_set r4 :writeu unit float z2d ELSE:writeu unit double z2d endcase free_lun unit return end"); 98 a[96] = new Array("./ReadWrite/writebat.html", "writebat.pro", "", " NAME: writebat PURPOSE: write the bathymetry ASCII file of OPA CATEGORY: for OPA CALLING SEQUENCE: writebat bat filename INPUTS: bat: the bathymetry a 2d array filename: a string containing the filename KEYWORD PARAMETERS: OUTPUTS:no COMMON BLOCKS:no SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr Sept 30 2003 based on batsav2 pro written by Maurice Imbard March 17 1998 PRO writebat zbat filename basic checks IF n_params NE 2 THEN BEGIN print bad number of aguments in the call of writebat return ENDIF IF size filename type NE 7 THEN BEGIN print the filename should be a string return ENDIF sbat size zbat IF sbat 0 NE 2 THEN BEGIN print bathymetry array should be 2d array return ENDIF jpi2 sbat 1 jpj2 sbat 2 parameters def ifreq 40 ifin jpi2 ifreq 1 irest jpi2 ifin 1 ifreq zbati intarr ifreq zbati2 intarr irest i0 intarr ifreq 5 i1 intarr max 1 irest 5 openw iunit filename get_lun fill the file printf iunit FORMAT 1x bathy IDL 2i8 jpi2 jpj2 printf iunit FORMAT il1 0 FOR jn 1 ifin 1 DO BEGIN printf iunit FORMAT il2 min jpi2 1 il1 ifreq 1 i0 0 il1 1 FOR jj 1 ifreq 5 1 DO BEGIN i0 jj i0 jj 1 5 END printf iunit FORMAT 3x 13 i3 12x i0 printf iunit FORMAT il3 il2 jn 1 ifreq iformat string il3 2 i3 FOR jj jpj2 1 0 1 DO BEGIN zbati 0:il3 zbat il1:il2 jj printf iunit FORMAT iformat jj 1 zbati END il1 il1 ifreq END printf iunit FORMAT il2 min jpi2 1 il1 ifreq 1 i1 0 il1 1 FOR jj 1 irest 5 1 DO BEGIN i1 jj i1 jj 1 5 END printf iunit FORMAT 3x 13 i3 12x i1 printf iunit FORMAT il3 il2 ifin 1 ifreq iformat string il3 2 i3 FOR jj jpj2 1 0 1 DO BEGIN zbati2 0:irest 1 0 zbati2 0:il3 zbat il1:il2 jj printf iunit FORMAT iformat jj 1 zbati2 END end close iunit free_lun iunit return end"); 99 a[97] = new Array("./Tests/TestsOld/tst_basic_old.html", "tst_basic_old.pro", "", "PRO tst_basic_old figure 1: basics plots 1 plot n 10 y findgen n basic plot splot y petit 2 2 1 portrait improved plot by using plot and graphic keywords splot y petit 2 2 2 noerase yrange 0 n 1 2 title x and x 2 oplot y 2 color 100 linestyle 2 thick 3 2 contour z dist n basic plot scontour z fill nlevels 15 petit 2 2 3 noerase improved plot by using contour and graphic keywords ind findgen 2 n 2 n scontour z levels n ind c_orientation 180 ind c_spacing 2 ind petit 2 2 4 noerase contour z overplot c_label rebin 1 0 2 n levels n ind c_charthick 2 c_charsize 1 5 c_colors 250 ind return end"); 100 a[98] = new Array("./Tests/TestsOld/tst_initlev_index_old.html", "tst_initlev_index_old.pro", "", ""); 101 a[99] = new Array("./Tests/TestsOld/tst_initlev_index_stride_old.html", "tst_initlev_index_stride_old.pro", "", ""); 102 a[100] = new Array("./Tests/TestsOld/tst_initlev_old.html", "tst_initlev_old.pro", "", ""); 103 a[101] = new Array("./Tests/TestsOld/tst_initlev_stride_old.html", "tst_initlev_stride_old.pro", "", ""); 104 a[102] = new Array("./Tests/TestsOld/tst_initorca05_index_old.html", "tst_initorca05_index_old.pro", "", ""); 105 a[103] = new Array("./Tests/TestsOld/tst_initorca05_index_stride_old.html", "tst_initorca05_index_stride_old.pro", "", ""); 106 a[104] = new Array("./Tests/TestsOld/tst_initorca05_old.html", "tst_initorca05_old.pro", "", ""); 107 a[105] = new Array("./Tests/TestsOld/tst_initorca05_short_old.html", "tst_initorca05_short_old.pro", "", ""); 108 a[106] = new Array("./Tests/TestsOld/tst_initorca05_short_stride_old.html", "tst_initorca05_short_stride_old.pro", "", ""); 109 a[107] = new Array("./Tests/TestsOld/tst_initorca05_stride_old.html", "tst_initorca05_stride_old.pro", "", ""); 110 a[108] = new Array("./Tests/TestsOld/tst_initorca2_index_old.html", "tst_initorca2_index_old.pro", "", ""); 111 a[109] = new Array("./Tests/TestsOld/tst_initorca2_index_stride_old.html", "tst_initorca2_index_stride_old.pro", "", ""); 112 a[110] = new Array("./Tests/TestsOld/tst_initorca2_old.html", "tst_initorca2_old.pro", "", ""); 113 a[111] = new Array("./Tests/TestsOld/tst_initorca2_short_old.html", "tst_initorca2_short_old.pro", "", ""); 114 a[112] = new Array("./Tests/TestsOld/tst_initorca2_short_stride_old.html", "tst_initorca2_short_stride_old.pro", "", ""); 115 a[113] = new Array("./Tests/TestsOld/tst_initorca2_stride_old.html", "tst_initorca2_stride_old.pro", "", ""); 116 a[114] = new Array("./Tests/TestsOld/tst_plt_old.html", "tst_plt_old.pro", "", "PRO tst_plt IMAGE image commons common figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 domdef domdef gdept 0 gdept 0 grille T temp read_ncdf votemper 00101 00131 file file plt temp landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 5 nocontour format i3 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 color_c if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 nocouleur c_thick 1 cont_thick 2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp cell_fill 1 jpi EQ 180 we must use cell_fill 2 for ORCA2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 zoom IF key_onearth THEN box 40 375 20 20 ELSE box jpi 4 3 jpi 4 jpj 4 3 jpj 4 plt temp boite box landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 projections IF key_onearth THEN BEGIN plt temp boite 20 380 60 90 stereo map 90 0 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp boite 20 380 90 50 ortho map 90 180 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp ortho map 0 0 21 portrait carte if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 ENDIF deep plot domdef 150 150 warning message domdef gdept jpk 2 gdept jpk 2 grille T temp read_ncdf votemper 00101 00131 file file plt temp carte 2 key_onearth land if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 117 a[115] = new Array("./Tests/TestsOld/tst_pltt_old.html", "tst_pltt_old.pro", "", "PRO tst_pltt IMAGE image commons common common figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 1 1 xt plot IF key_onearth THEN domdef 20 380 1 1 0 gdept 0 ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 gdept 0 temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab help jpt time pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocontour if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp color_c if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocouleur if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 equatorial plot IF key_onearth THEN BEGIN a abs gphit 0 yind where a EQ min a domdef 20 380 yind 0 yind n_elements yind 1 gdept 10 jpk 1 gdept 10 jpk 1 grille T yindex ENDIF ELSE BEGIN domdef min glamt max glamf jpj 2 jpj 2 gdept 10 jpk 1 gdept 10 jpk 1 grille T yindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 gdept 0 gdept 0 grille T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif gdept 0 gdept 0 grille T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 118 a[116] = new Array("./Tests/TestsOld/tst_pltz_old.html", "tst_pltz_old.pro", "", "PRO tst_pltz IMAGE image commons common IF jpk EQ 1 THEN return dummy cnt 1 CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return IF key_onearth THEN domdef 20 380 1 1 0 max gdept ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 max gdept temp read_ncdf votemper 00101 00131 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltz temp portrait if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocontour if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait color_c if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocouleur if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 ysurx 2 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boite 6000 zoom 1000 ysurx 2 hzsurht 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 0 max gdept grille T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif 0 max gdept grille T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file pltz temp boite 6000 zoom 1000 ysurx 2 hzsurht 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 oblique sections IF key_onearth THEN endpoints 110 45 290 45 ELSE endpoints jpi 6 jpj 3 5 jpi 6 2 jpj 3 domdef endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 false oblique sections IF key_onearth THEN endpoints 180 70 180 90 ELSE endpoints jpi 2 0 25 0 25 jpi 2 0 25 jpj domdef 6000 endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boite 6000 zoom 1000 ysurx 2 hzsurht 5 showbuild if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 comparison between real section and false oblique sections IF where gphit EQ 0 0 NE 1 THEN BEGIN IF key_onearth THEN box 20 380 0 0 0 6000 ELSE box 0 jpi 1 jpj 2 jpj 2 0 6000 domdef box grille T temp read_ncdf votemper 00101 00131 file file pltz temp boite 6000 portrait petit 1 2 1 zoom 500 hzsurht 5 IF key_onearth THEN endpoints 20 0 380 0 ELSE endpoints 0 jpj 2 jpi 1 jpj 2 domdef 6000 endpoints endpoints type pltz grille T temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boite 6000 zoom 500 hzsurht 5 petit 1 2 2 noerase if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png cnt cnt 1 ENDIF return end"); 119 a[117] = new Array("./Tests/tst_basic.html", "tst_basic.pro", "", "PRO tst_basic figure 1: basics plots 1 plot n 10 y findgen n basic plot splot y small 2 2 1 portrait improved plot by using plot and graphic keywords splot y small 2 2 2 noerase yrange 0 n 1 2 title x and x 2 oplot y 2 color 100 linestyle 2 thick 3 2 contour z dist n basic plot scontour z fill nlevels 15 small 2 2 3 noerase improved plot by using contour and graphic keywords ind findgen 2 n 2 n scontour z levels n ind c_orientation 180 ind c_spacing 2 ind small 2 2 4 noerase contour z overplot c_label rebin 1 0 2 n levels n ind c_charthick 2 c_charsize 1 5 c_colors 250 ind return end"); 120 a[118] = new Array("./Tests/tst_initlev.html", "tst_initlev.pro", "", ""); 121 a[119] = new Array("./Tests/tst_initlev_index.html", "tst_initlev_index.pro", "", ""); 122 a[120] = new Array("./Tests/tst_initlev_index_stride.html", "tst_initlev_index_stride.pro", "", ""); 123 a[121] = new Array("./Tests/tst_initlev_stride.html", "tst_initlev_stride.pro", "", ""); 124 a[122] = new Array("./Tests/tst_initorca05.html", "tst_initorca05.pro", "", ""); 125 a[123] = new Array("./Tests/tst_initorca05_index.html", "tst_initorca05_index.pro", "", ""); 126 a[124] = new Array("./Tests/tst_initorca05_index_stride.html", "tst_initorca05_index_stride.pro", "", ""); 127 a[125] = new Array("./Tests/tst_initorca05_short.html", "tst_initorca05_short.pro", "", ""); 128 a[126] = new Array("./Tests/tst_initorca05_short_stride.html", "tst_initorca05_short_stride.pro", "", ""); 129 a[127] = new Array("./Tests/tst_initorca05_stride.html", "tst_initorca05_stride.pro", "", ""); 130 a[128] = new Array("./Tests/tst_initorca2.html", "tst_initorca2.pro", "", ""); 131 a[129] = new Array("./Tests/tst_initorca2_index.html", "tst_initorca2_index.pro", "", ""); 132 a[130] = new Array("./Tests/tst_initorca2_index_stride.html", "tst_initorca2_index_stride.pro", "", ""); 133 a[131] = new Array("./Tests/tst_initorca2_short.html", "tst_initorca2_short.pro", "", ""); 134 a[132] = new Array("./Tests/tst_initorca2_short_stride.html", "tst_initorca2_short_stride.pro", "", ""); 135 a[133] = new Array("./Tests/tst_initorca2_stride.html", "tst_initorca2_stride.pro", "", ""); 136 a[134] = new Array("./Tests/tst_plt.html", "tst_plt.pro", "", "PRO tst_plt IMAGE image commons cm_4mesh figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 domdef domdef gdept 0 gdept 0 gridtype T temp read_ncdf votemper 00101 00131 file file plt temp landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 5 nocontour format i3 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 color_c if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp 2 31 int 1 nofill c_thick 1 coast_thick 2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp cell_fill 1 jpi EQ 180 we must use cell_fill 2 for ORCA2 if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 zoom IF key_onearth THEN box 40 375 20 20 ELSE box jpi 4 3 jpi 4 jpj 4 3 jpj 4 plt temp boxzoom box landscape if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 projections IF key_onearth THEN BEGIN plt temp boxzoom 20 380 60 90 stereo map 90 0 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp boxzoom 20 380 90 50 ortho map 90 180 0 portrait if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 plt temp ortho map 0 0 21 portrait realcont if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 ENDIF deep plot domdef 150 150 warning message domdef gdept jpk 2 gdept jpk 2 gridtype T temp read_ncdf votemper 00101 00131 file file plt temp realcont 2 key_onearth land if keyword_set image then saveimage tst_plt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 137 a[135] = new Array("./Tests/tst_pltt.html", "tst_pltt.pro", "", "PRO tst_pltt IMAGE image commons cm_4mesh cm_4cal figure 2: regular grid CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return dummy cnt 1 1 1 xt plot IF key_onearth THEN domdef 20 380 1 1 0 gdept 0 ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 gdept 0 temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab help jpt time pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nocontour if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp color_c if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltt temp nofill if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 equatorial plot IF key_onearth THEN BEGIN a abs gphit 0 yind where a EQ min a domdef 20 380 yind 0 yind n_elements yind 1 gdept 10 jpk 1 gdept 10 jpk 1 gridtype T yindex ENDIF ELSE BEGIN domdef min glamt max glamf jpj 2 jpj 2 gdept 10 jpk 1 gdept 10 jpk 1 gridtype T yindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 gdept 0 gdept 0 gridtype T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif gdept 0 gdept 0 gridtype T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltt temp if keyword_set image then saveimage tst_pltt_ image _ string cnt format i2 2 png png cnt cnt 1 return end"); 138 a[136] = new Array("./Tests/tst_pltz.html", "tst_pltz.pro", "", "PRO tst_pltz IMAGE image commons cm_4mesh IF jpk EQ 1 THEN return dummy cnt 1 CASE jpi key_stride 0 jpj key_stride 1 OF 180 148:file Levitus98_1m_01_12_Temperature_Pot_ORCA2 nc 360 180:file Levitus98_1m_01_12_Temperature_Pot_1x1 nc 720 510:file Levitus98_1m_01_12_Temperature_Pot_ORCA05 nc ENDCASE file isafile file title Where is file lookalldir IF size file type NE 7 THEN return IF key_onearth THEN domdef 20 380 1 1 0 max gdept ELSE domdef min glamt max glamf jpj 2 1 jpj 2 1 0 max gdept temp read_ncdf votemper 00101 00131 file file IF key_forgetold THEN help temp arr ELSE help temp tab pltz temp portrait if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nocontour if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait color_c if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp portrait nofill if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 yxaspect 2 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 pltz temp boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 yt plot along the column that contain the largest latitude IF key_onearth THEN BEGIN ind where gphit EQ max gphit ind ind 0 MOD jpi domdef ind ind 90 90 0 max gdept gridtype T xindex ENDIF ELSE BEGIN domdef jpi 2 jpi 2 min gphit max gphif 0 max gdept gridtype T xindex ENDELSE temp read_ncdf votemper 00101 01231 file file pltz temp boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 oblique sections IF key_onearth THEN endpoints 110 45 290 45 ELSE endpoints jpi 6 jpj 3 5 jpi 6 2 jpj 3 domdef endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 false oblique sections IF key_onearth THEN endpoints 180 70 180 90 ELSE endpoints jpi 2 0 25 0 25 jpi 2 0 25 jpj domdef 6000 endpoints endpoints type pltz temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boxzoom 6000 zoom 1000 yxaspect 2 zratio 5 showbuild if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png ELSE read dummy prompt press return for the next plot cnt cnt 1 comparison between real section and false oblique sections IF where gphit EQ 0 0 NE 1 THEN BEGIN IF key_onearth THEN box 20 380 0 0 0 6000 ELSE box 0 jpi 1 jpj 2 jpj 2 0 6000 domdef box gridtype T temp read_ncdf votemper 00101 00131 file file pltz temp boxzoom 6000 portrait small 1 2 1 zoom 500 zratio 5 IF key_onearth THEN endpoints 20 0 380 0 ELSE endpoints 0 jpj 2 jpi 1 jpj 2 domdef 6000 endpoints endpoints type pltz gridtype T temp read_ncdf votemper 00101 00131 file file pltz temp endpoints endpoints boxzoom 6000 zoom 500 zratio 5 small 1 2 2 noerase if keyword_set image then saveimage tst_pltz_ image _ string cnt format i2 2 png png cnt cnt 1 ENDIF return end"); 139 a[137] = new Array("./Textoidl/matchdelim.html", "matchdelim.pro", "", " NAME: MATCHDELIM PURPOSE: Match open close delimiters in a string CATEGORY: text strings CALLING SEQUENCE: position matchdelim strn openpos INPUTS: strn a string containing an open in delimiter e g in which you want to find the matching closing delimiter e g KEYWORD PARAMETERS: OPEN_DELIM A single character containing the opening in delimiter e g Default is CLOSE_DELIM A single character containing the closing in delimiter e g Default is OUTPUTS: position returns the position in strn of the out closing delimiter 1 if no closing found openpos Set to a named variable to receive the out position of the first opening delimiter Optional COMMON BLOCKS: SIDE EFFECTS: NOTES: Any pair of nonidentical characters can be used as delimiters EXAMPLE: matchdelim one two three returns 9 the character just before three MODIFICATION HISTORY: Id: matchdelim pro 47 2006 05 09 09:13:01Z pinsard Log: matchdelim pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Removed restriction that open delim must be first char Added argument to allow for return of position of open delim Revision 1 1 1996 01 31 18:41:06 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Matchdelim InString OpenPos OPEN_DELIM OpenDelim CLOSE_DELIM CloseDelim HELP Help Return to caller if error On_error 2 IF n_params LT 1 OR keyword_set Help THEN BEGIN offset print offset Match open close delimiters in a string print offset position matchdelim strn openpos print offset Inputs: print offset offset strn a string containing an open in print offset offset delimiter e g in which you print offset offset want to find the matching closing print offset offset delimiter e g print offset Keywords: print offset offset OPEN_DELIM A single character containing the opening in print offset offset delimiter e g Default is print offset offset CLOSE_DELIM A single character containing the closing in print offset offset delimiter e g Default is print offset Outputs: print offset offset position returns the position in strn of the out print offset offset closing delimiter 1 if no closing found print offset offset openpos Set to a named variable to receive the out print offset offset position of the first opening delimiter print offset offset Optional print offset Example: print offset offset matchdelim a one two three returns 10 the character just print offset offset before three print offset offset a matchdelim aaa bbb ccc ddd eee f OP CL print offset offset returns a 12 just before ddd f 3 just before bbb return 1 ENDIF Set default delimiters IF n_elements OpenDelim EQ 0 THEN OpenDelim IF n_elements CloseDelim EQ 0 THEN CloseDelim Make sure InString has more than 1 character length strlen InString IF length LE 1 THEN return 1 Return if no open delimiter OpenPos strpos InString OpenDelim IF OpenPos EQ 1 THEN BEGIN print Error: No opening delimiter return 1 ENDIF Convert strings to array of integers to speed processing OpenDelim fix byte OpenDelim 0 CloseDelim fix byte CloseDelim 0 TmpStr fix byte strmid InString OpenPos length Leave the 1 in here This forces conversion from BYTE to INTEGER necessary because there are no negative BYTEs TmpStr TmpStr EQ OpenDelim 1 TmpStr EQ CloseDelim length n_elements TmpStr Initialize count of number of delimiters We ve found one the first opener BraceCnt 1 i 0 WHILE BraceCnt GT 0 AND i LT length 1 DO BEGIN i i 1 BraceCnt BraceCnt TmpStr i ENDWHILE i i OpenPos IF BraceCnt GT 0 THEN i 1 return i END "); 140 a[138] = new Array("./Textoidl/nexttok.html", "nexttok.pro", "", " NAME: NEXTTOK PURPOSE: Find the next occurance of any of a set of characters in a string and return the character which occurs next CATEGORY: text strings CALLING SEQUENCE: tok nexttok strn tokens INPUTS: strn string to be searched for sub superscripts in tokens string containing characters to be found in KEYWORD PARAMETERS: POSITION Set to a named variable to get position out of next token or 1 if none found HELP Print useful message and exit OUTPUTS: tok Contains the character among tokens which out occurs next in strn or null if none found COMMON BLOCKS: SIDE EFFECTS: NOTES: EXAMPLE: nexttok x 2 N_j 3 _ position pos returns and sets pos to 1 MODIFICATION HISTORY: Id: nexttok pro 47 2006 05 09 09:13:01Z pinsard Log: nexttok pro v Revision 1 4 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Generalized so that the next occurence of any of a set of characters will be returned Revision 1 1 1996 01 31 18:41:06 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION nexttok strn tokens POSITION position HELP Help Return to caller on error On_error 2 Help those in need of it IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Find the next occurance of any of a set of characters in a print offset string and return the character which occurs next CALLING SEQUENCE: print offset tok nexttok strn tokens INPUTS: print offset Inputs: print offset offset strn string to be searched for sub superscripts in print offset offset tokens string containing characters to be found in KEYWORD PARAMETERS: print offset Keywords: print offset offset POSITION Set to a named variable to get position out print offset offset of next token or 1 if none found print offset offset HELP Print useful message and exit OUTPUTS: print offset Outputs: print offset offset tok Contains the character among tokens which out print offset offset occurs next in strn or null if none found EXAMPLE: print offset Example: print offset offset nexttok x 2 N_j 3 _ position pos returns and sets print offset offset pos to 1 return ENDIF TmpStr byte strn TmpTok byte tokens NumToks n_elements TmpTok MatchIdx 0L Matches 0L FOR j 0 NumToks 1 DO BEGIN TmpMatch where TmpStr EQ TmpTok j TmpCnt IF TmpCnt GT 0 THEN BEGIN MatchIdx MatchIdx Replicate j TmpCnt Matches Matches TmpMatch ENDIF ENDFOR IF n_elements MatchIdx EQ 1 THEN BEGIN Position 1 return ENDIF MatchIdx MatchIdx 1: Matches Matches 1: SortInd sort Matches Position Matches SortInd 0 Tok string TmpTok MatchIdx SortInd 0 return Tok END "); 141 a[139] = new Array("./Textoidl/showtex.html", "showtex.pro", "", " NAME: SHOWTEX PURPOSE: Display TeX sequence translation table on current graphics device CATEGORY: text strings CALLING SEQUENCE: showtex INPUTS: KEYWORD PARAMETERS: HELP print out info on use of the function and exit FONT Set to 0 to use hardware font 1 to use vector Note that the only hardware font supported is Postscript OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: Plot is created NOTES: Hardware fonts are supported only for device PS PostScript EXAMPLE: MODIFICATION HISTORY: Id: showtex pro 47 2006 05 09 09:13:01Z pinsard Log: showtex pro v Revision 1 4 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added error handling and updated built in help Revision 1 1 1996 02 08 18:55:12 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details PRO Showtex FONT fnt HELP help Return to caller on error On_error 2 Print help if needed IF keyword_set help THEN BEGIN print Display TeX sequence translation table on current graphics device print showtex print Keywords: print HELP print this message and return print FONT set to 0 to use hardware fonts for current device print 1 to use vector fonts DEFAULT print NOTES: The only hardware font supported is PostScript print The FONT keyword overrides the font selected in p font return ENDIF We begin by deciding on the font PostScript 0 means use vector PostScript 0 PlotTitle Vector Fonts IF n_elements fnt EQ 0 THEN BEGIN get font from p font IF P font NE 1 THEN BEGIN User wants hardware font PostScript 1 PlotTitle PostScript Fonts ENDIF ENDIF ELSE BEGIN get font from FONT keyword IF fnt NE 1 THEN BEGIN PostScript 1 PlotTitle PostScript Fonts ENDIF ENDELSE Bomb out if user wants hardware font for non PostScript device IF PostScript EQ 1 AND strupcase D name NE PS THEN BEGIN Device isn t postscript and user wants hardware font Not good print Warning: No translation for device: D name return ENDIF Set P font to value indicated by FONT keyword saving surrent setting to reset at end OldPFont p font p font PostScript 1 erase seq textoidl tex DisplayString seq textoidl seq nseq n_elements seq nrows nseq 5 1 Five sequences per row dx 9 5 dy 9 nrows y 95 xyouts 5 y PlotTitle align 5 norm size 2 5 count 0 FOR i 1L nrows DO BEGIN y y dy x 1 FOR j 1 5 DO BEGIN IF count LT nseq THEN xyouts x y DisplayString count align 5 norm count count 1 x x dx ENDFOR ENDFOR Restore old P font p font OldPFont END"); 142 a[140] = new Array("./Textoidl/str_token.html", "str_token.pro", "", " NAME: STR_TOKEN PURPOSE: Retrieve portion of string up to token CATEGORY: text strings CALLING SEQUENCE: new str_token old token INPUTS: old String to be split Contains text after in out token on output token Token to use in splitting old in KEYWORD PARAMETERS: TRIM set to remove leading blanks from old before returning HELP print useful message and exit OUTPUTS: new portion of string up to token out old portion of old after token out in COMMON BLOCKS: SIDE EFFECTS: Input parameter old is modified NOTES: Token may be one or more characters If token is not found returns old and sets old to EXAMPLE: If old is foo44 bar then str_token old 44 would return foo and upon return old will be left with bar If TRIM were set old would be bar on return If old xyz then new str_token old a would return with new xyz and old THANKS: To D Linder who wrote GETTOK part of the goddard library upon which this is based MODIFICATION HISTORY: Id: str_token pro v 1 1 2000 06 14 19:09:22 mcraig Exp Log: str_token pro v Revision 1 1 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added built in help Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Str_token string token TRIM trim HELP Help Back to the caller if error occurs On_error 2 IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Retrieve portion of string up to token print offset new str_token old token print offset Inputs: print offset offset old String to be split Contains text after in out print offset offset token on output print offset offset token Token to use in splitting old in print offset Keywords: print offset offset TRIM set to remove leading blanks from old print offset offset before returning print offset offset HELP print useful message and exit print offset Outputs: print offset offset new portion of string up to token out print offset offset old portion of old after token out in print offset Side effects: print offset offset Input parameter old is modified print offset Notes: print offset offset Token may be one or more characters print offset offset If token is not found returns old and sets old to print offset Examples: print offset offset If old is foo44 bar then str_token old 44 would return print offset offset foo and upon return old will be left with bar If TRIM print offset offset were set old would be bar on return print offset offset If old xyz then new str_token old a would return with print offset offset new xyz and old return 1 ENDIF pos strpos string token IF pos GE 0 THEN BEGIN front strmid string 0 pos string strmid string pos strlen token strlen string IF keyword_set trim THEN string strtrim string 1 return front ENDIF front string string return front END "); 143 a[141] = new Array("./Textoidl/strcnt.html", "strcnt.pro", "", " NAME: STRCNT PURPOSE: Count number of occurrences of a substring in a string CATEGORY: text strings CALLING SEQUENCE: num strcnt strn substring pos INPUTS: string The string in which to count occurences in substring The substring to count occurrences of in pos the position at which to begin the search in If not supplied start at beginning of string KEYWORD PARAMETERS: HELP Print useful message and return OUTPUTS: num Number of occurances of substring in string out COMMON BLOCKS: SIDE EFFECTS: NOTES: Overlapping occurances are not counted separately For example counting occurances of bb in blah bbb returns one occurance EXAMPLE: MODIFICATION HISTORY: Id: strcnt pro v 1 3 1996 06 14 20:00:27 mcraig Exp Log: strcnt pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added fast processing using BYTE arrays if we are counting occurences of a single character Added error handling Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strcnt strn substrn startpos HELP Help Return to caller if error On_error 2 Help user if needed IF n_params LT 2 OR keyword_set Help THEN BEGIN offset print offset Count number of occurrences of a substring in a string print offset num strcnt strn substring pos print offset Inputs: print offset offset string The string in which to count occurences in print offset offset substring The substring to count occurrences of in print offset offset pos the position at which to begin the search in print offset offset If not supplied start at beginning of print offset offset string print offset Keywords: print offset offset HELP Print useful message and return print offset Outputs: print offset offset num Number of occurances of substring in string out return 1 ENDIF IF n_params EQ 2 THEN startpos 0 return if we weren t really given a substring to search for IF strlen substrn EQ 0 THEN BEGIN print Error: Can t count occurances of null string return 1 ENDIF or if we were told to start at the end of the string tmpstrn strmid strn startpos strlen strn IF strlen tmpstrn EQ 0 THEN return 0 If looking for occurences of single character process using BYTE array IF strlen substrn EQ 1 THEN BEGIN tmpstrn byte TmpStrn count n_elements where TmpStrn EQ byte substrn 0 ENDIF ELSE BEGIN count 0L pos rstrpos tmpstrn substrn WHILE pos GE 0 DO BEGIN count count 1 pos rstrpos tmpstrn substrn pos ENDWHILE ENDELSE return count END "); 144 a[142] = new Array("./Textoidl/strtrans.html", "strtrans.pro", "", " NAME: STRTRANS PURPOSE: Translate all occurences of one substring to another CATEGORY: text strings CALLING SEQUENCE: new strtrans oldstr from to ned INPUTS: oldstr string on which to operate in May be an array from substrings to be translated May be in an array to what strings in from should be in translated to May be an array KEYWORD PARAMETERS: HELP Set this to print useful message and exit OUTPUTS: new Translated string Array if oldstr is out an array ned number of substitutions performed in out oldstr Array if oldstr is an array COMMON BLOCKS: SIDE EFFECTS: NOTES: Any of old from and to can be arrays from and to must have the same number of elements EXAMPLE: inp Many bad chars in_here from _ to out strtrans inp from to ned Will produce out Many bad chars in here and set ned to 4 MODIFICATION HISTORY: Id: strtrans pro v 1 7 2004 06 15 17:25:54 mcraig Exp Log: strtrans pro v Revision 1 7 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 6 2004 01 11 01:49:00 mcraig Changed format of one array to newer style to avoidf conflict with function name in astro library Revision 1 5 2001 11 23 21:14:35 mcraig Added keywords EXTRACT PRESERVE_NULL REGEX to call to strsplit This comes very close to reproducing the behavior of the obsolete routine str_sep Revision 1 4 2001 11 21 19:13:23 mcraig Changed str_sep to strsplit The former is now considered obsolete by RSI Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Sped up significantly by using str_sep to handle the translation No longer relies on routines fromother user libraries Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION strtrans InputString from to ned HELP Help Bomb out to caller if error On_error 2 Offer help if we don t have at least InputString from and to or if the user asks for it IF n_params LT 3 OR keyword_set help THEN BEGIN offset print offset Translate all occurences of one substring to another print offset new strtrans oldstr from to ned print offset Inputs: print offset offset oldstr string on which to operate in print offset offset May be an array print offset offset from substrings to be translated May be in print offset offset an array print offset offset to what strings in from should be in print offset offset translated to May be an array print offset Outputs: print offset offset new Translated string Array if oldstr is out print offset offset an array print offset offset ned number of substitutions performed in out print offset offset oldstr Array if oldstr is an array print offset Notes: print offset offset Any of old from and to can be arrays print offset offset from and to must have the same number of elements return 1 ENDIF strn InputString Check that From To have same number of elements RETURN if they don t NFrom n_elements from NTo n_elements to IF NFrom EQ 0 OR NTo EQ 0 THEN return strn IF NFrom NE NTo THEN BEGIN print Error: Number of elements in from to unequal return 1 ENDIF Make sure there are no null strings in From RETURN if there are FromLen strlen From IF total FromLen EQ 0 GT 0 THEN BEGIN print Error: elements of From must have nonzero length return 1 ENDIF NStrings n_elements strn ned lonarr NStrings tmpned 0L Say strn a b c from and to Then the approach here is to first split strn at all occurances of then recombine the pieces with inserted instead Do this for all elements of strn and all elements of from FOR i 0L NStrings 1 DO BEGIN ned i 0L FOR j 0L NFrom 1 DO BEGIN SepStr strsplit strn i from j EXTRACT REGEX PRESERVE_NULL NSubs n_elements SepStr 1 strn i SepStr 0 FOR k 1L NSubs DO strn i strn i To j SepStr k ned i ned i NSubs ENDFOR ENDFOR return strn END "); 145 a[143] = new Array("./Textoidl/sub_sup_idl.html", "sub_sup_idl.pro", "", " NAME: SUB_SUP_IDL PURPOSE: Return the proper IDL font positioning command for TeX sub superscripts CATEGORY: CALLING SEQUENCE: fnt sub_sup_idl strn INPUTS: strn Either or _ the TeX super subscript in characters KEYWORD PARAMETERS: FORCE_UD Set this to use U D instead of E I for sub superscripts OUTPUTS: fnt Either U or E for superscripts out or D or I for subscripts COMMON BLOCKS: SIDE EFFECTS: NOTES: EXAMPLE: LIBRARY FUNCTIONS CALLED: MODIFICATION HISTORY: Id: sub_sup_idl pro v 1 1 1996 01 31 18:47:37 mcraig Exp Log: sub_sup_idl pro v Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 FUNCTION Sub_sup_idl token FORCE_UD force_ud IF keyword_set force_ud THEN BEGIN IF token EQ THEN return U IF token EQ _ THEN return D return ENDIF ELSE BEGIN IF token EQ THEN return E IF token EQ _ THEN return I return ENDELSE END "); 146 a[144] = new Array("./Textoidl/textable.html", "textable.pro", "", " NAME: TEXTABLE PURPOSE: Returns a translation table from TeX to IDL CATEGORY: text strings CALLING SEQUENCE: table textable INPUTS: None KEYWORD PARAMETERS: POSTSCRIPT If set return postscript translation table rather than vector fonts table Default is translations for vector fonts HELP Print help and exit OUTPUTS: table a 2D text array table 0 contains out the words to be translated away table 1 contains the words to translate them to COMMON BLOCKS: SIDE EFFECTS: NOTES: To find out what TeX sequences are available look at table 0 EXAMPLE: MODIFICATION HISTORY: Id: textable pro 47 2006 05 09 09:13:01Z pinsard Log: textable pro v Revision 1 8 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 7 1996 07 22 23:56:08 mcraig Added vartheta Revision 1 6 1996 07 12 21:31:42 mcraig Fixed varphi in vector font added circ Revision 1 5 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 4 1996 05 09 00:22:17 mcraig Added command to return to previous font after switching to Greek or symbol font Revision 1 3 1996 02 08 19:49:35 mcraig Removed control sequence perp because the postscript code for it is Revision 1 2 1996 02 08 18:53:38 mcraig Added translations for PostScript fonts and added several new TeX control sequences Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION textable POSTSCRIPT ps VECTOR vec HELP Help Return to caller if error On_error 2 Print help if necessary IF keyword_set Help THEN BEGIN offset print offset Returns a translation table from TeX to IDL print offset table textable print offset Keywords: print offset offset POSTSCRIPT If set return postscript translation print offset offset table rather than vector fonts table print offset offset Default is translations for vector print offset offset fonts print offset offset HELP Print help and exit print offset Outputs: print offset offset table a 2D text array table 0 contains out print offset offset the words to be translated away table 1 print offset offset contains the words to translate them to print offset Notes: print offset offset To find out what TeX sequences are available look at print offset offset table 0 ENDIF VECFONT 1 index of vector font in translation table PSFONT 2 index of postscript font in trans table IF keyword_set ps THEN FontSelection PSFONT ELSE FontSelection VECFONT Set IDL font sequence needed to switch to Greek letters GreekFont strarr 3 GreekFont VECFONT 7 GreekFont PSFONT M Set IDL font sequence needed to switch to special symbol font SymbolFont strarr 3 SymbolFont VECFONT M SymbolFont PSFONT M Set IDL font sequence needed to switch back to initial font PreviousFont strarr 3 PreviousFont VECFONT X PreviousFont PSFONT X lowercase Greek Note there is some trickery involved in getting varphi to work in the vector fonts because it is actually a member of the symbol font set not the Greek font set Go figure Solution is just to make the vector character a switch to symbol the proper character from that font and a switch back out of symbol Same comment holds for vartheta TeX SEQUENCE VECTOR POSTSCRIPT LowercaseGreek alpha a a beta b b gamma c g delta d d epsilon e e zeta f z eta g h theta h q iota i i kappa j k lambda k l mu l m nu m n xi n S Rx pi p p rho q r sigma r s tau s t upsilon t u phi u f chi v c psi w y omega x w varpi p v varepsilon e e varphi SymbolFont VECFONT P PreviousFont VECFONT j vartheta SymbolFont VECFONT t PreviousFont VECFONT J Uppercase Greek TeX SEQUENCE VECTOR POSTSCRIPT UppercaseGreek Gamma C G Delta D D Theta H Q Lambda K L Xi N S RX Pi P P Sigma R S Upsilon T string byte 161 Phi U F Psi W Y Omega X W Special symbols NOTES You must leave infty before in in the translatation table to avoid having the in part of infty translated away DO NOT blindly add the control sequence perp Its PostScript code is which leads to thing being interpreted as superscripts which shouldn t be TeX SEQUENCE VECTOR POSTSCRIPT Symbols aleph string byte 192 ast cap 3 string byte 199 cdot string byte 215 cup 1 string byte 200 exists E infty string byte 165 in e string byte 206 equiv : string byte 186 pm string byte 177 div string byte 184 subset 0 string byte 204 superset 2 string byte 201 leftarrow 4 string byte 172 downarrow 5 string byte 175 rightarrow 6 string byte 174 uparrow 7 string byte 173 neq string byte 185 propto string byte 181 sim A string byte 126 partial D string byte 182 nabla G string byte 209 angle a string byte 208 times X string byte 180 geq b string byte 179 leq l string byte 163 string byte 162 prime string byte 162 circ string byte 176 LowercaseGreek 1 GreekFont FontSelection LowercaseGreek FontSelection PreviousFont FontSelection UppercaseGreek 1 GreekFont FontSelection UppercaseGreek FontSelection PreviousFont FontSelection Symbols 1 SymbolFont FontSelection Symbols FontSelection PreviousFont FontSelection TranslationTable LowercaseGreek UppercaseGreek Symbols return TranslationTable 0:1 END "); 147 a[145] = new Array("./Textoidl/textoidl.html", "textoidl.pro", "", " NAME: TEXTOIDL PURPOSE: Convert a valid TeX string to a valid IDL string for plot labels CATEGORY: text strings CALLING SEQUENCE: new textoidl old INPUTS: old TeX string to be converted Will not be in modified old may be a string array KEYWORD PARAMETERS: FONT Set to 0 to use hardware font 1 to use vector Note that the only hardware font supported is PostScript TEX_SEQUENCES return the available TeX sequences HELP print out info on use of the function and exit OUTPUTS: new IDL string corresponding to old out COMMON BLOCKS: SIDE EFFECTS: NOTES: Use the procedure SHOWTEX to get a list of the available TeX control sequences The only hardware font for which translation is available is PostScript The only device for which hardware font translation is available is PostScript The FONT keyword overrides the font selected by p font EXAMPLE: out TeXtoIDL Gamma 2 5N_ ed The string out may be used in XYOUTS or other IDL text display routines It will be an uppercase Gamma with an exponent of 2 then a plus sign then an N with the subscript ed MODIFICATION HISTORY: Id: textoidl pro 47 2006 05 09 09:13:01Z pinsard Log: textoidl pro v Revision 1 7 2004 06 15 17:25:54 mcraig Fixed bug in regular expression changed array notation to square brackets Revision 1 6 2004 01 11 01:49:00 mcraig Changed format of one array to newer style to avoidf conflict with function name in astro library Revision 1 5 2001 11 23 21:10:55 mcraig Added backslash to tex sequences in translation table to protect them during regexp search in strsplit Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Added error handling cleaned up documentation Revision 1 2 1996 02 08 18:52:50 mcraig Added ability to use hardware fonts for PostScript device Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Textoidl InputString FONT fnt HELP hlp TEX_SEQUENCES tex_seq Return to caller if there is an error On_error 2 We begin by deciding on the font PostScript 0 means use vector PostScript 0 IF n_elements fnt EQ 0 THEN BEGIN get font from p font IF p font NE 1 THEN BEGIN User wants hardware font PostScript 1 ENDIF ENDIF ELSE BEGIN get font from FONT keyword IF fnt NE 1 THEN PostScript 1 ENDELSE Bomb out if user wants non PostScript hardware font IF PostScript EQ 1 AND d name NE PS THEN BEGIN Device isn t postscript and user wants hardware font Not good print Warning: No translation for device: d name return InputString ENDIF IF keyword_set tex_seq THEN BEGIN table textable return table 0 ENDIF IF keyword_set hlp OR n_params EQ 0 THEN BEGIN print Convert a TeX string to an IDL string print new TeXtoIDL old print old TeX string to translate in print new resulting IDL string out print Keywords: print FONT set to 1 to translate for vector fonts print DEFAULT Set to 0 to translate for print hardware font print TEX_SEQUENCES return the available TeX sequences print HELP print this message and exit print NOTES: print Use SHOWTEX to obtain a list of the available print TeX control sequences print old may be a string array If so new is too print The only device for which hardware font print translation is available is PostScript print The FONT keyword overrides the font selected print by p font return 1 ENDIF PostScript has been set to 1 if PostScript fonts are desired strn InputString table textable POSTSCRIPT PostScript Greek sub superscripts need to be protected by putting braces around them if they are unbraced This will have the result the it will be difficult to use as a sub superscript Get over it V2 11 Must include the in from of translation table TeX sequences to ensure that strsplit properly treats the in the TeX sequence Since strsplit is doing a regexp replace and is special in regexps need to escape it strn strtrans strn table 0 table 0 strn strtrans strn _ table 0 _ table 0 First we translate Greek letters and the like This makes guessing alignment of sub superscripts easier as all special characters will then be one character long V2 11 Must include the in from of translation table TeX sequences to ensure that strsplit properly treats the in the TeX sequence Since strsplit is doing a regexp replace and is special in regexps need to escape it strn strtrans strn table 0 table 1 FOR i 0L n_elements strn 1 DO BEGIN strn i translate_sub_super strn i Take care of sub superscripts ENDFOR return strn END "); 148 a[146] = new Array("./Textoidl/translate_sub_super.html", "translate_sub_super.pro", "", " NOTE to future maintainers: Make sure sub_sup_idl stays before translate_sub_super At least for now when IDL encounters a function and automatically compiles it it only compiles the functions in the file up to the named function So even if sub_sup_idl was declared with FORWARD_FUNCTION in translate_sub_super it would not properly compile SPECIAL NOTE: The file translate_sub_super pro contains two functions translate_sub_super and sub_sup_idl The former is the generic routine for processing TeX sub superscripts the latter is used only by translate_sub_super and has no general utility Hence it lives here You will see documentation for translate_sub_super second if you use DOC_LIBRARY NAME: SUB_SUP_IDL PURPOSE: Return the proper IDL font positioning command for TeX sub superscripts CATEGORY: TeXtoIDL CALLING SEQUENCE: fnt sub_sup_idl strn INPUTS: strn Either or _ the TeX super subscript in characters KEYWORD PARAMETERS: FORCE_UD Set this to use U D instead of E I for sub superscripts HELP Set to print useful message and exit OUTPUTS: fnt Either U or E for superscripts out or D or I for subscripts COMMON BLOCKS: SIDE EFFECTS: NOTES: Used only by translate_sub_super Should be kept in same file EXAMPLE: MODIFICATION HISTORY: Id: translate_sub_super pro 47 2006 05 09 09:13:01Z pinsard Log: translate_sub_super pro v Revision 1 5 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Changed some function calls to reflect changes in those functions moved some code out of the main loop that didn t need to be there added documentation Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Sub_sup_idl token FORCE_UD force_ud provide help if needed IF n_params NE 1 OR keyword_set Help THEN BEGIN offset print offset Return the proper IDL font positioning command for TeX print offset sub superscripts print offset fnt sub_sup_idl strn print offset Inputs: print offset offset strn Either or _ the TeX super subscript in print offset offset characters print offset Keywords: print offset offset FORCE_UD Set this to use U D instead of E I for print offset offset sub superscripts print offset offset HELP Set to print useful message and exit print offset Outputs: print offset offset fnt Either U or E for superscripts out print offset offset or D or I for subscripts return 1 ENDIF IF keyword_set force_ud THEN BEGIN IF token EQ THEN return U IF token EQ _ THEN return D return ENDIF ELSE BEGIN IF token EQ THEN return E IF token EQ _ THEN return I return ENDELSE END NAME: TRANSLATE_SUB_SUPER PURPOSE: Translate TeX sub superscripts to IDL sub superscripts CATEGORY: text strings CALLING SEQUENCE: new translate_sub_super old INPUTS: old string to be translated from TeX to IDL in KEYWORD PARAMETERS: RECURSED set if this function is being called recursively HELP Set to print useful message and exit OUTPUTS: new string old converted from TeX to IDL out COMMON BLOCKS: SIDE EFFECTS: NOTES: For best results when both a sub and superscript are used place the shorter of the two first e g N a _ bbbb is better than N_ bbbb a Single character sub super scripts do not need to be protected by braces Sub superscripts may be nested e g N N_1 N EXAMPLE: out translate_sub_super N 2_ big Then out N U2 N Dbig N which looks like it should on the display LIBRARY FUNCTIONS CALLED: str_token Text string mcraig sub_sup_idl contained in this file MODIFICATION HISTORY: Id: translate_sub_super pro 47 2006 05 09 09:13:01Z pinsard Log: translate_sub_super pro v Revision 1 5 2000 06 14 19:09:22 mcraig Changed name of strtok str_token to avoid conflict in IDL 5 3 Revision 1 4 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 3 1996 05 09 00:22:17 mcraig Changed some function calls to reflect changes in those functions moved some code out of the main loop that didn t need to be there added documentation Revision 1 2 1996 02 08 18:54:20 mcraig Changed default sub superscript size to be D U rather than I E to improve readability of plat annotations Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_2_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Translate_sub_super InputString RECURSED recursed HELP Help Return to caller if error On_error 2 Offer help if needed and or desired IF n_params NE 1 OR keyword_set help THEN BEGIN offset print offset Translate TeX sub superscripts to IDL sub superscripts print offset new translate_sub_super old print offset Inputs: print offset offset old string to be translated from TeX to IDL in print offset Keywords: print offset offset RECURSED set if this function is being called print offset offset recursively print offset offset HELP Set to print useful message and exit print offset Outputs: print offset offset new string old converted from TeX to IDL out print offset Notes: print offset offset For best results when both a sub and superscript are used print offset offset place the shorter of the two first e g N a _ bbbb is print offset offset better than N_ bbbb a print offset offset Single character sub super scripts do not need to be print offset offset protected by braces print offset offset Sub superscripts may be nested e g N N_1 N return 1 ENDIF To allow for nested scripts use E I instead of U D for scripts when called recursively IF NOT keyword_set recursed THEN ud 1 ELSE ud 0 Return to the normal level after making sub superscript unless we are recursed which indicates we are processing a nested script IF keyword_set recursed THEN fontRestore ELSE fontRestore N Initialize vars for processing scripts SpcByte byte 0 We need the BYTE value for a space below strn InputString pos 0 StorePos RecallPos OldToken LenLastScript 0 Grab next sub superscript Token will be either or _ RETURN if no scripts Token nexttok strn _ pos pos if pos EQ 1 then return InputString nothing to process FntChange sub_sup_idl Token Our approach will be to grab the input string up to the next or _ then process the script we ve found NewString str_token strn Token WHILE strlen strn GT 0 DO BEGIN Grab first char of sub superscript Script strmid strn 0 1 EndOfScript 0 Position of end of this script IF Script EQ THEN BEGIN Scripts of more than 1 char EndOfScript matchdelim strn Script translate_sub_super strmid strn 1 EndOfScript 1 recursed ENDIF Grab rest of string _after_ the end of the script strn strmid strn EndOfScript 1 strlen strn EndOfScript 1 Find the next script and prepare for processing it FntChange sub_sup_idl Token FORCE_UD ud OldToken Token Token nexttok strn _ POS pos If the input is n 2_j we want the 2 to be directly above the j rather than having the j below and to the right of the 2 In other words we want the first below not the second 2 2 N N J J To accomplish this we need to save the position at which we begin writing the 2 with a S and restore that position with a R after writing the 2 The first section in the IF block below handles the J above the thing after the first script We don t care if there is another script following We also padd the second script with spaces if it is shorter than the first to make sure that whatever comes out after the scripts starts in the proper place The worry is that without the spaces the input N looong _ s 1 will end up with the starting right the s ends IF StorePos EQ S THEN BEGIN StorePos RecallPos calculate the difference in length between this script and the previous stacked one removing font change commands crudely by guessing that the number of characters this takes is twice the number of exclamation points The 1 below is a kludge I don t know why but I need one extra space NumSpaces LenLastScript strlen script 2 strcnt Script NumSpaces NumSpaces 1 0 IF NumSpaces GT 0 THEN Script Script string replicate SpcByte NumSpaces ENDIF ELSE BEGIN IF Token NE OldToken AND pos EQ 0 THEN BEGIN The next script immediately folows this one Arrange to save the position of the current script so that both begin with the same horizontal position StorePos S RecallPos R LenLastScript strlen Script 2 strcnt Script ENDIF ENDELSE Continue building the IDL string adding on our just processed script NewString NewString StorePos FntChange Script RecallPos FontRestore IF pos NE 1 THEN BEGIN more left to process NewString NewString str_token strn Token ENDIF ELSE BEGIN we are done NewString NewString strn strn ENDELSE ENDWHILE return NewString END "); 149 a[147] = new Array("./ToBeReviewed/CALCULS/curl.html", "curl.pro", "", " NAME:curl PURPOSE:calcule la composante verticale du rotationnel d un champ de vecteur horizontaux CATEGORY:calcule sur les matrices CALLING SEQUENCE:res curl u v INPUTS: u et v deux matrices representant les coordonnes d un champ de vecteur KEYWORD PARAMETERS: OUTPUTS:res: une matrice 2d COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: les matrices u et v peuvent de 2 a 4 dimensions attention pour distinger les differents configurations de u et v xy xyz xyt xyzt on regarde la variable du common time qui contient le calendrier en jour julien d IDL auquel se rapportent u et v ansi que la variable jpt qui est le nombre de pas de temps a considerer ds time les tableaux u et v sont decoupes sur le meme domaine geographique A cause du decalage des grilles T U V et F il est possiible que ces 2 tableaux n aient pas la meme taille et se repportent a des indices differents Si tel est le cas les tableaux sont redecoupes sur les indices qu ils ont en commun et le dommaine est redefinit pour qu il colle a ces indices communs pour eviter ces redecoupes utiliser le mot cles memeindice ds domdef pro les points sur le bord du dessin sont mis a values f_nan EXAMPLE: MODIFICATION HISTORY:Guillaume Roullet grlod ipsl jussieu fr Sebastien Masson smasson lodyc jussieu fr adaptation pour marcher avec un domaine reduit 21 5 1999: valeurs manquantes a values f_nan periodicite FUNCTION curl uu vv common tempsun systime 1 pour key_performance IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of curl is based on Arakawa C grid U and V grids must therefore be defined u litchamp uu v litchamp vv date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 3 OR size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return 1 endcase calcul du rotationnel coefu e1u indice2d replicate 1 nzt coefu reform coefu nx ny nzt over coefu coefu umask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefv e2v indice2d replicate 1 nzt coefv reform coefv nx ny nzt over coefv coefv vmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan tabf fmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt div e1f indice2d e2f indice2d replicate 1 nzt div reform div nx ny nzt over tabf tabf div zu u temporary coefu zv v temporary coefv psi shift zv 1 0 0 zv zu shift zu 0 1 0 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask pour le trace graphique domdef glagmt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi moyenne psi direc nan END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:BEGIN print problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs return 1 end endcase calcul du rotationnel coefu e1u indice2d umask indice2d jpi jpj firstzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefu temporary coefu replicate 1 jpt coefu reform coefu nx ny jpt over coefv e2v indice2d vmask indice2d jpi jpj firstzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan coefv temporary coefv replicate 1 jpt coefv reform coefv nx ny jpt over tabf fmask indice2d jpi jpj firstzt e1f indice2d e2f indice2d tabf temporary tabf replicate 1 jpt tabf reform tabf nx ny jpt over calcul du rotationnel zu u temporary coefu zv v temporary coefv psi shift zv 1 0 0 zv zu shift zu 0 1 0 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi grossemoyenne psi direc nan END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN return report non code END xy ELSE:BEGIN xy indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return 1 endcase calcul du rotationnel coefu e1u indice2d umask indice2d jpi jpj firstzt terreu where coefu EQ 0 if terreu 0 NE 1 then coefu temporary terreu values f_nan coefv e2v indice2d vmask indice2d jpi jpj firstzt terrev where coefv EQ 0 if terrev 0 NE 1 then coefv temporary terrev values f_nan tabf fmask indice2d jpi jpj firstzt e1f indice2d e2f indice2d zu u temporary coefu zv v temporary coefv psi shift zv 1 0 zv zu shift zu 0 1 psi tabf psi mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin psi 0 values f_nan psi nx 1 values f_nan endif psi 0 values f_nan psi ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 terref where tabf EQ 0 if terref 0 NE 1 then psi temporary terref valmask pour le trace graphique domdef glamt indice2d 0 0 glamf indice2d nx 1 0 gphit indice2d 0 0 gphif indice2d 0 ny 1 vert1 vert2 gridtype t f if keyword_set direc then psi moyenne psi direc nan END endcase if keyword_set key_performance THEN print temps curl systime 1 tempsun vargrid F varname vorticity return psi end"); 150 a[148] = new Array("./ToBeReviewed/CALCULS/depth2floatlevel.html", "depth2floatlevel.pro", "", " NAME:depth2floatlevel PURPOSE: assez comparable a depth2level mais ici le niveau calcule est en float Par ex le niveau 5 4 correspond a une profondeur egale a gdep 5 4 gdep 6 gdep 5 CATEGORY: SANS BOUCLE CALLING SEQUENCE:res depth2floatlevel depth2d INPUTS: depth2d tableau 2d de profondeur ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d de float contenant les valeurs des niveaux COMMON BLOCKS:common pro SIDE EFFECTS:accepte les vcaleurs a values f_nan et masque les points terres a valmask RESTRICTIONS: EXAMPLE: IDL a jpk 1 1 jpi jpj findgen jpi jpj IDL plt 1e6 a floatlevel2depth depth2floatlevel a nocontour champ nul a 1e 6 pres MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 06 2000 FUNCTION depth2floatlevel tab NOMASK nomask tempsun systime 1 pour key_performance common depthin litchamp tab levelup depth2level depthin UPPER nomask depthup level2depth levelup nomask levellow depth2level depthin lower nomask depthlow level2depth levellow nomask calcule de la distance depthlow depthup et gestion du cas ou cette distance est nulle ou egale a values f_nan divi depthlow depthup nan where finite divi EQ 0 if nan 0 NE 1 then divi nan 0 nan where divi EQ 0 if nan 0 NE 1 then divi nan values f_nan calcule du resultat res levelup depthin depthup divi on masque les points terre a valmask if NOT keyword_set nomask then begin grille mask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask endif if keyword_set key_performance THEN print temps depth2floatlevel systime 1 tempsun return res end"); 151 a[149] = new Array("./ToBeReviewed/CALCULS/depth2level.html", "depth2level.pro", "", " NAME: depth2level PURPOSE: permet de passer d un tableau 2d de profondeur au tableau 2d correspondant de niveaux CATEGORY: SANS BOUCLE CALLING SEQUENCE: res depth2level depth2d INPUTS: depth2d tableau 2d de profondeur ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: UPPER: active par defaut on selectionne le niveau directement au dessus de la profondeur LOWER: on selectionne le niveau directement au dessous de la profondeur CLOSER: on selectionne le niveau le plus proche de la profondeur NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant les valeurs des niveaux COMMON BLOCKS:common pro SIDE EFFECTS:pour les profondeurs hors des valeurs de gdep la valeur values f_nan est retournee Si la profondeur est superieur a celle du fond on retourne jpk 1dans le cas upper et values f_nan ds le cas lower RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 15 6 2000 accepte values f_nan FUNCTION depth2level tab LOWER lower UPPER upper CLOSER closer NOMASK nomask _extra ex tempsun systime 1 pour key_performance common upper 1 if keyword_set lower THEN upper 0 lecture du champ d entree et recuperation de la taille du sous domaine utilise in litchamp tab grille mask 1 1 gdep nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef IF ny EQ 1 THEN in reform in nx ny over taille size in if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:in in firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase vire les points a values f_nan notanumber where finite in nan EQ 1 if notanumber 0 NE 1 then in notanumber 0 on transforme le tableau 2d de profondeur en tableau 2d de niveaux correspondant aux profondeurs on passe en tableaux qui ont la taille des tableaux 3d prof replicate 1 nx ny gdep firstz:lastz in in replicate 1 nz mask01 prof LT in mask01 reform mask01 nx ny nz levels total mask01 3 notvalid where levels EQ nz if keyword_set upper then begin levels levels 1 notvalid where levels EQ 1 ENDIF ELSE notvalid where levels EQ nz IF notvalid 0 NE 1 THEN levels notvalid values f_nan si closer est active if keyword_set closer then begin test litchamp tab level2depth levels level2depth levels 1 jpk 1 litchamp tab test test 0 test 1 changer where test GE 0 if changer 0 NE 1 then levels changer levels changer 1 jpk 1 endif on replace les points a values f_nan if notanumber 0 NE 1 then levels notanumber values f_nan on masque les points terres a valmask if NOT keyword_set nomask then begin if n_elements valmask EQ 0 then valmask 1e20 terre where mask 0 EQ 0 if terre 0 NE 1 then levels terre valmask endif if keyword_set key_performance THEN print temps depth2level systime 1 tempsun return levels end"); 152 a[150] = new Array("./ToBeReviewed/CALCULS/depth2mask.html", "depth2mask.pro", "", " NAME: depth2mask PURPOSE: permet de passer d un tableau 2d de profondeur seuil au tableau 3d de mask avec des 1 ds les niveaux au dessus de la profondeur seuil et des 0 en dessous CATEGORY: SANS BOUCLE CALLING SEQUENCE: res depth2mask depht2d INPUTS: depht2d tableau 2d de profondeur seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: UPPER: active par defaut on selectionne le niveau directement au dessus de la profondeur LOWER: on selectionne le niveau directement au dessous de la profondeur CLOSER: on selectionne le niveau le plus proche de la profondeur OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de profondeurs seuil COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 FUNCTION depth2mask tab _extra ex tempsun systime 1 pour key_performance common on transforme le tableau 2d de profondeur en tableau 2d de niveaux correspondant aux profondeurs niveaux depth2level tab _extra ex IF niveaux 0 EQ 1 THEN return 1 on transforme le tableau 2d de niveaux en tableau 3d de mask mask level2mask niveaux if keyword_set key_performance NE 0 THEN print temps depth2mask systime 1 tempsun return mask end"); 153 a[151] = new Array("./ToBeReviewed/CALCULS/determ2.html", "determ2.pro", "", " NAME:determ2 PURPOSE: computes the determinant of n 2 by 2 arrays CATEGORY: no DO loops and better accuracy CALLING SEQUENCE: 2 cases: res determ2 z2ds res determ2 z1d00 z1d01 z1d10 z1d11 INPUTS: z2ds: an 2 2 n array or z1d00 z1d01 z1d10 z1d11: the four n elements arrays defined as: z2ds 0 0 z1d00 z2ds 0 1 z1d01 z2ds 1 0 z1d10 z2ds 1 1 z1d11 OUTPUTS: n elements array the determinent of each 2 2 arrrays EXAMPLE: a findgen 2 2 5 print determ2 a FOR i 0 4 DO print determ a i IDL solution MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 11th 2002 FUNCTION determ2 a b c d CASE n_params OF 1:res a 0 0 a 1 1 a 0 1 a 1 0 4:res a d c b ELSE:stop ENDCASE RETURN res END"); 154 a[152] = new Array("./ToBeReviewed/CALCULS/determ3.html", "determ3.pro", "", " NAME:determ3 PURPOSE: computes the determinant of n 3 by 3 arrays CATEGORY: no DO loops and better accuracy CALLING SEQUENCE:2 cases: res determ2 z2ds res determ2 in00 in01 in02 in10 in11 in12 in20 in21 in22 INPUTS: z2ds: an 3 3 n array or in00 in01 in02 in10 in11 in12 in20 in21 in22: the nine n elements arrays defined as: in00 z2ds 0 0 in01 z2ds 0 1 in02 z2ds 0 2 in10 z2ds 1 0 in11 z2ds 1 1 in12 z2ds 1 2 in20 z2ds 2 0 in21 z2ds 2 1 in22 z2ds 2 2 OUTPUTS: n elements array the determinent of each 3 3 arrrays EXAMPLE: a findgen 3 3 5 print determ3 a 2 FOR i 0 4 DO print determ a i 2 IDL solution MODIFICATION HISTORY: S Masson smasson lodyc jussieu fr July 11th 2002 FUNCTION determ3 in00 in01 in02 in10 in11 in12 in20 in21 in22 IF n_params EQ 1 THEN BEGIN in00save temporary in00 in00 in00save 0 0 in01 in00save 0 1 in02 in00save 0 2 in10 in00save 1 0 in11 in00save 1 1 in12 in00save 1 2 in20 in00save 2 0 in21 in00save 2 1 in22 in00save 2 2 ENDIF a01 determ2 in10 in20 in12 in22 a11 determ2 in00 in20 in02 in22 a21 determ2 in00 in10 in02 in12 res in01 a01 in11 a11 in21 a21 IF n_params EQ 1 THEN in00 temporary in00save RETURN res END"); 155 a[153] = new Array("./ToBeReviewed/CALCULS/div.html", "div.pro", "", " NAME:div PURPOSE:calcule la divergence d un champ 2D CATEGORY:calcule sur les matrices CALLING SEQUENCE:res div u v INPUTS: u et v deux matrices representant les coordonnes d un champ de vecteur KEYWORD PARAMETERS: OUTPUTS:res: une matrice 2d COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: les matrices u et v peuvent de 2 a 4 dimensions attention pour distinger les differents configurations de u et v xy xyz xyt xyzt on regarde la variable du common time qui contient le calendrier en jour julien d IDL auquel se rapportent u et v ansi que la variable jpt qui est le nombre de pas de temps a considerer ds time les tableaux u et v sont decoupes sur le meme domaine geographique A cause du decalage des grilles T U V et F il est possiible que ces 2 tableaux n aient pas la meme taille et se repportent a des indices differents Si tel est le cas les tableaux sont redecoupes sur les indices qu ils ont en commun et le dommaine est redefinit pour qu il colle a ces indices communs pour eviter ces redecoupes utiliser le mot cles memeindice ds domdef pro les points sur le bord du dessin sont mis a values f_nan EXAMPLE: MODIFICATION HISTORY:Guillaume Roullet grlod ipsl jussieu fr Creation : printemps 1998 Sebastien Masson smasson lodyc jussieu fr adaptation pour marcher avec un domaine reduit 12 1 2000 FUNCTION div uu vv tempsun systime 1 pour key_performance common IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of div is based on Arakawa C grid U and V grids must therefore be defined u litchamp uu v litchamp vv date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN extraction de u et v sur le domaine qui convient case 1 of size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:BEGIN zdiv 1 GOTO sortie end endcase calcul de la divergence zu e2u indice2d replicate 1 nzt zu reform zu nx ny nzt over zu temporary u temporary zu umask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zv e1v indice2d replicate 1 nzt zv reform zv nx ny nzt over zv temporary v temporary zv vmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zdiv 1e6 e1t indice2d e2t indice2d zdiv zdiv replicate 1 nzt zdiv reform zdiv nx ny nzt over zdiv temporary zdiv zu shift zu 1 0 0 zv shift zv 0 1 0 tmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan zdiv temporary zdiv if n_elements valmask EQ 0 THEN valmask 1e20 terre where tmask indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt EQ 0 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv moyenne zdiv direc nan END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 3 OR size v 0 NE 3: return 1 size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return 1 endcase calcul de la divergence zu e2u indice2d umask indice2d jpi jpj firstzt terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zu zu replicate 1 jpt zu reform zu nx ny jpt over zu temporary u temporary zu zv e1v indice2d vmask indice2d jpi jpj firstzt terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zv zv replicate 1 jpt zv reform zv nx ny jpt over zv temporary v temporary zv zdiv 1e6 tmask indice2d jpi jpj firstzt e1t indice2d e2t indice2d zdiv zdiv replicate 1 jpt zdiv reform zdiv nx ny jpt over terre where zdiv EQ 0 zdiv temporary zdiv zu shift zu 1 0 0 zv shift zv 0 1 0 mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan if n_elements valmask EQ 0 THEN valmask 1e20 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv grossemoyenne zdiv direc nan END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN return report non code END xy ELSE:BEGIN xy indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: BEGIN zdiv 1 GOTO sortie end size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case 1 of nxu NE nx:if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx nxv NE nx:if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx nyu NE ny:if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny nyv NE ny:if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny ELSE : endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return 1 endcase calcul de la divergence zu temporary u e2u indice2d umask indice3d terreu where zu EQ 0 if terreu 0 NE 1 then zu temporary terreu values f_nan zv temporary v e1v indice2d vmask indice3d terrev where zv EQ 0 if terrev 0 NE 1 then zv temporary terrev values f_nan zdiv zu shift zu 1 0 zv shift zv 0 1 zdiv temporary zdiv tmask indice3d e1t indice2d e2t indice2d mise a values f_nan de la bordure if NOT keyword_set key_periodic OR nx NE jpi then begin zdiv 0 values f_nan zdiv nx 1 values f_nan endif zdiv 0 values f_nan zdiv ny 1 values f_nan zdiv temporary zdiv 1e6 if n_elements valmask EQ 0 THEN valmask 1e20 terre where tmask indice3d EQ 0 if terre 0 NE 1 then zdiv temporary terre valmask pour le trace graphique vargrid T varname div varunits 1e6 s 1 domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 gridtype t if keyword_set direc then zdiv moyenne zdiv direc nan END endcase sortie: if keyword_set key_performance THEN print temps div systime 1 tempsun return zdiv end"); 156 a[154] = new Array("./ToBeReviewed/CALCULS/floatlevel2depth.html", "floatlevel2depth.pro", "", " NAME:floatlevel2depth PURPOSE: assez comparable a level2depth C est la fonction inverse de depth2floatlevel CATEGORY:SANS BOUCLE CALLING SEQUENCE:res floatlevel2depth niveau INPUTS: tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant des profondeurs COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL a gdept jpk 1 1 jpi jpj findgen jpi jpj IDL plt 1e6 a floatlevel2depth depth2floatlevel a nocontour champ nul a 1e 6 pres MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 6 2000 FUNCTION floatlevel2depth tab NOMASK nomask tempsun systime 1 pour key_performance common flevelin litchamp tab on vire les points a values f_nan notanumber where finite flevelin nan EQ 1 if notanumber 0 NE 1 then flevelin notanumber 0 on seuil vire les points terres a valmask par ex flevelin 0 flevelin jpk 1 on calcule la profondeur depthup level2depth floor flevelin nomask depthlow level2depth ceil flevelin nomask weight flevelin floor flevelin res depthup weight depthlow depthup on replace les points a values f_nan if notanumber 0 NE 1 then res notanumber values f_nan on masque les points terres a valmask if NOT keyword_set nomask then begin grille mask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask endif if keyword_set key_performance THEN print temps floatlevel2depth systime 1 tempsun return res end"); 157 a[155] = new Array("./ToBeReviewed/CALCULS/fsfzpt.html", "fsfzpt.pro", "", " Ice freezing point fsfzpt: freezing point of seawater in degrees celsius units : salinity pfs ipss 78 pressure pfp decibars temperature fszfpt degrees celsius freezing pt reference : unesco tech papers in the marine science no 28 1978 eigth report jpots annex 6 freezing point of seawater F J Millero pp 29 35 checkvalue: fsfzpt 2 588567 deg c for s 40 0 p 500 decibars FUNCTION fsfzpt pfs pfp RETURN 0 0575 1 710523e 3 sqrt pfs 2 154996e 4 pfs pfs 7 53e 4 pfp END"); 158 a[156] = new Array("./ToBeReviewed/CALCULS/grad.html", "grad.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION grad field direc common IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of grad is based on Arakawa C grid U and V grids must therefore be defined res litchamp field taille size res grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz if n_elements valmask EQ 0 then valmask 1e20 case strupcase vargrid of T :BEGIN case direc of x :BEGIN divi e1u firstx:lastx firsty:lasty newmask umask firstx:lastx firsty:lasty firstz:lastz vargrid U domdef glamt firstx 0 glamu lastx 0 gphit 0 firsty gphiu 0 lasty gridtype T U END y :BEGIN divi e2v firstx:lastx firsty:lasty newmask vmask firstx:lastx firsty:lasty firstz:lastz vargrid V domdef glamt firstx 0 glamv lastx 0 gphit 0 firsty gphiv 0 lasty gridtype T V END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument ENDCASE END W :BEGIN case direc of x :divi e1u firstx:lastx firsty:lasty y :divi e2v firstx:lastx firsty:lasty z :BEGIN divi e3t firstz:lastz newmask mask vargrid T END ELSE:return report Bad definition of direction argument endcase END U :BEGIN case direc of x :BEGIN divi shift e1t 1 0 firstx:lastx firsty:lasty newmask tmask firstx:lastx firsty:lasty firstz:lastz vargrid T domdef glamt firstx 0 glamu lastx gphit 0 firsty gphiu 0 lasty gridtype T U END y :BEGIN divi e2f firstx:lastx firsty:lasty newmask fmask firstx:lastx firsty:lasty firstz:lastz vargrid F domdef glamu firstx 0 glamf lastx 0 gphiu 0 firsty gphif 0 lasty gridtype U F END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument endcase END V :BEGIN case direc of x :BEGIN divi e1f firstx:lastx firsty:lasty newmask fmask firstx:lastx firsty:lasty firstz:lastz vargrid F domdef glamv firstx 0 glamf lastx 0 gphiv 0 firsty gphif 0 lasty gridtype V F END y :BEGIN divi shift e2t 0 1 firstx:lastx firsty:lasty newmask tmask firstx:lastx firsty:lasty firstz:lastz vargrid T domdef glamt firstx 0 glamv lastx 0 gphit 0 firsty gphiv 0 lasty gridtype T V END z :BEGIN divi e3w firstz:lastz newmask mask vargrid W END ELSE:return report Bad definition of direction argument endcase END F :BEGIN case direc of x :divi shift e1v 1 0 firstx:lastx firsty:lasty y :divi shift e2u 0 1 firstx:lastx firsty:lasty z :divi e3w firstz:lastz ELSE:return report Bad definition of direction argument endcase END ELSE:return report Bad definition of vargrid ENDCASE res fitintobox res case 1 of xy taille 0 EQ 2:BEGIN earth where mask firstz EQ 0 if earth 0 NE 1 then res earth values f_nan case direc of x :BEGIN res shift res 1 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 END y :BEGIN res shift res 0 1 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 END ELSE:return report Bad definition of direction argument for the type of array ENDCASE earth where newmask firstz EQ 0 if earth 0 NE 1 then res earth valmask END xyt taille 0 EQ 3 AND jpt NE 1:BEGIN earth where mask firstz EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate 1 n_elements earth nx ny lindgen jpt res earth values f_nan ENDIF divi divi replicate 1 jpt case direc of x :BEGIN res shift res 1 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 END y :BEGIN res shift res 0 1 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 END ELSE:return report Bad definition of direction argument for the type of array ENDCASE earth where newmask firstz EQ 0 if earth 0 NE 1 THEN res earth valmask END xyz taille 0 EQ 3 AND jpt EQ 1:BEGIN earth where mask EQ 0 if earth 0 NE 1 then res earth values f_nan case direc OF x :BEGIN divi divi replicate 1 nz res shift res 1 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 END y :BEGIN divi divi replicate 1 nz res shift res 0 1 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 END z :BEGIN divi reform replicate 1 nx ny divi nx ny nz if nx EQ 1 OR ny EQ 1 then res reform res nx ny nz if vargrid EQ W THEN BEGIN res shift res 0 0 1 res divi res 0 values f_nan ENDIF ELSE BEGIN res res shift res 0 0 1 divi res nz 1 values f_nan ENDELSE if earth 0 NE 1 then res earth valmask END ENDCASE END xyzt taille 0 EQ 4:BEGIN earth where mask replicate 1 jpt EQ 0 if earth 0 NE 1 then res earth values f_nan case direc OF x :BEGIN divi divi replicate 1 nz jpt res shift res 1 0 0 0 res divi if key_periodic EQ 0 OR nx NE jpi THEN res nx 1 values f_nan if vargrid EQ T OR vargrid EQ V then res shift res 1 0 0 0 END y :BEGIN divi divi replicate 1 nz jpt res shift res 0 1 0 0 res divi res ny 1 values f_nan if vargrid EQ T OR vargrid EQ U then res shift res 0 1 0 0 END z :BEGIN divi replicate 1 nx ny divi divi reform divi replicate 1 jpt nx ny nz jpt over if nx EQ 1 OR ny EQ 1 then res reform res nx ny nz jpt if vargrid EQ W THEN BEGIN res shift res 0 0 1 0 res divi res 0 values f_nan ENDIF ELSE BEGIN res res shift res 0 0 1 0 divi res nz 1 values f_nan ENDELSE END ENDCASE if earth 0 NE 1 then res earth valmask END endcase varname grad of varname varunit varunit m return res end "); 159 a[157] = new Array("./ToBeReviewed/CALCULS/grossemoyenne.html", "grossemoyenne.pro", "", " NAME: grossemoyenne PURPOSE: averages a 3 or 4 d time serie field over a selected geographical area or along the time axis For one ore more selected axes x y z t CATEGORY: CALLING SEQUENCE: result grossemoyenne tab direc BOXZOOM boxzoom INPUTS: tab 3 or 4d field direc x y z t xy xz yz xyz xt yt zt xyt xzt yzt or xyzt KEYWORD PARAMETERS: boxzoom xmin xmax ymin ymax zmin zmax pour plus de detail cf domdef boxzoom peut prendre 5 formes: vert2 vert1 vert2 lon1 lon2 lat1 lat2 lon1 lon2 lat1 lat2 vert2 lon1 lon2 lat1 lat2 vert1 vert2 NAN: not a number a activer si l on peut faire veut faire une moyenne sans tenir compte de certaines valeurs masques de tab si les valeurs masques de tab sont la valeur consacree par IDL values f_nan il suffit de mettre NAN si les valeurs masques de tab on pour valeur a a doit etre differente de 1 correspond a nan values f_nan et de 0 qui desactive nan Il faut mettre NAN a Rq: en sorties les points de result qui sont NAN auront pour valeur a ou values f_nan NODOMDEF: activer si l on ne veut pas passer ds domdef bien que le mot cle boxzoom soit present comme c est le cas qd grossemoyenne est appelee via checkfield INTEGRATION: pour faire une integrale plutot qu une moyenne SPATIALFIRST when performing at the same time spatial and temporal mean grossemoyenne is assuming that the mask is not changing with the time In consequence grossemoyenne performs temporal mean first and then call moyenne Activate SPATIALFIRST if you want to perform the spatial mean before the temporal mean Note that if NAN is activated then SPATIALFIRST is activated automatically TEMPORALFIRST: to force to perform first temporal mean even if nan is activated see SPATIALFIRST explanations WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: COMMON BLOCKS: result:un tableau common domdef SIDE EFFECTS: met les valeurs correspondants a la terre a 1e20 RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 Sebastien Masson smasson lodyc jussieu fr adaptation pour les tableaux comportants une dimension temporelle 14 8 98 15 1 98 12 3 99 adaptation pour NAN et utilisation de TEMPORARY PLAN DU PROGRAMME: I preliminaires I 1 determination des directions de moyennes d apres direc I 2 verification de la taille du tableau d entree I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne II moyennes pour les tableaux 3d x y t II 1 verification de la coherence de la taille du tableau a moyenner II 2 renvoie sur moyenne qd une moyenne sur t est demandee II 3 differents types de moyennes possibles III moyennes pour les tableaux 4d x y z t III 1 verification de la coherence de la taille du tableau a moyenner III 2 differents types de moyennes possibles IV finitions IV 1 on masque les terres par une valeur a 1e 20 IV 2 on remplace quand nan ne 1 values f_nan par nan IV 3 on revient au sous domaine initial function grossemoyenne tab direc BOXZOOM boxzoom INTEGRATION integration NAN nan NODOMDEF nodomdef WDEPTH wdepth SPATIALFIRST spatialfirst TEMPORALFIRST temporalfirst _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preliminaires dirt 0 dirx 0 diry 0 dirz 0 dim aa I 1 direction s suivants lesquelles on integre if strpos direc t ge 0 then dirt 1 if strpos direc x ge 0 then dirx 1 if strpos direc y ge 0 then diry 1 if strpos direc z ge 0 then dirz 1 IF keyword_set NAN AND dirx EQ 1 OR diry EQ 1 OR dirz EQ 1 THEN spatialfirst 1 IF keyword_set temporalfirst THEN spatialfirst 0 I 2 verification de la taille du tableau d entree taille size tab case 1 of taille 0 eq 1 :return report Le tableau n a qu une dimension cas non traite taille 0 eq 2 :return report Le tableau n a qu deux dimension cas non traite taille 0 eq 3 :BEGIN dim 3d if dirx eq 0 and diry eq 0 and dirt eq 0 then return tab END taille 0 eq 4 :BEGIN dim 4d if dirx eq 0 and diry eq 0 and dirz eq 0 and dirt eq 0 then return tab END else : return report Le tableau d entree doit etre a 3 ou 4 dimensions s il ne contient pas de dim temporelle utiliser moyenne endcase I 4 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne redefinition du domaine ajuste a boxzoom a 6 elements ceci va nous permetre de faire les calcules que sur le sous domaine comcerne par la moyenne domdef suivit de grille nous donne tous les tableaux de la grille sur le sous domaine if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1: bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2: bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4: bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5: bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6: bte Boxzoom Else: return report Wrong Definition of Boxzoom endcase if NOT keyword_set nodomdef then BEGIN savedbox 1b saveboxparam boxparam4grmoyenne dat domdef bte GRIDTYPE vargrid _extra ex ENDIF ENDIF attribution du mask et des tableaux de longitude et latitude grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 WDEPTH wdepth I 3 si dirt eq 1 on fait la moyenne temporelle et on envoie ds moyenne if dirt EQ 1 AND NOT keyword_set spatialfirst then begin if dim EQ 3d then BEGIN case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpt: res tab firstx:firstx nx 1 firsty:firsty ny 1 taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpt:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny jpt strtrim nx 1 strtrim ny 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 END ENDCASE if keyword_set integration then begin res total res 3 nan nan ENDIF ELSE BEGIN if keyword_set nan then BEGIN divi finite res divi total temporary divi 3 notanum where divi EQ 0 res total res 3 nan keyword_set nan 1 divi if notanum 0 NE 1 then res temporary notanum values f_nan ENDIF ELSE res total res 3 1 taille 3 ENDELSE ENDIF ELSE BEGIN case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk and taille 4 eq jpt: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz and taille 4 eq jpt: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz and taille 4 eq jpt:res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk and taille 4 eq jpt: res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz jpt strtrim nx 1 strtrim ny 1 strtrim nz 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 strtrim taille 4 1 END endcase if keyword_set integration then begin res total res 4 nan nan ENDIF ELSE BEGIN if keyword_set nan then begin divi finite res divi total temporary divi 4 notanum where divi EQ 0 res total res 4 nan 1 divi if notanum 0 NE 1 then res temporary notanum values f_nan ENDIF ELSE res total res 4 1 taille 4 ENDELSE ENDELSE if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return moyenne temporary res direc BOXZOOM boxzoom NAN nan INTEGRATION integration NODOMDEF nodomdef WDEPTH wdepth _extra ex ENDIF ELSE res tab IF jpt EQ 1 THEN BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return moyenne reform res over direc BOXZOOM boxzoom NAN nan INTEGRATION integration NODOMDEF nodomdef WDEPTH wdepth _extra ex END II Cas serie tableaux 2d tab3d if dim eq 3d then begin II 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpt soit celle du domaine reduit nx ny jpt case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpt: res tab firstx:firstx nx 1 firsty:firsty ny 1 taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpt:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny jpt strtrim nx 1 strtrim ny 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 enD endcase if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 then BEGIN res reform res nx ny jpt over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over II 3 differents types de moyennes if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 mask mask 0 case 1 of dirx eq 1 and diry eq 0 : begin e temporary e1 temporary mask echelle temporary e replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total echelle msknan 1 ELSE divi total echelle 1 ENDELSE res total temporary res echelle 1 nan nan divi 1 if msknan 0 NE 1 then BEGIN echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 1 total temporary echelle 1 EQ 0 endif end dirx eq 0 and diry eq 1 : begin e temporary e2 temporary mask if nx EQ 1 OR ny EQ 1 then e reform e nx ny over echelle temporary e replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total echelle msknan 2 ELSE divi total echelle 2 ENDELSE res total temporary res echelle 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 2 total temporary echelle 2 EQ 0 endif end dirx eq 1 and diry eq 1 : begin echelle temporary e1 temporary e2 temporary mask replicate 1 jpt echelle reform echelle nx ny jpt over if keyword_set integration then divi 1 ELSE BEGIN IF msknan 0 NE 1 THEN divi total total echelle msknan 1 1 ELSE divi total total echelle 1 1 ENDELSE res total temporary total temporary res echelle 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 1 total total temporary echelle 1 1 EQ 0 endif end endcase endif III Cas serie tableaux 3d tab4d if dim eq 4d then begin III 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpk jpt soit celle du domaine reduit nx ny ny jpt case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk and taille 4 eq jpt: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz and taille 4 eq jpt: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz and taille 4 eq jpt:res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk and taille 4 eq jpt: res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz jpt strtrim nx 1 strtrim ny 1 strtrim nz 1 strtrim jpt 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 strtrim taille 4 1 END endcase if nx EQ 1 OR ny EQ 1 OR nz EQ 1 OR jpt EQ 1 then res reform res nx ny nz jpt over if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN res reform res nx ny nz jpt over mask reform mask nx ny nz over ENDIF IF keyword_set key_partialstep THEN BEGIN the top of the ocean floor is IF vargrid EQ T OR vargrid EQ W THEN bottom total mask 3 ELSE bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 we suppress columns with only ocean or land good where bottom NE 0 AND bottom NE nz the bottom of the ocean in 3D index is: bottom lindgen nx ny temporary bottom 1L nx ny IF good 0 NE 1 THEN bottom bottom good ELSE bottom 1 ENDIF ELSE bottom 1 III 2 differents types de moyennes IF keyword_set nan NE 0 THEN msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 and dirz eq 0 : BEGIN e13 temporary e1 replicate 1 nz e13 reform e13 nx ny nz over echelle temporary e13 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz jpt nan 1 ENDIF bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 1 ELSE divi total echelle 1 endelse res temporary res echelle res total temporary res 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 1 total temporary echelle 1 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 0 : begin e23 temporary e2 replicate 1 nz e23 reform e23 nx ny nz over echelle temporary e23 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 2 ELSE divi total echelle 2 endelse res total temporary res echelle 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 2 total temporary echelle 2 EQ 0 endif end dirx eq 0 and diry eq 0 and dirz eq 1 : begin e33 replicate 1 1 nx ny e3 e33 reform e33 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e33 bottom e3w_ps firstx:lastx firsty:lasty temporary good ELSE e33 bottom e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e33 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total echelle msknan 3 ELSE divi total echelle 3 endelse res total temporary res echelle 3 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total temporary testnan 3 total temporary echelle 3 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 0 : begin e13 e1 replicate 1 nz e13 reform e13 nx ny nz over e23 e2 replicate 1 nz e23 reform e23 nx ny nz over echelle temporary e13 temporary e23 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif bottom bottom replicate 1 jpt 4D bottom replicate 1 n_elements bottom nx ny nz lindgen jpt msknan bottom 0 res temporary bottom values f_nan ENDIF if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 1 1 ELSE divi total total echelle 1 1 endelse res total total temporary res echelle 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 1 total total temporary echelle 1 1 EQ 0 endif end dirx eq 1 and diry eq 0 and dirz eq 1 : begin e133 e1 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e133 bottom e1 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e133 bottom e1 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e133 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 1 2 ELSE divi total total echelle 1 2 endelse res total total temporary res echelle 1 nan nan 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 1 2 total total temporary echelle 1 2 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 1 : begin e233 e2 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e233 bottom e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e233 bottom e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e233 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total echelle msknan 2 2 ELSE divi total total echelle 2 2 endelse res total total temporary res echelle 2 nan nan 2 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total temporary testnan 2 2 total total temporary echelle 2 2 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 1 : begin e1233 e1 e2 e3 IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e1233 bottom e1 e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e1233 bottom e1 e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF echelle temporary e1233 temporary mask replicate 1 jpt echelle reform echelle nx ny nz jpt over if keyword_set integration then divi 1 ELSE begin IF msknan 0 NE 1 THEN divi total total total echelle msknan 1 1 1 ELSE divi total total total echelle 1 1 1 endelse res total total total temporary res echelle 1 nan nan 1 nan nan 1 nan nan divi 1 if msknan 0 NE 1 then begin echelle temporary echelle NE 0 testnan temporary msknan echelle testnan total total total temporary testnan 1 1 1 total total total temporary echelle 1 1 1 EQ 0 endif end endcase endif if dirt EQ 1 AND keyword_set spatialfirst then BEGIN IF reverse size res dimension 0 NE jpt THEN BEGIN print the last dimension of res is not equal to jpt: strtrim jpt 2 if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat return 1 ENDIF tdim size res n_dimensions if keyword_set integration then res total res tdim nan nan ELSE BEGIN if keyword_set nan then BEGIN testnan testnan divi ENDELSE ENDIF IV finitions IV 1 on masque les terres par une valeur a 1e 20 valmask 1e 20 terre where divi EQ 0 IF terre 0 NE 1 THEN BEGIN res temporary terre 1e 20 ENDIF IV 2 on remplace quand nan ne 1 values f_nan par nan if keyword_set nan NE 0 then BEGIN puttonan where temporary testnan EQ 0 if puttonan 0 NE 1 then res temporary puttonan values f_nan if nan NE 1 then BEGIN notanumber where finite res eq 0 if notanumber 0 NE 1 then res temporary notanumber nan ENDIF ENDIF IV 3 on se remplace ds le sous domaine qui etait definit a l entree de moyenne if keyword_set savedbox THEN restoreboxparam boxparam4grmoyenne dat if keyword_set key_performance THEN print temps grossemoyenne systime 1 tempsun return res end"); 160 a[158] = new Array("./ToBeReviewed/CALCULS/hdyn.html", "hdyn.pro", "", " NAME:hdyn PURPOSE:calcule la hauteur dynamique par rapport a un etat de reference pour une profondeur de reference Cf les mots cles pour les differentes possibilites Par defaut l etat de reference est rho 1020 et la profondeur de reference est gdepw ka avec ka le premier niveau W directement au dessus de 1000 m CATEGORY: calculs de post traitement CALLING SEQUENCE:res hdyn sn tn INPUTS:sn et tn sont des tableaux de meme taille representant la salinite et la temperature KEYWORD PARAMETERS: GILL: activer cette cle si on veut faire le calcul de la hauteur dynamique comme ds le GILL page 215 cad par rapport a un etat de reference qui varie en profondeur et qui est determine par une temperature de reference tref a 0 degre et une salinite de reference sref a 35psu LEVEL: C est le niveau de reference a prendre Ce niveau est definit tel que gdepw level est la profondeur de reference SREF: donner une valeur a ce mot cle pour changer la salinite de reference utiliser ds le calcul lorsque GILL est active TREF: donner une valeur a ce mot cle pour changer la temperature de reference utiliser ds le calcul lorsque GILL est active PROFREF: donner a ce mot cle une profondeur qui sera prise comme la profondeur de reference ds ce cas LEVEL n a aucun effet le calcul sera alors effectue jusqu a cette profondeur en effectuant une interpolation entre le dernier niveau W au dessus de PROFREF et PROFREF SURFACE_LEVEL: C est le niveau auquel on veut calculer la hauteur dynamique Par defaut c est le niveau 0 OUTPUTS:un tableau de la meme taille que sn et tn representant la hauteur dynamique calculee a partir d une profondeur de reference et par rapport a un etat de reference COMMON BLOCKS: common pro SIDE EFFECTS: les points pour lesquels on nje peut calcule la hauteur dynamique dont la batymetrie est moins profonde que la profondeur de reference sont mis a la valeur values f_nan RESTRICTIONS:approximation: la pression en decibars est egale a la profondeur en metres la pression augmente de 1bar tous les 10m EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr FUNCTION hdyn tabsn tabtn TREF tref SREF sref PROFREF profref LEVEL level GILL gill SURFACE_LEVEL surface_level tempsun systime 1 pour key_performance common if NOT keyword_set surface_level then surface_level 0 utile si GILL est active if NOT keyword_set tref then tref 0 if NOT keyword_set sref then sref 35 on determine si besoin est la profondeur de reference et le niveau W situe directement au dessus if keyword_set profref then begin rien where gdepw LE profref level level level 1 za gdepw level ENDIF ELSE BEGIN if NOT keyword_set level then BEGIN rien where gdepw LE 1000 level level level 1 ENDIF profref gdepw level za profref ENDELSE tailles size tabsn taillet size tabtn if total tailles 0:tailles 0 NE taillet 0:taillet 0 NE 0 then return report Les tableaux sn et tn doivent avoir la meme taille if tailles 3 NE jpk then return report La dim verticale des tableaux sn et tn doit etre egalre a jpk nx nxt ny nyt case size tabsn 0 OF 3:BEGIN case 1 of tailles 1 eq jpi and tailles 2 eq jpj: BEGIN sn tabsn firstxt:lastxt firstyt:lastyt tn tabtn firstxt:lastxt firstyt:lastyt end tailles 1 eq nx and tailles 2 eq ny:BEGIN sn tabsn tn tabtn end else:return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if keyword_set gill then rhonref rhon replicate sref nx ny jpk replicate tref nx ny jpk insitu ELSE rhonref 1020 vol rhonref rhon sn tn insitu rhonref e33d replicate 1 nx ny e3t e33d reform e33d nx ny jpk over terre where tmask firstxt:lastxt firstyt:lastyt EQ 0 if terre 0 NE 1 then vol terre values f_nan case level of 0:hdyn 100 profref gdepw 0 vol 0 1:hdyn 100 vol e33d 0 profref gdepw 1 vol 1 ELSE:hdyn 100 total vol e33d surface_level: level 1 3 profref gdepw level vol level endcase END 4:BEGIN case 1 of tailles 1 eq jpi and tailles 2 eq jpj AND tailles 4 EQ jpt: BEGIN sn tabsn firstxt:lastxt firstyt:lastyt tn tabtn firstxt:lastxt firstyt:lastyt end tailles 1 eq nx and tailles 2 eq ny AND tailles 4 EQ jpt:BEGIN sn tabsn tn tabtn end else:return report Probleme d adequation entre les tailles du domaine et de la boite endcase if keyword_set gill then rhonref rhon replicate sref nx ny jpk jpt replicate tref nx ny jpk jpt insitu ELSE rhonref 1020 vol rhonref rhon sn tn insitu rhonref e33d replicate 1 nx ny e3t e33d e33d replicate 1 jpt e33d reform e33d nx ny jpk jpt over mask tmask firstxt:lastxt firstyt:lastyt mask mask replicate 1 jpt terre where mask EQ 0 if terre 0 NE 1 then vol terre values f_nan case level of 0:hdyn 100 profref gdepw 0 vol 0 1:hdyn 100 vol e33d 0 profref gdepw 1 vol 1 ELSE:hdyn 100 total vol e33d surface_level: level 1 3 profref gdepw level vol level endcase END ELSE: return report cas non code ENDCASE varunit cm varname Dynamic Height href strtrim round profref 1 m IF keyword_set key_performance THEN print temps hdyn systime 1 tempsun return hdyn end"); 161 a[159] = new Array("./ToBeReviewed/CALCULS/level2depth.html", "level2depth.pro", "", " NAME:level2depht PURPOSE: permet de passer d un tableau 2d de niveau au tableau 2d de profondeur correspondant a ces niveaux CATEGORY: SANS BOUCLE CALLING SEQUENCE: res level2depth niveau INPUTS: niveau tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: NOMASK: pour ne pas masquer les points terres OUTPUTS: un tableau 2d contenant des profondeurs COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 14 6 2000 accepte values f_nan FUNCTION level2depth tab NOMASK nomask tempsun systime 1 pour key_performance common lecture du champ d entree et recuperation de la taille du sous domaine utilise niveaux litchamp tab grille mask 1 1 gdep nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef taille size niveaux if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:niveaux niveaux firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase wherenan where finite niveaux nan EQ 1 if wherenan 0 NE 1 then niveaux wherenan 0 niveaux 0 niveaux jpk 1 gdep replicate 1 nx ny gdep niveaux lindgen nx ny nx ny niveaux gdep reform gdep niveaux nx ny if wherenan 0 NE 1 then gdep wherenan values f_nan if NOT keyword_set nomask then begin if n_elements valmask EQ 0 then valmask 1e20 terre where mask 0 EQ 0 if terre 0 NE 1 then gdep terre valmask endif if keyword_set key_performance THEN print temps level2depth systime 1 tempsun return gdep end"); 162 a[160] = new Array("./ToBeReviewed/CALCULS/level2index.html", "level2index.pro", "", " NAME:level2index PURPOSE: on veut ds une matrice 3d extraire un tableau 2d x y dont chacun des elements a ete extrait a un niveau specifie par le tableau 2d level typiquement on veut obtenir la salinite le long d une isopycne que l on a reperee par son niveau level2index est une fonction qui donne en fonction de level un tableau 2d d indice qui permettra d extraire le tableau 2d du tableau 3d CATEGORY: SANS BOUCLE CALLING SEQUENCE: index level2index level INPUTS:level: un tableau 2d de niveaux KEYWORD PARAMETERS: OUTPUTS: untableau 2d d indices COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 24 11 1999 FUNCTION level2index level un elements de tableau 3d dont les 2 premieres dimensions sont nx et ny dont les coordonnes sont i j et k a pour indice ds le meme tableau 3d i j nx k nx ny level etant donne pour chaque points de level on connait i j et k on peut donc calculer l indice taille size level nx taille 1 ny taille 2 tableau k nx ny tabknxny nx ny long level return lindgen nx ny tabknxny end"); 163 a[161] = new Array("./ToBeReviewed/CALCULS/level2mask.html", "level2mask.pro", "", " NAME:level2mask PURPOSE: permet de passer d un tableau 2d de niveau seuil au tableau 3d de mask avec des 1 ds les niveaux au dessus du niveau seuil et des 0 en dessous et sur CATEGORY: SANS BOUCLE CALLING SEQUENCE: res level2mask niveau INPUTS: niveau tableau 2d de niveaux seuil ou une structure repondant aux criteres de litchamp KEYWORD PARAMETERS: OUTPUTS: un tableau 3d contenant le mask associe au tableau 2d de niveaux seuil COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 17 6 1999 Setp 2004: boundary level have 0 values and not 1 as it was explained before in the header see: print array_equal niveau total level2mask niveau 3 FUNCTION level2mask tab tempsun systime 1 pour key_performance common lecture du champ d entree et recuperation de la taille du sous domaine utilise niveaux litchamp tab grille maskterre 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz verification de la coherence entre la taille du tableau et le domaine definit par domdef IF ny EQ 1 THEN niveaux reform niveaux nx ny over taille size niveaux if taille 0 NE 2 then return report le champ en entree doit contenir un tableau 2d case 1 of taille 1 eq jpi and taille 2 eq jpj:niveaux niveaux firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du champ endcase on transforme le tableau 2d de niveaux en tableau 3d de mask mask reform niveaux 1 indgen nz 1 nx ny nz mask floor temporary mask 1 mask temporary mask temporary maskterre if keyword_set key_performance THEN print temps level2mask systime 1 tempsun return mask end"); 164 a[162] = new Array("./ToBeReviewed/CALCULS/moyenne.html", "moyenne.pro", "", " NAME: moyenne PURPOSE: averages a 2 or 3 d field over a selected geographical area and along one ore more selected axes x y or z CATEGORY: CALLING SEQUENCE: result moyenne tab direc BOXZOOM boxzoom INPUTS: tab 2 or 3d field direc x y z xy xz yz or xyz KEYWORD PARAMETERS: BOXZOOM xmin xmax ymin ymax zmin zmax pour plus de detail cf domdef boxzoom peut prendre 5 formes: vert2 vert1 vert2 lon1 lon2 lat1 lat2 lon1 lon2 lat1 lat2 vert2 lon1 lon2 lat1 lat2 vert1 vert2 NAN: not a number a activer si l on peut faire veut faire une moyenne sans tenir compte de certaines valeurs masques de tab si les valeurs masques de tab sont la valeur consacree par IDL values f_nan il suffit de mettre NAN si les valeurs masques de tab on pour valeur a a doit etre differente de 1 correspond a nan values f_nan et de 0 qui desactive nan il faut mettre NAN a Rq: en sorties les points de result qui sont NAN auront pour valeur a ou values f_nan NODOMDEF: activer si l on ne veut pas passer ds domdef bien que le mot cle boxzoom soit present comme c est le cas qd moyenne est appelee via checkfield INTEGRATION: pour faire une integrale plutot qu une moyenne WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: result:un tableau COMMON BLOCKS: common domdef SIDE EFFECTS:met les valeurs correspondants a la terre a 1e20 RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Jerome Vialard jv lodyc jussieu fr 2 7 98 Sebastien Masson smasson lodyc jussieu fr mise au propre de certains truc les terres 14 8 98 15 1 98 11 3 99 adaptation pour NAN 28 7 99 moyennes tableaux 1d PLAN DU PROGRAMME: I preliminaires I 1 determination des directions de moyennes d apres direc I 2 verification de la taille du tableau d entree I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne moyennes pour les tableaux 1d x y II moyennes pour les tableaux 2d x y II 1 verification de la coherence de la taille du tableau a moyenner II 2 differents types de moyennes possibles III moyennes pour les tableaux 3d x y z III 1 verification de la coherence de la taille du tableau a moyenner III 2 differents types de moyennes possibles IV finitions IV 1 on masque les terres par une valeur a 1e 20 IV 2 on remplace quand nan ne 1 values f_nan par nan IV 3 on revient au sous domaine initial function moyenne tab direc BOXZOOM boxzoom INTEGRATION integration NAN nan NODOMDEF nodomdef WDEPTH wdepth _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preliminaires dirt 0 dirx 0 diry 0 dirz 0 I 1 direction s suivants lesquelles on integre if strpos direc t ge 0 then dirt 1 if strpos direc x ge 0 then dirx 1 if strpos direc y ge 0 then diry 1 if strpos direc z ge 0 then dirz 1 if dirx eq 0 and diry eq 0 and dirz eq 0 then return tab I 2 verification de la taille du tableau d entree taille size tab case 1 of taille 0 eq 1 :dim 1d taille 0 eq 2 :BEGIN dim 2d if dirx eq 0 and diry eq 0 then return tab END taille 0 eq 3 :BEGIN dim 3d if dirx eq 0 and diry eq 0 and dirz eq 0 then return tab END else : return report Le tableau d entree doit etre a 2 ou 3 dimensions s il contient une dim temporelle utiliser grossemoyenne endcase I 3 obtention des facteurs d echelles et du masque sur le sous domaine concerne par la moyenne redefinition du domaine ajuste a boxzoom a 6 elements ceci va nous permetre de faire les calcules que sur le sous domaine comcerne par la moyenne domdef suivit de grille nous donne tous les tableaux de la grille sur le sous domaine if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: return report Mauvaise Definition de Boxzoom endcase if NOT keyword_set nodomdef then BEGIN savedbox 1b saveboxparam boxparam4moyenne dat domdef bte GRIDTYPE vargrid _extra ex ENDIF ENDIF attribution du mask et des tableaux de longitude et latitude IF vargrid EQ W THEN wdepth 1 grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 WDEPTH wdepth II Cas du tableau 1d if dim EQ 1d then BEGIN if n_elements tab NE nx ny AND n_elements tab NE nx ny nz then BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom ENDIF case 1 of nx EQ 1 AND ny EQ 1:BEGIN vecteur suivant z case n_elements tab of jpk:res tab firstz:lastz nz:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if dirz EQ 1 then BEGIN dim 3d taille size reform res nx ny nz ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END ny EQ 1:BEGIN vecteur suivant x case n_elements tab of jpi:res tab firstx:lastx nx:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if dirx EQ 1 then BEGIN dim 2d taille size reform res nx ny ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END nx EQ 1:BEGIN vecteur suivant y case n_elements tab of jpj:res tab firsty:lasty ny:res tab ELSE:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine et de la boxzoom END ENDCASE if diry EQ 1 then BEGIN dim 2d taille size reform res nx ny ENDIF ELSE BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return res ENDELSE END endcase endif II Cas du tableau 2d if dim eq 2d then begin II 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj soit celle du domaine reduit nx ny case 1 of taille 1 eq jpi and taille 2 eq jpj: res tab firstx:lastx firsty:lasty taille 1 eq nx and taille 2 eq ny:res tab else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine nx ny strtrim nx 1 strtrim ny 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 END ENDCASE if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 then BEGIN res reform res nx ny over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over II 3 differents types de moyennes mask mask 0 if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 : begin e e1 mask if keyword_set integration then divi 1 else begin divi e IF msknan 0 NE 1 THEN divi temporary divi msknan if ny EQ 1 then divi reform divi nx ny over divi total divi 1 endelse res res e if ny EQ 1 then res reform res nx ny over res total res 1 nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask if ny EQ 1 then testnan reform testnan nx ny over testnan total testnan 1 total mask 1 EQ 0 endif end dirx eq 0 and diry eq 1 : begin e e2 mask if keyword_set integration then divi 1 else begin divi e IF msknan 0 NE 1 THEN divi temporary divi msknan if ny EQ 1 then divi reform divi nx ny over divi total divi 2 endelse res res e if ny EQ 1 then res reform res nx ny over res total res 2 nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask if ny EQ 1 then testnan reform testnan nx ny over testnan total testnan 2 total mask 2 EQ 0 endif end dirx eq 1 and diry eq 1 : begin if keyword_set integration then divi 1 else BEGIN IF msknan 0 NE 1 THEN divi total e1 e2 mask msknan ELSE divi total e1 e2 mask ENDELSE res total res e1 e2 mask nan nan divi 1 if msknan 0 NE 1 then begin testnan msknan mask testnan total testnan total mask EQ 0 endif end endcase endif III Cas du tableau 3d if dim eq 3d then begin III 1 verification de la coherence de la taille du tableau a moyenner verification de la coherence entre la taille du tableau et le domaine definit par domdef le tableau en entree doit avoir soit la taille du domaine total jpi jpj jpk soit celle du domaine reduit nx ny ny case 1 of taille 1 eq jpi and taille 2 eq jpj and taille 3 eq jpk: res tab firstx:lastx firsty:lasty firstz:lastz taille 1 eq jpi and taille 2 eq jpj and taille 3 eq nz: res tab firstx:lastx firsty:lasty taille 1 EQ nx and taille 2 eq ny and taille 3 eq nz :res tab taille 1 EQ nx and taille 2 eq ny and taille 3 eq jpk : res tab firstz:lastz else:BEGIN if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat return report Probleme d adequation entre les tailles du domaine nx ny nz strtrim nx 1 strtrim ny 1 strtrim nz 1 et du tableau strtrim taille 1 1 strtrim taille 2 1 strtrim taille 3 1 END endcase if keyword_set nan NE 0 then BEGIN if nan NE 1 then BEGIN si nan n est pas values f_nan on le met a values f_nan if abs nan LT 1e6 then notanumber where res EQ nan ELSE notanumber where abs res GT abs nan 10 if notanumber 0 NE 1 then res temporary notanumber values f_nan ENDIF ENDIF rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER 1 ET S ASSURER QU ELLE EXISTE BIEN D OU LES reform nx ny QUI PEUVENT SEMBLER INUTILE AU DEPART if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN res reform res nx ny nz over e1 reform e1 nx ny over e2 reform e2 nx ny over endif if nx EQ 1 OR ny EQ 1 OR nz EQ 1 THEN mask reform mask nx ny nz over IF keyword_set key_partialstep THEN BEGIN the top of the ocean floor is IF vargrid EQ T OR vargrid EQ W THEN bottom total mask 3 ELSE bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 we suppress columns with only ocean or land good where bottom NE 0 AND bottom NE nz the bottom of the ocean in 3D index is: bottom lindgen nx ny temporary bottom 1L nx ny IF good 0 NE 1 THEN bottom bottom good ELSE bottom 1 ENDIF ELSE bottom 1 III 2 differents types de moyennes if keyword_set nan NE 0 then msknan finite res ELSE msknan 1 case 1 of dirx eq 1 and diry eq 0 and dirz eq 0 : begin e13 e1 replicate 1 nz e13 reform e13 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else begin divi e13 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 1 ENDELSE res res e13 mask if nz EQ 1 then res reform res nx ny nz over res total res 1 nan nan divi 1 e13 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 1 total mask 1 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 0 : begin e23 e2 replicate 1 nz e23 reform e23 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else begin divi e23 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 2 ENDELSE res res e23 mask if nz EQ 1 then res reform res nx ny nz over res total res 2 nan nan divi 1 e23 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 2 total mask 2 EQ 0 endif end dirx eq 0 and diry eq 0 and dirz eq 1 : begin e33 replicate 1 1 nx ny e3 e33 reform e33 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e33 bottom e3w_ps firstx:lastx firsty:lasty temporary good ELSE e33 bottom e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else begin divi e33 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total divi 3 ENDELSE res res e33 mask if nz EQ 1 then res reform res nx ny nz over res total res 3 nan nan divi 1 e33 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total testnan 3 total mask 3 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 0 : begin e123 e1 e2 replicate 1 nz e123 reform e123 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 AND nx ny NE 1 THEN BEGIN IF msknan 0 EQ 1 THEN BEGIN msknan replicate 1b nx ny nz nan 1 endif msknan bottom 0 res bottom values f_nan ENDIF if keyword_set integration then divi 1 else BEGIN divi e123 mask IF msknan 0 NE 1 THEN divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 1 1 ENDELSE res res e123 mask if nz EQ 1 then res reform res nx ny nz over res total total res 1 nan nan 1 nan nan divi 1 e123 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 1 1 total total mask 1 1 EQ 0 endif end dirx eq 1 and diry eq 0 and dirz eq 1 : begin e133 e1 e3 e133 reform e133 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e133 bottom e1 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e133 bottom e1 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN divi e133 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 1 2 ENDELSE res res e133 mask if nz EQ 1 then res reform res nx ny nz over res total total res 1 nan nan 2 nan nan divi 1 e133 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 1 2 total total mask 1 2 EQ 0 endif end dirx eq 0 and diry eq 1 and dirz eq 1 : begin e233 e2 e3 e233 reform e233 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e233 bottom e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e233 bottom e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN divi e233 mask if msknan 0 NE 1 then divi temporary divi msknan if nz EQ 1 then divi reform divi nx ny nz over divi total total divi 2 2 ENDELSE res res e233 mask if nz EQ 1 then res reform res nx ny nz over res total total res 2 nan nan 2 nan nan divi 1 e233 1 if msknan 0 NE 1 then begin testnan msknan mask if nz EQ 1 then testnan reform testnan nx ny nz over testnan total total testnan 2 2 total total mask 2 2 EQ 0 endif end dirx eq 1 and diry eq 1 and dirz eq 1 : begin e1233 e1 e2 e3 e1233 reform e1233 nx ny nz over IF keyword_set key_partialstep AND bottom 0 NE 1 THEN BEGIN IF keyword_set wdepth THEN e1233 bottom e1 e2 e3w_ps firstx:lastx firsty:lasty temporary good ELSE e1233 bottom e1 e2 e3t_ps firstx:lastx firsty:lasty temporary good ENDIF if keyword_set integration then divi 1 else BEGIN if msknan 0 NE 1 then divi total e1233 mask msknan ELSE divi total e1233 mask ENDELSE res total res e1233 mask nan nan divi 1 e1233 1 if msknan 0 NE 1 then begin testnan msknan mask testnan total testnan total mask EQ 0 endif end endcase endif IV finitions IV 1 on masque les terres par une valeur a 1e 20 valmask 1e 20 terre where divi EQ 0 IF terre 0 NE 1 THEN BEGIN res terre 1e 20 ENDIF IV 2 on remplace quand nan ne 1 values f_nan par nan if keyword_set nan NE 0 then BEGIN puttonan where testnan EQ 0 if puttonan 0 NE 1 then res puttonan values f_nan if nan NE 1 then BEGIN notanumber where finite res eq 0 if notanumber 0 NE 1 then res notanumber nan ENDIF ENDIF IV 3 on se remplace ds le sous domaine qui etait definit a l entree de moyenne if keyword_set savedbox THEN restoreboxparam boxparam4moyenne dat if keyword_set key_performance THEN print temps moyenne systime 1 tempsun return res end"); 165 a[163] = new Array("./ToBeReviewed/CALCULS/norme.html", "norme.pro", "", " NAME:norme PURPOSE: calcule la norme d un champ de vecteurs puis fait une moyenne eventuelle Rq1: le champ de vecteur peut etre 2d:xy 3d: xyz ou xyt 4d: xyzt Rq2: le calcul de la norme est fait avant l eventuelle moyenne spatiale ou temporelle car la moyenne de la norme n est pas egale a la norme des moyennes CATEGORY: calcul de post traitement CALLING SEQUENCE:res norme champ_de_vecteurs INPUTS:un tableau 2d 3d ou 4d KEYWORD PARAMETERS: BOXZOOM: boxzoom sur laquelle moyenner par defaut le domaine selectionner par le dernier domdef effectue DIREC: t x y z xy xz yz xyz xt yt zt xyt xzt yzt xyzt directions selon lesquelles effectuer les moyennes OUTPUTS:tableau a tracer avec plt pltz ou pltt COMMON BLOCKS: common pro SIDE EFFECTS: La norme est calculee aux points T Pour faire ce calcul on moyenne les champs U et V aux points T avant de calculer la norme Au bord des cotes et du domaine on ne peut pas calculer les champs U et V aux points T ces points sont donc a la valeur values f_nan lorsqu on fait le calcul sur un domaine geographique reduit les champs U et V ne comprennent pas forcement le meme nombre de points Dans ce cas on redecoupe U et V pour ne garder que les points en commun Au passage on refait un domdef qui redefinit un domaine geographique sur lequel les champs U et V sont extraits sur les meme points RESTRICTIONS: pour savoir a quel type de tableau on a a faire on teste la taille de celui ci et les dates donnees par time 0 et time jpt 1 pour savoir si il y a une dimension temporelle Avant de lancer norme s assurer que time et jpt sont bien definis comme il faut EXAMPLE: pour calculer la moyenne de la norme des courants sur tout le dommaine entre 0 et 50: IDL res norme un vn boxzoom 0 50 dir xyz MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 9 6 1999 FUNCTION norme composanteu composantev BOXZOOM boxzoom DIREC direc _extra ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance IF finite glamu 0 finite gphiu 0 finite glamv 0 finite gphiv 0 EQ 0 THEN return report This version of norme is based on Arakawa C grid U and V grids must therefore be defined if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: return report Mauvaise Definition de Boxzoom ENDCASE domdef boxzoom ENDIF if NOT keyword_set direc then direc 0 construction de u et v aux pts T u litchamp composanteu v litchamp composantev date1 time 0 if n_elements jpt EQ 0 then date2 date1 ELSE date2 time jpt 1 if size u 0 NE size v 0 then return 1 vargrid T varname norme valmask 1e20 grilleu litchamp composanteu grid if grilleu EQ then grilleu U grillev litchamp composantev grid if grillev EQ then grillev V IF grilleu EQ V AND grillev EQ U THEN inverse 1 IF grilleu EQ T AND grillev EQ T THEN BEGIN interpolle 0 return report cas non code mais facile a faire ENDIF ELSE interpolle 1 if keyword_set inverse then begin rien u u v v rien endif on trouve les points que u et v ont en communs indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey case 1 of xyz size u 0 EQ 3 AND date1 EQ date2 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case size u 3 OF nzt:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny end jpk:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 firstzt:lastzt ELSE u u 1: nx firstzt:lastzt IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 firstzt:lastzt ELSE v v 1: nx firstzt:lastzt IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 firstzt:lastzt ELSE u u 1: ny firstzt:lastzt IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 firstzt:lastzt ELSE v v 1: ny firstzt:lastzt end ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size u 3 EQ jpk AND size v 1 EQ jpi AND size v 2 EQ jpj AND size u 3 EQ jpk :BEGIN u u indice3d v v indice3d END ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if nzt EQ 1 then begin u reform u nx ny nzt over v reform v nx ny nzt over endif construction de u et v aux pts T a u 0 u u shift u 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude mask tmask indice3d if nzt EQ 1 then mask reform mask nx ny nzt over if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN res mask valmask moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res moyenne res direc nan boxzoom boxzoom nodomdef END xyt date1 NE date2 AND size u 0 EQ 3 :BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 END ELSE:return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase construction de u et v aux pts T a u 0 u u shift u 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin mask tmask indice2d jpi jpj firstzt if ny EQ 1 then mask reform mask nx ny over construction de terre qui contient tous les point a masquer if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN BEGIN coeftps lindgen jpt nx ny coeftps replicate 1 n_elements mask coeftps mask temporary mask replicate 1 jpt mask temporary mask temporary coeftps res temporary mask valmask ENDIF moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res grossemoyenne res direc nan boxzoom boxzoom nodomdef END xyzt date1 NE date2 AND size u 0 EQ 4:BEGIN indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 indice3d lindgen jpi jpj jpk indice3d indice3d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN case size u 3 OF nzt:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny end jpk:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 firstzt:lastzt ELSE u u 1: nx firstzt:lastzt IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 firstzt:lastzt ELSE v v 1: nx firstzt:lastzt IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 firstzt:lastzt ELSE u u 1: ny firstzt:lastzt IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 firstzt:lastzt ELSE v v 1: ny firstzt:lastzt end ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase END size u 1 EQ jpi AND size u 2 EQ jpj AND size u 3 EQ jpk AND size v 1 EQ jpi AND size v 2 EQ jpj AND size u 3 EQ jpk :BEGIN u u indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt v v indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 firstzt:lastzt END ELSE: return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase construction de u et v aux pts T a u 0 u u shift u 1 0 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 0 0 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude mask tmask indice3d if nzt EQ 1 then mask reform mask nx ny nzt over if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN BEGIN coeftps lindgen jpt nx ny nzt coeftps replicate 1 n_elements mask coeftps mask temporary mask replicate 1 jpt mask temporary mask temporary coeftps res temporary mask valmask ENDIF moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res grossemoyenne res direc nan boxzoom boxzoom nodomdef END xy ELSE:BEGIN xy indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:return report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if ny EQ 1 then begin u reform u nx ny over v reform v nx ny over endif construction de u et v aux pts T a u 0 u u shift u 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin mask tmask indice2d jpi jpj firstzt if nyt EQ 1 THEN mask reform mask nx ny over construction de terre qui contient tous les point a masquer if n_elements valmask EQ 0 THEN valmask 1e20 landu where u GE valmask 10 if landu 0 NE 1 then u landu 0 landv where v GE valmask 10 if landv 0 NE 1 then v landv 0 res sqrt u 2 v 2 if NOT keyword_set key_periodic OR nx NE jpi then res 0 values f_nan res 0 values f_nan mask where mask eq 0 IF mask 0 NE 1 THEN res mask valmask moyennes en tous genres domdef glamt indice2d 0 0 glamu indice2d nx 1 0 gphit indice2d 0 0 gphiv indice2d 0 ny 1 vert1 vert2 meme if keyword_set direc then res moyenne res direc nan boxzoom boxzoom nodomdef END endcase if keyword_set key_performance THEN print temps norme systime 1 tempsun return res end"); 166 a[164] = new Array("./ToBeReviewed/CALCULS/projectondepth.html", "projectondepth.pro", "", " NAME:projectondepth PURPOSE: routine permettant de projeter un champ 3d suivant un tableau de profondeurs CATEGORY: sans boucles CALLING SEQUENCE:res projectondepth arrayin depthin INPUTS: arrayin: un tableau 3d dont la 3eme dimension doit etre egale a jpk depthin: un tableau 2d indiquant n chaque point a quel profondeur projeter KEYWORD PARAMETERS:none OUTPUTS:res: un tableau 2d projection du tableau 3d suivant les profondeurs indiquees par depthin COMMON BLOCKS:common pro SIDE EFFECTS: points a values f_nan qd calcul impossible points terres masques a Valmask RESTRICTIONS: EXAMPLE: on contruit un tableau de profondeurs possibles IDL a gdept jpk 1 1 jpi jpj findgen jpi jpj on contruit un tableau a projeter sur ces profondeurs pour le test on construit un tableau 3d dont chaque vecteur suivant z est la profondeur IDL arraytest replicate 1 jpi jpj gdept IDL arraytest reform arraytest jpi jpj jpk over on test la projection du tabeau profondeur sur la profondeur IDL plt 1e6 a projectondepth arraytest a nocontour champ nul a 1e 6 pres verifcation en projettant la temperature sur la profondeur de la 20 degres par exemple MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 6 2000 FUNCTION projectondepth arrayin depthin tempsun systime 1 pour key_performance common depth litchamp depthin array litchamp arrayin petites verifications tailledepth size depth taillearray size array if tailledepth 0 NE 2 THEN return report Depth array must have 2 dimensions if taillearray 0 NE 3 THEN return report Array in must have 3 dimensions verification de la coherence entre la taille du tableau et le domaine grille mask 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz case 1 of tailledepth 1 eq jpi and tailledepth 2 eq jpj:depth depth firstx:lastx firsty:lasty tailledepth 1 eq nx and tailledepth 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du tableau de profondeur endcase case 1 OF taillearray 3 NE jpk:return report Le tableau 3d doit avoir sa 3eme dimension egale a jpk taillearray 1 eq jpi and taillearray 2 eq jpj:array array firstx:lastx firsty:lasty taillearray 1 eq nx and taillearray 2 eq ny: else:return report Probleme d adequation entre les tailles du domaine et celle du tableau de profondeur endcase c est parti flevel depth2floatlevel depth on vire les points a values f_nan notanumber where finite flevel nan EQ 1 if notanumber 0 NE 1 then flevel notanumber 0 on seuil vire les points terres a valmask par ex flevel 0 flevel jpk 1 indexup level2index floor flevel indexlow nx ny indexup out where indexlow GE nx ny jpk 1 if out 0 NE 1 then indexlow out indexlow out nx ny weight flevel floor flevel res array indexup res res weight array indexlow res on replace les points a values f_nan if notanumber 0 NE 1 then res notanumber values f_nan if out 0 NE 1 then res out values f_nan on masque les points terres a valmask if n_elements valmask EQ 0 then valmask 1e20 terre where temporary mask 0 EQ 0 if terre 0 NE 1 then res terre valmask if keyword_set key_performance THEN print temps projectondepth systime 1 tempsun return res end"); 167 a[165] = new Array("./ToBeReviewed/CALCULS/remplit.html", "remplit.pro", "", " Extrapole zinout jpi jpj sur les continents en utilisant les 4 plus proches voisins masques oceaniquement et construit un nouveau masque contenant l ancien masque oceanique PLUSles points extrapoles Reitere le processus niter fois C est pas clair essayez Nan: to fill the point which have the value values f_nan Whitout this keyword these point are not filling and stays at values f_nan FUNCTION remplit zinput NAN nan NITER niter BASIQUE basique mask mask FILLXDIR fillxdir FILLYDIR fillydir FILLVAL fillval _extra ex common tempsun systime 1 pour key_performance les points non remplis sont masques a valmask IF n_elements niter EQ 0 THEN niter 1 IF niter EQ 0 THEN return zinput z zinput if n_elements key_gridtype EQ 0 then key_gridtype c if keyword_set basique then begin oldkey_gridtype key_gridtype key_gridtype c nx size zinput 1 ny size zinput 2 if NOT keyword_set mask then mmmask basique ELSE mmmask mask if key_gridtype eq e then begin case vargrid of T :glam glamt firstxt:lastxt firstyt:lastyt U :glam glamu firstxu:lastxu firstyu:lastyu endcase endif ENDIF ELSE grille mmmask glam gphi gdep nx ny nz _extra ex if keyword_set mask then mmmask mask if size mmmask 0 EQ 3 THEN mmmask mmmask 0 if n_elements mmmask EQ 1 then mmmask replicate 1b nx ny if keyword_set nan then begin nanpoint where finite z EQ 0 if nanpoint 0 NE 1 then begin mmmask nanpoint 0b z nanpoint 0 endif ENDIF mmmask byte mmmask on ajoute un cadre de zero a z mask e1 e2 comme ca apres on peut faire des shifts ds tous les sens sans se soucier des bords du domaine tempdeux systime 1 pour key_performance 2 nx2 nx 2 case key_gridtype of c :BEGIN ztmp bytarr nx 2 ny 2 ztmp 1:nx 1:ny mmmask mmmask temporary ztmp ztmp fltarr nx 2 ny 2 ztmp 1:nx 1:ny z if keyword_set key_periodic AND nx EQ jpi then begin ztmp 0 1:ny z jpi 1 ztmp nx 1 1:ny z 0 endif z temporary ztmp END e :BEGIN ztmp bytarr nx 2 ny 4 ztmp 1:nx 2:ny 1 mmmask mmmask temporary ztmp ztmp fltarr nx 2 ny 4 ztmp 1:nx 2:ny 1 z if keyword_set key_periodic AND nx EQ jpi then begin ztmp 0 2:ny 1 z jpi 1 ztmp nx 1 2:ny 1 z 0 endif z temporary ztmp END endcase IF testvar var key_performance EQ 2 THEN print temps remplit: on ajoute un cadre de zero systime 1 tempdeux iteration FOR n 1 niter DO BEGIN on trouve les points coast tempdeux systime 1 pour key_performance 2 les points du bord du cadre ne doivent pas etre selectionnes comme la coast case key_gridtype of c :BEGIN mmmask 0 1b mmmask nx 1 1b mmmask 0 1b mmmask ny 1 1b END e :BEGIN mmmask 0 1b mmmask nx 1 1b mmmask 0:1 1b mmmask ny 2:ny 3 1b END endcase liste des points terre restant IF keyword_set fillxdir THEN BEGIN we stop if all the lines that contains data have been filled test total mmmask 1:nx 1 IF total test EQ 0 test EQ nx EQ ny 2 THEN GOTO fini ENDIF IF keyword_set fillydir THEN BEGIN we stop if all the columns that contains data have been filled test total mmmask 1:ny 2 IF total test EQ 0 test EQ ny EQ nx 2 THEN GOTO fini ENDIF land where mmmask EQ 0 if land 0 EQ 1 then GOTO fini les points du bord du cadre doivent maintenant etre dans la terre case key_gridtype of c :BEGIN mmmask 0 0b mmmask nx 1 0b mmmask 0 0b mmmask ny 1 0b END e :BEGIN mmmask 0 0b mmmask nx 1 0b mmmask 0:1 0b mmmask ny 2:ny 3 0b END endcase if keyword_set key_periodic AND nx EQ jpi then begin mmmask 0 mmmask nx mmmask nx 1 mmmask 1 endif liste des voisins mer case key_gridtype of c :BEGIN CASE 1 OF keyword_set fillxdir :weight mmmask 1 land mmmask 1 land keyword_set fillydir :weight mmmask nx2 land mmmask nx2 land ELSE:weight mmmask 1 land mmmask 1 land mmmask nx2 land mmmask nx2 land 1 sqrt 2 mmmask nx2 1 land mmmask nx2 1 land mmmask nx2 1 land mmmask nx2 1 land ENDCASE END e :BEGIN shifted glam 0 0 LT glam 0 1 oddeven land nx2 1 shifted MOD 2 weight mmmask 1 land mmmask 1 land mmmask 2 nx2 land mmmask 2 nx2 land sqrt 2 mmmask nx2 oddeven land mmmask nx2 1 oddeven land mmmask nx2 oddeven land mmmask nx2 1 oddeven land END endcase ok where weight GT 0 weight weight ok coast land temporary ok IF testvar var key_performance EQ 2 THEN print temps remplit: trouver la coast systime 1 tempdeux remplissage des points coast tempdeux systime 1 pour key_performance 2 on masque z z temporary z mmmask case key_gridtype of c :BEGIN CASE 1 OF keyword_set fillxdir :zcoast z 1 coast z 1 coast keyword_set fillydir :zcoast z nx2 coast z nx2 coast ELSE:zcoast z 1 coast z 1 coast z nx2 coast z nx2 coast 1 sqrt 2 z nx2 1 coast z nx2 1 coast z nx2 1 coast z nx2 1 coast ENDCASE END e :BEGIN oddeven coast nx2 1 shifted MOD 2 zcoast z 1 coast z 1 coast z 2 nx2 coast z 2 nx2 coast sqrt 2 z nx2 oddeven coast z nx2 1 oddeven coast z nx2 oddeven coast z nx2 1 oddeven coast END endcase z coast temporary zcoast temporary weight we update the the boundary conditions of z if keyword_set key_periodic AND nx EQ jpi then begin z 0 z nx z nx 1 z 1 endif IV on reduit le masque mmmask temporary coast 1 IF testvar var key_performance EQ 2 THEN print temps remplit: une iteration systime 1 tempdeux ENDFOR fini: on masque les valeurs sur les lands restantes IF n_elements valmask EQ 0 then valmask 1e20 IF n_elements fillval EQ 0 THEN fillval valmask z temporary z mmmask fillval 1b mmmask on redecoupe le tableau pour retirer le cadre case key_gridtype of c :BEGIN z z 1:nx 1:ny END e :BEGIN z z 1:nx 2:ny 1 END endcase if keyword_set basique then key_gridtype oldkey_gridtype if keyword_set key_performance THEN print temps remplit systime 1 tempsun return z END "); 168 a[166] = new Array("./ToBeReviewed/CALCULS/rhon.html", "rhon.pro", "", " Calcul de la fonction d etat issue de eos F Creation : 1997 G Roullet adaptation pour les tableaux z zt xyz xyzt par seb FUNCTION rhon sn tn INSITU insitu SIGMA_N sigma_n common tempsun systime 1 pour key_performance sn 1e5 double sn double tn 1e5 IF keyword_set sigma_n then insitu 1 taille size sn case taille 0 of 0:BEGIN z zrhop 0d jkmax 1 END 1:BEGIN z zrhop dblarr taille 1 jkmax taille 1 END 2:BEGIN xy jpt 1 ou zt zrhop dblarr taille 1 taille 2 if jpt EQ 1 then jkmax 1 ELSE jkmax taille 1 END 3:BEGIN xyz jpt 1 ou xyt zrhop dblarr taille 1 taille 2 taille 3 if jpt EQ 1 then jkmax taille 3 ELSE jkmax 1 END 4:BEGIN xyzt zrhop dblarr taille 1 taille 2 taille 3 taille 4 jkmax taille 3 END endcase FOR jk 0 jkmax 1 DO BEGIN case taille 0 of 0:BEGIN z ztt tn zs sn END 1:BEGIN z ztt tn jk zs sn jk END 2:BEGIN xy jpt 1 ou zt if jpt EQ 1 then begin ztt tn zs sn ENDIF ELSE BEGIN ztt tn jk zs sn jk ENDELSE END 3:BEGIN xyz jpt 1 ou xyt if jpt EQ 1 then begin ztt tn jk zs sn jk endif ELSE BEGIN ztt tn zs sn ENDELSE END 4:BEGIN xyzt ztt tn jk zs sn jk END endcase if n_elements sigma_n NE 0 then zh 1000 sigma_n ELSE zh gdept jk square root salinity zsr sqrt abs zs compute density pure water at atm pressure zr1 6 536332e 9 ztt 1 120083e 6 ztt 1 001685e 4 ztt 9 095290e 3 ztt 6 793952e 2 ztt 999 842594 seawater density atm pressure zr2 5 3875e 9 ztt 8 2467e 7 ztt 7 6438e 5 ztt 4 0899e 3 ztt 0 824493 zr3 1 6546e 6 ztt 1 0227e 4 ztt 5 72466e 3 zr4 4 8314e 4 potential density reference to the surface case taille 0 of 0: zrhop zr4 zs zr3 zsr zr2 zs zr1 1: zrhop jk zr4 zs zr3 zsr zr2 zs zr1 2:BEGIN if jpt EQ 1 then zrhop zr4 zs zr3 zsr zr2 zs zr1 ELSE zrhop jk zr4 zs zr3 zsr zr2 zs zr1 END 3:BEGIN if jpt EQ 1 then zrhop jk zr4 zs zr3 zsr zr2 zs zr1 ELSE zrhop zr4 zs zr3 zsr zr2 zs zr1 END 4: zrhop jk zr4 zs zr3 zsr zr2 zs zr1 endcase IF n_elements insitu EQ 1 THEN BEGIN add the compression terms ze 3 508914e 8 ztt 1 248266e 8 ztt 2 595994e 6 zbw 1 296821e 6 ztt 5 782165e 9 ztt 1 045941e 4 zb zbw ze zs zd 2 042967e 2 zc 7 267926e 5 ztt 2 598241e 3 ztt 0 1571896 zaw 5 939910e 6 ztt 2 512549e 3 ztt 0 1028859 ztt 4 721788 za zd zsr zc zs zaw zb1 0 1909078 ztt 7 390729 ztt 55 87545 za1 2 326469e 3 ztt 1 553190 ztt 65 00517 ztt 1044 077 zkw 1 361629e 4 ztt 1 852732e 2 ztt 30 41638 ztt 2098 925 ztt 190925 6 zk0 zb1 zsr za1 zs zkw masked in situ density case taille 0 of 0: zrhop zrhop 1 0 zh zk0 zh za zh zb 1: zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb 2:BEGIN if jpt EQ 1 then zrhop zrhop 1 0 zh zk0 zh za zh zb ELSE zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb END 3:BEGIN if jpt EQ 1 then zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb ELSE zrhop zrhop 1 0 zh zk0 zh za zh zb END 4: zrhop jk zrhop jk 1 0 zh zk0 zh za zh zb endcase ENDIF ENDFOR terre where tn GE 1e6 if terre 0 NE 1 then zrhop terre valmask if keyword_set key_performance THEN print temps rhon systime 1 tempsun return zrhop END "); 169 a[167] = new Array("./ToBeReviewed/CALENDRIER/caldat.html", "caldat.pro", "", " Id: caldat pro 69 2006 05 11 10:35:53Z smasson Copyright c 1992 2003 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: CALDAT PURPOSE: Return the calendar date and time given julian date This is the inverse of the function JULDAY CATEGORY: Misc CALLING SEQUENCE: CALDAT Julian Month Day Year Hour Minute Second See also: julday the inverse of this function INPUTS: JULIAN contains the Julian Day Number which begins at noon of the specified calendar date It should be a long integer OUTPUTS: Trailing parameters may be omitted if not required MONTH: Number of the desired month 1 January 12 December DAY: Number of day of the month YEAR: Number of the desired year HOUR: Hour of the day Minute: Minute of the day Second: Second and fractions of the day KEYWORD PARAMETERS: NDAYSPM: for using a calendar with fixed number of days per months defaut value of NDAYSPM 30 COMMON BLOCKS: cm_4cal SIDE EFFECTS: None RESTRICTIONS: Accuracy using IEEE double precision numbers is approximately 1 10000th of a second MODIFICATION HISTORY: Translated from Numerical Recipies in C by William H Press Brian P Flannery Saul A Teukolsky and William T Vetterling Cambridge University Press 1988 second printing DMS July 1992 DMS April 1996 Added HOUR MINUTE and SECOND keyword AB 7 December 1997 Generalized to handle array input Eric Guilyardi June 1999 Added key_work ndayspm for fixed number of days per months AB 3 January 2000 Make seconds output as DOUBLE in array output pro CALDAT julian month day year hour minute second NDAYSPM ndayspm cm_4cal COMPILE_OPT idl2 ON_ERROR 2 Return to caller if errors IF n_elements key_caltype EQ 0 THEN key_caltype greg if keyword_set ndayspm then key_caltype 360d CASE key_caltype OF greg :BEGIN nParam N_PARAMS IF nParam LT 1 THEN MESSAGE Incorrect number of arguments min_julian 1095 max_julian 1827933925 minn MIN julian MAX maxx IF minn LT min_julian OR maxx GT max_julian THEN MESSAGE Value of Julian date is out of allowed range igreg 2299161L Beginning of Gregorian calendar julLong FLOOR julian 0 5d Better be long minJul MIN julLong IF minJul GE igreg THEN BEGIN all are Gregorian jalpha LONG julLong 1867216L 0 25d 36524 25d ja julLong 1L jalpha long 0 25d jalpha ENDIF ELSE BEGIN ja julLong gregChange WHERE julLong ge igreg ngreg IF ngreg GT 0 THEN BEGIN jalpha long julLong gregChange 1867216L 0 25d 36524 25d ja gregChange julLong gregChange 1L jalpha long 0 25d jalpha ENDIF ENDELSE jalpha 1 clear memory jb TEMPORARY ja 1524L jc long 6680d jb 2439870L 122 1d0 365 25d jd long 365d jc 0 25d jc je long jb jd 30 6001d day TEMPORARY jb TEMPORARY jd long 30 6001d je month TEMPORARY je 1L month TEMPORARY month 1L MOD 12L 1L year TEMPORARY jc 4715L year TEMPORARY year month GT 2 year year year LE 0 see if we need to do hours minutes seconds IF nParam GT 4 THEN BEGIN fraction julian 0 5d TEMPORARY julLong hour floor fraction 24d fraction TEMPORARY fraction hour 24d minute floor fraction 1440d second TEMPORARY fraction minute 1440d 86400d ENDIF if julian is an array reform all output to correct dimensions IF SIZE julian N_DIMENSION GT 0 THEN BEGIN dimensions SIZE julian DIMENSION month REFORM month dimensions day REFORM day dimensions year REFORM year dimensions IF nParam GT 4 THEN BEGIN hour REFORM hour dimensions minute REFORM minute dimensions second REFORM second dimensions ENDIF ENDIF END 360d :BEGIN jul long julian f jul floor jul IF total f NE 0 0 GT 0 THEN BEGIN Get hours minutes seconds hour floor f 24 f f hour 24 d minute floor f 1440 second f minute 1440 d0 86400 0d0 ENDIF ELSE BEGIN hour replicate 0L n_elements julian minute replicate 0L n_elements julian second replicate 0L n_elements julian ENDELSE IF keyword_set ndayspm THEN BEGIN IF ndayspm EQ 1 THEN ndayspm 30 ENDIF ELSE ndayspm 30 ndayspm long ndayspm Z floor julian year z 12 ndayspm 1 month z 12 ndayspm year 1 ndayspm 1 day z 12 ndayspm year 1 ndayspm month 1 WHILE total day LT 1 GT 0 DO BEGIN tochange where day LT 1 month tochange month tochange 1 day tochange day tochange ndayspm ENDWHILE WHILE total month LT 1 GT 0 DO BEGIN tochange where month LT 1 year tochange year tochange 1 month tochange month tochange 12 ENDWHILE year 0 does not exist neg where year LT 0 IF neg 0 NE 1 THEN year neg year neg 1 END noleap :BEGIN jul long julian year jul 365 1 day jul MOD 365L zero where day EQ 0 month 1 day GT 31 day GT 59 day GT 90 day GT 120 day GT 151 day GT 181 day GT 212 day GT 243 day GT 273 day GT 304 day GT 334 month long month day day 31L day GT 31 28L day GT 59 31L day GT 90 30L day GT 120 31L day GT 151 30L day GT 181 31L day GT 212 31L day GT 243 30L day GT 273 31L day GT 304 30L day GT 334 IF zero 0 NE 1 THEN BEGIN year zero year zero 1 month zero 12L day zero 31L ENDIF END ELSE:BEGIN ng report only 3 types of calendar are accepted: greg 360d and noleap return END ENDCASE zero where year ge 600000L cnt IF cnt NE 0 THEN year zero year zero 654321L return END"); 170 a[168] = new Array("./ToBeReviewed/CALENDRIER/def_month.html", "def_month.pro", "", "FUNCTION def_month timave date translate month number in string IF strpos date _ GT 1 THEN date strmid date 0 strpos date _ CASE strmid timave 0 2 OF 1m : BEGIN CASE strmid date strlen date 2 2 OF 01 : mn January 02 : mn February 03 : mn March 04 : mn April 05 : mn May 06 : mn June 07 : mn July 08 : mn August 09 : mn September 10 : mn October 11 : mn November 12 : mn December ELSE: mn ENDCASE END 3m : BEGIN CASE strmid date strlen date 2 2 OF 01 : mn DJF 02 : mn MMA 03 : mn JJA 04 : mn SON ELSE: mn ENDCASE END ELSE: ENDCASE return mn END "); 171 a[169] = new Array("./ToBeReviewed/CALENDRIER/julday.html", "julday.pro", "", " Id: julday pro 69 2006 05 11 10:35:53Z smasson Copyright c 1988 2003 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: JULDAY PURPOSE: Calculate the Julian Day Number for a given month day and year This is the inverse of the library function CALDAT See also caldat the inverse of this function CATEGORY: Misc CALLING SEQUENCE: Result JULDAY Month Day Year Hour Minute Second INPUTS: MONTH: Number of the desired month 1 January 12 December DAY: Number of day of the month YEAR: Number of the desired year Year parameters must be valid values from the civil calendar Years B C E are represented as negative integers Years in the common era are represented as positive integers In particular note that there is no year 0 in the civil calendar 1 B C E 1 is followed by 1 C E 1 HOUR: Number of the hour of the day MINUTE: Number of the minute of the hour SECOND: Number of the second of the minute Note: Month Day Year Hour Minute and Second can all be arrays The Result will have the same dimensions as the smallest array or will be a scalar if all arguments are scalars OPTIONAL INPUT PARAMETERS: Hour Minute Second optional time of day KEYWORD PARAMETERS: NDAYSPM: for using a calendar with fixed number of days per months defaut value of NDAYSPM 30 OUTPUTS: JULDAY returns the Julian Day Number which begins at noon of the specified calendar date If Hour Minute and Second are not specified then the result will be a long integer otherwise the result is a double precision floating point number COMMON BLOCKS: cm_4cal SIDE EFFECTS: None RESTRICTIONS: Accuracy using IEEE double precision numbers is approximately 1 10000th of a second with higher accuracy for smaller earlier Julian dates MODIFICATION HISTORY: Translated from Numerical Recipies in C by William H Press Brian P Flannery Saul A Teukolsky and William T Vetterling Cambridge University Press 1988 second printing AB September 1988 DMS April 1995 Added time of day Eric Guilyardi June 1999 Added key_work ndayspm for fixed number of days per months change to accept year 0 Sebastien Masson Aug 2003 fix bug for negative and large values of month values eg julday 349 1 1970 CT April 2000 Now accepts vectors or scalars function JULDAY MONTH DAY YEARin Hour Minute Second NDAYSPM ndayspm cm_4cal COMPILE_OPT idl2 ON_ERROR 2 Return to caller if errors IF n_elements key_caltype EQ 0 THEN key_caltype greg if keyword_set ndayspm then key_caltype 360d YEAR long yearin zero where year EQ 0 cnt IF cnt NE 0 THEN YEAR zero 654321L CASE key_caltype OF greg :BEGIN Gregorian Calander was adopted on Oct 15 1582 skipping from Oct 4 1582 to Oct 15 1582 GREG 2299171L incorrect Julian day for Oct 25 1582 Process the input if all are missing use todays date NP n_params IF np EQ 0 THEN RETURN SYSTIME JULIAN IF np LT 3 THEN MESSAGE Incorrect number of arguments Find the dimensions of the Result: 1 Find all of the input arguments that are arrays ignore scalars 2 Out of the arrays find the smallest number of elements 3 Find the dimensions of the smallest array Step 1: find all array arguments nDims SIZE month N_DIMENSIONS SIZE day N_DIMENSIONS SIZE year N_DIMENSIONS SIZE hour N_DIMENSIONS SIZE minute N_DIMENSIONS SIZE second N_DIMENSIONS arrays WHERE nDims GE 1 nJulian 1L assume everything is a scalar IF arrays 0 GE 0 THEN BEGIN Step 2: find the smallest number of elements nElement N_ELEMENTS month N_ELEMENTS day N_ELEMENTS year N_ELEMENTS hour N_ELEMENTS minute N_ELEMENTS second nJulian MIN nElement arrays whichVar step 3: find dimensions of the smallest array CASE arrays whichVar OF 0: julianDims SIZE month DIMENSIONS 1: julianDims SIZE day DIMENSIONS 2: julianDims SIZE year DIMENSIONS 3: julianDims SIZE hour DIMENSIONS 4: julianDims SIZE minute DIMENSIONS 5: julianDims SIZE second DIMENSIONS ENDCASE ENDIF d_Second 0d defaults d_Minute 0d d_Hour 0d convert all Arguments to appropriate array size type SWITCH np OF use switch so we fall thru all arguments 6: d_Second SIZE second N_DIMENSIONS GT 0 second 0:nJulian 1 : second 5: d_Minute SIZE minute N_DIMENSIONS GT 0 minute 0:nJulian 1 : minute 4: d_Hour SIZE hour N_DIMENSIONS GT 0 hour 0:nJulian 1 : hour 3: BEGIN convert m d y to type LONG L_MONTH SIZE month N_DIMENSIONS GT 0 LONG month 0:nJulian 1 : LONG month L_DAY SIZE day N_DIMENSIONS GT 0 LONG day 0:nJulian 1 : LONG day L_YEAR SIZE year N_DIMENSIONS GT 0 LONG year 0:nJulian 1 : LONG year END ENDSWITCH min_calendar 4716 max_calendar 5000000 minn MIN l_year MAX maxx IF minn LT min_calendar OR maxx GT max_calendar THEN MESSAGE Value of Julian date is out of allowed range change to accept year 0 if MAX L_YEAR eq 0 NE 0 then message There is no year zero in the civil calendar by seb Aug 2003 tochange where L_MONTH LT 0 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 1 L_MONTH tochange 12 L_MONTH tochange MOD 12 ENDIF tochange where L_MONTH GT 12 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 L_MONTH tochange L_MONTH tochange MOD 12 ENDIF by seb Aug 2003 end bc L_YEAR LT 0 L_YEAR TEMPORARY L_YEAR TEMPORARY bc inJanFeb L_MONTH LE 2 JY L_YEAR inJanFeb JM L_MONTH 1b 12b TEMPORARY inJanFeb JUL floor 365 25d JY floor 30 6001d TEMPORARY JM L_DAY 1720995L Test whether to change to Gregorian Calandar IF MIN JUL GE GREG THEN BEGIN change all dates JA long 0 01d TEMPORARY JY JUL TEMPORARY JUL 2L JA long 0 25d JA ENDIF ELSE BEGIN gregChange WHERE JUL ge GREG ngreg IF ngreg GT 0 THEN BEGIN JA long 0 01d JY gregChange JUL gregChange JUL gregChange 2L JA long 0 25d JA ENDIF ENDELSE hour minute second IF np GT 3 THEN BEGIN yes compute the fractional Julian date Add a small offset so we get the hours minutes seconds back correctly if we convert the Julian dates back This offset is proportional to the Julian date so small dates a long long time ago will be more accurate eps MACHAR DOUBLE eps eps eps ABS jul eps For Hours divide by 24 then subtract 0 5 in case we have unsigned ints jul TEMPORARY JUL TEMPORARY d_Hour 24d 0 5d TEMPORARY d_Minute 1440d TEMPORARY d_Second 86400d eps ENDIF check to see if we need to reform vector to array of correct dimensions IF N_ELEMENTS julianDims GT 1 THEN JUL REFORM TEMPORARY JUL julianDims RETURN jul END 360d :BEGIN Fixed number of days per month default 30 : IF keyword_set ndayspm THEN BEGIN IF ndayspm EQ 1 THEN ndayspm 30 ENDIF ELSE ndayspm 30 L_MONTH LONG MONTH L_DAY LONG DAY L_YEAR LONG YEAR neg where L_YEAR LT 0 IF neg 0 NE 1 THEN L_YEAR neg L_YEAR neg 1 JUL L_YEAR 1 12 L_MONTH 1 ndayspm L_DAY if n_elements Hour n_elements Minute n_elements Second eq 0 then return JUL if n_elements Hour eq 0 then Hour 0 if n_elements Minute eq 0 then Minute 0 if n_elements Second eq 0 then Second 0 IF Hour Minute Second EQ 0 THEN return JUL ELSE return JUL Hour 24 0d0 Minute 1440 0d0 Second 86400 0d0 END noleap :BEGIN L_MONTH LONG MONTH L_DAY LONG DAY L_YEAR LONG YEAR tochange where L_MONTH LT 0 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 1 L_MONTH tochange 12 L_MONTH tochange MOD 12 ENDIF tochange where L_MONTH GT 12 IF tochange 0 NE 1 THEN BEGIN L_YEAR tochange L_YEAR tochange L_MONTH tochange 12 L_MONTH tochange L_MONTH tochange MOD 12 ENDIF L_YEAR L_YEAR 1 daysyear long total 0 0 31 28 31 30 31 30 31 31 30 31 30 cumulative return 365 L_YEAR daysyear L_MONTH L_DAY END ELSE:return report only 3 types of calendar are accepted: greg 360d and noleap ENDCASE END"); 172 a[170] = new Array("./ToBeReviewed/COULEURS/color24.html", "color24.pro", "", " NAME: COLOR24 PURPOSE: The purpose of this function is to convert a RGB color triple into the equivalent 24 big long integer CATEGORY: Graphics Color Specification CALLING SEQUENCE: color COLOR24 rgb_triple INPUTS: RGB_TRIPLE: A three element column or row array representing a color triple The values of the elements must be between 0 and 255 KEYWORD PARAMETERS: None COMMON BLOCKS: None SIDE EFFECTS: None RESTRICTIONS: None EXAMPLE: To convert the color triple for the color YELLOW 255 255 0 to the hexadecimal value 00FFFF x or the decimal number 65535 type: color COLOR24 255 255 0 This routine was written to be used with routines like COLORS or GETCOLOR MODIFICATION HISTORY: Written by: David Fanning 3 February 96 FUNCTION COLOR24 number This FUNCTION accepts a red green blue triple that describes a particular color and returns a 24 bit long integer that is equivalent to that color The color is described in terms of a hexidecimal number e g FF206A where the left two digits represent the blue color the middle two digits represent the green color and the right two digits represent the red color The triple can be either a row or column vector of 3 elements ON_ERROR 1 IF N_ELEMENTS number NE 3 THEN MESSAGE Augument must be a three element vector IF MAX number GT 255 OR MIN number LT 0 THEN MESSAGE Argument values must be in range of 0 255 base16 1L 16L 256L 4096L 65536L 1048576L num24bit 0L FOR j 0 2 DO num24bit num24bit number j MOD 16 base16 0 j Fix number j 16 base16 1 j RETURN num24bit END "); 173 a[171] = new Array("./ToBeReviewed/COULEURS/colorbar.html", "colorbar.pro", "", " NAME: COLORBAR PURPOSE: The purpose of this routine is to add a color bar to the current graphics window CATEGORY: Graphics Widgets CALLING SEQUENCE: COLORBAR INPUTS: None KEYWORD PARAMETERS: BOTTOM: The lowest color index of the colors to be loaded in the bar CB_CHARSIZE: The character size of the color bar annotations Default is 1 0 CB_CHARTICK: The character thick of the color bar annotations Default is 1 0 CB_COLOR: The color index of the bar outline and characters Default is ncolors 1 bottom CB_LOG: to get logarithmic scale for the colorbar CB_TITLE: This is title for the color bar The default is to have no title DISCRET: Vecteur contenant les incices des couleurs a tracer en barre de couleur On obtient ainsi une barre de couleur discrete ne comportant que les couleurs specifiees ds l ordre ou elles apparaissent ds le vecteur DIVISIONS: The number of divisions to divide the bar into There will be divisions 1 annotations The default is 2 FORMAT: The format of the bar annotations Default is F6 2 CB_LABEL: C est un vecteur qui specifie la valeur des sticks presents dans la barre de couleur Il permet qd on utilise DISCRET d avoir des couleurs qui ne s incrementent pas de facon regulieres MAX: The maximum data value for the bar annotation Default is NCOLORS 1 MIN: The minimum data value for the bar annotation Default is 0 NCOLORS: This is the number of colors in the color bar NOTITLE: oblige a ne pas mettre de titre meme si cb_title est declare POSITION: A four element array of normalized coordinates in the same form as the POSITION keyword on a plot Default is 0 88 0 15 0 95 0 95 for a vertical bar and 0 15 0 88 0 95 0 95 for a horizontal bar PSCOLOR: This keyword is only applied if the output is being sent to a PostScript file It indicates that the PostScript device is configured for color output If this keyword is set then the annotation is drawn in the color specified by the COLOR keyword If the keyword is not set the annotation is drawn in the color specified by the P COLOR system variable usually this will be the color black In general this gives better looking output on non color or gray scale printers If you are not specifically setting the annotation color with the COLOR keyword it will probably be better NOT to set this keyword either even if you are outputting to a color PostScript printer RIGHT: This puts the labels on the right hand side of a vertical color bar It applies only to vertical color bars TOP: This puts the labels on top of the bar rather than under it The keyword only applies if a horizontal color bar is rendered VERTICAL: Setting this keyword give a vertical color bar The default is a horizontal color bar COMMON BLOCKS: None SIDE EFFECTS: Color bar is drawn in the current graphics window RESTRICTIONS: The number of colors available on the display device not the PostScript device is used unless the NCOLORS keyword is used EXAMPLE: To display a horizontal color bar above a contour plot type: LOADCT 5 NCOLORS 100 CONTOUR DIST 31 41 POSITION 0 15 0 15 0 95 0 75 C_COLORS INDGEN 25 4 NLEVELS 25 COLORBAR NCOLORS 100 MODIFICATION HISTORY: Written by: David Fanning 10 JUNE 96 10 27 96: Added the ability to send output to PostScript DWF 11 4 96: Substantially rewritten to go to screen or PostScript file without having to know much about the PostScript device or even what the current graphics device is DWF 1 27 97: Added the RIGHT and TOP keywords Also modified the way the TITLE keyword works DWF 7 15 97: Fixed a problem some machines have with plots that have no valid data range in them DWF 3 3 98: ajout du keyword discret par sebastien smasson lodyc jussieu fr PRO COLORBAR BOTTOM bottom CB_CHARSIZE cb_charsize CB_CHARTHICK cb_charthick CB_COLOR cb_color DIVISIONS divisions DISCRET discret CB_LABEL cb_label FORMAT format POSITION position MAX max MIN min NCOLORS ncolors PSCOLOR pscolor CB_TITLE cb_title VERTICAL vertical TOP top RIGHT right CB_LOG CB_log _extra ex Is the PostScript device selected postScriptDevice D NAME EQ PS Check and define keywords IF N_ELEMENTS ncolors EQ 0 THEN BEGIN Most display devices to not use the 256 colors available to the PostScript device This presents a problem when writing general purpose programs that can be output to the display or to the PostScript device This problem is especially bothersome if you don t specify the number of colors you are using in the program One way to work around this problem is to make the default number of colors the same for the display device and for the PostScript device Then the colors you see in PostScript are identical to the colors you see on your display Here is one way to do it IF postScriptDevice THEN BEGIN oldDevice D NAME What kind of computer are we using SET_PLOT to appropriate display device thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x Open a window to make sure D N_COLORS is accurate WINDOW FREE PIXMAP XSIZE 10 YSIZE 10 WDELETE D WINDOW Here is how many colors we should use ncolors D N_COLORS SET_PLOT oldDevice IF oldDevice EQ X OR oldDevice EQ MAC OR oldDevice EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF ENDIF ELSE ncolors D N_COLORS ENDIF IF N_ELEMENTS bottom EQ 0 THEN bottom 0B IF N_ELEMENTS cb_charsize EQ 0 THEN cb_charsize 1 0 IF N_ELEMENTS cb_charthick EQ 0 THEN cb_charthick 1 0 IF N_ELEMENTS format EQ 0 THEN format F6 2 IF N_ELEMENTS cb_color EQ 0 THEN cb_color ncolors 1 bottom IF N_ELEMENTS min EQ 0 THEN min 0 0 IF N_ELEMENTS max EQ 0 THEN max FLOAT ncolors 1 IF N_ELEMENTS divisions EQ 0 THEN divisions 2 IF N_ELEMENTS cb_title EQ 0 THEN cb_title IF N_ELEMENTS notitle EQ 1 THEN cb_title pscolor KEYWORD_SET pscolor IF KEYWORD_SET vertical THEN BEGIN IF KEYWORD_SET discret THEN begin facteur 256 n_elements discret discret reform replicate 1 facteur discret facteur n_elements discret overwrite bar REPLICATE 1B 10 discret endif else bar REPLICATE 1B 10 BINDGEN 256 IF N_ELEMENTS position EQ 0 THEN position 0 88 0 15 0 95 0 95 ENDIF ELSE BEGIN IF KEYWORD_SET discret THEN begin facteur 256 n_elements discret discret reform replicate 1 facteur discret facteur n_elements discret overwrite bar discret REPLICATE 1B 10 endif else bar BINDGEN 256 REPLICATE 1B 10 IF N_ELEMENTS position EQ 0 THEN position 0 15 0 88 0 95 0 95 ENDELSE Scale the color bar IF NOT KEYWORD_SET discret THEN bar BYTSCL bar TOP ncolors 1 bottom Get starting locations in DEVICE coordinates xstart position 0 D X_VSIZE ystart position 1 D Y_VSIZE Get the size of the bar in DEVICE coordinates xsize position 2 position 0 D X_VSIZE ysize position 3 position 1 D Y_VSIZE For PostScript output only draw the annotation in P COLOR unless pscolor is set This makes better output on grayscale printers IF postScriptDevice AND pscolor NE 1 THEN BEGIN oldcolor cb_color cb_color P COLOR ENDIF Display the color bar in the window Sizing is different for PostScript and regular display IF postScriptDevice THEN BEGIN TV bar xstart ystart XSIZE xsize YSIZE ysize ENDIF ELSE BEGIN bar CONGRID bar CEIL xsize CEIL ysize INTERP TV bar xstart ystart ENDELSE Annotate the color bar if keyword_set cb_label then begin divisions n_elements cb_label 1 for i 0 divisions DO cb_label string cb_label FORMAT format format ENDIF ELSE cb_label IF KEYWORD_SET vertical THEN BEGIN IF KEYWORD_SET right THEN BEGIN PLOT min max min max NODATA XTICKS 1 YTICKS divisions XSTYLE 1 YSTYLE 9 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT A1 YTICKLEN 0 1 YRANGE min max YTITLE cb_title AXIS YAXIS 1 YRANGE min max YTICKFORMAT format YTICKS divisions YTICKLEN 0 1 YSTYLE 1 COLOR cb_color CHARTHICK cb_charthick CHARSIZE cb_charsize xtickname cb_label ylog cb_log ENDIF ELSE BEGIN PLOT min max min max NODATA XTICKS 1 YTICKS divisions XSTYLE 1 YSTYLE 9 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT format XTICKFORMAT A1 YTICKLEN 0 1 YRANGE min max xtickname cb_label AXIS YAXIS 1 YRANGE min max YTICKFORMAT A1 YTICKS divisions YTICKLEN 0 1 YTITLE cb_title YSTYLE 1 COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick ylog cb_log ENDELSE ENDIF ELSE BEGIN IF KEYWORD_SET top THEN BEGIN PLOT min max min max NODATA XTICKS divisions YTICKS 1 XSTYLE 9 YSTYLE 1 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT A1 XTICKLEN 0 1 XRANGE min max XTITLE cb_title AXIS XTICKS divisions XSTYLE 1 COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick XTICKFORMAT format XTICKLEN 0 1 XRANGE min max XAXIS 1 xtickname cb_label xlog cb_log ENDIF ELSE BEGIN PLOT min max min max NODATA XTICKS divisions YTICKS 1 XSTYLE 1 YSTYLE 1 POSITION position COLOR cb_color CHARSIZE cb_charsize CHARTHICK cb_charthick NOERASE YTICKFORMAT A1 XTICKFORMAT format XTICKLEN 0 1 XRANGE min max TITLE cb_title xtickname cb_label xlog cb_log ENDELSE ENDELSE Restore color variable if changed for PostScript IF postScriptDevice AND pscolor NE 1 THEN cb_color oldcolor return END"); 174 a[172] = new Array("./ToBeReviewed/COULEURS/getcolor.html", "getcolor.pro", "", " NAME: GETCOLOR PURPOSE: The original purpose of this function was to enable the user to specify one of the 16 colors supported by the McIDAS color map by name Over time however the function has become a general purpose function for handling and supporting drawing colors in a device independent way In particular I have been looking for ways to write color handling code that will work transparently on both 8 bit and 24 bit machines On 24 bit machines the code should work the same where color decomposition is turned on or off The 16 supported colors in GETCOLOR come from the McIDAS color table offered on the IDL newsgroup by Liam Gumley CATEGORY: Graphics Color Specification CALLING SEQUENCE: result GETCOLOR color OPTIONAL INPUT PARAMETERS: COLOR: A string with the name of the color Valid names are: black magenta cyan yellow green red blue navy gold pink aqua orchid gray sky beige white The color YELLOW is returned if the color name can t be resolved Case is unimportant If the function is called with just this single input parameter the return value is either a 1 by 3 array containing the RGB values of that particular color or a 24 bit integer that can be decomposed into that particular color depending upon the state of the TRUE keyword and upon whether color decomposition is turned on or off The state of color decomposition can ONLY be determined if the program is being run in IDL 5 2 or higher INDEX: The color table index where the specified color should be loaded If this parameter is passed then the return value of the function is the index number and not the color triple If color decomposition is turned on AND the user specifies an index parameter the color is loaded in the color table at the proper index but a 24 bit value is returned to the user in IDL 5 2 and higher If no positional parameter is present then the return value is either a 16 by 3 byte array containing the RGB values of all 16 colors or it is a 16 element long integer array containing color values that can be decomposed into colors The 16 by 3 array is appropriate for loading color tables with the TVLCT command: Device Decomposed 0 colors GetColor TVLCT colors 100 INPUT KEYWORD PARAMETERS: NAMES: If this keyword is set the return value of the function is a 16 element string array containing the names of the colors These names would be appropriate for example in building a list widget with the names of the colors If the NAMES keyword is set the COLOR and INDEX parameters are ignored listID Widget_List baseID Value GetColor Names YSize 16 LOAD: If this keyword is set all 16 colors are automatically loaded starting at the color index specified by the START keyword Note that setting this keyword means that the return value of the function will be a structure with each field of the structure corresponding to a color name The value of each field will be an index number set by the START keyword corresponding to the associated color or a 24 bit long integer value that creates the color on a true color device What you have as the field values is determined by the TRUE keyword or whether color decomposition is on or off in the absense of the TRUE keyword It will either be a 1 by 3 byte array or a long integer value START: The starting color index number if the LOAD keyword is set This keyword value is ignored unless the LOAD keyword is also set The keyword is also ignored if the TRUE keyword is set or if color decomposition in on in IDL 5 2 and higher The default value for the START keyword is D TABLE_SIZE 17 TRUE: If this keyword is set the specified color triple is returned as a 24 bit integer equivalent The lowest 8 bits correspond to the red value the middle 8 bits to the green value and the highest 8 bits correspond to the blue value In IDL 5 2 and higher if color decomposition is turned on it is as though this keyword were set COMMON BLOCKS: None SIDE EFFECTS: None RESTRICTIONS: The TRUE keyword causes the START keyword to be ignored The NAMES keyword causes the COLOR INDEX START and TRUE parameters to be ignored The COLOR parameter is ignored if the LOAD keyword is used On systems where it is possible to tell the state of color decomposition i e IDL 5 2 and higher a 24 bit value or values is automatically returned if color decomposition is ON EXAMPLE: To load a yellow color in color index 100 and plot in yellow type: yellow GETCOLOR yellow 100 PLOT data COLOR yellow or PLOT data COLOR GETCOLOR yellow 100 To do the same thing on a 24 bit color system with decomposed color on type: PLOT data COLOR GETCOLOR yellow TRUE or in IDL 5 2 and higher DEVICE Decomposed 1 PLOT data COLOR GETCOLOR yellow To load all 16 colors into the current color table starting at color index 200 type: TVLCT GETCOLOR 200 To add the color names to a list widget: listID Widget_List baseID Value GetColor Names YSize 16 To load all 16 colors and have the color indices returned in a structure: DEVICE Decomposed 0 colors GetColor Load Start 1 HELP colors Structure PLOT data COLOR colors yellow To get the direct color values as 24 bit integers in color structure fields: DEVICE Decomposed 1 colors GetColor Load PLOT data COLOR colors yellow Note that the START keyword value is ignored if on a 24 bit device so it is possible to write completely device independent code by writing code like this: colors GetColor Load PLOT data Color colors yellow MODIFICATION HISTORY: Written by: David Fanning 10 February 96 Fixed a bug in which N_ELEMENTS was spelled wrong 7 Dec 96 DWF Added the McIDAS colors to the program 24 Feb 99 DWF Added the INDEX parameter to the program 8 Mar 99 DWF Added the NAMES keyword at insistence of Martin Schultz 10 Mar 99 DWF Reorderd the colors so black is first and white is last 7 June 99 DWF Added automatic recognition of DECOMPOSED 1 state 7 June 99 DWF Added LOAD AND START keywords 7 June 99 DWF FUNCTION COLOR24 number This FUNCTION accepts a red green blue triple that describes a particular color and returns a 24 bit long integer that is equivalent to that color The color is described in terms of a hexidecimal number e g FF206A where the left two digits represent the blue color the middle two digits represent the green color and the right two digits represent the red color The triple can be either a row or column vector of 3 elements ON_ERROR 1 IF N_ELEMENTS number NE 3 THEN MESSAGE Augument must be a three element vector IF MAX number GT 255 OR MIN number LT 0 THEN MESSAGE Argument values must be in range of 0 255 base16 1L 16L 256L 4096L 65536L 1048576L num24bit 0L FOR j 0 2 DO num24bit num24bit number j MOD 16 base16 0 j Fix number j 16 base16 1 j RETURN num24bit END of COLOR24 FUNCTION GETCOLOR thisColor index TRUE truecolor NAMES colornames LOAD load START start Set up the color vectors names Black Magenta Cyan Yellow Green rvalue 0 255 0 255 0 gvalue 0 0 255 255 255 bvalue 0 255 255 0 0 names names Red Blue Navy Gold Pink rvalue rvalue 255 0 0 255 255 gvalue gvalue 0 0 0 187 127 bvalue bvalue 0 255 115 0 127 names names Aqua Orchid Gray Sky Beige White rvalue rvalue 112 219 127 0 255 255 gvalue gvalue 219 112 127 163 171 255 bvalue bvalue 147 219 127 255 127 255 Did the user ask for a specific color If not return all the colors If the user asked for a specific color find out if a 24 bit value is required Return to main IDL level if an error occurs ON_Error 1 np N_Params IF Keyword_Set start EQ 0 THEN start D TABLE_SIZE 17 User ask for the color names IF Keyword_Set colornames THEN RETURN names ELSE names StrUpCase names If no positional parameter return all colors IF np EQ 0 THEN BEGIN Did the user want a 24 bit value If so call COLOR24 IF Keyword_Set trueColor THEN BEGIN returnColor LonArr 16 FOR j 0 15 DO returnColor j Color24 rvalue j gvalue j bvalue j If LOAD keyword set return a color structure IF Keyword_Set load THEN BEGIN returnValue Create_Struct black returnColor 0 FOR j 1 15 DO returnValue Create_Struct returnValue names j returnColor j returnColor returnValue ENDIF RETURN returnColor ENDIF If color decomposition is ON return 24 bit values IF Float Version Release GE 5 2 THEN BEGIN IF D Name EQ X OR D Name EQ WIN OR D Name EQ MAC THEN BEGIN Device Get_Decomposed decomposedState ENDIF ELSE decomposedState 0 IF decomposedState EQ 1 THEN BEGIN returnColor LonArr 16 FOR j 0 15 DO returnColor j Color24 rvalue j gvalue j bvalue j IF Keyword_Set load THEN BEGIN returnValue Create_Struct black returnColor 0 FOR j 1 15 DO returnValue Create_Struct returnValue names j returnColor j RETURN returnValue ENDIF RETURN returnColor ENDIF IF Keyword_Set load THEN BEGIN TVLCT Reform rvalue gvalue bvalue 16 3 start returnValue Create_Struct black start FOR j 1 15 DO returnValue Create_Struct returnValue names j start j RETURN returnValue ENDIF returnColor REFORM rvalue gvalue bvalue 16 3 RETURN returnColor ENDIF IF Keyword_Set load THEN BEGIN TVLCT Reform rvalue gvalue bvalue 16 3 start returnValue Create_Struct black start FOR j 1 15 DO returnValue Create_Struct returnValue names j start j RETURN returnValue ENDIF returnColor REFORM rvalue gvalue bvalue 16 3 RETURN returnColor ENDIF Check synonyms of colors IF StrUpCase thisColor EQ GREY THEN thisColor GRAY IF StrUpCase thisColor EQ CHARCOAL THEN thisColor GRAY IF StrUpCase thisColor EQ AQUAMARINE THEN thisColor AQUA IF StrUpCase thisColor EQ SKYBLUE THEN thisColor SKY Make sure the parameter is an uppercase string varInfo SIZE thisColor IF varInfo varInfo 0 1 NE 7 THEN MESSAGE The color name must be a string thisColor STRUPCASE thisColor Get the color triple for this color colorIndex WHERE names EQ thisColor If you can t find it Issue an infomational message set the index to a YELLOW color and continue IF colorIndex 0 LT 0 THEN BEGIN MESSAGE Can t find color Returning YELLOW INFORMATIONAL colorIndex 3 ENDIF Get the color triple r rvalue colorIndex g gvalue colorIndex b bvalue colorIndex returnColor REFORM r g b 1 3 Did the user want a 24 bit value If so call COLOR24 IF KEYWORD_SET trueColor THEN BEGIN returnColor COLOR24 returnColor RETURN returnColor ENDIF If color decomposition is ON return 24 bit value IF Float Version Release GE 5 2 THEN BEGIN IF D Name EQ X OR D Name EQ WIN OR D Name EQ MAC THEN BEGIN Device Get_Decomposed decomposedState ENDIF ELSE decomposedState 0 IF decomposedState EQ 1 THEN BEGIN Before you change return color load index if requested IF N_Elements index NE 0 THEN BEGIN index 0 index index D Table_Size 1 TVLCT returnColor index returnColor index ENDIF RETURN returnColor END"); 175 a[173] = new Array("./ToBeReviewed/COULEURS/lct.html", "lct.pro", "", " NAME:lct PURPOSE:plus court que de taper loadct file palette tbl CATEGORY:flemme CALLING SEQUENCE:lct numerp_couleur INPUTS:optionnel: numero de la couleur que l on veut ds palette tbl KEYWORD PARAMETERS: ceux de loadct LIGHTNESS: a scalar used to change the Lightness of the color palette to be abble to adjust according to the printer we use the media paper or slide lightness 1 to get darker colors rq: si le mot cle file n est pas specifie on cherche un fichier contenant les palette du nom de palette tbl Ce fichier peut etre dans n importe quel repertoire du path MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 30 3 1999 ajout de _extra de la recherche du nom complet et pour que ca marche aussi en mode PS et Z 6 7 1999: compatibilite mac et windows PRO lct numero GET_NAME get_name LIGHTNESS Lightness _EXTRA ex common le mot cle file est passe par l intermediere de EXTRA definition du mon du fichier qui contient les palettes de couleur if n_elements ex NE 0 then BEGIN if where tag_names ex EQ FILE 0 NE 1 then nompal ex FILE ELSE nompal palette tbl ENDIF ELSE nompal palette tbl quelle est l adresse complete de nompal thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos nompal sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep for i 0 n_elements multipath 1 do if rstrpos multipath i sep NE strlen multipath i 1 then multipath i multipath i sep nompal current multipath nompal ENDIF on test tous les noms possibles pour trouver ou est le fichier nfile n_elements nompal n 0 repeat begin res findfile nompal n n n 1 endrep until res 0 NE OR n EQ n_elements nompal if res 0 NE then BEGIN nompal nompal n 1 if n_elements ex NE 0 then if where tag_names ex EQ FILE 0 NE 1 then ex FILE nompal si on est en mode POSTSCRIPT il faut repasser en mode X pour changer la palette de couleur oldname d name if d name EQ PS OR d name EQ Z then BEGIN thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF if arg_present get_name then begin if n_elements numero EQ 0 then loadct file nompal GET_NAME get_name _EXTRA ex ELSE loadct numero file nompal silent GET_NAME get_name _EXTRA ex ENDIF ELSE BEGIN if n_elements numero EQ 0 then loadct file nompal _EXTRA ex ELSE loadct numero file nompal silent _EXTRA ex ENDELSE if oldname EQ PS AND keyword_set lightness then palit lightness set_plot oldname IF oldname EQ X OR oldname EQ MAC OR oldname EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF ENDIF ELSE ras report le fichier de palettes demande n existe pas return end"); 176 a[174] = new Array("./ToBeReviewed/COULEURS/newpalette.html", "newpalette.pro", "", " NAME:newpalette PURPOSE:permet de stocker la palette qui est a l ecran dans un fichier du meme type que celui fournit par defaut dans IDL: colors1 tbl CATEGORY:pour garder ses jolies palettes perso CALLING SEQUENCE:newpalette nom_de_palette INPUTS:nom_de_palette: c est un string qui contient le nom de la nouvelle palette que l on veut ecrire KEYWORD PARAMETERS: OVER: c est un entier qui designe le numero de la palette que l on veut remplacer par la palette a l ecran ceux de modifyct rq: si le mot cle file n est pas specifie on cherche un fichier contenant les palettes du nom de palette tbl Ce fichier peut etre dans n importe quel repertoire du path Par contre il doit etre en droit d ecriture MODIFICATION HISTORY: Guillaume Roulet gr lodyc jussieu fr 30 3 1999 s masson ajout de _extra de le recherche du nom complet de OVER et du blabla 5 5 1999 s masson va copie eventuelle du fichier contenant les palettes pro newpalette nom OVER over _extra ex le mot cle file est passe par l intermediere de EXTRA definition du mon du fichier qui contient les palettes de couleur if n_elements ex NE 0 then BEGIN if where tag_names ex EQ FILE 0 NE 1 then nompal ex FILE ELSE nompal palette tbl ENDIF ELSE nompal palette tbl nomcourt nompal quelle est l adresse complete de nompal nompal find nompal if nompal 0 NE NOT FOUND then begin nompal nompal 0 nompal nous appartient spawn whoami login appartient strpos nompal login 0 if appartient EQ 1 then begin ouinon report Le fichier nompal ne vous appartient pas Voulez vous copier le fichier nomcourt dans le repertoire courant: current default_no question if ouinon then return ELSE BEGIN spawn cp nompal nomcourt on copie nompal nomcourt spawn chmod u w nompal on se donne les droits d ecriture ENDELSE endif ENDIF ELSE BEGIN aucun fichier nompal a ete trouve nompal nomcourt on recupe le nompal d origine ouinon report le fichier de palettes demande nompal n existe pas ds les repertoires path Voulez vous cree un fichier nompal dans le repertoire courant default_no question if NOT ouinon then return nomfichsource filepath colors1 tbl subdir resource colors spawn cp nomfichsource nompal on copie spawn chmod u w nompal on se donne les droits d ecriture ENDELSE if n_elements ex NE 0 then if where tag_names ex EQ FILE 0 NE 1 then ex FILE nompal tvlct r g b get r congrid r 256 g congrid g 256 b congrid b 256 IF n_elements over EQ 0 then over 255 modifyct over nom r g b file nompal _extra ex return end"); 177 a[175] = new Array("./ToBeReviewed/COULEURS/palit.html", "palit.pro", "", " Eclaircit la palette courante en jouant sur la luminosite coef regle l attenuation des couleurs par defaut divise par 2 la luminosite coef 0 1 pour la QMS papier de l IPSL convient tres bien PRO palit coef red green blue IF n_elements coef EQ 0 THEN coef 0 5 IF n_elements red EQ 0 THEN tvlct red green blue get color_convert red green blue h l s rgb_hls l 1 coef 1 l Le noir doit rester bien noir toutes mes palettes commencent par du noir et finissent par du blanc l 0 0 tvlct h l s hls return END"); 178 a[176] = new Array("./ToBeReviewed/COULEURS/xlct.html", "xlct.pro", "", " Id: xlct pro 19 2006 05 02 09:40:19Z pinsard Copyright c 1991 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited PRO XLCT_PSAVE Save Restore our plotting state Swaps our state with the current state each time its called COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback updt_cb_data tmp xlct_psave win: d window x: x s y: y s xtype: x type ytype: y type clip: p clip wset psave win x type psave xtype y type psave ytype x s psave x y s psave y p clip psave clip psave tmp end pro xlct_alert_caller COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data ErrorStatus 0 CATCH ErrorStatus if ErrorStatus NE 0 then begin CATCH CANCEL v DIALOG_MESSAGE Unexpected error in XLCT: ERR_STRING ERR_STRING ERROR return endif if STRLEN updt_callback gt 0 then begin if PTR_VALID p_updt_cb_data then begin CALL_PROCEDURE updt_callback DATA p_updt_cb_data endif else begin CALL_PROCEDURE updt_callback endelse endif end Redraw the ramp image PRO xlct_show COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data cur_win D WINDOW WSET show_win TV BYTE FLOAT ncolors FINDGEN siz FLOAT siz 1 REPLICATE 1 w_height BYTE cbot WSET cur_win Let the caller of XLCT know that the color table was modified xlct_alert_caller END PRO xlct_draw_cps i c COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot tc color if n_elements c gt 0 then begin tc c if c ne 0 then color c endif if i 0 eq 1 then j indgen n_elements cps else j i plots cps j tfun j noclip color tc plots cps j tfun j noclip psym 6 color tc end PRO xlct_transfer UPDATE update COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot l lonarr ncolors Subscripts m n_elements cps for i 0 m 2 do begin n cps i 1 cps i Interval b tfun i 1 tfun i float n l cps i findgen n b tfun i cbot endfor l ncolors 1 tfun m 1 Last point if use_values then begin r_curr cbot r l r_orig g_curr cbot g l g_orig b_curr cbot b l b_orig endif else begin r_curr cbot r r_orig l g_curr cbot g g_orig l b_curr cbot b b_orig l endelse tvlct r g b cbot if keyword_set update then xlct_show end PRO xlct_event event COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data IF event id eq state draw THEN BEGIN PROCESS DRAWABLE EVENTS if event press ne 0 then begin Pressed button dmin 1 0e8 Find closest control pnt xlct_psave Remove old p convert_coord event x event y TO_DATA DEVICE xlct_psave Restore old x fix p 0 y fix p 1 for i 0 n_elements cps 1 do begin d p 0 cps i 2 p 1 tfun i 2 dist 2 if d lt dmin then begin dmin d pnt i endif endfor return endif if event release ne 0 then begin Released button pnt 1 xlct_transfer update return endif if pnt lt 0 then return Don t care here xlct_psave Remove old For visuals with static colormaps erase plot before drawing new if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin ERASE color 0 endif p convert_coord event x event y TO_DATA DEVICE Coord of mouse n ncolors 1 Into range m n_elements cps 1 x fix p 0 0 cps pnt 1 1 0 0 0 0 0 else s findgen nc s nc int nc 0 0 gamma nc if chop ne 0 then begin too_high where s ge nc n if n gt 0 then s too_high 0L endif if use_values then begin s s 1 cps cps keep tfun tfun keep goto interp_cps ENDIF ENDCASE ADDCP : BEGIN xlct_psave xlct_draw_cps 1 0 igap 0 Find largest gap for i 0 n_elements cps 2 do if cps i 1 cps i gt cps igap 1 cps igap then igap i cps cps 0:igap cps igap cps igap 1 2 cps igap 1: tfun tfun 0:igap tfun igap tfun igap 1 2 tfun igap 1: interp_cps: xlct_draw_cps 1 Redraw new xlct_transfer update xlct_psave Restore old points if n_elements reset_all then goto reset_all ENDCASE ENDCASE END NAME: XLCT PURPOSE: comme xloadct mais plus cour a ecrire et appelle par defaut la palette palette tbl qui peut etre situee dans n importe quel repertoire de path CATEGORY: Widgets CALLING SEQUENCE: XLCT INPUTS: None KEYWORDS: FILE: If this keyword is set the file by the given name is used instead of the file colors1 tbl in the IDL directory This allows multiple IDL users to have their own color table file GROUP The widget ID of the widget that calls Xlct When this ID is specified a death of the caller results in a death of Xlct NCOLORS number of colors to use Use color indices from BOTTOM to the smaller of D TABLE_SIZE 1 and NCOLORS 1 Default D TABLE_SIZE all available colors BOTTOM first color index to use Use color indices from BOTTOM to BOTTOM NCOLORS 1 Default 0 SILENT Normally no informational message is printed when a color map is loaded If this keyword is present and zero this message is printed USE_CURRENT: If set use the current color tables regardless of the contents of the COMMON block COLORS MODAL: If set then XLCT runs in modal mode meaning that all other widgets are blocked until the user quits XLCT A group leader must be specified via the GROUP keyword for the MODAL keyword to have any effect The default is to not run in modal mode BLOCK: Set this keyword to have XMANAGER block when this application is registered By default the Xmanager keyword NO_BLOCK is set to 1 to provide access to the command line if active command line processing is available Note that setting BLOCK for this application will cause all widget applications to block not only this application For more information see the NO_BLOCK keyword to XMANAGER UPDATECALLBACK: Set this keyword to a string containing the name of a user supplied procedure that will be called when the color table is updated by XLCT The procedure may optionally accept a keyword called DATA which will be automatically set to the value specified by the optional UPDATECBDATA keyword UPDATECBDATA: Set this keyword to a value of any type It will be passed via the DATA keyword to the user supplied procedure specified via the UPDATECALLBACK keyword if any If the UPDATECBDATA keyword is not set the value accepted by the DATA keyword to the procedure specified by UPDATECALLBACK will be undefined OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: One of the predefined color maps may be loaded RESTRICTIONS: This routine uses the LOADCT user library procedure to do the actual work MODIFICATION HISTORY: 5 5 1999 copie de xloadct par Sebastien Masson smlod ipsl jussieu fr PRO XLct SILENT silent_f GROUP group FILE file USE_CURRENT use_current NCOLORS nc BOTTOM bottom MODAL modal BLOCK block UPDATECALLBACK updt_cb_name UPDATECBDATA updt_cb_data COMMON colors r_orig g_orig b_orig r_curr g_curr b_curr COMMON xlct_com r0 g0 b0 tfun state filename cps psave pnt top bot silent chop lock g_lbl vbot vtop g_slider gamma color use_values ncolors cbot siz w_height show_win updt_callback p_updt_cb_data IF XRegistered xlct NE 0 THEN return IF N_ELEMENTS block EQ 0 THEN block 0 IF N_ELEMENTS updt_cb_name EQ 0 THEN updt_callback ELSE updt_callback updt_cb_name IF N_ELEMENTS updt_cb_data GT 0 THEN p_updt_cb_data PTR_NEW updt_cb_data ELSE p_updt_cb_data PTR_NEW values_button lonarr 2 IF KEYWORD_SET SILENT_f THEN silent SILENT_F ELSE silent 1 changements effectues par S Masson IF N_ELEMENTS file GT 0 THEN filename file ELSE BEGIN filename find palette tbl filename filename 0 if filename EQ NOT FOUND then filename filepath colors1 tbl subdir resource colors ENDELSE file filename siz 256 Basic width of tool names 0 LOADCT GET_NAMES names FILE file Get table names w_height 50 Height of ramp cur_win D WINDOW lock 0 chop 0 vbot 0 vtop 100 gamma 1 0 use_values 0 Bases: 0 slider base stretch bottom stretch top gamma 1 transfer function drawable buttons 2 color table list 3 options base sliders top stretch state bases: lonarr 4 draw: 0L name_list: 0L DJC Added modal keyword Moved group_leader keyword from XMANAGER to WIDGET_BASE Ignore modal keyword if a group leader is not supplied if N_ELEMENTS group GT 0L then base WIDGET_BASE TITLE Xlct COLUMN GROUP_LEADER group MODAL KEYWORD_SET modal else base WIDGET_BASE TITLE Xlct COLUMN Setting the managed attribute indicates our intention to put this app under the control of XMANAGER and prevents our draw widgets from becoming candidates for becoming the default window on WSET 1 XMANAGER sets this but doing it here prevents our own WSETs at startup from having that problem WIDGET_CONTROL MANAGED base show WIDGET_DRAW base YSIZE w_height XSIZE siz FRAME RETAIN 2 junk WIDGET_BASE base ROW done WIDGET_BUTTON junk VALUE Done UVALUE DONE junk1 WIDGET_BUTTON junk VALUE Help UVALUE HELP junk CW_BGROUP base ROW EXCLUSIVE NO_REL Tables Options Function UVALUE NEWBASE SET_VALUE 0 junk widget_base base for i 0 1 do state bases i WIDGET_BASE junk COLUMN sbase WIDGET_BASE state bases 0 COLUMN bot WIDGET_SLIDER sbase TITLE Stretch Bottom MINIMUM 0 MAXIMUM 100 VALUE 0 DRAG UVALUE BOTTOM xsize siz top WIDGET_SLIDER sbase TITLE Stretch Top MINIMUM 0 MAXIMUM 100 VALUE 100 DRAG UVALUE TOP xsize siz g_lbl WIDGET_LABEL sbase VALUE STRING 1 0 g_slider WIDGET_slider sbase TITLE Gamma Correction MINIMUM 0 MAXIMUM 100 VALUE 50 UVALUE GAMMA SUPPRESS_VALUE DRAG xsize siz junk WIDGET_BASE sbase for i 2 3 do state bases i WIDGET_BASE junk COLUMN DEVICE GET_SCREEN junk if junk 1 le 768 then junk 8 else junk 16 state name_list WIDGET_LIST state bases 2 VALUE names ysize junk Drawable for transfer function junk WIDGET_BASE state bases 1 COLUMN FRAME junk1 WIDGET_BUTTON junk VALUE Reset Transfer Function UVALUE TFUNR junk1 WIDGET_BUTTON junk VALUE Add Control Point UVALUE ADDCP junk1 WIDGET_BUTTON junk VALUE Remove Control Point UVALUE REMCP state draw WIDGET_DRAW state bases 1 xsize siz ysize siz BUTTON_EVENTS MOTION_EVENTS opt_id state bases 3 junk CW_BGROUP opt_id ROW LABEL_LEFT Sliders: EXCLUSIVE NO_REL Independent Gang UVALUE GANG SET_VALUE lock junk CW_BGROUP opt_id ROW LABEL_LEFT Top: EXCLUSIVE NO_REL Clip Chop SET_VALUE chop UVALUE CHOP junk CW_BGROUP opt_id ROW LABEL_LEFT Stretch: EXCLUSIVE NO_REL Indices Intensity UVALUE VALUES SET_VALUE use_values junk WIDGET_BUTTON opt_id VALUE Reverse Table UVALUE REVERSE NO_REL junk WIDGET_BUTTON opt_id VALUE REPLACE Original Table UVALUE OVERWRITE NO_REL junk WIDGET_BUTTON opt_id VALUE RESTORE Original Table UVALUE RESTORE NO_REL WIDGET_CONTROL state bases 1 MAP 0 Tfun is not visible WIDGET_CONTROL state bases 3 MAP 0 options are not visible WIDGET_CONTROL base REALIZE WIDGET_CONTROL state draw GET_VALUE tmp if n_elements bottom gt 0 then cbot bottom else cbot 0 ncolors d table_size cbot if n_elements nc gt 0 then ncolors ncolors nc if ncolors le 0 then message Number of colors is 0 or negative psave xlct_psave win: d window x: x s y: y s xtype: x type ytype: y type clip: p clip Our initial state wset tmp Initial graph xlct_psave Save original scaling window plot 0 ncolors 1 0 ncolors 1 xstyle 3 ystyle 3 xmargin 1 1 ymargin 1 1 ticklen 0 03 NODATA xlct_psave Restore original scaling window If no common use current colors IF KEYWORD_SET use_current or N_ELEMENTS r_orig LE 0 THEN BEGIN TVLCT r_orig g_orig b_orig GET r_curr r_orig b_curr b_orig g_curr g_orig ENDIF r0 r_curr Save original colors g0 g_curr b0 b_curr color ncolors cbot 1 cps 0 ncolors 1 tfun cps pnt 1 WIDGET_CONTROL show GET_VALUE show_win WSET show_win DJC fixed color bar display bug TVSCL BYTSCL INDGEN siz REPLICATE 1 w_height top ncolors 1 TV BYTE FLOAT ncolors FINDGEN siz FLOAT siz 1 REPLICATE 1 w_height BYTE cbot WSET cur_win DJC moved GROUP_LEADER keyword to WIDGET_BASE XManager xlct base NO_BLOCK NOT FLOAT block MODAL KEYWORD_SET modal END"); 179 a[177] = new Array("./ToBeReviewed/COULEURS/xpal.html", "xpal.pro", "", " Id: xpal pro 19 2006 05 02 09:40:19Z pinsard Copyright c 1992 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: XPAL PURPOSE: comme xpalette mais plus court a ecrire et possede en plus une touche save qui grace a la routine newpalette permet de sauver la routine que l on vient de faire Rq qd on appuie sur la touche predefined appelle xlct plutot que xloadct CATEGORY: Color tables widgets CALLING SEQUENCE: XPAL INPUTS: No explicit inputs The current color table is used as a starting point KEYWORD PARAMETERS: BLOCK: Set this keyword to have XMANAGER block when this application is registered By default the Xmanager keyword NO_BLOCK is set to 1 to provide access to the command line if active command line processing is available Note that setting BLOCK for this application will cause all widget applications to block not only this application For more information see the NO_BLOCK keyword to XMANAGER UPDATECALLBACK: Set this keyword to a string containing the name of a user supplied procedure that will be called when the color table is updated by XLOADCT The procedure may optionally accept a keyword called DATA which will be automatically set to the value specified by the optional UPDATECBDATA keyword UPDATECBDATA: Set this keyword to a value of any type It will be passed via the DATA keyword to the user supplied procedure specified via the UPDATECALLBACK keyword if any If the UPDATECBDATA keyword is not set the value accepted by the DATA keyword to the procedure specified by UPDATECALLBACK will be undefined OUTPUTS: None COMMON BLOCKS: COLORS: Contains the current RGB color tables XP_COM: Private to this module SIDE EFFECTS: XPAL uses two colors from the current color table as drawing foreground and background colors These are used for the RGB plots on the left and the current index marker on the right This means that if the user set these two colors to the same value the XPAL display could become unreadable like writing on black paper with black ink XPAL minimizes this possibility by noting changes to the color map and always using the brightest available color for the foreground color and the darkest for the background Thus the only way to make XPAL s display unreadable is to set the entire color map to a single color which is highly unlikely The only side effect of this policy is that you may notice XPAL redrawing the entire display after you ve modified the current color This simply means that the change has made XPAL pick new drawing colors The new color tables are saved in the COLORS common and loaded to the display PROCEDURE: The XPAL widget has the following controls: Left: Three plots showing the current Red Green and Blue vectors Center: A status region containing: 1 The total number of colors 2 The current color XPAL allows changing one color at a time This color is known as the current color and is indicated in the color spectrum display with a special marker 3 The current mark index The mark is used to remember a color index It is established by pressing the Set Mark Button while the current color index is the desired mark index 4 The current color The special marker used in color spectrum display prevents the user from seeing the color of the current index but it is visible here A panel of control buttons which do the following when pressed: Done: Exits XPAL Predefined: Starts XLOADCT to allow selection of one of the predefined color tables Help: Supplies help information similar to this header Redraw: Completely redraws the display using the current state of the color map Set Mark: Set the value of the mark index to the current index Switch Mark: Exchange the mark and the current index Copy Current: Every color lying between the current index and the mark index inclusive is given the current color Interpolate: The colors lying between the current index and the mark index are interpolated linearly to lie between the colors of two endpoints save: permet de sauver la palette qui est actuellement a l ecran Qd on appuie sur ce bouton un widget apparait qui demande: 1 le nom a donner a la palette que l on veut sauver 2 le numero de la palette que l on veut eventuellement ecrase par la nouvelle palette Si aucun numero n est specifie la nouvelle palette estajoutee aux anciennes 3 le nom du fichier qui contient les palettes Rq: suivre eventuellement les indications fournis au prompteur Three sliders R G and B that allow the user to modify the current color Right: A display which shows the current color map as a series of squares Color index 0 is at the upper left The color index increases monotonically by rows going left to right and top to bottom The current color index is indicated by a special marker symbol There are 4 ways to change the current color: 1 Press any mouse button while the mouse pointer is over the color map display 2 Use the By Index slider to move to the desired color index 3 Use the Row Slider to move the marker vertically 4 Use the Column Slider to move the marker horizontally MODIFICATION HISTORY: addaptation de xpalette pour ajouter un bouton save par Gima Nicolas nglod ipsl jussieu fr et par Masson Sebastien smlod ipsl jussieu fr function XP_NEW_COLORS Choose the best foreground and background colors for the current color maps and set P appropriately Returns 1 if the colors changed 0 otherwise common xp_com xpw state res 0 junk CT_LUMINANCE dark dark_col bright bright_col if bright_col ne p color then begin p color bright_col res 1 endif if dark_col ne p background then begin p background dark_col res 1 endif return res end pro XP_ALERT_CALLER common xp_com xpw state ErrorStatus 0 CATCH ErrorStatus if ErrorStatus NE 0 then begin CATCH CANCEL v DIALOG_MESSAGE Unexpected error in XPAL: ERR_STRING ERR_STRING ERROR return endif if STRLEN state updt_callback gt 0 then begin if PTR_VALID state p_updt_cb_data then begin CALL_PROCEDURE state updt_callback DATA state p_updt_cb_data endif else begin CALL_PROCEDURE state updt_callback endelse endif end pro XP_XLCTCALLBACK For visuals with static colormaps update the graphics after a change by XLOADCT if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin XP_REDRAW endif end pro XP_REDRAW common xp_com xpw state junk XP_NEW_COLORS WIDGET_CONTROL xpw colorsel set_value 1 XP_REPLOT p color F Update the plots of RGB Let the caller of XPAL know that the color table was modified XP_ALERT_CALLER end pro XP_REPLOT color_index type Re draw the RGB plots Type has the following possible values D : Draw the data part of all three plots F : draw all three plots R : Draw the data part of the Red plot G : Draw the data part of the Green plot B : Draw the data part of the Blue plot common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr common pscale r_x_s r_y_s g_x_s g_y_s b_x_s b_y_s Update the plots of RGB save_win D WINDOW wset state plot_win save_p_region p region save_x_margin x margin save_y_margin y margin save_x_s x s save_y_s y s save_x_type x type save_y_type y type y margin 2 2 x margin 6 2 if type eq F then begin p region 0 6667 1 1 plot xstyle 2 ystyle 3 yrange 0 260 r_curr title Red r_x_s x s r_y_s y s p region 0 333 1 6667 plot noerase xstyle 2 ystyle 3 yrange 0 260 g_curr title Green g_x_s x s g_y_s y s p region 0 0 1 333 plot noerase xstyle 2 ystyle 3 yrange 0 260 b_curr title Blue b_x_s x s b_y_s y s endif else begin if type eq D or type eq R then begin p region 0 6667 1 1 x s r_x_s y s r_y_s oplot r_curr color color_index endif if type eq D or type eq G then begin p region 0 333 1 6667 x s g_x_s y s g_y_s oplot g_curr color color_index endif if type eq D or type eq B then begin p region 0 0 1 333 x s b_x_s y s b_y_s oplot b_curr color color_index endif endelse empty WSET save_win p region save_p_region x margin save_x_margin y margin save_y_margin x s save_x_s y s save_y_s x type save_x_type y type save_y_type end pro XP_CHANGE_COLOR type value Change current color Type has the following possible values R : Change the R part of the current color G : B : common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr cur_idx state cur_idx XP_REPLOT p background type if type eq R then r_curr cur_idx value if type eq G then g_curr cur_idx value if type eq B then b_curr cur_idx value tvlct r_curr cur_idx g_curr cur_idx b_curr cur_idx cur_idx if XP_NEW_COLORS then begin Highlight the current position using the marker WIDGET_CONTROL xpw colorsel set_value 1 Re initialize XP_REPLOT p color F endif else begin XP_REPLOT p color type endelse For visuals with static colormaps update the graphics of the current color if COLORMAP_APPLICABLE redrawRequired GT 0 and redrawRequired GT 0 then begin Mark new square tmp D WINDOW wset state cur_color_win erase color state cur_idx wset tmp endif Let the caller of XPAL know that the color table was modified xp_alert_caller end pro XP_BUTTON_EVENT event common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr NOTE: The value of these tags depend on the order of the buttons in the base case event value of DONE 0: begin empty r_orig r_curr g_orig g_curr b_orig b_curr new orig color tbl WIDGET_CONTROL DESTROY event top p state old_p end PREDEFINED 1: xlct silent group xpw base UPDATECALLBACK XP_XLCTCALLBACK HELP 2: XDisplayFile FILEPATH xpal txt subdir help widget TITLE Xpal Help GROUP event top WIDTH 55 HEIGHT 16 REDRAW 3: XP_REDRAW SET MARK 4: begin state mark_idx state cur_idx WIDGET_CONTROL xpw mark_label set_value strcompress state mark_idx REMOVE end SWITCH MARK 5 : if state mark_idx ne state cur_idx then begin tmp state mark_idx state mark_idx state cur_idx state cur_idx tmp WIDGET_CONTROL xpw colorsel set_value tmp WIDGET_CONTROL xpw idx_label set_value strcompress state cur_idx REMOVE WIDGET_CONTROL xpw mark_label set_value strcompress state mark_idx REMOVE endif COPY CURRENT 6 : begin do_copy: cur_idx state cur_idx if state mark_idx le cur_idx then begin s state mark_idx e cur_idx endif else begin s cur_idx e state mark_idx endelse n e s 1 XP_REPLOT p background D if event value eq 6 then begin r_curr s:e r_curr cur_idx g_curr s:e g_curr cur_idx b_curr s:e b_curr cur_idx endif else begin Interpolate scale findgen n float n 1 r_curr s:e r_curr s fix r_curr e fix r_curr s scale g_curr s:e g_curr s fix g_curr e fix g_curr s scale b_curr s:e b_curr s fix b_curr e fix b_curr s scale endelse tvlct r_curr s:e g_curr s:e b_curr s:e s if XP_NEW_COLORS then begin WIDGET_CONTROL xpw colorsel SET_VALUE 1 XP_REPLOT p color F endif else begin XP_REPLOT p color D endelse Let the caller of XPAL know that the color table was modified xp_alert_caller end 7: goto do_copy 8: BEGIN COMMON basecommon bas212 bas222 bas232 base WIDGET_BASE COLUMN FRAME bas1 WIDGET_LABEL base value Save bas2 WIDGET_BASE base COLUMN bas21 WIDGET_BASE bas2 COLUMN bas211 WIDGET_LABEL bas21 value Palette Name : bas212 WIDGET_TEXT bas21 value Noname editable bas22 WIDGET_BASE bas2 COLUMN bas221 WIDGET_LABEL bas22 value Overwrite palette number : bas222 WIDGET_TEXT bas22 value editable bas23 WIDGET_BASE bas2 COLUMN bas231 WIDGET_LABEL bas23 value file name : bas232 WIDGET_TEXT bas23 value palette tbl editable bas3 WIDGET_BASE base ROW ok WIDGET_BUTTON bas3 value OK ALIGN_LEFT FRAME UVALUE ok cancel WIDGET_BUTTON bas3 value CANCEL ALIGN_RIGHT FRAME UVALUE cancel WIDGET_CONTROL base REALIZE WIDGET_CONTROL base SET_UVALUE drawID XMANAGER xp_button_event base END else: endcase end PRO xp_button_event_event ev COMMON basecommon bas212 bas222 bas232 WIDGET_CONTROL ev id GET_UVALUE uval IF TAG_NAMES ev STRUCTURE_NAME EQ WIDGET_BUTTON THEN BEGIN CASE uval OF ok :BEGIN WIDGET_CONTROL bas212 GET_VALUE palname WIDGET_CONTROL bas222 GET_VALUE over WIDGET_CONTROL bas232 GET_VALUE fichname if over 0 EQ then over 255 ELSE over long over newpalette palname 0 OVER over 0 file fichname 0 WIDGET_CONTROL ev top DESTROY END cancel : WIDGET_CONTROL ev top DESTROY ENDCASE ENDIF END pro XP_EVENT event common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr case event id of xpw button_base: XP_BUTTON_EVENT event xpw rgb_base: begin cur_idx state cur_idx if event r ne r_curr cur_idx then XP_CHANGE_COLOR R event r if event g ne g_curr cur_idx then XP_CHANGE_COLOR G event g if event b ne b_curr cur_idx then XP_CHANGE_COLOR B event b end xpw colorsel: begin cur_idx state cur_idx new_pos event value ne cur_idx Update the RBG sliders if event value ne cur_idx then begin state cur_idx cur_idx event value WIDGET_CONTROL xpw idx_label set_value strcompress cur_idx REMOVE_ALL Mark new square tmp D WINDOW wset state cur_color_win erase color cur_idx wset tmp WIDGET_CONTROL xpw rgb_base set_value r_curr cur_idx g_curr cur_idx b_curr cur_idx endif end else: endcase end pro XPAL group group BLOCK block UPDATECALLBACK updt_cb_name UPDATECBDATA updt_cb_data common xp_com xpw state common colors r_orig g_orig b_orig r_curr g_curr b_curr IF N_ELEMENTS updt_cb_name EQ 0 THEN updt_callback ELSE updt_callback updt_cb_name IF N_ELEMENTS updt_cb_data GT 0 THEN p_updt_cb_data PTR_NEW updt_cb_data ELSE p_updt_cb_data PTR_NEW xpw xp_widgets base:0L colorsel:0L mark_label:0L idx_label:0L button_base:0L rgb_base:0L state old_p: p Original value of P mark_idx:0 Current mark index cur_idx:0 Current index cur_color_win:0 Current Color draw window index plot_win:0 RGB plot draw window index updt_callback: updt_callback user defined callback optional p_updt_cb_data:p_updt_cb_data data for callback optional if XREGISTERED XPAL then return Only one copy at a time IF N_ELEMENTS block EQ 0 THEN block 0 on_error 2 Return to caller if an error occurs nc d table_size of colors avail if nc eq 0 then message Device has static color tables Can t modify if nc eq 2 then message Unable to work with monochrome system state old_p p Save p p noclip 1 No clipping p color nc 1 Foreground color p font 0 Hdw font save_win d window Previous window IF N_ELEMENTS r_orig LE 0 THEN BEGIN If no common use current colors TVLCT r_orig g_orig b_orig GET r_curr r_orig b_curr b_orig g_curr g_orig ENDIF Create widgets xpw base WIDGET_BASE title Xpal ROW space 30 This is a little tricky Setting the managed attribute indicates our intention to put this app under the control of XMANAGER and prevents our draw widgets from becoming candidates for becoming the default window on WSET 1 XMANAGER sets this but doing it here prevents our own WSETs at startup from having that problem WIDGET_CONTROL MANAGED xpw base version WIDGET_INFO VERSION if version style Motif then junk 510 else junk 580 plot_frame WIDGET_DRAW xpw base xsize 200 ysize junk c1 WIDGET_BASE xpw base COLUMN space 20 status WIDGET_BASE c1 COLUMN FRAME ncw WIDGET_LABEL WIDGET_BASE status DYNAMIC_RESIZE xpw idx_label CW_FIELD status title Current Index: value 0 xsize 20 STRING xpw mark_label CW_FIELD status title Mark Index: value 0 xsize 20 STRING c1_1 widget_base status ROW junk WIDGET_LABEL c1_1 value Current Color: cur_color WIDGET_DRAW c1_1 xsize 125 ysize 50 frame names Done Predefined Help Redraw Set Mark Switch Mark Copy Current Interpolate save xpw button_base CW_BGROUP c1 names COLUMN 3 FRAME xpw rgb_base CW_RGBSLIDER c1 FRAME DRAG junk WIDGET_BASE xpw base Responds to YOFFSET if version style Motif then junk2 30 else junk2 50 xpw colorsel CW_COLORSEL junk yoffset junk2 state cur_idx 0 state mark_idx 0 Position RGB slider appropriately WIDGET_CONTROL xpw rgb_base SET_VALUE r_curr 0 g_curr 0 b_curr 0 WIDGET_CONTROL REALIZE xpw base WIDGET_CONTROL ncw set_value Number Of Colors: strcompress d n_colors REMOVE_ALL WIDGET_CONTROL get_value tmp cur_color state cur_color_win tmp WIDGET_CONTROL get_value tmp plot_frame state plot_win tmp Update the plots of RGB junk XP_NEW_COLORS XP_REPLOT p color F WSET save_win XMANAGER Xpal xpw base event_handler XP_EVENT group group NO_BLOCK NOT FLOAT block end "); 180 a[178] = new Array("./ToBeReviewed/GRILLE/changegrid.html", "changegrid.pro", "", "function changegrid newgrid cm_4mesh if cmpgrid newgrid EQ 0 then return 0 update the common paramaters ccmeshparameters newgrid ixminmesh newgrid ixminmesh ixmaxmesh newgrid ixmaxmesh iyminmesh newgrid iyminmesh iymaxmesh newgrid iymaxmesh izminmesh newgrid izminmesh izmaxmesh newgrid izmaxmesh read the new file loadgrid newgrid filename IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return 1 end"); 181 a[179] = new Array("./ToBeReviewed/GRILLE/cmpgrid.html", "cmpgrid.pro", "", "FUNCTION cmpgrid newgrid common newgrid must be a structure if size newgrid type NE 8 then return 0 does ccmeshparameters exist if n_elements ccmeshparameters EQ 0 then return 1 we compare the structure which caracterise the grid whith ccmeshparameters case 1 of ccmeshparameters jpiglo NE newgrid jpiglo: ccmeshparameters jpjglo NE newgrid jpjglo: ccmeshparameters jpkglo NE newgrid jpkglo: ccmeshparameters jpi NE newgrid jpi: ccmeshparameters jpj NE newgrid jpj: ccmeshparameters jpk NE newgrid jpk: total ccmeshparameters glaminfo newgrid glaminfo NE 0: total ccmeshparameters gphiinfo newgrid gphiinfo NE 0: ccmeshparameters ixminmesh NE newgrid ixminmesh: ccmeshparameters ixmaxmesh NE newgrid ixmaxmesh: ccmeshparameters iyminmesh NE newgrid iyminmesh: ccmeshparameters iymaxmesh NE newgrid iymaxmesh: ccmeshparameters izminmesh NE newgrid izminmesh: ccmeshparameters izmaxmesh NE newgrid izmaxmesh: ccmeshparameters key_shift NE newgrid key_shift: ccmeshparameters key_periodic NE newgrid key_periodic: array_equal ccmeshparameters key_stride newgrid key_stride EQ 0: ccmeshparameters key_gridtype NE newgrid key_gridtype: ccmeshparameters key_yreverse NE newgrid key_yreverse: ccmeshparameters key_zreverse NE newgrid key_zreverse: ccmeshparameters key_partialstep NE newgrid key_partialstep: ccmeshparameters key_onearth NE newgrid key_onearth: ELSE:return 0 endcase return 1 end"); 182 a[180] = new Array("./ToBeReviewed/GRILLE/decoupeterre.html", "decoupeterre.pro", "", " NAME:decoupeterre PURPOSE:tres semblable a grille Ici qd vargrid ne T ou W alors pour le trace il faut recuperer Tmask glamt gphit et le tableau de triangulation sur le sous domaine considere La specificite de decoupeterre par rapport a grille c est que l on prend ds la mesure du possible un sous domaine juste un peu plus grand que celui definit par domdef de facon a etre sur que le masque que l on trace recouvrira bien tout le dessin CATEGORY:pour plt CALLING SEQUENCE:decoupeterre mask glam gphi z nx ny nz TRI tri INPUTS: KEYWORD PARAMETERS: TRI si ce mot clef sert a obtenir grace a grille la triangulation qui se rapporte a la grille mais uniquement sur la partie du zoom ce tableau de triangulation reduit est passe ds la variable que l on a egalee a tri par ex: grille tri triangulation_reduite ne mot clef est utilise dans plt pro WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS:le masque et ses coordonnees COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 24 2 99 PRO decoupeterre mask glam gphi gdep TYPE type TRI tri INDICEZOOM indicezoom COINMONTE coinmonte COINDESCEND coindescend WDEPTH wdepth REALSECTION realsection USETRI usetri _extra ex cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance if vargrid EQ W then wdepth 1 horizontal parameters if possible extent the domain according to the grid type default case case vargrid of U :BEGIN firstx 0 min firstxt firstxu 1 lastx max lastxt lastxu 1 min firstyt firstyu 1 lasty max lastyt lastyu 1 min firstxt firstxv 1 lastx max lastxt lastxv 1 min firstyt firstyv 1 lasty max lastyt lastyv 1 min firstxt firstxf 1 lastx max lastxt lastxf 1 min firstyt firstyf 1 lasty max lastyt lastyf 1 firstx 1 :lastx firsty:lasty ELSE glam glamu 0 firstx 1 :lastx firsty:lasty ENDELSE END yz :BEGIN if keyword_set realsection EQ 0 then begin if vargrid EQ U OR vargrid EQ F then gphi gphiu firstx:lastx firsty:lasty ENDIF ELSE BEGIN to drawsectionbottom if vargrid EQ U OR vargrid EQ F OR finite gphiv 0 EQ 0 then gphi gphif firstx:lastx 0 firsty 1 :lasty ELSE gphi gphiv firstx:lastx 0 firsty 1 :lasty ENDELSE END ELSE: ENDCASE vertical boundaries if keyword_set wdepth then begin firstz 0 min firstzt firstzw 1 lastz max lastzt lastzw 1 jpk 1 ENDIF ELSE BEGIN firstz firstzt lastz lastzt ENDELSE nz lastz firstz 1 mask case type of xy :BEGIN mask tmask firstx:lastx firsty:lasty firstz profond firstz NE 0 END for the verical section we have to choose the right mask according to the grid point and to the direction of the section xz :BEGIN if vargrid EQ V OR vargrid EQ F then begin mask vmask firstx:lastx firstyv:lastyv firstz:lastz ENDIF ELSE mask tmask firstx:lastx firsty:lasty firstz:lastz END yz :BEGIN if vargrid EQ U OR vargrid EQ F then begin mask umask firstxu:lastxu firsty:lasty firstz:lastz ENDIF ELSE mask tmask firstx:lastx firsty:lasty firstz:lastz END ELSE:mask tmask firstx:lastx firsty:lasty firstz:lastz endcase vertical axis when we do a real section we directly plot the gdepw in drawsectionbottom pro instead of contouring the mask at 0 5 at gdept IF keyword_set realsection EQ 0 then gdep gdept firstz:lastz ELSE BEGIN if lastz EQ jpk 1 then we add some fictive very deep level that will not be used but that is necessary to avoid array size bugs in draw bottom section gdep gdepw firstz 1:lastz 2 gdept jpk 1 ELSE gdep gdepw firstz 1:lastz 1 gdep gdepw firstz:lastz special case when we are using the partial steps in the vertical section that are only 1 point wide in that case the z axis is a 2d array and we modify the depth of the last level ocean with hdepw that is the real depth of the bottom CASE 1 OF keyword_set key_partialstep and type EQ xz AND ny EQ 1 AND keyword_set realsection :BEGIN bottom total mask 3 good where bottom NE 0 AND bottom NE nz 1 bottom lindgen nx bottom nx IF good 0 NE 1 THEN BEGIN bottom bottom good gdep replicate 1 nx gdep truegdep hdepw firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END keyword_set key_partialstep and type EQ yz AND nx EQ 1 AND keyword_set realsection :BEGIN bottom total mask 3 good where bottom NE 0 AND bottom NE nz 1 bottom lindgen ny bottom ny IF good 0 NE 1 THEN BEGIN bottom bottom good gdep replicate 1 ny gdep truegdep hdepw firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ELSE: ENDCASE ENDELSE vecteur triangulation Qd TRI est active IF arg_present TRI then if triangles_list 0 EQ 1 OR usetri LT 1 then tri 1 ELSE BEGIN si on est en train de tracer un niveau profond on refait la triangulation if keyword_set profond then begin tri triangule mask coinmonte coinmonte coindescend coindescend _extra ex indicezoom lindgen jpi jpj firstx:lastx firsty:lasty ENDIF ELSE BEGIN sinon on recupere la partie de triangulation qui nous interesse et on la numerote convenablement if nx EQ jpi AND ny EQ jpj then tri triangles_list ELSE BEGIN msk bytarr jpi jpj msk firstx:lastx firsty:lasty 1 ind where msk triangles_list 0 EQ 1 AND msk triangles_list 1 EQ 1 AND msk triangles_list 2 EQ 1 tri triangles_list ind firstx firsty jpi y tri jpi x tri y jpi tri x y nx ENDELSE ENDELSE ENDELSE if keyword_set key_performance THEN print temps decoupeterre systime 1 tempsun return end "); 183 a[181] = new Array("./ToBeReviewed/GRILLE/domdef.html", "domdef.pro", "", " NAME: DOMDEF PURPOSE:permet d extraire un sous domaine d etude en fournissant les parametres necessaires pour les traces cf outputs CATEGORY: CALLING SEQUENCE:domdef lon1 lon2 lat1 lat2 vert1 vert2 ou bien domdef vecteur INPUTS: facultatif vecteur a 2 4 ou 6 elements: sans l utilisation des mots cles index xindex yindex zindex: vert1 vert2: pour un domaine 3D dont la partie horizontale couvre tout glam et gphi lon1 lon2 lat1 lat2: definissant les longitudes min max et les latitudes min max du domaine a etudier tous les niveaux sont selectiones lon1 lon2 lat1 lat2 vert1 vert2 pour specifier les profondeurs KEYWORD PARAMETERS: ENDPOINTS: a four elements vector x1 y1 x2 y2 used to specify that domdef must define the box used to make a plot pltz pltt plt1d done strictly along the line that can have any direction starting at x1 y1 ending at x2 y2 When defining endpoints you must also define TYPE which define the type of plots pltz xt yt zt x y z t will used ENDPOINTS keywords FINDALWAYS:oblige a redefinir une boite meme qd auqun point n est trouve ds la boite dans ce cas on selectionne toute la grille GRIDTYPE:un string ou un vecteur de string contennant le nom des grilles determinees uniquement par : T U V W F pour lesquelles le calcul doit etre fait par ex : T ou T U MEMEINDICES: il se peut que les points t u v et F correspondant a une meme boite geographique ne concernent pas les memes indices des tableaux Ceci pose parfois de pb ou du moins de serieuses complications ds les programmes ou plusieurs types de grilles interviennent cf : norme curl Activer MEMEINDICES pour forcer domdef a prendre les memes indices ceux de la grille T pour toutes les autres grilles INDEX: activer si on veut specifier que tous les elements passes en entree de domdef se rapportent aux indices des tableaux glam gphi et gdep plutot qu aux valeurs de ces tableaux xindex: activer si on veut que les elements passes en entrre de domdef et concernant la dimension en x se rapportent aux indices des tableaux glam qu aux valeurs de ces tableaux yindex: cf xindex mais pour y et les gphi zindex: cf xindex mais pour z et les gdep OUTPUTS:on recupere pour les 4 grilles t u v f nxt u v:entier qui contient le nombre de pts en longitude de la grille reduite au domaine nyt u v:entier qui contient le nombre de pts en latitude de la grille reduite au domaine nzt w:entier qui contient le nombre de pts en profondeur de la grille reduite au domaine 3D firstxt u v f: le first indice qui delimite le sous domaine suivant x firstyt u v f: le first indice qui delimite le sous domaine suivant y firstzt w: le first indice qui delimite le sous domaine suivant z lastxt u v f: le last indice qui delimite le sous domaine suivant x lastyt u v f: le last indice qui delimite le sous domaine suivant y lastzt w: le last indice qui delimite le sous domaine suivant z COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 8 2 98 rewrite everything debug and spee up Sebastien Masson April 2005 pro domdef x1 x2 y1 y2 z1 z2 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex ENDPOINTS endpoints TYPE type INDEX index _extra ex include commons cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance CASE N_PARAMS OF 0: 1: 2: 4: 6: ELSE:BEGIN ras report Bad number of parameter in the call of domdef RETURN END ENDCASE IF keyword_set endpoints THEN BEGIN IF NOT keyword_set type THEN BEGIN dummy report If domdef is used do find the box associated to endpoints you must also specify type keyword return ENDIF CASE N_PARAMS OF 0: 1:boxzoom x1 2:boxzoom x1 x2 4:boxzoom x1 x2 y1 y2 6:boxzoom x1 x2 y1 y2 z1 z2 ENDCASE section BOXZOOM boxzoom ENDPOINTS endpoints TYPE type ONLYBOX return ENDIF recall domdef when there is only one input parameter IF N_PARAMS EQ 1 THEN BEGIN CASE n_elements x1 OF 2:domdef x1 0 x1 1 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex 4:domdef x1 0 x1 1 x1 2 x1 3 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex 6:domdef x1 0 x1 1 x1 2 x1 3 x1 4 x1 5 FINDALWAYS findalways GRIDTYPE gridtype MEMEINDICES memeindices XINDEX xindex YINDEX yindex ZINDEX zindex INDEX index _extra ex ELSE:BEGIN ras report Bad number of elements in x1 RETURN END ENDCASE RETURN ENDIF default definitions and checks IF NOT keyword_set gridtype THEN gridtype T U V W F ELSE gridtype strupcase gridtype IF keyword_set memeindices THEN gridtype T gridtype IF finite glamu 0 eq 0 THEN gridtype gridtype where gridtype NE U IF finite glamv 0 eq 0 THEN gridtype gridtype where gridtype NE V default definitions lon1t 99999 lon2t 99999 lat1t 99999 lat2t 99999 lon1u 99999 lon2u 99999 lat1u 99999 lat2u 99999 lon1v 99999 lon2v 99999 lat1v 99999 lat2v 99999 lon1f 99999 lon2f 99999 lat1f 99999 lat2f 99999 vert1t 99999 vert2t 99999 vert1w 99999 vert2w 99999 IF jpj EQ 1 THEN BEGIN IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN glamt reform glamt jpi jpj over gphit reform gphit jpi jpj over ENDIF IF where gridtype eq U 0 NE 1 THEN BEGIN glamu reform glamu jpi jpj over gphiu reform gphiu jpi jpj over ENDIF IF where gridtype eq V 0 NE 1 THEN BEGIN glamv reform glamv jpi jpj over gphiv reform gphiv jpi jpj over ENDIF IF where gridtype eq F 0 NE 1 THEN BEGIN glamf reform glamf jpi jpj over gphif reform gphif jpi jpj over ENDIF ENDIF IF N_PARAMS EQ 2 THEN GOTO vertical define all horizontal parameters lon1 et lon2 lat1 et lat2 firstx tuvf lastx tuvf nx tuvf check if the grid is defined for U and V points If not take care of the cases gridtype eq U or V errstatus 0 IF finite glamu 0 gphiu 0 EQ 0 OR n_elements glamu EQ 0 OR n_elements gphiu EQ 0 AND where gridtype eq U 0 NE 1 THEN BEGIN firstxu values f_nan lastxu values f_nan nxu values f_nan okgrid where gridtype NE U count IF count NE 0 THEN gridtype gridtype okgrid ELSE errstatus report U grid is undefined Impossible to call domdef with vargid U ENDIF IF finite glamv 0 gphiv 0 EQ 0 OR n_elements glamv EQ 0 OR n_elements gphiv EQ 0 AND where gridtype eq V 0 NE 1 THEN BEGIN firstxv values f_nan lastxv values f_nan nxv values f_nan okgrid where gridtype NE V count IF count NE 0 THEN gridtype gridtype okgrid ELSE errstatus report V grid is undefined Impossible to call domdef with vargid V ENDIF IF errstatus EQ 1 THEN return horizontal domain defined with lon1 lon2 lat1 and lat2 IF N_PARAMS EQ 0 OR N_PARAMS EQ 4 OR N_PARAMS EQ 6 AND NOT keyword_set xindex AND NOT keyword_set yindex AND NOT keyword_set index THEN BEGIN IF N_PARAMS EQ 0 THEN BEGIN find lon1 and lon2 the longitudinal boudaries of the full domain IF where gridtype eq T 0 NE 1 THEN lon1t min glamt max lon2t IF where gridtype eq W 0 NE 1 AND where gridtype eq T 0 EQ 1 THEN lon1t min glamt max lon2t IF where gridtype eq U 0 NE 1 THEN lon1u min glamu max lon2u IF where gridtype eq V 0 NE 1 THEN lon1v min glamv max lon2v IF where gridtype eq F 0 NE 1 THEN lon1f min glamf max lon2f lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f find lat1 and lat2 the latitudinal boudaries of the full domain IF where gridtype eq T 0 NE 1 THEN lat1t min gphit max lat2t IF where gridtype eq W 0 NE 1 AND where gridtype eq T 0 EQ 1 THEN lat1t min gphit max lat2t IF where gridtype eq U 0 NE 1 THEN lat1u min gphiu max lat2u IF where gridtype eq V 0 NE 1 THEN lat1v min gphiv max lat2v IF where gridtype eq F 0 NE 1 THEN lat1f min gphif max lat2f lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f ENDIF ELSE BEGIN lon1 min x1 x2 max lon2 lat1 min y1 y2 max lat2 ENDELSE find firstxt firstxt nxt and nyt according to lon1 lon2 lat1 and lat2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN dom where glamt GE lon1 AND glamt LE lon2 AND gphit GE lat1 AND gphit LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt gphit sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt gphit sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamt neig1 max glamt neig2 min gphit neig1 max gphit neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamt neig1 max glamt neig2 min gphit neig1 max gphit neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstxt 1 lastxt 1 nxt 0 firstyt 1 lastyt 1 nyt 0 ENDELSE ENDIF ELSE BEGIN jyt dom jpi ixt temporary dom MOD jpi firstxt min temporary ixt max lastxt firstyt min temporary jyt max lastyt nxt lastxt firstxt 1 nyt lastyt firstyt 1 ENDELSE ENDIF find firstxu firstxu firstyu firstyu nxu and nyu according to lon1 lon2 lat1 and lat2 IF where gridtype eq U 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxu firstxt lastxu lastxt nxu nxt firstyu firstyt lastyu lastyt nyu nyt ENDIF ELSE BEGIN dom where glamu GE lon1 AND glamu LE lon2 AND gphiu GE lat1 AND gphiu LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN if t grid parameters alreday defined we use them CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstxu firstxt lastxu lastxt nxu nxt firstyu firstyt lastyu lastyt nyu nyt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu gphiu sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu gphiu sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamu neig1 max glamu neig2 min gphiu neig1 max gphiu neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamu neig1 max glamu neig2 min gphiu neig1 max gphiu neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstxu 1 lastxu 1 nxu 0 firstyu 1 lastyu 1 nyu 0 ENDELSE ENDIF ELSE BEGIN jyu dom jpi ixu temporary dom MOD jpi firstxu min temporary ixu max lastxu firstyu min temporary jyu max lastyu nxu lastxu firstxu 1 nyu lastyu firstyu 1 ENDELSE ENDELSE ENDIF find firstxv firstxv firstyv firstyv nxv and nyv according to lon1 lon2 lat1 and lat2 IF where gridtype eq V 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxv firstxt lastxv lastxt nxv nxt firstyv firstyt lastyv lastyt nyv nyt ENDIF ELSE BEGIN dom where glamv GE lon1 AND glamv LE lon2 AND gphiv GE lat1 AND gphiv LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstxv firstxt lastxv lastxt nxv nxt firstyv firstyt lastyv lastyt nyv nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstxv firstxu lastxv lastxu nxv nxu firstyv firstyu lastyv lastyu nyv nyu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv gphiv sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv gphiv sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamv neig1 max glamv neig2 min gphiv neig1 max gphiv neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamv neig1 max glamv neig2 min gphiv neig1 max gphiv neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstxv 1 lastxv 1 nxv 0 firstyv 1 lastyv 1 nyv 0 ENDELSE ENDIF ELSE BEGIN jyv dom jpi ixv temporary dom MOD jpi firstxv min temporary ixv max lastxv firstyv min temporary jyv max lastyv nxv lastxv firstxv 1 nyv lastyv firstyv 1 ENDELSE ENDELSE ENDIF find firstxf firstxf firstyf firstyf nxf and nyf according to lon1 lon2 lat1 and lat2 IF where gridtype eq F 0 NE 1 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstxf firstxt lastxf lastxt nxf nxt firstyf firstyt lastyf lastyt nyf nyt ENDIF ELSE BEGIN dom where glamf GE lon1 AND glamf LE lon2 AND gphif GE lat1 AND gphif LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstxf firstxt lastxf lastxt nxf nxt firstyf firstyt lastyf lastyt nyf nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstxf firstxu lastxf lastxu nxf nxu firstyf firstyu lastyf lastyu nyf nyu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstxf firstxv lastxf lastxv nxf nxv firstyf firstyv lastyf lastyv nyf nyv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf gphif sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf gphif sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamf neig1 max glamf neig2 min gphif neig1 max gphif neig2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex 6:domdef min glamf neig1 max glamf neig2 min gphif neig1 max gphif neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstxf 1 lastxf 1 nxf 0 firstyf 1 lastyf 1 nyf 0 ENDELSE ENDIF ELSE BEGIN jyf dom jpi ixf temporary dom MOD jpi firstxf min temporary ixf max lastxf firstyf min temporary jyf max lastyf nxf lastxf firstxf 1 nyf lastyf firstyf 1 ENDELSE ENDELSE ENDIF ENDIF ELSE BEGIN CASE 1 OF horizontal domain defined with the X and Y indexes keyword_set xindex AND keyword_set yindex OR keyword_set index :BEGIN fstx min x1 x2 max lstx fsty min y1 y2 max lsty IF fstx LT 0 OR lstx GE jpi THEN BEGIN ras report Bad definition of X1 or X2 return ENDIF IF fsty LT 0 OR lsty GE jpj THEN BEGIN ras report Bad definition of Y1 or Y2 return ENDIF nx lstx fstx 1 ny lsty fsty 1 find lon1t lon2t lat1t lat2t firstxt firstxt nxt and nyt according to x1 x2 y1 y2 IF where gridtype eq T 0 NE 1 OR where gridtype eq W 0 NE 1 THEN BEGIN lon1t min glamt fstx:lstx fsty:lsty max lon2t lat1t min gphit fstx:lstx fsty:lsty max lat2t firstxt fstx lastxt lstx firstyt fsty lastyt lsty nxt nx nyt ny ENDIF find lon1u lon2u lat1u lat2u firstxu firstxu nxu and nyu according to x1 x2 y1 y2 IF where gridtype eq U 0 NE 1 THEN BEGIN lon1u min glamu fstx:lstx fsty:lsty max lon2u lat1u min gphiu fstx:lstx fsty:lsty max lat2u firstxu fstx lastxu lstx firstyu fsty lastyu lsty nxu nx nyu ny ENDIF find lon1v lon2v lat1v lat2v firstxv firstxv nxv and nyv according to x1 x2 y1 y2 IF where gridtype eq V 0 NE 1 THEN BEGIN lon1v min glamv fstx:lstx fsty:lsty max lon2v lat1v min gphiv fstx:lstx fsty:lsty max lat2v firstxv fstx lastxv lstx firstyv fsty lastyv lsty nxv nx nyv ny ENDIF find lon1f lon2f lat1f lat2f firstxf firstxf nxf and nyf according to x1 x2 y1 y2 IF where gridtype eq F 0 NE 1 THEN BEGIN lon1f min glamf fstx:lstx fsty:lsty max lon2f lat1f min gphif fstx:lstx fsty:lsty max lat2f firstxf fstx lastxf lstx firstyf fsty lastyf lsty nxf nx nyf ny ENDIF lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f END horizontal domain defined with the X index and lat1 lat2 keyword_set xindex :BEGIN fstx min x1 x2 max lstx IF fstx LT 0 OR lstx GE jpi THEN BEGIN ras report Bad definition of X1 or X2 return ENDIF nx lstx fstx 1 lat1 min y1 y2 max lat2 find lon1t lon2t firstxt firstxt firstyt firstyt nxt and nyt according to x1 x2 lat1 and lat2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN firstxt fstx lastxt lstx nxt nx dom where gphit fstx:lstx GE lat1 AND gphit fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt fstx:lstx gphit fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt fstx:lstx gphit fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphit fstx:lstx neig1 max gphit fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphit fstx:lstx neig1 max gphit fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstyt 1 lastyt 1 nyt 0 ENDELSE ENDIF ELSE BEGIN jyt temporary dom nx firstyt min temporary jyt max lastyt nyt lastyt firstyt 1 ENDELSE IF nyt NE 0 THEN lon1t min glamt firstxt:lastxt firstyt:lastyt max lon2t ENDIF find lon1u lon2u firstxu firstxu firstyu firstyu nxu and nyu according to x1 x2 lat1 and lat2 IF where gridtype eq U 0 NE 1 THEN BEGIN firstxu fstx lastxu lstx nxu nx IF keyword_set memeindices THEN BEGIN firstyu firstyt lastyu lastyt nyu nyt ENDIF ELSE BEGIN dom where gphiu fstx:lstx GE lat1 AND gphiu fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstyu firstyt lastyu lastyt nyu nyt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu fstx:lstx gphiu fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu fstx:lstx gphiu fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphiu fstx:lstx neig1 max gphiu fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphiu fstx:lstx neig1 max gphiu fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstyu 1 lastyu 1 nyu 0 ENDELSE ENDIF ELSE BEGIN jyu temporary dom nx firstyu min temporary jyu max lastyu nyu lastyu firstyu 1 ENDELSE ENDELSE IF nyu NE 0 THEN lon1u min glamu firstxu:lastxu firstyu:lastyu max lon2u ENDIF find lon1v lon2v firstxv firstxv firstyv firstyv nxv and nyv according to x1 x2 lat1 and lat2 IF where gridtype eq V 0 NE 1 THEN BEGIN firstxv fstx lastxv lstx nxv nx IF keyword_set memeindices THEN BEGIN firstyv firstyt lastyv lastyt nyv nyt ENDIF ELSE BEGIN dom where gphiv fstx:lstx GE lat1 AND gphiv fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstyv firstyt lastyv lastyt nyv nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstyv firstyu lastyv lastyu nyv nyu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv fstx:lstx gphiv fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv fstx:lstx gphiv fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphiv fstx:lstx neig1 max gphiv fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphiv fstx:lstx neig1 max gphiv fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstyv 1 lastyv 1 nyv 0 ENDELSE ENDIF ELSE BEGIN jyv temporary dom nx firstyv min temporary jyv max lastyv nyv lastyv firstyv 1 ENDELSE ENDELSE IF nyv NE 0 THEN lon1v min glamv firstxv:lastxv firstyv:lastyv max lon2v ENDIF find lon1f lon2f firstxf firstxf firstyf firstyf nxf and nyf according to x1 x2 lat1 and lat2 IF where gridtype eq F 0 NE 1 THEN BEGIN firstxf fstx lastxf lstx nxf nx IF keyword_set memeindices THEN BEGIN firstyf firstyt lastyf lastyt nyf nyt ENDIF ELSE BEGIN dom where gphif fstx:lstx GE lat1 AND gphif fstx:lstx LE lat2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstyf firstyt lastyf lastyt nyf nyt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstyf firstyu lastyf lastyu nyf nyu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstyf firstyv lastyf lastyv nyf nyv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf fstx:lstx gphif fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf fstx:lstx gphif fstx:lstx sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef fstx lstx min gphif fstx:lstx neig1 max gphif fstx:lstx neig2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex 6:domdef fstx lstx min gphif fstx:lstx neig1 max gphif fstx:lstx neig2 z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices XINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstyf 1 lastyf 1 nyf 0 ENDELSE ENDIF ELSE BEGIN jyf temporary dom nx firstyf min temporary jyf max lastyf nyf lastyf firstyf 1 ENDELSE ENDELSE IF nyf NE 0 THEN lon1f min glamf firstxf:lastxf firstyf:lastyf max lon2f ENDIF lon1 min lon1t lon1u lon1v lon1f lon2 max lon2t lon2u lon2v lon2f END horizontal domain defined with the Y index and lon1 lon2 keyword_set yindex :BEGIN fsty min y1 y2 max lsty IF fsty LT 0 OR lsty GE jpj THEN BEGIN ras report Bad definition of Y1 or Y2 return ENDIF ny lsty fsty 1 lon1 min x1 x2 max lon2 find lat1t lat2t firstxt firstxt firstyt firstyt nxt and nyt according to x1 x2 lon1 and lon2 IF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1 THEN BEGIN firstyt fsty lastyt lsty nyt ny dom where glamt fsty:lsty GE lon1 AND glamt fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN print WARNING empty T points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamt fsty:lsty gphit fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamt fsty:lsty gphit fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamt fsty:lsty neig1 max glamt fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamt fsty:lsty neig1 max glamt fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN ENDIF ELSE BEGIN ras report WARNING The box does not contain any T points firstxt 1 lastxt 1 nxt 0 ENDELSE ENDIF ELSE BEGIN jxt temporary dom MOD jpi firstxt min temporary jxt max lastxt nxt lastxt firstxt 1 ENDELSE IF nxt NE 0 THEN lat1t min gphit firstxt:lastxt firstyt:lastyt max lat2t ENDIF find lat1u lat2u firstxu firstxu firstyu firstyu nxu and nyu according to x1 x2 lon1 and lon2 IF where gridtype eq U 0 NE 1 THEN BEGIN firstyu fsty lastyu lsty nyu ny IF keyword_set memeindices THEN BEGIN firstxu firstyt lastxu lastyt nxu nxt ENDIF ELSE BEGIN dom where glamu fsty:lsty GE lon1 AND glamu fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty U points box we use the same index as T points firstxu firstxt lastxu lastxt nxu nxt END ELSE:BEGIN print WARNING empty U points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamu fsty:lsty gphiu fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamu fsty:lsty gphiu fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamu fsty:lsty neig1 max glamu fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamu fsty:lsty neig1 max glamu fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any U points firstxu 1 lastxu 1 nxu 0 ENDELSE ENDIF ELSE BEGIN jxu temporary dom MOD jpi firstxu min temporary jxu max lastxu nxu lastxu firstxu 1 ENDELSE ENDELSE IF nxu NE 0 THEN lat1u min gphiu firstxu:lastxu firstyu:lastyu max lat2u ENDIF find lat1v lat2v firstxv firstxv firstyv firstyv nxv and nyv according to x1 x2 lon1 and lon2 IF where gridtype eq V 0 NE 1 THEN BEGIN firstyv fsty lastyv lsty nyv ny IF keyword_set memeindices THEN BEGIN firstxv firstyt lastxv lastyt nxv nxt ENDIF ELSE BEGIN dom where glamv fsty:lsty GE lon1 AND glamv fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty V points box we use the same index as T points firstxv firstxt lastxv lastxt nxv nxt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty V points box we use the same index as U points firstxv firstxu lastxv lastxu nxv nxu END ELSE:BEGIN print WARNING empty V points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamv fsty:lsty gphiv fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamv fsty:lsty gphiv fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamv fsty:lsty neig1 max glamv fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamv fsty:lsty neig1 max glamv fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any V points firstxv 1 lastxv 1 nxv 0 ENDELSE ENDIF ELSE BEGIN jxv temporary dom MOD jpi firstxv min temporary jxv max lastxv nxv lastxv firstxv 1 ENDELSE ENDELSE IF nxv NE 0 THEN lat1v min gphiv firstxv:lastxv firstyv:lastyv max lat2v ENDIF find lat1f lat2f firstxf firstxf firstyf firstyf nxf and nyf according to x1 x2 lon1 and lon2 IF where gridtype eq F 0 NE 1 THEN BEGIN firstyf fsty lastyf lsty nyf ny IF keyword_set memeindices THEN BEGIN firstxf firstyt lastxf lastyt nxf nxt ENDIF ELSE BEGIN dom where glamf fsty:lsty GE lon1 AND glamf fsty:lsty LE lon2 IF dom 0 EQ 1 THEN BEGIN IF keyword_set findalways THEN BEGIN CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype EQ W 0 NE 1:BEGIN print WARNING empty F points box we use the same index as T points firstxf firstxt lastxf lastxt nxf nxt END where gridtype eq U 0 NE 1:BEGIN print WARNING empty F points box we use the same index as U points firstxf firstxu lastxf lastxu nxf nxu END where gridtype eq V 0 NE 1:BEGIN print WARNING empty F points box we use the same index as V points firstxf firstxv lastxf lastxv nxf nxv END ELSE:BEGIN print WARNING empty F points box we get the neighnors to define a new box neig1 neighbor lon1 lat1 glamf fsty:lsty gphif fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular neig2 neighbor lon2 lat2 glamf fsty:lsty gphif fsty:lsty sphere keyword_set key_onearth keyword_set key_irregular CASE N_PARAMS OF 4:domdef min glamf fsty:lsty neig1 max glamf fsty:lsty neig2 fsty lsty GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex 6:domdef min glamf fsty:lsty neig1 max glamf fsty:lsty neig2 fsty lsty z1 z2 GRIDTYPE gridtype MEMEINDICES memeindices YINDEX ZINDEX zindex _extra ex ENDCASE RETURN END ENDCASE ENDIF ELSE BEGIN ras report WARNING The box does not contain any F points firstxf 1 lastyf 1 nxf 0 ENDELSE ENDIF ELSE BEGIN jxf temporary dom MOD jpi firstxf min temporary jxf max lastxf nxf lastxf firstxf 1 ENDELSE ENDELSE IF nxf NE 0 THEN lat1f min gphif firstxf:lastxf firstyf:lastyf max lat2f ENDIF lat1 min lat1t lat1u lat1v lat1f lat2 max lat2t lat2u lat2v lat2f END ENDCASE ENDELSE The extracted domain is it regular or not CASE 1 OF where gridtype eq T 0 NE 1 OR where gridtype eq W 0 NE 1 AND nxt NE 0 AND nyt NE 0:BEGIN to get faster we first test the most basic cases befor testing the full array CASE 0 OF array_equal glamt firstxt:lastxt firstyt glamt firstxt:lastxt lastyt :key_irregular 1b array_equal gphit firstxt firstyt:lastyt gphit lastxt firstyt:lastyt :key_irregular 1b array_equal glamt firstxt:lastxt firstyt:lastyt glamt firstxt:lastxt firstyt replicate 1 nyt :key_irregular 1b array_equal gphit firstxt:lastxt firstyt:lastyt replicate 1 nxt gphit firstxt firstyt:lastyt :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq U 0 NE 1 AND nxu NE 0 AND nyu NE 0:BEGIN CASE 0 OF array_equal glamu firstxu:lastxu firstyu glamu firstxu:lastxu lastyu :key_irregular 1b array_equal gphiu firstxu firstyu:lastyu gphiu lastxu firstyu:lastyu :key_irregular 1b array_equal glamu firstxu:lastxu firstyu:lastyu glamu firstxu:lastxu firstyu replicate 1 nyu :key_irregular 1b array_equal gphiu firstxu:lastxu firstyu:lastyu replicate 1 nxu gphiu firstxu firstyu:lastyu :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq V 0 NE 1 AND nxv NE 0 AND nyv NE 0:BEGIN CASE 0 OF array_equal glamv firstxv:lastxv firstyv glamv firstxv:lastxv lastyv :key_irregular 1b array_equal gphiv firstxv firstyv:lastyv gphiv lastxv firstyv:lastyv :key_irregular 1b array_equal glamv firstxv:lastxv firstyv:lastyv glamv firstxv:lastxv firstyv replicate 1 nyv :key_irregular 1b array_equal gphiv firstxv:lastxv firstyv:lastyv replicate 1 nxv gphiv firstxv firstyv:lastyv :key_irregular 1b ELSE:key_irregular 0b ENDCASE END where gridtype eq F 0 NE 1 AND nxf NE 0 AND nyf NE 0:BEGIN CASE 0 OF array_equal glamf firstxf:lastxf firstyf glamf firstxf:lastxf lastyf :key_irregular 1b array_equal gphif firstxf firstyf:lastyf gphif lastxf firstyf:lastyf :key_irregular 1b array_equal glamf firstxf:lastxf firstyf:lastyf glamf firstxf:lastxf firstyf replicate 1 nyf :key_irregular 1b array_equal gphif firstxf:lastxf firstyf:lastyf replicate 1 nxf gphif firstxf firstyf:lastyf :key_irregular 1b ELSE:key_irregular 0b ENDCASE END ELSE: ENDCASE define all vertical parameters vert1 vert2 firstz tw lastz tw nz tw vertical: vertical domain defined with vert1 vert2 IF NOT keyword_set zindex OR keyword_set index THEN BEGIN define vert1 et vert2 CASE N_PARAMS OF 2:vert1 min x1 x2 max vert2 6:vert1 min z1 z2 max vert2 ELSE:BEGIN IF inter byte gridtype byte T U V F 0 NE 1 THEN vert1t min gdept max vert2t IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN vert1w min gdepw max vert2w vert1 min vert1t vert1w vert2 max vert2t vert2w END ENDCASE define firstzt firstzt nzt IF inter byte gridtype byte T U V F 0 NE 1 THEN BEGIN domz where gdept ge vert1 and gdept le vert2 nzt IF nzt NE 0 THEN BEGIN firstzt domz 0 lastzt domz nzt 1 ENDIF ELSE BEGIN ras report WARNING The box does not contain any T level firstzt 1 lastzt 1 ENDELSE ENDIF define firstzw firstzw nzw IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN BEGIN IF keyword_set memeindices THEN BEGIN firstzw firstzt lastzw lastzt nzw nzt ENDIF ELSE BEGIN domz where gdepw ge vert1 and gdepw le vert2 nzw IF nzw NE 0 THEN BEGIN firstzw domz 0 lastzw domz nzw 1 ENDIF ELSE BEGIN ras report WARNING The box does not contain any W level firstzw 1 lastzw 1 ENDELSE ENDELSE ENDIF vertical domain defined with the Z index ENDIF ELSE BEGIN CASE N_PARAMS OF 2:fstz min x1 x2 max lstz 4:return 6:fstz min z1 z2 max lstz ENDCASE IF fstz LT 0 OR lstz GE jpk THEN BEGIN ras report Bad definition of X1 X2 Z1 or Z2 return ENDIF nz lstz fstz 1 find vert1t vert2t firstzt firstzt nzt according to x1 x2 or z1 z2 IF where gridtype eq T 0 NE 1 THEN BEGIN vert1t min gdept fstz:lstz max vert2t firstzt fstz lastzt lstz nzt nz ENDIF find vert1w vert2w firstzw firstzw nzw according to x1 x2 or z1 z2 IF where gridtype eq W 0 NE 1 AND n_elements gdepw NE 0 THEN BEGIN vert1w min gdepw fstz:lstz max vert2w firstzw fstz lastzw lstz nzw nz ENDIF vert1 min vert1t vert1w vert2 max vert2t vert2w ENDELSE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF if keyword_set key_performance THEN print temps domdef systime 1 tempsun return end"); 184 a[182] = new Array("./ToBeReviewed/GRILLE/f2v.html", "f2v.pro", "", " NAME:f2v PURPOSE:permet de passer un champs se rapportant a la grille F sur la grille V grace a la moyenne: res 0 5 res shift res 1 0 CATEGORY:grille CALLING SEQUENCE:res f2v tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION f2v temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxf etc firstxv firstxf lastxv lastxf firstyv firstyf lastyv lastyf nxv nxf nyv nyf vargrid V if NOT keyword_set valmask then valmask 1e20 lon1 glamv firstxv 0 lon2 glamf lastxf 0 cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf: taille 1 eq jpi and taille 2 eq jpj: res res firstxf:lastxf firstyf:lastyf else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask fmask firstxf:lastxf firstyf:lastyf 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 1 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan mask vmask firstxf:lastxf firstyf:lastyf 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ nzt: taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxf:lastxf firstyf:lastyf firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxf:lastxf firstyf:lastyf else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask fmask firstxf:lastxf firstyf:lastyf lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxf nyf jpt over ENDIF ELSE mask fmask firstxf:lastxf firstyf:lastyf firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxf:lastxf firstyf:lastyf lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxf nyf jpt over ENDIF ELSE mask vmask firstxf:lastxf firstyf:lastyf firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxf and taille 2 eq nyf AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxf:lastxf firstyf:lastyf firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask fmask firstxf:lastxf firstyf:lastyf firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxf nyf nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 0 if NOT keyword_set key_periodic AND nxf EQ jpi then res 0 values f_nan mask vmask firstxf:lastxf firstyf:lastyf firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxf nyf nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 185 a[183] = new Array("./ToBeReviewed/GRILLE/fmask.html", "fmask.pro", "", " NAME:fmask PURPOSE:calcule fmask CATEGORY:fonction economisatrice de memoire plus besion de garder fmask CALLING SEQUENCE:res fmask OUTPUTS:un tableau 3d correspondant a fmask EXAMPLE:s utilise comme si fmask etait un tableau connu en replacant ds la syntaxe fmask par fmask par ex: au lieu de taper fmask domainef il faut taper fmask domainef MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 FUNCTION fmask cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 1 0 shift tmask 0 1 shift tmask 1 1 3:res tmask shift tmask 1 0 0 shift tmask 0 1 0 shift tmask 1 1 0 ENDCASE if NOT keyword_set key_periodic then res jpi 1 fmaskredy res jpj 1 fmaskredx if keyword_set key_performance THEN print temps fmask systime 1 tempsun return res end"); 186 a[184] = new Array("./ToBeReviewed/GRILLE/grille.html", "grille.pro", "", " NAME:grille PURPOSE: choisit la grille qui doit etre utilisee pour faire le graphe en fonction de vargrid et renvoie les parametres correspondants calcules ds domdef pro et reduit au domaine definit par domdef contrairement a grandegrille pro CATEGORY: CALLING SEQUENCE: grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 INPUTS:rien ATTENTION les choix de la grille se fait a partir de la valeur de la variable globale vargrid qui peut etre egale a T U V W ou F KEYWORD PARAMETERS: TRI si ce mot clef sert a obtenir grace a grille la triangulation qui se rapporte a la grille mais uniquement sur la partie du zoom ce tableau de triangulation reduit est passe ds la variable que l on a egalee a tri par ex: grille tri triangulation_reduite ne mot clef est utilise dans plt pro FORPLT: ds plt on veut que sur les points terres glam et gphi soit egale a glamt et gphit quelle que soit la grille NOTRI: utile seulement qd TRI est active dans ce cas grille retourne 1 ds la variable tri meme si la variable du common triangles_list est definie et differente de 1 WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS:mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 pour leur definition cf domdef et la gestion des sous domaines sur le web Rq: ces outputs sont optionnels si je veux recuperer que mask glam et gphi il suffit de taper grille mask glam gphi COMMON BLOCKS: cm_4mesh and cm_4data SIDE EFFECTS: utilise la variable globale vargird RESTRICTIONS: vargrid doit etre T W U V ou F EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 12 2 1999 10 11 1999 forplt pro grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz e1 e2 e3 TRI tri NOTRI notri TOUT tout FORPLT forplt IFPLTZ ifpltz WDEPTH wdepth _EXTRA ex include commons cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance vargrid strupcase strmid vargrid 0 reverse_offset if vargrid eq W then wdepth 1 if keyword_set tout then begin savedbox 1b saveboxparam boxparam4grille dat domdef gridtype vargrid _EXTRA ex endif tempdeux systime 1 pour key_performance 2 IF keyword_set wdepth THEN BEGIN firstz firstzw lastz lastzw nz nzw ENDIF ELSE BEGIN firstz firstzt lastz lastzt nz nzt ENDELSE CASE 1 OF grille T and W vargrid eq T OR vargrid eq W : begin scalaires nx nxt ny nyt firstx firstxt firsty firstyt lastx lastxt lasty lastyt vecteurs 2d IF arg_present glam THEN glam glamt firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphit firstx:lastx firsty:lasty IF arg_present e1 THEN e1 e1t firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2t firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask tmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask tmask firstx:lastx firsty:lasty firstz:lastz end grille U vargrid eq U : begin scalaires nx nxu ny nyu firstx firstxu firsty firstyu lastx lastxu lasty lastyu vecteurs 2d IF arg_present glam THEN glam glamu firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphiu firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz eastboarder mask shift mask 1 0 mask westboarder mask shift mask 1 0 mask if key_periodic NE 1 OR nx NE jpi then westboarder nx 1 0b tmp1 shift eastboarder 0 1 tmp1 0 0b tmp2 shift eastboarder 0 1 tmp2 ny 1 0b add temporary tmp1 temporary tmp2 1b eastboarder 1b temporary westboarder eastboarder temporary eastboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 1b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 0b endif no1 temporary tmp1 temporary tmp2 tmp temporary eastboarder temporary no1 mask mask 0:nx 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1u firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2u firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask umask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask umask firstx:lastx firsty:lasty firstz:lastz end grille V vargrid eq OPAPTDHV or vargrid eq OPAPT3DV or vargrid eq V : begin scalaires nx nxv ny nyv firstx firstxv firsty firstyv lastx lastxv lasty lastyv vecteurs 2d IF arg_present glam THEN glam glamv firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphiv firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz northboarder mask shift mask 0 1 mask southboarder mask shift mask 0 1 mask southboarder ny 1 0b tmp1 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp1 nx 1 0b tmp2 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp2 0 0b add temporary tmp1 temporary tmp2 1b northboarder 1b southboarder northboarder temporary northboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 0b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 1b endif no1 temporary tmp1 temporary tmp2 tmp temporary northboarder mask temporary no1 mask 0:ny 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1v firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2v firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask vmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask vmask firstx:lastx firsty:lasty firstz:lastz end grille F vargrid eq OPAPTDHF or vargrid eq OPAPT3DF or vargrid eq F : begin scalaires nx nxf ny nyf firstx firstxf firsty firstyf lastx lastxf lasty lastyf vecteurs 2d IF arg_present glam THEN glam glamf firstx:lastx firsty:lasty IF arg_present gphi THEN gphi gphif firstx:lastx firsty:lasty if keyword_set forplt then BEGIN mask 1b tmask firstx:lastx firsty:lasty firstz eastboarder mask shift mask 1 0 mask westboarder mask shift mask 1 0 mask westboarder nx 1 0b northboarder mask shift mask 0 1 mask southboarder mask shift mask 0 1 mask southboarder ny 1 0b tmp1 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp1 nx 1 0b tmp2 shift northboarder 1 0 if key_periodic NE 1 OR nx NE jpi then tmp2 0 0b add temporary tmp1 temporary tmp2 1b northboarder 1b southboarder northboarder temporary northboarder temporary add tmp1 shift eastboarder 0 1 tmp1 0 0b tmp2 shift eastboarder 0 1 tmp2 ny 1 0b add temporary tmp1 temporary tmp2 1b eastboarder 1b temporary westboarder eastboarder temporary eastboarder temporary add tmp1 mask shift mask 0 1 shift mask 0 1 NE 1b tmp1 ny 1 1b tmp1 0 1b tmp2 mask shift mask 1 0 shift mask 1 0 NE 1b if key_periodic NE 1 OR nx NE jpi then begin tmp2 nx 1 1b tmp2 0 1b endif no1 temporary tmp1 temporary tmp2 tmp temporary northboarder temporary eastboarder mask temporary no1 mask 0:nx 2 0b mask 0:ny 2 0b tmp temporary tmp temporary mask tmp where tmp GE 1 if tmp 0 NE 1 then begin glam tmp glamt firstx:lastx firsty:lasty tmp gphi tmp gphit firstx:lastx firsty:lasty tmp endif ENDIF IF arg_present e1 THEN e1 e1f firstx:lastx firsty:lasty IF arg_present e2 THEN e2 e2f firstx:lastx firsty:lasty vecteurs 3d IF keyword_set forplt THEN mask fmask firstx:lastx firsty:lasty firstz ELSE IF arg_present mask THEN mask fmask firstx:lastx firsty:lasty firstz:lastz END ELSE:BEGIN ras report Wrong definition of vargrid vargrid Only T U V W or F are acceptable stop END ENDCASE IF testvar var key_performance EQ 2 THEN print temps grille: attribution des scalaires vecteurs et tableaux systime 1 tempdeux Variables se rapportant a la dimension verticale tempdeux systime 1 pour key_performance 2 if keyword_set wdepth then begin gdep gdepw firstz:lastz e3 e3w firstz:lastz endif else begin gdep gdept firstz:lastz e3 e3t firstz:lastz ENDELSE for the vertical sections with partial steps IF keyword_set ifpltz AND keyword_set key_partialstep THEN BEGIN CASE 1 OF ifpltz EQ xz AND ny EQ 1:BEGIN bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 good where bottom NE 0 AND bottom NE nz keyword_set wdepth bottom lindgen nx bottom 1l keyword_set wdepth nx IF good 0 NE 1 THEN BEGIN bottom bottom good IF lastz EQ jpk 1 THEN gdep nz 1 max hdepw gdep replicate 1 nx gdep if keyword_set wdepth THEN truegdep hdepw firstx:lastx firsty:lasty ELSE truegdep hdept firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ifpltz EQ yz AND nx EQ 1:BEGIN bottom total tmask firstx:lastx firsty:lasty firstz:lastz 3 good where bottom NE 0 AND bottom NE nz keyword_set wdepth bottom lindgen ny bottom 1l keyword_set wdepth ny IF good 0 NE 1 THEN BEGIN bottom bottom good IF lastz EQ jpk 1 THEN gdep nz 1 max hdepw gdep replicate 1 ny gdep if keyword_set wdepth THEN truegdep hdepw firstx:lastx firsty:lasty ELSE truegdep hdept firstx:lastx firsty:lasty gdep bottom truegdep good ENDIF END ELSE: ENDCASE ENDIF IF testvar var key_performance EQ 2 THEN print temps grille: Variables se rapportant a la dimension verticale systime 1 tempdeux vecteur triangulation Qd TRI est active if arg_present TRI then if triangles_list 0 EQ 1 OR keyword_set notri then tri 1 ELSE BEGIN tempdeux systime 1 pour key_performance 2 msk bytarr jpi jpj msk firstx:lastx firsty:lasty 1 ind where msk triangles_list 0 msk triangles_list 1 msk triangles_list 2 EQ 1 tri triangles_list ind firstx firsty jpi y tri jpi x tri y jpi tri x y nx IF testvar var key_performance EQ 2 THEN print temps grille: decoupage de la triangulation systime 1 tempdeux ENDELSE pour s assurer qu il n y a pas de dimension degenerees 1 mask reform mask over glam reform glam over gphi reform gphi over gdep reform gdep over e1 reform e1 over e2 reform e2 over e3 reform e3 over if keyword_set savedbox THEN restoreboxparam boxparam4grille dat if keyword_set key_performance THEN print temps grille systime 1 tempsun IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end "); 187 a[185] = new Array("./ToBeReviewed/GRILLE/t2v.html", "t2v.pro", "", " NAME:t2v PURPOSE:permet de passer un champs se rapportant a la grille T sur la grille V grace a la moyenne: res 0 5 res shift res 0 1 CATEGORY:grille CALLING SEQUENCE:res t2v tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION t2v temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxv etc firstxv firstxt lastxv lastxt firstyv firstyt lastyv lastyt nxv nxt nyv nyt vargrid V if NOT keyword_set valmask then valmask 1e20 lat1 gphit 0 firstyt lat2 gphiv 0 lastyv cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt: taille 1 eq jpi and taille 2 eq jpj: res res firstxt:lastxt firstyt:lastyt else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask tmask firstxt:lastxt firstyt:lastyt 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 0 1 res nyt 1 values f_nan mask vmask firstxt:lastxt firstyt:lastyt 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ nzt: taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxt:lastxt firstyt:lastyt firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxt:lastxt firstyt:lastyt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask tmask firstxt:lastxt firstyt:lastyt lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxt nyt jpt over ENDIF ELSE mask tmask firstxt:lastxt firstyt:lastyt firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 res nyt 1 values f_nan if taille 3 EQ jpt then BEGIN mask vmask firstxt:lastxt firstyt:lastyt lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxt nyt jpt over ENDIF ELSE mask vmask firstxt:lastxt firstyt:lastyt firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxt and taille 2 eq nyt AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxt:lastxt firstyt:lastyt firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask tmask firstxt:lastxt firstyt:lastyt firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxt nyt nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 0 res nyt 1 values f_nan mask vmask firstxt:lastxt firstyt:lastyt firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxt nyt nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END ENDCASE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 188 a[186] = new Array("./ToBeReviewed/GRILLE/tracegrille.html", "tracegrille.pro", "", " NAME:tracegrille PURPOSE:dessine la grille CATEGORY: CALLING SEQUENCE:tracegrille INPUTS:glam et gphi les tableaux 1d ou 2d des position en longitude latitude des points de la grille Si glam et gphi ne sont pas specifies trace la grille specifiee par vargrid sur le domaine definit par le dernier domdef KEYWORD PARAMETERS: XSTRIDE un entier pour specifier qu on ne veut tracer qu une ligne de i constant tout les xstride points YSTRIDE un entier pour specifier qu on ne veut tracer qu une ligne de j constant tout les ystride points OCEAN: pour ne tracer la grille que sur les points oceans EARTH: pour ne tracer la grille que sur les points terre RMOUT:select to remove all cell having one corner out of the plot boundaries x range y range tous les mots clefs de la procedure PLOTS OUTPUTS:none COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL plt indgen jpi jpj nocontour nofill IDL vargrid T IDL tracegrille ocean color 20 IDL tracegrille earth color 80 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO tracegrille glamin gphiin OCEAN ocean EARTH earth XSTRIDE xstride YSTRIDE ystride RMOUT rmout _extra extra cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance to avoid warning message oldexcept except except 0 if n_elements key_gridtype EQ 0 then key_gridtype c if n_elements glamin n_elements gphiin EQ 0 then BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz IF keyword_set ocean AND key_gridtype EQ c THEN BEGIN we reduce the mask to take into account the point located ON the coastline CASE vargrid OF U :BEGIN mask tmask firstx:lastx firsty:lasty IF NOT keyword_set key_periodic OR nx NE jpi THEN tmpx mask nx 1 mask mask shift mask 1 0 1 IF NOT keyword_set key_periodic OR nx NE jpi THEN mask nx 1 temporary tmpx END V :BEGIN mask tmask firstx:lastx firsty:lasty tmpy mask ny 1 mask mask shift mask 0 1 1 mask ny 1 temporary tmpy END F :BEGIN mask tmask firstx:lastx firsty:lasty IF NOT keyword_set key_periodic OR nx NE jpi THEN tmpx mask nx 1 tmpy mask ny 1 mask mask shift mask 1 0 shift mask 0 1 shift mask 1 1 1 mask ny 1 temporary tmpy IF NOT keyword_set key_periodic OR nx NE jpi THEN mask nx 1 temporary tmpx END ELSE: ENDCASE ENDIF ENDIF ELSE BEGIN glam glamin gphi gphiin IF size glam 0 EQ 1 AND size gphi 0 EQ 1 THEN BEGIN nx n_elements glam ny n_elements gphi glam glam replicate 1 ny gphi replicate 1 nx gphi ENDIF ELSE BEGIN nx size glam 1 ny size glam 2 ENDELSE ENDELSE if n_elements mask EQ 0 then mask replicate 1b nx ny if size mask 0 EQ 3 then mask mask 0 IF keyword_set RMOUT THEN BEGIN out where glam GT max x range OR glam LT min x range OR gphi GT max y range OR gphi LT min y range IF out 0 NE 1 THEN BEGIN glam out values f_nan gphi out values f_nan ENDIF ENDIF IF keyword_set ocean then BEGIN earth where mask EQ 0 if earth 0 NE 1 then begin glam earth values f_nan gphi earth values f_nan ENDIF earth 0 ENDIF IF keyword_set earth THEN BEGIN ocean where mask EQ 1 if ocean 0 NE 1 then begin glam ocean values f_nan gphi ocean values f_nan ENDIF ocean 0 ENDIF if NOT keyword_set xstride then xstride 1 if NOT keyword_set ystride then ystride 1 case key_gridtype of c :BEGIN for i 0 ny 1 ystride do begin plots glam i gphi i _extra extra endfor for i 0 nx 1 xstride do begin plots glam i gphi i _extra extra endfor END e :BEGIN shifted glam 0 0 LT glam 0 1 glam2 glam glam 1 glam 0 2 if shifted then begin for i 0 ny 2 do BEGIN xx transpose glam i glam2 i yy transpose gphi i gphi i 1 plots xx 0:2 nx 2 yy 0:2 nx 2 _extra extra ENDFOR ENDIF ELSE BEGIN for i 1 ny 1 do BEGIN xx transpose glam i glam2 i yy transpose gphi i gphi i 1 plots xx 0:2 nx 2 yy 0:2 nx 2 _extra extra ENDFOR ENDELSE for i 1 ny 1 2 do plots glam 0 2 i 1 glam 0 2 i gphi 0 2 i 1 gphi 0 2 i _extra extra for i 0 ny 2 2 do plots glam nx 1 2 i glam nx 1 2 i 1 gphi nx 1 2 i gphi nx 1 2 i 1 _extra extra END endcase if keyword_set key_performance THEN print temps trace grille systime 1 tempsun except oldexcept return end"); 189 a[187] = new Array("./ToBeReviewed/GRILLE/u2t.html", "u2t.pro", "", " NAME:u2t PURPOSE:permet de passer un champs se rapportant a la grille U sur la grille T grace a la moyenne: res 0 5 res shift res 1 0 CATEGORY:grille CALLING SEQUENCE:res u2t tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION u2t temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxu etc firstxt firstxu lastxt lastxu firstyt firstyu lastyt lastyu nxt nxu nyt nyu vargrid T if NOT keyword_set valmask then valmask 1e20 lon1 glamt firstxt 0 lon2 glamu lastxu 0 cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu: taille 1 eq jpi and taille 2 eq jpj: res res firstxu:lastxu firstyu:lastyu else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask umask firstxu:lastxu firstyu:lastyu 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 1 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan mask tmask firstxu:lastxu firstyu:lastyu 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ nzt: taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxu:lastxu firstyu:lastyu firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxu:lastxu firstyu:lastyu else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask umask firstxu:lastxu firstyu:lastyu lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxu nyu jpt over ENDIF ELSE mask umask firstxu:lastxu firstyu:lastyu firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxu:lastxu firstyu:lastyu lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxu nyu jpt over ENDIF ELSE mask tmask firstxu:lastxu firstyu:lastyu firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxu and taille 2 eq nyu AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxu:lastxu firstyu:lastyu firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask umask firstxu:lastxu firstyu:lastyu firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxu nyu nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 1 0 0 0 if NOT keyword_set key_periodic AND nxu EQ jpi then res 0 values f_nan mask tmask firstxu:lastxu firstyu:lastyu firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxu nyu nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 190 a[188] = new Array("./ToBeReviewed/GRILLE/umask.html", "umask.pro", "", " NAME:umask PURPOSE:calcule umask CATEGORY:fonction economisatrice de memoire plus besion de garder umask CALLING SEQUENCE:res umask INPUTS: KEYWORD PARAMETERS: OUTPUTS:un tableau 3d correspondant a umask COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE:s utilise comme si umask etait un tableau connu en replacant ds la syntaxe umask par umask par ex: au lieu de taper umask domaineu il faut taper umask domaineu MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 6 99 introduction du key_shift 20 9 99 cas jpk 1 merci jpblod ipsl jussieu fr FUNCTION umask cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 1 0 3:res tmask shift tmask 1 0 0 ENDCASE if NOT keyword_set key_periodic then res jpi 1 umaskred if keyword_set key_performance THEN print temps umask systime 1 tempsun return res end"); 191 a[189] = new Array("./ToBeReviewed/GRILLE/v2t.html", "v2t.pro", "", " NAME:v2t PURPOSE:permet de passer un champs se rapportant a la grille V sur la grille T grace a la moyenne: res 0 5 res shift res 0 1 CATEGORY:grille CALLING SEQUENCE:res v2t tab INPUTS:tab un tableau 2 3 ou 4d KEYWORD PARAMETERS: OUTPUTS:res un tableau 2 3 ou 4d COMMON BLOCKS:common pro SIDE EFFECTS:force les parametres du zoom sur la grille V a etre les memes que ceux sur la grille T RESTRICTIONS:les points qui ne peuvent etre calcules sont mis a la valeur NaN consacree par IDL: values f_nan EXAMPLE: MODIFICATION HISTORY:a partir des programmes de Marina Levy Sebastien Masson smasson lodyc jussieu fr : inspection des traveuax finis 5 6 2000 FUNCTION v2t temp cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF res temp on force nxt nxv etc firstxt firstxv lastxt lastxv firstyt firstyv lastyt lastyv nxt nxv nyt nyv vargrid T if NOT keyword_set valmask then valmask 1e20 lat1 gphit 0 firstyt lat2 gphiv 0 lastyv cas sur la taille du tableau et application taille size temp CASE taille 0 OF 1: res 1 2: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv: taille 1 eq jpi and taille 2 eq jpj: res res firstxv:lastxv firstyv:lastyv else: return report Probleme d adequation entre les tailles du domaine et de la boite endcase mask vmask firstxv:lastxv firstyv:lastyv 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre values f_nan res 0 5 res shift res 0 1 res 0 values f_nan mask tmask firstxv:lastxv firstyv:lastyv 0 terre where mask EQ 0 IF terre 0 NE 1 THEN res terre valmask END 3: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ nzt: taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpk: res res firstzt:lastzt taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpt: taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk: res res firstxv:lastxv firstyv:lastyv firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpt: res res firstxv:lastxv firstyv:lastyv else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE if taille 3 EQ jpt then begin mask vmask firstxv:lastxv firstyv:lastyv lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxv nyv jpt over ENDIF ELSE mask vmask firstxv:lastxv firstyv:lastyv firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 res 0 values f_nan if taille 3 EQ jpt then BEGIN mask tmask firstxv:lastxv firstyv:lastyv lastzt nzt NE jpk mask temporary mask replicate 1 jpt mask reform mask nxv nyv jpt over ENDIF ELSE mask tmask firstxv:lastxv firstyv:lastyv firstzt:lastzt terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END 4: BEGIN case 1 of taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ nzt AND taille 4 EQ jpt: taille 1 eq nxv and taille 2 eq nyv AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstzt:lastzt taille 1 eq jpi and taille 2 eq jpj AND taille 3 EQ jpk AND taille 4 EQ jpt: res res firstxv:lastxv firstyv:lastyv firstzt:lastzt else: return report Probleme d adequation entre les tailles du domaine et de la boite ENDCASE mask vmask firstxv:lastxv firstyv:lastyv firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxv nyv nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre values f_nan res 0 5 res shift res 0 1 0 0 res 0 values f_nan mask tmask firstxv:lastxv firstyv:lastyv firstzt:lastzt mask temporary mask replicate 1 jpt mask reform mask nxv nyv nzt jpt over terre where temporary mask EQ 0 IF terre 0 NE 1 THEN res temporary terre valmask END endcase IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return res END "); 192 a[190] = new Array("./ToBeReviewed/GRILLE/vmask.html", "vmask.pro", "", " NAME:vmask PURPOSE:calcule vmask CATEGORY:fonction economisatrice de memoire plus besion de garder vmask CALLING SEQUENCE:res vmask OUTPUTS:un tableau 3d correspondant a vmask EXAMPLE:s utilise comme si vmask etait un tableau connu en replacant ds la syntaxe vmask par vmask par ex: au lieu de taper vmask domainef il faut taper vmask domainef MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 20 9 99 cas jpk 1 merci jpblod ipsl jussieu fr FUNCTION vmask common tempsun systime 1 pour key_performance CASE size tmask n_dimensions OF 2:res tmask shift tmask 0 1 3:res tmask shift tmask 0 1 0 ENDCASE res jpj 1 vmaskred if keyword_set key_performance THEN print temps vmask systime 1 tempsun return res end"); 193 a[191] = new Array("./ToBeReviewed/HOPE/completetype.html", "completetype.pro", "", " function completetype typein type typein case type of x :type type yzt y :type type xzt z :type type zyt t :type type xyz xy :type type zt xz :type type yt yz :type type xt xt :type type yz yt :type type xz zt :type type xy xyz :type type t xyt :type type z yzt :type type x xyzt : endcase return type end "); 194 a[192] = new Array("./ToBeReviewed/HOPE/computehopegrid.html", "computehopegrid.pro", "", " NAME:computehopegrid PURPOSE: CATEGORY:grille CALLING SEQUENCE:computehopegrid INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2001 06 PRO computehopegrid xaxis yaxis zaxis linetype FORTHEMASK forthemask WPOINT wpoint FIRSTS firsts LASTS lasts PTTYPE pttype cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF if not keyword_set scalar keyword_set vector then scalar 1 jpiglo n_elements xaxis jpjglo n_elements yaxis jpkglo n_elements zaxis jpi jpiglo jpj jpjglo jpk jpkglo if NOT keyword_set firsts then firsts 0 0 0 if NOT keyword_set lasts then lasts jpi 1 jpj 1 jpk 1 depermination of the grid type and of the point type if keyword_set pttype then vargrid pttype if linetype EQ odd even then key_gridtype e ELSE key_gridtype c computation of the horizontal grid if key_gridtype EQ e then begin if vargrid EQ T then begin glamt xaxis glamt glamt replicate 1 jpj xstep glamt 1 0 glamt 0 0 2 glamt 2 lindgen jpj 2 glamt 2 lindgen jpj 2 xstep glamu glamt xstep ENDIF ELSE BEGIN glamu xaxis glamu glamu replicate 1 jpj xstep glamu 1 0 glamu 0 0 2 glamu 2 lindgen jpj 2 glamu 2 lindgen jpj 2 xstep glamt glamu xstep ENDELSE zoom glamt glamt firsts 0 :lasts 0 firsts 1 :lasts 1 glamu glamu firsts 0 :lasts 0 firsts 1 :lasts 1 jpiglo lasts 0 firsts 0 1 jpi jpiglo jpjglo lasts 1 firsts 1 1 jpj jpjglo glamv glamu glamf glamu gphit yaxis firsts 1 :lasts 1 gphit replicate 1 jpi gphit gphif gphit gphiu gphit gphiv gphif ENDIF ELSE BEGIN if vargrid eq T then begin glamt xaxis glamt glamt replicate 1 jpj glamu glamt glamt 1 0 glamt 0 0 2 ENDIF ELSE BEGIN glamu xaxis glamu glamu replicate 1 jpj xstep glamu 1 0 glamu 0 0 2 glamt glamu glamu 1 0 glamu 0 0 2 ENDELSE zoom glamt glamt firsts 0 :lasts 0 firsts 1 :lasts 1 glamu glamu firsts 0 :lasts 0 firsts 1 :lasts 1 jpiglo lasts 0 firsts 0 1 jpi jpiglo jpjglo lasts 1 firsts 1 1 jpj jpjglo glamv glamt glamf glamu gphit yaxis firsts 1 :lasts 1 gphit replicate 1 jpi gphit gphiu gphit if jpj GT 1 then begin gphiv gphit gphit 0 1 gphit 0 0 2 gphif gphit gphit 0 1 gphit 0 0 2 ENDIF ELSE BEGIN gphiv gphit gphif gphit ENDELSE ENDELSE computation of the vertical grid if keyword_set wpoint then begin gdepw zaxis if jpk ne 1 then begin gdept shift gdepw 1 gdepw 2 gdept jpk 1 gdepw jpk 1 5 gdepw jpk 1 gdepw jpk 2 endif else gdept zaxis endif else begin gdept zaxis if jpk ne 1 then begin gdepw shift gdept 1 gdept 2 gdepw 0 0 endif else gdepw zaxis endelse computation of the vertical scale factors if jpk ne 1 then begin e3t abs shift gdepw 1 gdepw e3t jpk 1 abs gdept jpk 1 gdepw jpk 1 e3w abs gdept shift gdept 1 e3w 0 abs gdept 0 gdepw 0 endif else begin e3t 1 e3w 1 endelse zoom gdept gdept firsts 2 :lasts 2 gdepw gdepw firsts 2 :lasts 2 e3t e3t firsts 2 :lasts 2 e3w e3w firsts 2 :lasts 2 jpkglo lasts 2 firsts 2 1 jpk jpkglo computation of the horizontal scale factors e1t replicate 1b jpi jpj e2t replicate 1b jpi jpj e1u e1t e2u e2t e1v e1t e2v e2t e1f e1t e2f e2t mask tmask replicate 1b jpi jpj jpk if keyword_set forthemask then BEGIN land where forthemask ge valmask 10 if land 0 ne 1 then tmask land 0b endif umaskred replicate 1 jpj jpk vmaskred replicate 1 jpi jpk fmaskredy replicate 1 jpj jpk fmaskredx replicate 1 jpi jpk updateold domdef if keyword_set firsts AND keyword_set lasts then BEGIN if vargrid EQ T then BEGIN if jpj GT 1 then begin lon1 min glamt 0 0 1 lon2 max glamt jpi 1 0 1 endif ELSE BEGIN lon1 min glamt 0 0 lon2 max glamt jpi 1 0 ENDELSE ENDIF ELSE BEGIN if jpj GT 1 then begin lon1 min glamu 0 0 1 lon2 max glamu jpi 1 0 1 endif ELSE BEGIN lon1 min glamu 0 0 lon2 max glamu jpi 1 0 ENDELSE ENDELSE lat1 min gphit 0 0 gphit 0 jpj 1 lat2 max gphit 0 0 gphit 0 jpj 1 domdef lon1 lon2 lat1 lat2 gdepw 0 gdept jpk 1 gridtype vargrid ENDIF ixminmesh 0l ixmaxmesh long jpi 1 iyminmesh 0l iymaxmesh long jpj 1 izminmesh 0l izmaxmesh long jpk 1 for the triangulation key_periodic glamt 0 EQ glamt jpi 1 glamt 1 glamt 0 MOD 360 if jpi gt 4 AND jpj GT 4 then begin triangles_list triangule shifted glamt 0 0 LT glamt 0 1 twin_corners_up 1 twin_corners_dn 1 ENDIF ELSE BEGIN triangles_list 1 twin_corners_up 1 twin_corners_dn 1 ENDELSE IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end "); 195 a[193] = new Array("./ToBeReviewed/HOPE/createhopestruct.html", "createhopestruct.pro", "", "FUNCTION createhopestruct event widget_control event top get_uvalue top_uvalue find the selected variable selected top_uvalue 1 findline top_uvalue selected get the variable id varid top_uvalue 1 findline top_uvalue datavarid selected get the section type type top_uvalue 1 findline top_uvalue sectype selected get its dimension dimsvar top_uvalue 1 findline top_uvalue dimvar selected tosort sortdim completetype type dimsvar dimsvar tosort get the specified spatial domain and build reading parameters linetype top_uvalue 1 findline top_uvalue linetype selected case linetype of odd :domainid widget_info event top find_by_uname basedomainodd even :domainid widget_info event top find_by_uname basedomaineven odd even :domainid widget_info event top find_by_uname basedomainodd even endcase allaxes top_uvalue 1 findline top_uvalue dimlist xaxis allaxes dimsvar 0 xlimits top_uvalue 1 findline top_uvalue xlimits if NOT keyword_set xlimits then begin xid widget_info domainid find_by_uname xinterval widget_control xid get_value xint endif ELSE xint xaxis where xaxis GE xlimits 0 AND xaxis LE xlimits 1 yaxis allaxes dimsvar 1 yaxis reverse yaxis latitudes from the south to the north ylimits top_uvalue 1 findline top_uvalue ylimits if NOT keyword_set ylimits then begin yid widget_info domainid find_by_uname yinterval widget_control yid get_value yint endif ELSE yint yaxis where yaxis GE ylimits 0 AND yaxis LE ylimits 1 zaxis allaxes dimsvar 2 zlimits top_uvalue 1 findline top_uvalue zlimits if NOT keyword_set zlimits then begin zid widget_info domainid find_by_uname zinterval widget_control zid get_value zint endif ELSE zint zaxis where zaxis GE zlimits 0 AND zaxis LE zlimits 1 time axis and time interval time allaxes dimsvar 3 yyyymmdd vairdate time tlimits top_uvalue 1 findline top_uvalue tlimits if NOT keyword_set tlimits then BEGIN date1id widget_info event top find_by_uname date1 widget_control date1id get_value date1 date2id widget_info event top find_by_uname date2 widget_control date2id get_value date2 tlimits date1 date2 ENDIF tint time where yyyymmdd GE tlimits 0 AND yyyymmdd LE tlimits 1 limits of the domain nxt n_elements xint nyt n_elements yint nzt n_elements zint jpt n_elements tint firstx where xaxis GE xint 0 0 firsty where yaxis GE yint 0 0 lasty firsty nyt 1 firstz where zaxis GE zint 0 0 firstt where time GE tint 0 0 read the array cdfid ncdf_open top_uvalue 1 findline top_uvalue filename offset firstx n_elements yaxis lasty 1 firstz firstt count nxt nyt nzt jpt tosortinv sortdim completetype type inv sort the offset and count for the case of the array is not written as a xyzt array but for example as a yzxt array offset offset tosortinv count count tosortinv call to ncdf_varget ncdf_varget cdfid varid array offset offset count count force to keep the dimension equal to 1 if count 3 eq 1 then array reform array count 0 count 1 count 2 count 3 over if not array_equal tosort lindgen 4 then array transpose temporary array tosort count nxt nyt nzt jpt if jpt eq 1 then array reform array count 0 count 1 count 2 count 3 over array reverse array 2 over if there is no longitude zoom shift the array to obtain longitude between 20 and 380 if nxt EQ 128 OR nxt EQ 256 then begin key_shift where xaxis GE 20 0 xaxis shift temporary xaxis key_shift xaxis where xaxis LT 20 xaxis where xaxis LT 20 360 array shift temporary array key_shift 0 0 0 ENDIF ELSE key_shift 0 get some informations about the array insidevar ncdf_varinq cdfid varid if insidevar natts NE 0 then begin attnames strarr insidevar natts for attiq 0 insidevar natts 1 do attnames attiq strlowcase ncdf_attname cdfid varid attiq get the name if where attnames EQ long_name 0 EQ 1 then value ELSE ncdf_attget cdfid varid long_name value varname strtrim string value 2 get the units if where attnames EQ units 0 EQ 1 then value ELSE ncdf_attget cdfid varid units value varunit strtrim string value 2 get the missing_value if where attnames EQ missing_value 0 EQ 1 then valmask 1e20 ELSE ncdf_attget cdfid varid missing_value valmask ENDIF ELSE BEGIN varunit valmask 1e20 varname ENDELSE varexp build arguments to use computehopegrid and put it together in a structure firsts firstx firsty firstz lasts firstx nxt 1 firsty nyt 1 firstz nzt 1 vargrid top_uvalue 1 findline top_uvalue pointtype selected hopegrid xaxis:xaxis yaxis:yaxis zaxis:zaxis firsts:firsts lasts:lasts type:type linetype:linetype pttype:vargrid hopestru array:array unit:varunit name:varname date:time firstt:firstt jpt 1 grid:vargrid hopegrid:hopegrid we close the netcdf file before living ncdf_close cdfid return hopestru end"); 196 a[194] = new Array("./ToBeReviewed/HOPE/cw_selectinterval.html", "cw_selectinterval.pro", "", " PRO testwid_event event widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy get :BEGIN id widget_info event top find_by_uname discret widget_control id get_value value1 help value1 print value1 value1 id widget_info event top find_by_uname continus widget_control id get_value value2 help value2 print value2 value2 END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN nothing widget_label base value beginning of the test nothing cw_selectinterval base 10 indgen 5 _extra ex uname discret uvalue discret print nothing nothing cw_selectinterval base indgen 20 _extra ex uname continus uvalue continus print nothing nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base no_block return end function cw_selectinterval_get_value id bgroupid widget_info id find_by_uname bgroup the widget is a set of button if bgroupid ne 0 then begin widget_control bgroupid get_value selected widget_control bgroupid get_uvalue vecteur vecteur vecteur vecteur endif else begin the widget is 2 sliders Minid Widget_Info Id Find_by_uname min widget_control minid get_value minval minval minval value maxid widget_info id find_by_uname max widget_control maxid get_value maxval maxval maxval value widget_control minid get_uvalue vecteur vecteur vecteur vecteur selected where vecteur ge minval and vecteur le maxval ENDELSE if selected 0 eq 1 then return 1 else return vecteur selected END function cw_selectinterval_event event widget_control event id get_uvalue uval case uval name of min :begin change the value if the minimum for the slider called max maxid widget_info event handler find_by_uname max widget_control maxid set_value SLIDER_MIN:event value 1 end max :begin change the value if the maximum for the slider called min minid widget_info event handler find_by_uname min widget_control minid set_value SLIDER_MAX:event value 1 end bgroup : endcase return ID:event handler TOP:event top HANDLER:0L END function cw_selectinterval parent vecteur _extra ex base widget_base parent EVENT_FUNC cw_selectinterval_event FUNC_GET_VALUE cw_selectinterval_get_value PRO_SET_VALUE cw_selectinterval_set_value ROW _extra ex if n_elements vecteur le 10 then begin nothing CW_BGROUP base strtrim vecteur 1 nonexclusive row uvalue name: bgroup vecteur:vecteur uname bgroup buttvalue bytarr n_elements nothing buttvalue 0 1 widget_control nothing set_value buttvalue endif else begin min min floor vecteur max max ceil vecteur nothing cw_slider_pm base value min min min max max 1 uvalue name: min vecteur:vecteur uname min nothing cw_slider_pm base value max min min 1 max max uvalue name: max uname max endelse return base end"); 197 a[195] = new Array("./ToBeReviewed/HOPE/domainpart.html", "domainpart.pro", "", "pro domainpart top_uvalue basedomain selected DESTROY destroy if keyword_set destroy then BEGIN id widget_info basedomain find_by_uname title IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname oddsecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname evensecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname odd evensecchoice IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basex IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basey IF id NE 0 THEN widget_control id destroy id widget_info basedomain find_by_uname basez IF id NE 0 THEN widget_control id destroy return endif we get the size of the dimenstion id of this section dimvar top_uvalue 1 findline top_uvalue dimvar selecteddim dimvar selected typedim top_uvalue 1 findline top_uvalue typedim sorteddim selecteddim sortdim typedim selecteddim dimlist top_uvalue 1 findline top_uvalue dimlist longitude part basex widget_info basedomain find_by_uname basex IF basex NE 0 THEN widget_control basex destroy basex widget_base basedomain row uname basex nothing widget_text basex value longitude xsize 10 nothing cw_selectinterval basex dimlist sorteddim 0 uname xinterval uvalue name: xinterval latitude part basey widget_info basedomain find_by_uname basey IF basey NE 0 THEN widget_control basey destroy basey widget_base basedomain row uname basey nothing widget_text basey value latitude xsize 10 nothing cw_selectinterval basey reverse dimlist sorteddim 1 uname yinterval uvalue name: yinterval depth part basez widget_info basedomain find_by_uname basez IF basez NE 0 THEN widget_control basez destroy basez widget_base basedomain row uname basez nothing widget_text basez value depth xsize 10 nothing cw_selectinterval basez dimlist sorteddim 2 uname zinterval uvalue name: zinterval end "); 198 a[196] = new Array("./ToBeReviewed/HOPE/findlineandpointtype.html", "findlineandpointtype.pro", "", "FUNCTION findlineandpointtype sectype xaxis yaxis iodir the file HOPE_lonlat nc is used in this function This file must be localized in iodir netcdf HOPE_lonlat dimensions: latTlow 242 lonTlowodd 128 latThigh 390 lonThighodd 256 variables: float latTlow latTlow latTlow:units degrees_north float lonTlowodd lonTlowodd lonTlowodd:units degrees_east lonTlowodd:point_spacing even lonTlowodd:modulo float latThigh latThigh latThigh:units degrees_north float lonThighodd lonThighodd lonThighodd:units degrees_east lonThighodd:point_spacing even lonThighodd:modulo jpi n_elements xaxis jpj n_elements yaxis depermination of the grid type and of the point type low resolution grid: jpi 128 jpj 121 x 2 jpk 20 0 1 4 2 8 4 2 5 6 odd T u T u 93 3 even T u T u 92 2 odd T u T u 91 1 even T u T u 90 0 high resolution grid: jpi 256 jpj 195 x 2 jpk 29 0 0 7 1 4 2 1 2 8 odd T u T u 91 6 even T u T u 91 0 odd T u T u 90 5 even T u T u 90 0 x0 floor xaxis 0 10 10 y0 floor yaxis 0 10 10 case sectype of xy :BEGIN if jpi NE 128 and jpi NE 256 OR jpj NE 121 AND jpj NE 121 2 AND jpj NE 195 AND jpj NE 195 2 then begin print CASE NOT coded stop ENDIF case 1 of jpj EQ 195: BEGIN case X0 OF 0:BEGIN line even vargrid T END 0 7:BEGIN case y0 OF 91 6:BEGIN line odd vargrid T END 91 0:BEGIN line even vargrid U END ELSE:BEGIN print CASE NOT coded stop END endcase END 1 4:BEGIN line odd vargrid U END endcase END jpj EQ 121:BEGIN case x0 OF 0:BEGIN line even vargrid T END 1 4:BEGIN case y0 OF 93 3:BEGIN line odd vargrid T END 92 2:BEGIN line even vargrid U END ELSE:BEGIN print CASE NOT coded stop END endcase END 2 8:BEGIN line odd vargrid U END endcase END jpj EQ 195 2:BEGIN line odd even case x0 OF 0 7:vargrid T 1 4:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END jpj EQ 121 2:BEGIN line odd even case x0 OF 1 4:vargrid T 2 8:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END ELSE:BEGIN print CASE NOT coded stop END endcase END xz :BEGIN if jpi NE 128 and jpi NE 256 then begin print CASE NOT coded stop ENDIF case X0 OF 0:BEGIN line even vargrid T END 0 7:BEGIN id ncdf_open iodir HOPE_lonlat nc ncdf_varget id latThigh lat test where lat EQ yaxis 0 0 if test EQ 1 then begin print CASE NOT coded stop endif IF test MOD 2 EQ 1 THEN BEGIN line even vargrid U ENDIF ELSE BEGIN line odd vargrid T ENDELSE ncdf_close id END 1 4:BEGIN if jpi EQ 128 then begin id ncdf_open iodir HOPE_lonlat nc ncdf_varget id latTlow lat test where lat EQ yaxis 0 0 if test EQ 1 then begin print CASE NOT coded stop endif IF test MOD 2 EQ 1 THEN BEGIN line even vargrid U ENDIF ELSE BEGIN line odd vargrid T ENDELSE ncdf_close id ENDIF ELSE BEGIN line odd vargrid U ENDELSE END 2 8:BEGIN line odd vargrid U END endcase END yz :BEGIN if jpj NE 121 AND jpj NE 195 then begin print CASE NOT coded stop ENDIF id ncdf_open iodir HOPE_lonlat nc case y0 of 93 3:BEGIN line odd ncdf_varget id lonTlowodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid T where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END 92 2:BEGIN line even ncdf_varget id lonTlowodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid U where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid T ELSE:BEGIN print CASE NOT coded stop END endcase END 91 6:BEGIN line odd ncdf_varget id lonThighodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid T where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid U ELSE:BEGIN print CASE NOT coded stop END endcase END 91 0:BEGIN line even ncdf_varget id lonThighodd lonTodd xstep lonTodd 1 lonTodd 0 2 case 1 OF where lonTodd EQ xaxis 0 0 NE 1:vargrid U where lonTodd xstep EQ xaxis 0 0 NE 1:vargrid T ELSE:BEGIN print CASE NOT coded stop END endcase END ELSE:BEGIN print CASE NOT coded stop END endcase ncdf_close id END else:BEGIN print case not coded stop END endcase return linetype:line pointtype:vargrid end"); 199 a[197] = new Array("./ToBeReviewed/HOPE/read_hope.html", "read_hope.pro", "", " NAME: read_hope PURPOSE: read the Hope grid file converted in NetCdf by xconv CATEGORY: reading CALLING SEQUENCE: a read_hope typein varnamein INPUTS: typein: a string specifing from which type of section the 4D array based: xy xz yz varnamein: a string the name of the cariable to be read in lower or upper case KEYWORD PARAMETERS: FILENAME the name of the file to be read XLIMITS a two elements vertor lonmin lonmax the bondary of the longitudes from 0 to 360 YLIMITS a two elements vertor latmin latmax the bondary of the latitudes from 90 to 90 ZLIMITS a two elements vertor depthmin depthmax the bondary of the depth TLIMITS a two elements vertor date1 date2 the bondary of the calendar with date1 and date2 folowing the syntaxe yyyymmdd ODDPT: activate to read only the sections located on ODD points EVENPT: activate to read only the sections located on even points ODDEVENPT: activate to read only the sections located on both even and odd points horizontal sections OUTPUTS: 1 if typein and varnamein are undefine this is the widget version a structure which but be read by litchamp pro and is necessary to complute the grid associated to the data see the example COMMON BLOCKS: common pro usefull only for the definition of iodir SIDE EFFECTS: x y z t xt yt and zt section not coded xconv must be able to works with this kind of fonction The grib file has no zoom possibilities on horizontal dimensions RESTRICTIONS: When typein and varnamein are defined the methode to find the godd variable is: 1 find the variables which are available on this type of sections woth this name 2 if ODDPT EVENPT or ODDEVENPT are specified consider only these types of sections 3 for an XY section the chosen variable is the one which has the most level in the vertical domain specified by ZLIMITS for an XZ section the chosen variable is the one which has the most points in the latitude domain specified by YLIMITS for an YZ section the chosen variable is the one which has the most points in the longitude domain specified by XLIMITS EXAMPLE: IDL a read_hope xy ocpt filename CLIM_CNT_1993 1998 nc IDL help a struct Structure 6 tags length 1860176 refs 1: ARRAY FLOAT Array 128 242 15 UNIT STRING deg C NAME STRING Ocean potential temperature DATE FLOAT Array 1 GRID STRING T HOPEGRID STRUCT Array 1 IDL help a hopegrid struct Structure 8 tags length 1588 refs 2: XAXIS FLOAT Array 128 YAXIS FLOAT Array 242 ZAXIS FLOAT Array 15 FIRSTS LONG Array 3 LASTS LONG Array 3 TYPE STRING xy LINETYPE STRING odd even PTTYPE STRING T IDL help litchamp a FLOAT Array 128 242 15 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 2001 pro read_hope_event event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue case uval name OF cancel :begin close the file cdfid top_uvalue 1 findline top_uvalue cdfid ncdf_close cdfid clear the pointer for i 0 n_elements top_uvalue 1 do ptr_free top_uvalue i kill the widget widget_control event top destroy end type choice :begin find the new type of selected section typeindex widget_info event id droplist_select selectedtype top_uvalue 1 findline top_uvalue type choice typeindex find the available variables for this type of section sectype top_uvalue 1 findline top_uvalue sectype goodvar where sectype EQ selectedtype namevar top_uvalue 1 findline top_uvalue namevar goodnamevar namevar goodvar find the selected var name varchoiceid widget_info event top find_by_uname var choice varindex widget_info varchoiceid droplist_select varchoice top_uvalue 1 findline top_uvalue var choice selectedvarname varchoice varindex do we change the variable if where goodnamevar EQ selectedvarname 0 EQ 1 then begin selectedvarname goodnamevar 0 varindex where varchoice EQ selectedvarname 0 widget_control varchoiceid set_droplist_select varindex ENDIF displays the different domains selected goodvar where goodnamevar EQ selectedvarname rh_alldomains event top selected end var choice :BEGIN find the new variable varindex widget_info event id droplist_select selectedvar top_uvalue 1 findline top_uvalue var choice varindex find the available variables for this type of section namevar top_uvalue 1 findline top_uvalue namevar goodvar where namevar EQ selectedvar sectype top_uvalue 1 findline top_uvalue sectype goodtype sectype goodvar find the selected type of section typechoiceid widget_info event top find_by_uname type choice typeindex widget_info typechoiceid droplist_select typechoice top_uvalue 1 findline top_uvalue type choice selectedtype typechoice typeindex do we change the type of section if where goodtype EQ selectedtype 0 EQ 1 then begin selectedtype goodtype 0 typeindex where typechoice EQ selectedtype 0 widget_control typechoiceid set_droplist_select typeindex ENDIF displays the different domains selected goodvar where goodtype EQ selectedtype rh_alldomains event top selected END plot :BEGIN plot the array res createhopestruct event type of section selected top_uvalue 1 findline top_uvalue selected type top_uvalue 1 findline top_uvalue sectype selected get the informations of cw_specifie specifieid widget_info event top find_by_uname specifie widget_control specifieid get_value specifie specifie struct2string specifie direct2string case type of x :command plt1d res x specifie y :command plt1d res y specifie z :command plt1d res z specifie t :command pltt res t specifie xy :command plt res specifie xz :command pltz res xz specifie yz :command pltz res yz specifie xt :command pltt res xt specifie yt :command pltt res yt specifie zt :command pltt res zt specifie xyz : xyt : yzt : xyzt : ENDCASE test execute command if test EQ 0 then stop end linechoice :BEGIN if event select EQ 1 then begin sensitive bytarr 3 sensitive where odd even odd even eq event value 1 basedomainodd widget_info event top find_by_uname basedomainodd widget_control basedomainodd sensitive sensitive 0 basedomaineven widget_info event top find_by_uname basedomaineven widget_control basedomaineven sensitive sensitive 1 basedomainoddeven widget_info event top find_by_uname basedomainodd even widget_control basedomainoddeven sensitive sensitive 2 case where sensitive EQ 1 0 of 0:BEGIN widget_control basedomainodd get_uvalue oddsecchoice oddsecchoiceid widget_info event top find_by_uname oddsecchoice if oddsecchoiceid NE 0 then index widget_info oddsecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected oddsecchoice index END 1:BEGIN widget_control basedomaineven get_uvalue evensecchoice evensecchoiceid widget_info event top find_by_uname evensecchoice if evensecchoiceid NE 0 then index widget_info evensecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected evensecchoice index END 2:BEGIN widget_control basedomainodd get_uvalue oddevensecchoice oddevensecchoiceid widget_info event top find_by_uname odd evensecchoice if oddevensecchoiceid NE 0 then index widget_info oddevensecchoiceid droplist_select ELSE index 0 top_uvalue 1 findline top_uvalue selected oddevensecchoice index END endcase endif END oddsecchoice :BEGIN widget_control event top update 0 basedomainodd widget_info event top find_by_uname basedomainodd widget_control basedomainodd get_uvalue oddsecchoice domainpart top_uvalue basedomainodd oddsecchoice event index top_uvalue 1 findline top_uvalue selected oddsecchoice event index widget_control event top update 1 END evensecchoice :BEGIN widget_control event top update 0 basedomaineven widget_info event top find_by_uname basedomaineven widget_control basedomaineven get_uvalue evensecchoice domainpart top_uvalue basedomaineven evensecchoice event index top_uvalue 1 findline top_uvalue selected evensecchoice event index widget_control event top update 1 END odd evensecchoice :BEGIN widget_control event top update 0 basedomainoddeven widget_info event top find_by_uname basedomainodd even widget_control basedomainoddeven get_uvalue oddevensecchoice domainpart top_uvalue basedomainoddeven oddevensecchoice event index top_uvalue 1 findline top_uvalue selected oddevensecchoice event index widget_control event top update 1 END date1 :BEGIN date2id widget_info event top find_by_uname date2 widget_control date2id get_value date2 if event value GT date2 then widget_control date2id set_value event value END date2 :BEGIN date1id widget_info event top find_by_uname date1 widget_control date1id get_value date1 if event value LT date1 then widget_control date1id set_value event value END else: endcase return end FUNCTION read_hope typein varnamein FILENAME filename XLIMITS xlimits YLIMITS ylimits ZLIMITS zlimits TLIMITS tlimits ODDPT oddpt ODDEVENPT oddevenpt EVENPT evenpt _extra ex common usefull only for the definition of iodir if n_elements filename EQ 0 then filename isafile iodirectory iodir _extra ex IF size filename type NE 7 THEN return 1 filename isafile filename filename iodirectory iodir _extra ex cdfid ncdf_open filename id of the netcdf file wathinside ncdf_inquire cdfid structure with global informations dimensions namedim strarr wathinside ndims name of the dimensions typedim strarr wathinside ndims type of the dimensions x y z t sizedim lonarr wathinside ndims size of each dimension loop on the dimensions to get the names and sizes for dimiq 0 wathinside ndims 1 do begin ncdf_diminq cdfid dimiq name value namedim dimiq name case 1 of STRCMP name lon 3 FOLD_CASE :typedim dimiq x STRCMP name lat 3 FOLD_CASE :typedim dimiq y STRCMP name z 1 FOLD_CASE :typedim dimiq z STRCMP name t 1 FOLD_CASE :typedim dimiq t ELSE:BEGIN ncdf_close cdfid return report Unknown name of dimension END endcase sizedim dimiq value endfor dimlist: structure which contains the name and the value of each dimension we suppose that there is always a variable which has the same name that the dimension and which gives the values of this dimension ncdf_varget cdfid namedim 0 value dimlist create_struct namedim 0 value for dimiq 1 wathinside ndims 1 do begin ncdf_varget cdfid namedim dimiq value get the value dimlist create_struct dimlist namedim dimiq value endfor variables namevar strarr wathinside nvars names of the variables ndimsvar lonarr wathinside nvars number of dim for each variable dimvar replicate 1 wathinside ndims wathinside nvars dims of each variables loop over the variable ids to fill namevar ndimsvar and dimvar for varid 0 wathinside nvars 1 do begin res ncdf_varinq cdfid varid namevar varid res name namevar varid strjoin strsplit namevar varid _ 0 99 EXTRACT REGEX ndimsvar varid res ndims dimvar 0:res ndims 1 varid res dim ENDFOR we cut dimvar to select only the interessant part dimvar dimvar 0:max ndimsvar 1 selection of the data variables which are diffrent from the dimension variables we suppose that that data variables are 4D array with sometime dimensions equal to 1 they must be different from dimension variables which have only 1 dimension datavarid where ndimsvar eq 4 numberofvar n_elements datavarid namevar namevar datavarid ndimsvar ndimsvar datavarid dimvar dimvar datavarid sectype strarr numberofvar the type of section for each variable : xy xz yz linetype strarr numberofvar the line of the points : odd even or odd even pointtype strarr numberofvar the type of variable : scalar T or vector U for i 0 numberofvar 1 do begin dimofthevar dimvar i sectype i typedim dimofthevar 0 typedim dimofthevar 1 xaxisid dimofthevar where typedim dimofthevar EQ x yaxisid dimofthevar where typedim dimofthevar EQ y lineandpt findlineandpointtype sectype i dimlist xaxisid 0 dimlist yaxisid 0 iodir linetype i lineandpt linetype pointtype i lineandpt pointtype endfor definition of the widget base widget_base column first base: droplist to select the type of section droplist to select the variable button to select type of line : odd even or odd even base1 widget_base base row frame typechoice sectype uniq sectype sort sectype if n_elements typechoice GT 1 then typechoice typechoice sortdim typechoice base11 widget_droplist base1 title Type of section value typechoice uvalue name: type choice uname type choice if n_elements typein NE 0 then BEGIN selectedtype strmid typein 0 2 widget_control base11 set_droplist_select 0L where typechoice EQ selectedtype 0 ENDIF ELSE selectedtype typechoice 0 varchoice namevar uniq namevar sort namevar base12 widget_droplist base1 title Available data value varchoice uvalue name: var choice uname var choice if n_elements varnamein NE 0 THEN BEGIN selectedname varnamein widget_control base12 set_droplist_select 0L where strlowcase varchoice EQ strlowcase varnamein 0 ENDIF ELSE selectedname varchoice 0 base13 widget_base base1 row uname linechoicebase base 2: base to select the domain of the odd points base2 widget_base base column uname basedomainodd frame base 3: base to select the domain of the even points base3 widget_base base column uname basedomaineven frame base 4: base to select the domain of the odd even points base4 widget_base base column uname basedomainodd even frame base 5: calendar base5 widget_base base row uname baset frame timename strlowcase tag_names dimlist wathinside recdim read the time axis in julina days time ncdf_timeget cdfid timename update the dimlist structure dimlist wathinside recdim time base51 cw_calendar base5 time uname date1 uvalue name: date1 base52 cw_calendar base5 time uname date2 uvalue name: date2 base 6: base to select the min max and others keywords base6 cw_specifie base column uname specifie uvalue name: specifie base 7: last base with the action buttons base7 widget_base base row uname finalaction base71 widget_button base7 value Plot uvalue name: plot base72 widget_button base7 value Cancel uvalue name: cancel determination of the selected variable goodname 0 where strlowcase namevar EQ strlowcase selectedname goodtype 0 where sectype EQ selectedtype selected inter goodname goodtype if selected 0 EQ 1 then BEGIN widget_control base destroy ncdf_close cdfid return report impossible combinaison : type of section selectedtype variable name selectedname ENDIF if n_elements typein NE 0 then BEGIN if NOT keyword_set xlimits then xlimits 1e9 1e9 if NOT keyword_set ylimits then ylimits 1e9 1e9 if NOT keyword_set zlimits then zlimits 1e9 1e9 if NOT keyword_set tlimits then tlimits 1e9 1e9 ENDIF if n_elements typein NE 0 AND n_elements selected NE 1 then BEGIN if keyword_set oddpt then selected inter selected where linetype EQ odd if keyword_set evenpt then selected inter selected where linetype EQ even if keyword_set oddevenpt then selected inter selected where linetype EQ odd even if selected 0 EQ 1 then BEGIN widget_control base destroy ncdf_close cdfid return report impossible combinaison : type of section selectedtype variable name selectedname and line type endif if n_elements selected NE 1 then begin case selectedtype of xy :BEGIN choice on the vertical axis choice based on the variable which has the most available levels between the zlimits if NOT keyword_set zlimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin zdim dimvar 2 selected i zaxis dimlist zdim nothing where zaxis GE zlimits 0 AND zaxis LE zlimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END xz :BEGIN choice on the latitude axis if NOT keyword_set ylimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin ydim dimvar 2 selected i yaxis dimlist ydim nothing where yaxis GE ylimits 0 AND yaxis LE ylimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END yz :BEGIN choice on the longitude axis if NOT keyword_set xlimits then begin print case not coded stop ENDIF number lonarr n_elements selected for i 0 n_elements selected 1 do begin xdim dimvar 2 selected i xaxis dimlist xdim nothing where xaxis GE xlimits 0 AND xaxis LE xlimits 1 count number i count ENDFOR selected selected where number EQ max number if n_elements selected NE 1 then begin print case not coded stop endif END endcase endif ENDIF definition of the uvalue of the base which allows to share the variables between programs top_uvalue ptrarr 2 18 allocate_heap top_uvalue 0 0 type choice top_uvalue 1 0 temporary typechoice top_uvalue 0 1 var choice top_uvalue 1 1 temporary varchoice top_uvalue 0 2 namevar top_uvalue 1 2 temporary namevar top_uvalue 0 3 dimvar top_uvalue 1 3 temporary dimvar top_uvalue 0 4 sectype top_uvalue 1 4 temporary sectype top_uvalue 0 5 linetype top_uvalue 1 5 temporary linetype top_uvalue 0 6 pointtype top_uvalue 1 6 temporary pointtype top_uvalue 0 7 dimlist top_uvalue 1 7 temporary dimlist top_uvalue 0 8 typedim top_uvalue 1 8 temporary typedim top_uvalue 0 9 sizedim top_uvalue 1 9 temporary sizedim top_uvalue 0 10 cdfid top_uvalue 1 10 cdfid top_uvalue 0 11 datavarid top_uvalue 1 11 datavarid top_uvalue 0 12 selected top_uvalue 1 12 selected top_uvalue 0 13 filename top_uvalue 1 13 filename top_uvalue 0 14 xlimits top_uvalue 1 14 testvar var xlimits top_uvalue 0 15 ylimits top_uvalue 1 15 testvar var ylimits top_uvalue 0 16 zlimits top_uvalue 1 16 testvar var zlimits top_uvalue 0 17 tlimits top_uvalue 1 17 testvar var tlimits widget_control base set_uvalue top_uvalue rh_alldomains base selected if n_params EQ 0 then BEGIN we use the widget widget_control base REALIZE xmanager read_hope base no_block return 1 ENDIF get the output output createhopestruct top:base clear the pointer for i 0 n_elements top_uvalue 1 do ptr_free top_uvalue i close the file ncdf_close cdfid return output end"); 200 a[198] = new Array("./ToBeReviewed/HOPE/rh_alldomains.html", "rh_alldomains.pro", "", "PRO rh_alldomains topid selected widget_control topid get_uvalue top_uvalue widget_control topid update 0 selectedline top_uvalue 1 findline top_uvalue linetype selected we get the size of the dimenstion id of this section dimvar top_uvalue 1 findline top_uvalue dimvar typedim top_uvalue 1 findline top_uvalue typedim dimlist top_uvalue 1 findline top_uvalue dimlist sizedim top_uvalue 1 findline top_uvalue sizedim buttons to select type of line : odd even or odd even linechoicebase widget_info topid find_by_uname linechoicebase id widget_info linechoicebase find_by_uname linechoice IF id NE 0 THEN widget_control id destroy choice if where selectedline EQ odd 0 NE 1 then choice choice odd if where selectedline EQ even 0 NE 1 then choice choice even if where selectedline EQ odd even 0 NE 1 then choice choice odd even choice choice 1:n_elements choice 1 nothing cw_bgroup linechoicebase choice row exclusive return_name uname linechoice uvalue name: linechoice widget_control nothing set_value 0 sensitive bytarr 3 sensitive where odd even odd even eq choice 0 1 odd points domain basedomainodd widget_info topid find_by_uname basedomainodd id widget_info basedomainodd find_by_uname title IF id NE 0 THEN widget_control id destroy oddsecchoice where selectedline EQ odd if oddsecchoice 0 NE 1 then BEGIN oddsecchoice selected oddsecchoice nothing widget_label basedomainodd value Domain of the odd points uname title IF n_elements oddsecchoice GT 1 THEN BEGIN selecteddim dimvar oddsecchoice sorteddim selecteddim FOR i 0 n_elements oddsecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim oddsecchoice oddsecchoice sortedzdim nothing widget_droplist basedomainodd title number of levels value strtrim sizedims 2 uvalue name: oddsecchoice uname oddsecchoice ENDIF domainpart top_uvalue basedomainodd oddsecchoice 0 widget_control basedomainodd set_uvalue oddsecchoice ENDIF ELSE BEGIN nothing widget_label basedomainodd value uname title domainpart top_uvalue basedomainodd destroy widget_control basedomainodd set_uvalue 1 ENDELSE widget_control basedomainodd sensitive sensitive 0 even points domain basedomaineven widget_info topid find_by_uname basedomaineven id widget_info basedomaineven find_by_uname title IF id NE 0 THEN widget_control id destroy evensecchoice where selectedline EQ even if evensecchoice 0 NE 1 then BEGIN evensecchoice selected evensecchoice nothing widget_label basedomaineven value Domain of the even points uname title IF n_elements evensecchoice GT 1 THEN BEGIN selecteddim dimvar evensecchoice sorteddim selecteddim FOR i 0 n_elements evensecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim evensecchoice evensecchoice sortedzdim nothing widget_droplist basedomaineven title number of levels value strtrim sizedims 2 uvalue name: evensecchoice uname evensecchoice ENDIF domainpart top_uvalue basedomaineven evensecchoice 0 widget_control basedomaineven set_uvalue evensecchoice ENDIF ELSE BEGIN domainpart top_uvalue basedomaineven destroy nothing widget_label basedomaineven value uname title widget_control basedomaineven set_uvalue 1 ENDELSE widget_control basedomaineven sensitive sensitive 1 odd even points domain basedomainoddeven widget_info topid find_by_uname basedomainodd even id widget_info basedomainoddeven find_by_uname title IF id NE 0 THEN widget_control id destroy oddevensecchoice where selectedline EQ odd even if oddevensecchoice 0 NE 1 then BEGIN oddevensecchoice selected oddevensecchoice nothing widget_label basedomainoddeven value Domain of the odd even points uname title IF n_elements oddevensecchoice GT 1 THEN BEGIN selecteddim dimvar oddevensecchoice sorteddim selecteddim FOR i 0 n_elements oddevensecchoice 1 DO sorteddim i selecteddim sortdim typedim selecteddim i i zdim sorteddim 2 sizedims sizedim zdim sortedzdim sort sizedims sizedims sizedims sortedzdim oddevensecchoice oddevensecchoice sortedzdim nothing widget_droplist basedomainoddeven title number of levels value strtrim sizedims 2 uvalue name: odd evensecchoice uname odd evensecchoice ENDIF domainpart top_uvalue basedomainoddeven oddevensecchoice 0 widget_control basedomainoddeven set_uvalue oddevensecchoice ENDIF ELSE BEGIN domainpart top_uvalue basedomainoddeven destroy nothing widget_label basedomainoddeven value uname title widget_control basedomainoddeven set_uvalue 1 ENDELSE widget_control basedomainoddeven sensitive sensitive 2 case where sensitive EQ 1 0 of 0: top_uvalue 1 findline top_uvalue selected oddsecchoice 0 1: top_uvalue 1 findline top_uvalue selected evensecchoice 0 2: top_uvalue 1 findline top_uvalue selected oddevensecchoice 0 endcase widget_control topid update 1 return end"); 201 a[199] = new Array("./ToBeReviewed/HOPE/sortdim.html", "sortdim.pro", "", " function sortdim dims inverse inverse IDL a x y t z IDL b a sortdim a IDL print a x y t z IDL print b x y z t IDL print b sortdim a inv x y t z IDL a xytz IDL print sortdim a 0 1 3 2 tosort dims if n_elements tosort eq 1 then tosort string reform byte tosort 1 strlen tosort 0 tosort strrepl tosort strwhere tosort x a tosort strrepl tosort strwhere tosort y b tosort strrepl tosort strwhere tosort z c tosort strrepl tosort strwhere tosort t d tosort uniq tosort sort tosort if keyword_set inverse then tosort sort tosort return tosort end "); 202 a[200] = new Array("./ToBeReviewed/HOPE/xrh.html", "xrh.pro", "", " procedure to call read_hope in the widget mode PRO xrh _extra ex a read_hope _extra ex return end"); 203 a[201] = new Array("./ToBeReviewed/IMAGE/animgif.html", "animgif.pro", "", " NAME:animgif PURPOSE:construire une animation gif CATEGORY:pour faire des dessins animes CALLING SEQUENCE:animgif toto gif INPUTS:toto gif: c est le nom du fichier gif contenant l animation Rq ce fichier est place dans le repertoire definit par iodir KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS:on utilise le Z buffer pour aller plus vite donc si on plante ds animgif il faut faire: IDL device close IDL set_plot x IDL retall RESTRICTIONS: si on veut supprimer le common il faut definir a la main la taille de l image les variables xsize et ysize ainsi que iodir EXAMPLE: MODIFICATION HISTORY: Guillaume Roullet grlod ipsl jussieu fr Sebastien Masson smasson lodyc jussieu fr 30 4 1999 PRO animgif nomfic common recupere la palette de couleur et la place dans rouge vert bleu tvlct rouge vert bleu get complete la palette courante sur 256 couleurs red rouge replicate 255 256 n_elements rouge green vert replicate 255 256 n_elements rouge blue bleu replicate 255 256 n_elements rouge bascule sur le z device permettant de creer l image sans l afficher thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS set_plot z taille de l image en nombre de pixel: xsize 30 min page_size max ma key_portrait ma 1 key_portrait ysize 30 min page_size max ma 1 key_portrait ma key_portrait device set_resolution xsize ysize commencement du fichier gif ecriture d une image vide reinitplt plot 0 0 nodata write_gif iodir nomfic tvrd red green blue multiple debut de la partie a changer boucle de creation de l image calen TIMEGEN 366 START JULDAY 1 1 2000 debut where calen EQ 19810105 debut where calen EQ 19790105 debut debut 0 if debut EQ 1 then begin device close CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE stop endif for i 0 73 15 1 do begin for i 0 3 2 1 do begin for i 0 73 2 1 do begin print Image numero : strtrim i 2 date calen debut i erase 255 plt nlec sst date ATF 19 29 int 5 noerase plt nlec sss date ATF label 2 noerase plt nlec htoth date RE3 nlec hpycn date RE3 10 60 int 5 inv noerase domdef 290 340 5 15 plt norme nlec unsurf date RE3 nlec vnsurf date RE3 0 1 2 int 1 noerase Ecriture de l image dans le fichier gif write_gif iodir nomfic tvrd red green blue multiple ENDFOR fin de la partie a changer fermeture du fichier write_gif iodir nomfic close rebascule en mode terminal X device close CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE return end"); 204 a[202] = new Array("./ToBeReviewed/IMAGE/image_viewer.html", "image_viewer.pro", "", " NAME: IMAGE_VIEWER PURPOSE: The purpose of this program is to provide an interactive tool that can be used to view JPEG BMP GIF PNG and TIFF picture files Images are loaded into memory so the initial file access may take a while but once each picture has been opened they can all be viewed in a very rapid fashion CATEGORY: Visualization Widgets CALLING SEQUENCE: image_viewer INPUT PARAMETERS: None KEYWORD PARAMETERS: None OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: While this program is running in an IDL session it will change the current working directory enables disables color decomposition and sets QUIET 1 ORDER 0 P BACKGROUND 0 These settings are returned to their initial settings before the program was initiated once it is terminated RESTRICTIONS: This program is supported in IDL version 5 5 and newer In order to open GIF files or TIFF files with LZW compression the copy of IDL being used must be licensed with these features IDL only supports BMP files in the standard Windows format and does not support OS2 bitmaps MODIFICATION HISTORY: Written by: AEB 1 02 PRO IMAGE_VIEWER_OPEN_FILES event THIS PROCEDURE IS CALLED WHEN A USER SELECTS File Open Picture Files FROM THE MAIN MENU error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR if status report dialog is still active destroy it: if SIZE tlb TYPE NE 0 then WIDGET_CONTROL tlb DESTROY RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState prompt user to select files with native file selection dialog: if pState gifFlag EQ 1 then filter JPG jpg JPEG jpeg JPE jpe JFIF jfif GIF gif BMP bmp TIF tif TIFF tiff PNG png else filter JPG jpg JPEG jpeg JPE jpe JFIF jfif BMP bmp TIF tif TIFF tiff PNG png files DIALOG_PICKFILE TITLE Select picture files to open MULTIPLE_FILES FILTER filter GET_PATH path if user hit Cancel then return to previous program level: if files 0 EQ then RETURN change current working directory to location of selected files: CD path nFiles N_ELEMENTS files pState nFiles nFiles pState increment 100 nFiles files files SORT files create status report dialog: xCenter pState screenSize 0 2 yCenter pState screenSize 1 2 tlb2 WIDGET_BASE TITLE Status Report COLUMN ALIGN_CENTER TLB_FRAME_ATTR 19 MODAL GROUP_LEADER pState tlb spacer WIDGET_LABEL tlb2 VALUE label1 WIDGET_LABEL tlb2 VALUE LOADING SELECTED IMAGE FILES INTO MEMORY spacer WIDGET_LABEL tlb2 VALUE label2 WIDGET_LABEL tlb2 VALUE PLEASE WAIT spacer WIDGET_LABEL tlb2 VALUE statusBase WIDGET_BASE tlb2 ROW FRAME BASE_ALIGN_CENTER ALIGN_CENTER EVENT_PRO image_viewer_timer cancelBut WIDGET_BUTTON statusBase VALUE Cancel EVENT_PRO image_viewer_cancel progressLabel WIDGET_LABEL statusBase Value Progress : 0 statusSlider WIDGET_SLIDER statusBase SENSITIVE 0 TITLE XSIZE 200 percentLabel WIDGET_LABEL statusBase VALUE 100 geom WIDGET_INFO tlb2 GEOMETRY xHalfSize geom Scr_XSize 2 yHalfSize geom Scr_YSize 2 WIDGET_CONTROL tlb2 XOFFSET xCenter xHalfSize YOFFSET yCenter yHalfSize WIDGET_CONTROL tlb2 REALIZE pState statusBase statusBase pState statusSlider statusSlider WIDGET_CONTROL tlb2 SET_UVALUE pState reset settings of GUI: WIDGET_CONTROL pState fileText SET_VALUE WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE re create thumbnails base with appropriate size for number of images selected: nRows CEIL nFiles 3 0 WIDGET_CONTROL pState thumbBase DESTROY pState thumbBase WIDGET_BASE pState controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE nRows 89 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 initialize pointer array to reference image data: numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images pState images PTRARR nFiles ALLOCATE_HEAP pState files files loop through each file: pState timer 1B WIDGET_CONTROL statusBase TIMER 0 01 END PRO IMAGE_VIEWER_OPEN_FOLDER event THIS PROCEDURE IS CALLED WHEN A USER SELECTS File Open All In Folder FROM THE MAIN MENU error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR if status report dialog is still active destroy it: if SIZE tlb TYPE NE 0 then WIDGET_CONTROL tlb DESTROY RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState prompt user to select files with native file selection dialog: folder DIALOG_PICKFILE TITLE Select folder that contains picture files DIRECTORY if user hit Cancel then return to previous program level: if folder EQ then RETURN change current working directory to location of selected files: CD folder if pState gifFlag EQ 1 then filter JPG JPEG JPE JFIF GIF BMP TIF TIFF PNG else filter JPG JPEG JPE JFIF BMP TIF TIFF PNG files FILE_SEARCH filter COUNT nFiles FOLD_CASE FULLY_QUALIFY_PATH NOSORT if nFiles EQ 0 then begin dummy DIALOG_MESSAGE No valid picture files were found in the selected folder INFO RETURN endif pState nFiles nFiles pState increment 100 nFiles files files SORT files create status report dialog: xCenter pState screenSize 0 2 yCenter pState screenSize 1 2 tlb2 WIDGET_BASE TITLE Status Report COLUMN ALIGN_CENTER TLB_FRAME_ATTR 19 MODAL GROUP_LEADER pState tlb spacer WIDGET_LABEL tlb2 VALUE label1 WIDGET_LABEL tlb2 VALUE LOADING SELECTED IMAGE FILES INTO MEMORY spacer WIDGET_LABEL tlb2 VALUE label2 WIDGET_LABEL tlb2 VALUE PLEASE WAIT spacer WIDGET_LABEL tlb2 VALUE statusBase WIDGET_BASE tlb2 ROW FRAME BASE_ALIGN_CENTER ALIGN_CENTER EVENT_PRO image_viewer_timer cancelBut WIDGET_BUTTON statusBase VALUE Cancel EVENT_PRO image_viewer_cancel progressLabel WIDGET_LABEL statusBase Value Progress : 0 statusSlider WIDGET_SLIDER statusBase SENSITIVE 0 TITLE XSIZE 200 percentLabel WIDGET_LABEL statusBase VALUE 100 geom WIDGET_INFO tlb2 GEOMETRY xHalfSize geom Scr_XSize 2 yHalfSize geom Scr_YSize 2 WIDGET_CONTROL tlb2 XOFFSET xCenter xHalfSize YOFFSET yCenter yHalfSize WIDGET_CONTROL tlb2 REALIZE pState statusBase statusBase pState statusSlider statusSlider WIDGET_CONTROL tlb2 SET_UVALUE pState reset settings of GUI: WIDGET_CONTROL pState fileText SET_VALUE WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE re create thumbnails base with appropriate size for number of images selected: nRows CEIL nFiles 3 0 WIDGET_CONTROL pState thumbBase DESTROY pState thumbBase WIDGET_BASE pState controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE nRows 89 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 initialize pointer array to reference image data: numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images pState images PTRARR nFiles ALLOCATE_HEAP pState files files loop through each file: pState timer 1B WIDGET_CONTROL statusBase TIMER 0 01 END PRO IMAGE_VIEWER_CANCEL event obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState shut off timer: pState timer 0B END PRO IMAGE_VIEWER_TIMER event obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState if pState timer EQ 1 then begin continue processing files: if pState currFile LE pState nFiles 1 then begin i pState currFile extension STRUPCASE STRMID pState files i STRPOS pState files i REVERSE_SEARCH 1 if extension EQ JPG or extension EQ JPEG or extension EQ JPE or extension EQ JFIF then begin result QUERY_JPEG pState files i info if result NE 1 then begin dummy DIALOG_MESSAGE Selected file: pState files i does not appear to be a valid JPEG file ERROR if i MOD 3 EQ 0 then pState rowBase WIDGET_BASE pState thumbBase ROW ALIGN_LEFT if pState currFile EQ pState nFiles 1 then begin last file terminate timer: pState timer 0B pState currFile 0L WIDGET_CONTROL event top DESTROY endif else begin increment file number and update progress slider: pState currFile pState currFile 1 progressValue ROUND i 1 pState increment Exit FROM THE MAIN MENU terminate the program by destroying the top level base widgetID always stored in event top : WIDGET_CONTROL event top DESTROY END PRO IMAGE_VIEWER_HELP event THIS PROCEDURE IS CALLED WHEN A USER SELECTS Help Help on IMAGE_VIEWER FROM THE MAIN MENU display a simple message: messageStr IMAGE_VIEWER written by AEB 2002 The purpose of this program is to provide an interactive tool that can be used to view JPEG BMP GIF PNG and TIFF picture files In order to provide rapid viewing capabilities the images are loaded into memory which can cause the initial file access to take a bit of time while the pictures are opened and thumbnails are created dummy DIALOG_MESSAGE messageStr info END PRO IMAGE_VIEWER_THUMBS event THIS PROCEDURE IS CALLED WHEN A USER CLICKS ON ONE OF THE THUMBNAIL PICTURES error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR RETURN endif if event press EQ 1 then begin WIDGET_CONTROL HOURGLASS obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState WIDGET_CONTROL pState imageDraw GET_VALUE drawID WSET drawID TVLCT 0 0 0 0 ERASE obtain current image data: WIDGET_CONTROL event id GET_UVALUE fileID imageStruct pState images fileID 1 xOffset ROUND 710 imageStruct xSize 2 yOffset ROUND 650 imageStruct ySize 2 if pState colorMode EQ PSEUDO then begin TVLCT imageStruct red imageStruct green imageStruct blue TV TEMPORARY imageStruct image xOffset yOffset endif else begin pState colorMode EQ TRUE : if imageStruct imageColorMode EQ PSEUDO then begin DEVICE DECOMPOSED 0 TVLCT imageStruct red imageStruct green imageStruct blue TV TEMPORARY imageStruct image xOffset yOffset endif else begin imageStruct imageColorMode EQ TRUE : DEVICE DECOMPOSED 1 TV TEMPORARY imageStruct image xOffset yOffset TRUE 1 endelse endelse WIDGET_CONTROL pState fileText SET_VALUE pState files fileID 1 endif END PRO IMAGE_VIEWER_CLEANUP widgetID THIS PROCEDURE IS CALLED WHEN THE PROGRAM IS TERMINATED AND XMANAGER REGISTERS A CLEANUP: obtain state structure for top level base from its uvalue: WIDGET_CONTROL widgetID GET_UVALUE pState test for validity of state structure pointer: if PTR_VALID pState then begin reset original settings: QUIET pState quietInit ORDER pState orderInit P BACKGROUND pState backInit CD pState currentDir DEVICE DECOMPOSED pState dc TVLCT pState r pState g pState b cleanup heap memory: PTR_FREE TEMPORARY pState files numImages N_ELEMENTS pState images if numImages NE 0 then PTR_FREE pState images PTR_FREE TEMPORARY pState images PTR_FREE TEMPORARY pState endif END PRO IMAGE_VIEWER_EVENT event THIS PROCEDURE IS CALLED WHEN A USER RESIZES THE TOP LEVEL BASE error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR RETURN endif obtain state structure for top level base from its UVALUE: WIDGET_CONTROL event top GET_UVALUE pState reset widget size: WIDGET_CONTROL event top XSIZE pState tlbWidth YSIZE pState tlbHeight XOFFSET 0 YOFFSET 0 END PRO IMAGE_VIEWER error handling: ERROR_STATE CODE 0 CATCH error if error NE 0 then begin HELP LAST_MESSAGE OUTPUT traceback messageStr Error Caught : traceback dummy DIALOG_MESSAGE messageStr ERROR QUIET quietInit ORDER orderInit P BACKGROUND backInit CD currentDir RETURN endif ignore beta and development build versions of IDL because string to float conversion will fail: betaTest STRPOS STRLOWCASE VERSION RELEASE beta buildTest STRPOS STRLOWCASE VERSION RELEASE build check to make sure the version of IDL running is 5 5 or newer: if betaTest EQ 1 and buildTest EQ 1 then begin if FLOAT VERSION RELEASE LT 5 5 then begin dummy dialog_message IMAGE_VIEWER is only supported in IDL version 5 5 or newer ERROR RETURN endif endif check to make sure there is adequate real estate: DEVICE GET_SCREEN_SIZE screenSize if LONG screenSize 0 screenSize 1 LT 786432 then begin messageStr IMAGE_VIEWER requires the computer monitor Display to be configured in 1024 x 768 mode or better dummy DIALOG_MESSAGE messageStr RETURN endif check in auxiliary license: result LMGR idl_tifflzw VERSION 1 0 result LMGR idl_gif VERSION 1 0 gifFlag 1B if result NE 1 then begin messageStr The ability to read GIF and TIFF LZW compressed images requires an auxiliary license in order to conform with the patent rights of the Unisys Corporation IMAGE_VIEWER was unable to find the required license in this installation Consequently the ability to read GIF files will be disabled dummy DIALOG_MESSAGE messageStr gifFlag 0B endif warn users of color flashing if monitor in PseudoColor mode: if D N_COLORS LE 256 then begin messageStr The computer monitor Display is currently configured in 8 bit 256 Colors PseudoColor mode Due to the dynamic read write nature of the colormap system for this visual when a colortable is loaded for an image it affects all visible graphics windows including the thumbnails of other images This can lead to a phenomenon known as color flashing If possible it is recommended that you exit this program reconfigure your monitor in 24 bit TrueColor mode or better and restart IMAGE_VIEWER dummy DIALOG_MESSAGE messageStr endif obtain the current working directory: CD CURRENT currentDir if STRUPCASE VERSION OS_FAMILY EQ WINDOWS then begin executeStr cd USERPROFILE My Documents My Pictures cd SPAWN executeStr pathInit HIDE pathInit pathInit 0 result FILE_TEST pathInit READ if result EQ 1 then begin CD pathInit endif else begin result FILE_TEST C: My Documents My Pictures READ if result EQ 1 then begin CD C: My Documents My Pictures endif else begin result FILE_TEST C: READ if result EQ 1 then CD C: endelse endelse endif suppress informational messaging: quietInit QUIET QUIET 1 make sure color decomposition is disabled: DEVICE GET_DECOMPOSED dc if D N_COLORS GT 256 then colorMode TRUE else colorMode PSEUDO obtain the current color table: TVLCT r g b GET LOADCT 0 SILENT force ORDER 0: orderInit ORDER ORDER 0 force P BACKGROUND 0: backInit P BACKGROUND P BACKGROUND 0 create GUI: tlb WIDGET_BASE TITLE Image Viewer ROW MBAR menuBar TLB_SIZE_EVENTS XOFFSET 0 YOFFSET 0 fileMenu WIDGET_BUTTON menuBar VALUE File MENU fileBttn1 WIDGET_BUTTON fileMenu VALUE Open Picture Files EVENT_PRO image_viewer_open_files fileBttn2 WIDGET_BUTTON fileMenu VALUE Open All In Folder EVENT_PRO image_viewer_open_folder fileBttn3 WIDGET_BUTTON fileMenu VALUE Exit EVENT_PRO image_viewer_exit helpMenu WIDGET_BUTTON menuBar VALUE Help MENU helpBttn1 WIDGET_BUTTON helpMenu VALUE Help on IMAGE_VIEWER EVENT_PRO image_viewer_help controlsBase WIDGET_BASE tlb COLUMN FRAME ALIGN_TOP labelBase WIDGET_BASE controlsBase COLUMN SCR_XSIZE 280 thumbLabel WIDGET_LABEL labelBase ALIGN_CENTER VALUE CLICK ON THUMBNAIL TO VIEW IMAGE thumbBase WIDGET_BASE controlsBase COLUMN ALIGN_TOP FRAME XSIZE 260 YSIZE 700 SCROLL X_SCROLL_SIZE 260 Y_SCROLL_SIZE 650 imageBase WIDGET_BASE tlb COLUMN FRAME ALIGN_TOP fileBase WIDGET_BASE imageBase ROW ALIGN_CENTER fileLabel WIDGET_LABEL fileBase VALUE Current Image File fileText WIDGET_TEXT fileBase XSIZE 75 YSIZE 1 imageDraw WIDGET_DRAW imageBase XSIZE 710 YSIZE 650 RETAIN 2 display the GUI on the computer monitor: WIDGET_CONTROL tlb REALIZE obtain the top level base geometry: tlbGeom WIDGET_INFO tlb GEOMETRY tlbWidth tlbGeom xsize tlbHeight tlbGeom ysize if tlbWidth EQ 0 or tlbHeight EQ 0 then begin WIDGET_CONTROL tlb TLB_GET_SIZE tlbSize tlbWidth tlbSize 0 tlbHeight tlbSize 1 endif create state structure to store information needed by the other event handling procedures: pState PTR_NEW files:PTR_NEW ALLOCATE_HEAP images:PTR_NEW ALLOCATE_HEAP screenSize:screenSize quietInit:quietInit orderInit:orderInit tlb:tlb statusBase:0L controlsBase:controlsBase thumbBase:thumbBase fileText:fileText timer:0B nFiles:0L currentDir:currentDir imageDraw:imageDraw dc:dc r:r g:g b:b gifFlag:gifFlag statusSlider:0L backInit:backInit colorMode:colorMode tlbWidth:tlbWidth tlbHeight:tlbHeight currFile:0L rowBase:0L increment:0 0 store this state structure in the uvalue of the top level base so it can be obtained by other program units: WIDGET_CONTROL tlb SET_UVALUE pState register the GUI with the XMANAGER event handler routine: XMANAGER image_viewer tlb CLEANUP image_viewer_cleanup END "); 205 a[203] = new Array("./ToBeReviewed/IMAGE/imdisp.html", "imdisp.pro", "", " FUNCTION IMDISP_GETPOS ASPECT POSITION POSITION MARGIN MARGIN Compute a position vector given an aspect ratio called by IMDISP_IMSIZE Check arguments if n_params ne 1 then message Usage: RESULT IMDISP_GETPOS ASPECT if n_elements aspect eq 0 then message ASPECT is undefined Check keywords if n_elements position eq 0 then position 0 0 0 0 1 0 1 0 if n_elements margin eq 0 then margin 0 1 Get range limited aspect ratio and margin input values aspect_val float aspect 0 0 01 0 0 0L y0 round position 1 d y_vsize 0L Compute size of image device units xsize round position 2 position 0 d x_vsize 2L ysize round position 3 position 1 d y_vsize 2L Recompute the image position based on actual image size position fltarr 4 position 0 x0 float d x_vsize position 1 y0 float d y_vsize position 2 x0 xsize float d x_vsize position 3 y0 ysize float d y_vsize END PRO IMDISP IMAGE RANGE RANGE BOTTOM BOTTOM NCOLORS NCOLORS MARGIN MARGIN INTERP INTERP DITHER DITHER ASPECT ASPECT POSITION POSITION OUT_POS OUT_POS NOSCALE NOSCALE NORESIZE NORESIZE ORDER ORDER USEPOS USEPOS CHANNEL CHANNEL BACKGROUND BACKGROUND ERASE ERASE AXIS AXIS NEGATIVE NEGATIVE _EXTRA EXTRA_KEYWORDS NAME: IMDISP PURPOSE: Display an image on the current graphics device IMDISP is an advanced replacement for TV and TVSCL Supports WIN MAC X CGM PCL PRINTER PS and Z graphics devices Image is automatically byte scaled can be disabled Custom byte scaling of Pseudo color images via the RANGE keyword Pseudo indexed color and True color images are handled automatically 8 bit and 24 bit graphics devices are handled automatically Decomposed color settings are handled automatically Image is automatically sized to fit the display can be disabled The P MULTI system variable is honored for multiple image display Image can be positioned via the POSITION keyword Color table splitting via the BOTTOM and NCOLORS keywords Image aspect ratio customization via the ASPECT keyword Resized images can be resampled default or interpolated Top down image display via the ORDER keyword ORDER is ignored Selectable display channel R G B via the CHANNEL keyword Background can be set to a specified color via the BACKGROUND keyword Screen can be erased prior to image display via the ERASE keyword Plot axes can be drawn on the image via the AXIS keyword Photographic negative images can be displayed via the NEGATIVE keyword CATEGORY: Image display CALLING SEQUENCE: IMDISP IMAGE INPUTS: IMAGE Array containing image data Pseudo indexed color images must have 2 dimensions True color images must have 3 dimensions in either 3 NX NY NX 3 NY or NX NY 3 form OPTIONAL INPUTS: None KEYWORD PARAMETERS: RANGE For Pseudo Color images only a vector with two elements specifying the minimum and maximum values of the image array to be considered when the image is byte scaled default is minimum and maximum array values This keyword is ignored for True Color images or if the NOSCALE keyword is set BOTTOM Bottom value in the color table to be used for the byte scaled image default is 0 This keyword is ignored if the NOSCALE keyword is set NCOLORS Number of colors in the color table to be used for the byte scaled image default is D TABLE_SIZE BOTTOM This keyword is ignored if the NOSCALE keyword is set MARGIN A scalar value specifying the margin to be maintained around the image in normal coordinates default is 0 1 or 0 025 if P MULTI is set to display multiple images INTERP If set the resized image will be interpolated using bilinear interpolation default is nearest neighbor sampling DITHER If set true color images will be dithered when displayed on an 8 bit graphics device default is no dithering ASPECT A scalar value specifying the aspect ratio height width for the displayed image default is to maintain native aspect ratio POSITION On input a 4 element vector specifying the position of the displayed image in the form X0 Y0 X1 Y1 in in normal coordinates default is 0 0 0 0 1 0 1 0 See the examples below to display an image where only the offset and size are known e g MAP_IMAGE output OUT_POS On output a 4 element vector specifying the position actually used to display the image NOSCALE If set the image will not be byte scaled default is to byte scale the image NORESIZE If set the image will not be resized default is to resize the image to fit the display ORDER If set the image is displayed from the top down default is to display the image from the bottom up Note that the system variable ORDER is always ignored USEPOS If set the image will be sized to exactly fit a supplied POSITION vector over riding ASPECT and MARGIN default is to honor ASPECT and MARGIN when a POSITION vector is supplied CHANNEL Display channel Red Green or Blue to be written 0 All channels the default 1 Red channel 2 Green channel 3 Blue channel This keyword is only recognized by graphics devices which support 24 bit decomposed color WIN MAC X It is ignored by all other graphics devices However True color RGB images can be displayed on any device supported by IMDISP BACKGROUND If set to a positive integer the background will be filled with the color defined by BACKGROUND ERASE If set the screen contents will be erased Note that if P MULTI is set to display multiple images the screen is always erased when the first image is displayed AXIS If set plot axes will be drawn on the image The default x and y axis ranges are determined by the size of the image When the AXIS keyword is set IMDISP accepts any keywords supported by PLOT e g TITLE COLOR CHARSIZE etc NEGATIVE If set a photographic negative of the image is displayed The values of BOTTOM and NCOLORS are honored This keyword allows True color images scanned from color negatives to be displayed It also allows Pseudo color images to be displayed as negatives without reversing the color table This keyword is ignored if the NOSCALE keyword is set OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The image is displayed on the current graphics device RESTRICTIONS: Requires IDL 5 0 or higher square bracket array syntax EXAMPLE: Load test data openr lun filepath ctscan dat subdir examples data get_lun ctscan bytarr 256 256 readu lun ctscan free_lun lun openr lun filepath hurric dat subdir examples data get_lun hurric bytarr 440 330 readu lun hurric free_lun lun read_jpeg filepath rose jpg subdir examples data rose help ctscan hurric rose Display single images p multi 0 loadct 0 imdisp hurric erase wait 3 0 imdisp rose interp erase wait 3 0 Display multiple images without color table splitting works on 24 bit displays only top 2 images are garbled on 8 bit displays p multi 0 1 3 0 0 loadct 0 imdisp ctscan margin 0 02 loadct 13 imdisp hurric margin 0 02 imdisp rose margin 0 02 wait 3 0 Display multiple images with color table splitting works on 8 bit or 24 bit displays p multi 0 1 3 0 0 loadct 0 ncolors 64 bottom 0 imdisp ctscan margin 0 02 ncolors 64 bottom 0 loadct 13 ncolors 64 bottom 64 imdisp hurric margin 0 02 ncolors 64 bottom 64 imdisp rose margin 0 02 ncolors 64 bottom 128 wait 3 0 Display an image at a specific position over riding aspect and margin p multi 0 loadct 0 imdisp hurric position 0 0 0 0 1 0 0 5 usepos erase wait 3 0 Display an image with axis overlay p multi 0 loadct 0 imdisp rose axis erase wait 3 0 Display an image with contour plot overlay p multi 0 loadct 0 imdisp hurric out_pos out_pos erase contour smooth hurric 10 edge noerase position out_pos xstyle 1 ystyle 1 levels findgen 5 40 0 follow wait 3 0 Display a small image with correct resizing p multi 0 loadct 0 data dist 8 1:7 1:7 imdisp data erase wait 3 0 imdisp data interp wait 3 0 Display a true color image without and with interpolation p multi 0 imdisp rose erase wait 3 0 imdisp rose interp wait 3 0 Display a true color image as a photographic negative imdisp rose negative erase wait 3 0 Display a true color image on PostScript output note that color table is handled automatically current_device d name set_plot PS device color bits_per_pixel 8 filename imdisp_true ps imdisp rose axis title PostScript True Color Output device close set_plot current_device Display a pseudo color image on PostScript output current_device d name set_plot PS device color bits_per_pixel 8 filename imdisp_pseudo ps loadct 0 imdisp hurric axis title PostScript Pseudo Color Output device close set_plot current_device Display an image where only the offset and size are known Read world elevation data file filepath worldelv dat subdir examples data openr lun file get_lun data bytarr 360 360 readu lun data free_lun lun Reorganize array so it spans 180W to 180E world data world 0:179 data 180: world 180: data 0:179 Create remapped image map_set orthographic isotropic noborder remap map_image world x0 y0 xsize ysize compress 1 Convert offset and size to position vector pos fltarr 4 pos 0 x0 float d x_vsize pos 1 y0 float d y_vsize pos 2 x0 xsize float d x_vsize pos 3 y0 ysize float d y_vsize Display the image loadct 0 imdisp remap pos pos usepos map_continents map_grid MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: imdisp pro v 1 47 2002 06 05 16:31:07 gumley Exp Copyright C 1999 2000 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: imdisp pro v 1 47 2002 06 05 16:31:07 gumley Exp CHECK INPUT Check arguments if n_params ne 1 then message Usage: IMDISP IMAGE if n_elements image eq 0 then message Argument IMAGE is undefined if max p multi eq 0 then begin if n_elements margin eq 0 then begin if n_elements position eq 4 then margin 0 0 else margin 0 1 endif endif else begin if n_elements margin eq 0 then margin 0 025 endelse if n_elements order eq 0 then order 0 if n_elements channel eq 0 then channel 0 Check position vector if n_elements position gt 0 then begin if n_elements position ne 4 then message POSITION must be a 4 element vector of the form X0 Y0 X1 Y1 if position 0 lt 0 0 then message POSITION 0 must be GE 0 0 if position 1 lt 0 0 then message POSITION 1 must be GE 0 0 if position 2 gt 1 0 then message POSITION 2 must be LE 1 0 if position 3 gt 1 0 then message POSITION 3 must be LE 1 0 if position 0 ge position 2 then message POSITION 0 must be LT POSITION 2 if position 1 ge position 3 then message POSITION 1 must be LT POSITION 3 endif Check the image dimensions result size image ndims result 0 if ndims lt 2 or ndims gt 3 then message IMAGE must be a Pseudo Color 2D or True Color 3D image array dims result 1:ndims Check that 3D image array is in valid true color format true 0 if ndims eq 3 then begin index where dims eq 3L count if count eq 0 then message True Color dimensions must be 3 NX NY NX 3 NY or NX NY 3 true 1 truedim index 0 endif Check scaling range for pseudo color images if true eq 0 then begin if n_elements range eq 0 then begin min_value min image max max_value range min_value max_value endif if n_elements range ne 2 then message RANGE keyword must be a 2 element vector endif else begin if n_elements range gt 0 then message RANGE keyword is not used for True Color images continue endelse Check for supported graphics devices names WIN MAC X CGM PCL PRINTER PS Z result where d name eq names count if count eq 0 then message Graphics device is not supported Get color table information if d flags and 256 ne 0 and d window lt 0 then begin window free pixmap wdelete d window endif if n_elements bottom eq 0 then bottom 0 if n_elements ncolors eq 0 then ncolors d table_size bottom Get IDL version number version float version release Check for IDL 5 2 or higher if printer device is selected if version lt 5 2 and d name eq PRINTER then message IDL 5 2 or higher is required for PRINTER device support GET RED GREEN AND BLUE COMPONENTS OF TRUE COLOR IMAGE if true eq 1 then begin case truedim of 0 : begin red image 0 grn image 1 blu image 2 end 1 : begin red image 0 grn image 1 blu image 2 end 2 : begin red image 0 grn image 1 blu image 2 end endcase red reform red overwrite grn reform grn overwrite blu reform blu overwrite endif COMPUTE POSITION FOR IMAGE Save first element of p multi multi_first p multi 0 Establish image position if not defined if n_elements position eq 0 then begin if max p multi eq 0 then begin position 0 0 0 0 1 0 1 0 endif else begin plot 0 nodata xstyle 4 ystyle 4 xmargin 0 0 ymargin 0 0 position x window 0 y window 0 x window 1 y window 1 endelse endif Erase and fill the background if required if multi_first eq 0 then begin if keyword_set erase then erase if n_elements background gt 0 then begin polyfill 0 01 1 01 1 01 0 01 0 01 0 01 0 01 1 01 1 01 0 01 normal color background 0 endif endif Compute image aspect ratio if not defined if n_elements aspect eq 0 then begin case true of 0 : result size image 1 : result size red endcase dims result 1:2 aspect float dims 1 float dims 0 endif Save image xrange and yrange for axis overlays xrange 0 dims 0 yrange 0 dims 1 if order eq 1 then yrange reverse yrange Set the aspect ratio and margin to fill the position window if requested if keyword_set usepos then begin xpos_size float d x_vsize position 2 position 0 ypos_size float d y_vsize position 3 position 1 aspect_value ypos_size xpos_size margin_value 0 0 endif else begin aspect_value aspect margin_value margin endelse Compute size of displayed image and save output position pos position case true of 0 : imdisp_imsize image x0 y0 xsize ysize position pos aspect aspect_value margin margin_value 1 : imdisp_imsize red x0 y0 xsize ysize position pos aspect aspect_value margin margin_value endcase out_pos pos BYTE SCALE THE IMAGE IF REQUIRED Choose whether to scale the image or not if keyword_set noscale eq 0 then begin Scale the image case true of 0 : scaled imdisp_imscale image bottom bottom ncolors ncolors range range negative keyword_set negative 1 : begin scaled_dims size red 1:2 scaled bytarr scaled_dims 0 scaled_dims 1 3 scaled 0 0 0 imdisp_imscale red bottom 0 ncolors 256 negative keyword_set negative scaled 0 0 1 imdisp_imscale grn bottom 0 ncolors 256 negative keyword_set negative scaled 0 0 2 imdisp_imscale blu bottom 0 ncolors 256 negative keyword_set negative end endcase endif else begin Don t scale the image case true of 0 : scaled image 1 : begin scaled_dims size red 1:2 scaled replicate red 0 scaled_dims 0 scaled_dims 1 3 scaled 0 0 0 red scaled 0 0 1 grn scaled 0 0 2 blu end endcase endelse DISPLAY IMAGE ON PRINTER DEVICE if d name eq PRINTER then begin Display the image case true of 0 : begin device index_color tv scaled x0 y0 xsize xsize ysize ysize order order end 1 : begin device true_color tv scaled x0 y0 xsize xsize ysize ysize order order true 3 end endcase Draw axes if required if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords Return to caller return endif DISPLAY IMAGE ON GRAPHICS DEVICES WHICH HAVE SCALEABLE PIXELS if d flags and 1 ne 0 then begin Display the image case true of 0 : tv scaled x0 y0 xsize xsize ysize ysize order order 1 : begin tvlct r g b get loadct 0 silent tv scaled x0 y0 xsize xsize ysize ysize order order true 3 tvlct r g b end endcase Draw axes if required if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords Return to caller return endif RESIZE THE IMAGE Resize the image if keyword_set noresize eq 0 then begin if true eq 0 then begin resized imdisp_imregrid scaled xsize ysize interp keyword_set interp endif else begin resized replicate scaled 0 xsize ysize 3 resized 0 0 0 imdisp_imregrid reform scaled 0 xsize ysize interp keyword_set interp resized 0 0 1 imdisp_imregrid reform scaled 1 xsize ysize interp keyword_set interp resized 0 0 2 imdisp_imregrid reform scaled 2 xsize ysize interp keyword_set interp endelse endif else begin resized temporary scaled x0 0 y0 0 endelse GET BIT DEPTH FOR THIS DISPLAY If this device supports windows make sure a window has been opened if d flags and 256 ne 0 then begin if d window lt 0 then begin window free pixmap wdelete d window endif endif Set default display depth depth 8 Get actual bit depth on supported displays if d name eq WIN or d name eq MAC or d name eq X then begin if version ge 5 1 then begin device get_visual_depth depth endif else begin if d n_colors gt 256 then depth 24 endelse endif SELECT DECOMPOSED COLOR MODE ON OR OFF FOR 24 BIT DISPLAYS if d name eq WIN or d name eq MAC or d name eq X then begin if depth gt 8 then begin if version ge 5 2 then device get_decomposed entry_decomposed else entry_decomposed 0 if true eq 1 or channel gt 0 then device decomposed 1 else device decomposed 0 endif endif DISPLAY THE IMAGE If the display is 8 bit and the image is true color convert image from true color to indexed color if depth le 8 and true eq 1 then begin resized color_quan temporary resized 3 r g b colors ncolors dither keyword_set dither byte bottom tvlct r g b bottom true 0 endif Set channel value for supported devices if d name eq WIN or d name eq MAC or d name eq X then begin channel_value channel endif else begin channel_value 0 endelse Display the image case true of 0 : tv resized x0 y0 order order channel channel_value 1 : tv resized x0 y0 order order true 3 endcase RESTORE THE DECOMPOSED COLOR MODE FOR 24 BIT DISPLAYS if d name eq WIN or d name eq MAC or d name eq X and depth gt 8 then begin device decomposed entry_decomposed if d name eq MAC then tv 0 1 1 endif DRAW AXES IF REQUIRED if keyword_set axis then plot 0 nodata noerase position out_pos xrange xrange xstyle 1 yrange yrange ystyle 1 _extra extra_keywords END"); 206 a[204] = new Array("./ToBeReviewed/IMAGE/saveimage.html", "saveimage.pro", "", "PRO SAVEIMAGE FILE BMP BMP PNG PNG PICT PICT JPEG JPEG TIFF TIFF QUALITY QUALITY DITHER DITHER CUBE CUBE QUIET QUIET MULTIPLE multiple NAME: SAVEIMAGE PURPOSE: Save the current graphics window to an output file GIF by default The output formats supported are: GIF 8 bit with color table BMP 8 bit with color table PNG 8 bit with color table PICT 8 bit with color table JPEG 24 bit true color TIFF 24 bit true color Any conversions necessary to convert 8 bit or 24 bit images onscreen to 8 bit or 24 bit output files are done automatically CATEGORY: Input Output CALLING SEQUENCE: SAVEIMAGE FILE INPUTS: FILE Name of the output file GIF format by default OPTIONAL INPUTS: None KEYWORD PARAMETERS: BMP Set this keyword to create BMP format 8 bit with color table PNG Set this keyword to create PNG format 8 bit with color table PICT Set this keyword to create PICT format 8 bit with color table JPEG Set this keyword to create JPEG format 24 bit true color TIFF Set this keyword to create TIFF format 24 bit true color QUALITY If set to a named variable specifies the quality for JPEG output default 75 Ranges from 0 terrible to 100 excellent Smaller quality values yield higher compression ratios and smaller output files DITHER If set dither the output image when creating 8 bit output which is read from a 24 bit display default is no dithering CUBE If set use the color cube method to quantize colors when creating 8 bit output which is read from a 24 bit display default is to use the statistical method This may improve the accuracy of colors in the output image especially white QUIET Set this keyword to suppress the information message default is to print an information message MULTIPLE to write multiple gif image OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The output file is overwritten if it exists RESTRICTIONS: Requires IDL 5 0 or higher square bracket array syntax EXAMPLE: openr lun filepath hurric dat subdir examples data get_lun image bytarr 440 330 readu lun image free_lun lun loadct 13 tvscl image saveimage hurric gif MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: saveimage pro 69 2006 05 11 10:35:53Z smasson Copyright C 1999 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: saveimage pro 69 2006 05 11 10:35:53Z smasson CHECK INPUT Check arguments if n_params ne 1 then message Usage: SAVEIMAGE FILE if n_elements file eq 0 then message Argument FILE is undefined if n_elements file gt 1 then message Argument FILE must be a scalar string Check keywords output GIF if keyword_set bmp then output BMP if keyword_Set png then output PNG if keyword_set pict then output PICT if keyword_set jpeg then output JPEG if keyword_set tiff then output TIFF if n_elements quality eq 0 then quality 75 Check for TVRD capable device if d flags and 128 eq 0 then message Unsupported graphics device Check for open window if d flags and 256 ne 0 then begin if d window lt 0 then message No graphics windows are open endif Get display depth depth 8 if d n_colors gt 256 then depth 24 GET CONTENTS OF GRAPHICS WINDOW Handle window devices other than the Z buffer if d flags and 256 ne 0 then begin Copy the contents of the current display to a pixmap current_window d window xsize d x_size ysize d y_size window free pixmap xsize xsize ysize ysize retain 2 device copy 0 0 xsize ysize 0 0 current_window Set decomposed color mode for 24 bit displays version float version release if depth gt 8 then begin if version gt 5 1 then device get_decomposed entry_decomposed device decomposed 1 endif endif Read the pixmap contents into an array if depth gt 8 then begin image tvrd order 0 true 1 endif else begin image tvrd order 0 endelse Handle window devices other than the Z buffer if d flags and 256 ne 0 then begin Restore decomposed color mode for 24 bit displays if depth gt 8 then begin if version gt 5 1 then begin device decomposed entry_decomposed endif else begin device decomposed 0 if keyword_set quiet eq 0 then print Decomposed color was turned off endelse endif Delete the pixmap wdelete d window wset current_window endif Get the current color table tvlct r g b get If an 8 bit image was read reduce the number of colors if depth le 8 then begin reduce_colors image index r r index g g index b b index endif WRITE OUTPUT FILE case 1 of Save the image in 8 bit output format output eq GIF or output eq BMP or output eq PICT or output eq PNG : begin if depth gt 8 then begin Convert 24 bit image to 8 bit case keyword_set cube of 0 : image color_quan image 1 r g b colors 256 dither keyword_set dither 1 : image color_quan image 1 r g b cube 6 endcase Sort the color table from darkest to brightest table_sum total long r long g long b 2 table_index sort table_sum image_index sort table_index r r table_index g g table_index b b table_index oldimage image image image_index temporary oldimage endif Save the image case output of GIF : write_gif file image r g b MULTIPLE multiple BMP : write_bmp file image r g b PNG : write_png file image r g b PICT : write_pict file image r g b endcase end Save the image in 24 bit output format output eq JPEG or output eq TIFF : begin Convert 8 bit image to 24 bit if depth le 8 then begin info size image nx info 1 ny info 2 true bytarr 3 nx ny true 0 r image true 1 g image true 2 b image image temporary true endif If TIFF format output reverse image top to bottom if output eq TIFF then image reverse temporary image 3 Write the image case output of JPEG : write_jpeg file image true 1 quality quality TIFF : write_tiff file image 1 endcase end endcase Print information for the user if keyword_set quiet eq 0 then print file output format Created a in a format END"); 207 a[205] = new Array("./ToBeReviewed/IMAGE/showimage.html", "showimage.pro", "", "PRO SHOWIMAGE FILE DITHER DITHER CURRENT CURRENT NAME: SHOWIMAGE PURPOSE: Show the contents of a graphics file in the current window The input formats supported are: GIF 8 bit with color table BMP 8 bit with color table or 24 bit true color PICT 8 bit with color table TIFF 8 bit with color table or 24 bit true color JPEG 24 bit true color Any conversions necessary to translate 8 bit or 24 bit files to 8 bit or 24 bit images on screen are done automatically CATEGORY: Input Output CALLING SEQUENCE: SHOWIMAGE FILE INPUTS: FILE Name of the output file format is identified automatically OPTIONAL INPUTS: None KEYWORD PARAMETERS: DITHER Set this keyword to dither the input image when displaying 24 bit images on an 8 bit display default is no dithering CURRENT Set this keyword to display the image in the current window default is to create a new window sized to fit the image OUTPUTS: None OPTIONAL OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: The color table is modified RESTRICTIONS: Requires IDL 5 2 or higher image QUERY functions EXAMPLE: showimage filepath rose jpg subdir examples data MODIFICATION HISTORY: Liam Gumley ssec wisc edu http: cimss ssec wisc edu gumley Id: showimage pro 69 2006 05 11 10:35:53Z smasson Copyright C 1999 Liam E Gumley This program is free software you can redistribute it and or modify it under the terms of the GNU General Public License as published by the Free Software Foundation either version 2 of the License or at your option any later version This program is distributed in the hope that it will be useful but WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License for more details You should have received a copy of the GNU General Public License along with this program if not write to the Free Software Foundation Inc 59 Temple Place Suite 330 Boston MA 02111 1307 USA rcs_id Id: showimage pro 69 2006 05 11 10:35:53Z smasson CHECK INPUT Check IDL version if float version release lt 5 2 then begin message IDL 5 2 or higher is required continue return endif Check input arguments case 1 of n_params ne 1 : error Usage: SHOWIMAGE FILE n_elements file eq 0 : error Argument FILE is undefined n_elements file gt 1 : error Argument FILE must be a scalar string findfile file 0 eq : error Argument FILE was not found else : error endcase if error ne then begin message error continue return endif CHECK THE GRAPHICS DEVICE Check for device supporting windows and tvrd if d flags and 256 eq 0 or d flags and 128 eq 0 then begin error string d name format Graphics device a is not supported message error continue return endif Make sure a window has been opened in this session and get visual depth if d window lt 0 then begin window free pixmap xsize 20 ysize 20 wdelete d window endif device get_visual_depth depth If 8 bit display is low on colors print a message if depth eq 8 and d table_size lt 64 then message Display has less than 64 colors image quality may degrade continue IDENTIFY FILE AND READ IMAGE Identify the file format result query_gif file info if result eq 0 then result query_bmp file info if result eq 0 then result query_pict file info if result eq 0 then result query_tiff file info if result eq 0 then result query_jpeg file info if result eq 0 then begin message File format not recognized continue return endif Fix the channel information for GIF images if info type eq GIF then info channels 1 Read the image case info type of GIF : read_gif file image r g b BMP : begin if info channels eq 1 then begin image read_bmp file r g b endif else begin image read_bmp file image reverse temporary image 1 endelse end PICT : read_pict file image r g b TIFF : begin if info channels eq 1 then begin image read_tiff file r g b order order image reverse temporary image 2 endif else begin image read_tiff file order order image reverse temporary image 3 endelse end JPEG : read_jpeg file image endcase If an 8 bit image was read reduce the number of colors if info channels eq 1 then begin reduce_colors image index r r index g g index b b index endif Get image size dims size image dimensions if n_elements dims eq 2 then begin nx dims 0 ny dims 1 endif else begin nx dims 1 ny dims 2 endelse CREATE A WINDOW Create a draw widget sized to fit the image if not keyword_set current then begin Set default window size scroll 0 xsize nx ysize ny draw_xsize nx draw_ysize ny Adjust the window size if the image is too large device get_screen_size screen screen_xsize screen 0 screen_ysize screen 1 if nx gt screen_xsize then begin xsize 0 9 screen_xsize scroll 1 endif if ny gt screen_ysize then begin ysize 0 9 screen_ysize scroll 1 endif Create the draw widget base widget_base title file draw widget_draw base scroll scroll widget_control draw xsize xsize ysize ysize draw_xsize draw_xsize draw_ysize draw_ysize endif HANDLE IDL 8 BIT MODE if depth eq 8 then begin If the color table of an 8 bit image is larger than the current display table convert the image to 24 bit if info channels eq 1 and n_elements r gt d table_size then begin Convert to 24 bit dims size image dimensions nx dims 0 ny dims 1 true bytarr 3 nx ny true 0 r image true 1 g image true 2 b image image temporary true Reset the number of channels info channels 3 endif If image is 24 bit convert to 8 bit if info channels eq 3 then begin Convert 24 bit image to 8 bit image color_quan image 1 r g b colors d table_size dither keyword_set dither Sort the color table from darkest to brightest table_sum total long r long g long b 2 table_index sort table_sum image_index sort table_index r r table_index g g table_index b b table_index oldimage image image image_index temporary oldimage Reset the number of channels info channels 1 endif endif DISPLAY THE IMAGE Realize the draw widget if not keyword_set current then widget_control base realize Save current decomposed mode and display order device get_decomposed current_decomposed current_order order Set image to display from bottom up order 0 Display the image if info channels eq 1 then begin device decomposed 0 tvlct r g b tv image endif else begin device decomposed 1 tv image true 1 endelse Restore decomposed mode and display order device decomposed current_decomposed order current_order END"); 208 a[206] = new Array("./ToBeReviewed/INIT/initncdf.html", "initncdf.pro", "", " NAME:initncdf PURPOSE:initfile for Netcdf file define all the grid parameters CATEGORY: CALLING SEQUENCE:initncdf ncfilename INPUTS:ncfilename: a string giving the name of the NetCdf file KEYWORD PARAMETERS: GLAMBOUNDARY:a 2 elements vector lon1 lon2 the longitute boundaries that should be used to visualize the data lon2 lon1 lon2 lon1 le 360 key_shift will be defined according to GLAMBOUNDARY INVMASK: to inverse the mask: mask 1 mask IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir MASKNAME: a string giving the name of the variable in the file that contains the land sea mask MISSING_VALUE: to define or redifine if the attribute is already existing the missing values used with USEASMASK keyword start1: index the axis from 1 instead of 0 when using xyindex and or zindex USEASMASK: a string giving the name of the variable in the file that will be used to build the land sea mask In this case the mask is based on the first record if record dimension exists The mask is build according to : 1 the keyword missing_value if existing 2 the attribute missing_value if existing 3 NaN values if existing XYZ AXISNAME a string giving the name of the variable in the file that contains the xyz axis for X axis default name must be x longitude nav_lon or lon for Y axis default name must be y latitude nav_lat or lat for Z axis default name must be z level lev depth XYZ MINMESH: to define the common variables i xyz minmesh used to define the grid only in a zoomed part of the original grid Defaut values are 0L XYZ MAXMESH: to define the common variables i xyz maxmesh used to define the grid only in a zoomed part of the original grid Defaut values are jp ijk glo 1 xyindex: to define the x y axis with index instead of using the values contained in X YAXISNAME x yaxis keyword_set start1 findgen jpi jpj this forces key_onearth 0 zindex: to define the z axis with index instead of using the values contained in ZAXISNAME zaxis keyword_set start1 findgen jpk OUTPUTS:none except the grid parameters of the common pro COMMON BLOCKS:common pro SIDE EFFECTS:change the grid parameters of the common pro RESTRICTIONS: the file must contain an x and an y axis 1 ou 2 dimentional array EXAMPLE: IDL initncdf toto nc glam 180 180 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 May 2002 PRO initncdf ncfilein XAXISNAME xaxisname YAXISNAME yaxisname ZAXISNAME zaxisname MASKNAME maskname INVMASK invmask USEASMASK useasmask MISSING_VALUE missing_value START1 start1 XYINDEX xyindex ZINDEX zindex _EXTRA ex common check the name of the file ncfile isafile FILENAME ncfilein IODIRECTORY iodir _extra ex if size ncfile type NE 7 then BEGIN print initncdf cancelled return endif if the file is stored on tape if version os_family EQ unix then spawn file ncfile dev null open the file cdfid ncdf_open ncfile what is inside the file inside ncdf_inquire cdfid name of the variables namevar strarr inside nvars for varid 0 inside nvars 1 do begin invar ncdf_varinq cdfid varid namevar varid strlowcase invar name ENDFOR find the xaxis if keyword_set xaxisname then xaxisname strlowcase xaxisname ELSE xaxisname x xvarid where namevar EQ xaxisname OR namevar EQ longitude OR namevar EQ nav_lon OR namevar EQ lon xvarid xvarid 0 if xvarid EQ 1 then begin print the xaxis was not found check the use of XAXISNAME keyword stop endif get the size of xaxis xinq ncdf_varinq cdfid xvarid ncdf_diminq cdfid xinq dim 0 blabla jpifromx should we read or compute the xaxis IF NOT keyword_set xyindex THEN BEGIN read the xaxis ncdf_varget cdfid xvarid xaxis make sure of the shape of xaxis IF xinq ndims GE 2 THEN BEGIN ncdf_diminq cdfid xinq dim 1 blabla jpjfromx xaxis reform xaxis jpifromx jpjfromx over ENDIF ENDIF ELSE xaxis keyword_set start1 findgen jpifromx find the yaxis if keyword_set yaxisname then yaxisname strlowcase yaxisname ELSE yaxisname y yvarid where namevar EQ yaxisname OR namevar EQ latitude OR namevar EQ nav_lat OR namevar EQ lat yvarid yvarid 0 if yvarid EQ 1 then begin print the yaxis was not found check the use of YAXISNAME keyword stop endif get the size of yaxis and check it is ok with the values found for x yinq ncdf_varinq cdfid yvarid IF xinq ndims GE 2 THEN BEGIN ncdf_diminq cdfid yinq dim 0 blabla jpifromy ncdf_diminq cdfid yinq dim 1 blabla jpjfromy IF jpifromy NE jpifromx THEN BEGIN print xaxis and y axis do not have the same x dimension ENDIF ENDIF ELSE ncdf_diminq cdfid yinq dim 0 blabla jpjfromy IF n_elements jpjfromx NE 0 THEN BEGIN IF jpjfromy NE jpjfromx THEN BEGIN print xaxis and y axis do not have the same y dimension ENDIF ENDIF should we read or compute the xaxis IF NOT keyword_set xyindex THEN BEGIN read the yaxis ncdf_varget cdfid yvarid yaxis make sure of the shape of xaxis IF xinq ndims GE 2 THEN yaxis reform yaxis jpifromy jpjfromy over ENDIF ELSE yaxis keyword_set start1 findgen jpjfromy find the zaxis if keyword_set zaxisname then zaxisname strlowcase zaxisname ELSE zaxisname z zvarid where namevar EQ nav_lev or namevar EQ zaxisname OR namevar EQ level OR namevar EQ lev OR strmid namevar 0 5 EQ depth zvarid zvarid 0 if zvarid EQ 1 AND inside ndims GT 3 then begin print initncdf: the zaxis was not found check the the use of ZAXISNAME keyword if you whant to find one stop endif read the zaxis if zvarid NE 1 THEN ncdf_varget cdfid zvarid zaxis IF keyword_set zindex THEN zaxis keyword_set start1 findgen n_elements zaxis mask CASE 1 OF keyword_set maskname :BEGIN mskid where namevar EQ strlowcase maskname 0 if mskid NE 1 THEN BEGIN mskinq ncdf_varinq cdfid mskid is the mask variable containing the record dimension withrcd where mskinq dim EQ inside recdim 0 IF withrcd NE 1 THEN BEGIN in order to read only the first record we need to get the size of each dimension count replicate 1L mskinq ndims FOR d 0 mskinq ndims 1 DO BEGIN IF d NE withrcd THEN BEGIN ncdf_diminq cdfid mskinq dim d name size count d size ENDIF ENDFOR read the variable for the first record ncdf_varget cdfid mskid tmask count count ENDIF ELSE ncdf_varget cdfid mskid tmask check if we need to applay add_offset and scale factor FOR a 0 mskinq natts 1 DO BEGIN attname ncdf_attname cdfid mskid a CASE strlowcase attname OF add_offset :ncdf_attget cdfid mskid attname add_offset scale_factor :ncdf_attget cdfid mskid attname scale_factor ELSE: ENDCASE ENDFOR IF n_elements scale_factor NE 0 THEN tmask tmask scale_factor IF n_elements add_offset NE 0 THEN tmask tmask add_offset if keyword_set invmask then tmask 1 tmask tmask byte round tmask ENDIF ELSE tmask 1 END keyword_set useasmask :BEGIN mskid where namevar EQ strlowcase useasmask 0 if mskid NE 1 THEN BEGIN mskinq ncdf_varinq cdfid mskid is the mask variable containing the record dimension withrcd where mskinq dim EQ inside recdim 0 IF withrcd NE 1 THEN BEGIN in order to read only the first record we need to get the size of each dimension count replicate 1L mskinq ndims FOR d 0 mskinq ndims 1 DO BEGIN IF d NE withrcd THEN BEGIN ncdf_diminq cdfid mskinq dim d name size count d size ENDIF ENDFOR read the variable for the first record ncdf_varget cdfid mskid tmask count count ENDIF ELSE ncdf_varget cdfid mskid tmask check if we need to applay add_offset and scale factor FOR a 0 mskinq natts 1 DO BEGIN attname ncdf_attname cdfid mskid a CASE strlowcase attname OF add_offset :ncdf_attget cdfid mskid attname add_offset scale_factor :ncdf_attget cdfid mskid attname scale_factor missing_value :IF n_elements missing_value EQ 0 THEN ncdf_attget cdfid mskid attname missing_value ELSE: ENDCASE ENDFOR IF n_elements scale_factor NE 0 THEN tmask tmask scale_factor IF n_elements add_offset NE 0 THEN tmask tmask add_offset IF n_elements missing_value NE 0 THEN BEGIN we have to take care of the float accuracy CASE 1 OF missing_value GE 1 e6:tmask tmask LT missing_value 10 missing_value LE 1 e6:tmask tmask GT missing_value 10 abs missing_value LE 1 e 6:tmask abs tmask GT 1 e 6 ELSE:tmask tmask NE missing_value ENDCASE if keyword_set invmask then tmask 1 tmask ENDIF ELSE BEGIN tmask finite tmask IF min tmask EQ 1 THEN BEGIN print missing or nan values not found tmask 1 ENDIF ENDELSE ENDIF ELSE tmask 1 END ELSE:tmask 1 ENDCASE ncdf_close cdfid compute the grid if zvarid EQ 1 then BEGIN computegrid xaxis xaxis yaxis yaxis mask tmask onearth 1b keyword_set xyindex _EXTRA ex ENDIF ELSE BEGIN computegrid xaxis xaxis yaxis yaxis zaxis zaxis mask tmask onearth 1b keyword_set xyindex _EXTRA ex ENDELSE IF n_elements time EQ 0 THEN time 0 jpt n_elements time return end"); 209 a[207] = new Array("./ToBeReviewed/INIT/initncdfxxx.html", "initncdfxxx.pro", "", ""); 210 a[208] = new Array("./ToBeReviewed/INIT/initorca05.html", "initorca05.pro", "", ""); 211 a[209] = new Array("./ToBeReviewed/INIT/initorca2.html", "initorca2.pro", "", ""); 212 a[210] = new Array("./ToBeReviewed/INIT/initorca2full.html", "initorca2full.pro", "", ""); 213 a[211] = new Array("./ToBeReviewed/LECTURE/GRIB/bit2int.html", "bit2int.pro", "", "FUNCTION bit2int bitin checkneg checkneg res 0L n n_elements bitin 1 IF keyword_set checkneg THEN BEGIN IF bitin 0 EQ 1 THEN BEGIN bitin 0 0 neg 1 ENDIF ELSE neg 1 ENDIF ELSE neg 1 FOR i 0 n DO res res 2L i bitin n i RETURN neg res END"); 214 a[212] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib.html", "read_grib.pro", "", "function read_grib varcode date1 date2 file file common http: www wmo ch web www WDM Guides Guide binary 2 html gribfile d1fes2 raid6 SINTEX common ES10 d 00 atm 5d ES10 d 00_5d_00911201_00911230 grib IF keyword_set file THEN gribfile isafile file file iodir iodir ELSE gribfile d1fes2 raid6 SINTEX common ES10 atm 5d ZOOM_IND ES10_5d_00210101_00301230 grib openr num gribfile GET_LUN ERROR err SWAP_IF_LITTLE_ENDIAN if err ne 0 then begin print err_string return 1 ENDIF recstart scan_grib_recstart num messize scan_grib_messize num recstart addoff lonarr n_elements recstart FOR i 1L n_elements recstart 1 DO addoff i recstart i recstart i 1 messize i 1 nbits scan_grib_nbits num recstart print nbits uniq nbits sort nbits codes scan_grib_code num recstart nbcodes uniq codes sort codes dates scan_grib_date num recstart nbdates uniq dates sort dates goodvar where codes EQ varcode IF goodvar 0 EQ 1 THEN BEGIN print no var code strtrim varcode 2 in the file return 1 ENDIF recstart recstart goodvar dates dates goodvar gooddate where dates GE date1 AND dates LE date2 IF gooddate 0 EQ 1 THEN BEGIN print no dates between strtrim date1 2 and strtrim date2 2 in the file return 1 ENDIF recstart recstart gooddate dates dates gooddate key_caltype 360d time date2jul dates jpt n_elements time IF jpt EQ 1 THEN vardate strtrim dates 0 2 ELSE vardate strtrim dates 0 2 strtrim dates jpt 1 2 varname vargrid T varexp varunit grib_pds read_grib_pds num recstart 0 grid parameters IF grib_pds gdsnotomitted THEN BEGIN grib_gds read_grib_gds num recstart 0 min max of the latitude with a precision of 10 2 lat1 fix 100 grib_gds la1 100 lat2 fix 100 grib_gds la2 100 CASE grib_gds gridtype OF Latitude Longitude Grid 0:BEGIN computegrid grib_gds lo1 grib_gds la1 grib_gds di grib_gds dj grib_gds ni grib_gds nj END Gaussian Latitude Longitude Grid 4:BEGIN find the latitude axis CASE 1 OF n48 grib_gds n EQ 48 AND lat1 EQ 88 57 AND lat2 EQ 88 57: gphit n48gaussian n80 grib_gds n EQ 80 AND lat1 EQ 89 14 AND lat2 EQ 89 14: gphit n80gaussian n128 grib_gds n EQ 128 AND lat1 EQ 89 46 AND lat2 EQ 89 46: gphit n128gaussian n160 grib_gds n EQ 160 AND lat1 EQ 89 57 AND lat2 EQ 89 57: gphit n160gaussian n256 grib_gds n EQ 256 AND lat1 EQ 89 73 AND lat2 EQ 89 73: gphit n256gaussian part of one of the gaussian grids defined above ELSE:BEGIN cnt 0 REPEAT BEGIN CASE cnt OF 0:gphit n48gaussian 1:gphit n80gaussian 2:gphit n128gaussian 3:gphit n160gaussian 4:gphit n256gaussian 5:BEGIN gphit n80gaussian lat1 29 71 lat2 19 62 END ELSE:stop ENDCASE nfix fix gphit 100 100 nlat1 where nfix EQ lat1 0 nlat2 where nfix EQ lat2 0 IF nlat1 NE 1 AND nlat2 NE 1 AND nlat2 nlat1 1 EQ grib_gds nj THEN gphit gphit nlat1:nlat2 ELSE gphit 1 cnt cnt 1 ENDREP UNTIL gphit 0 NE 1 END ENDCASE computegrid grib_gds lo1 1 grib_gds di 1 grib_gds ni 1 YAXIS gphit END Mercator Projection Grid gridtype EQ 1: Gnomonic Projection Grid gridtype EQ 2: Lambert Conformal secant or tangent conical or bipolar normal or oblique Projection Grid gridtype EQ 3: Polar Stereographic Projection Grid gridtype EQ 5: Oblique Lambert conformal secant or tangent conical or bipolar projection gridtype EQ 13: Spherical Harmonic Coefficients gridtype EQ 50: Space view perspective or orthographic grid gridtype EQ 90: reserved see Manual on Codes ELSE: ENDCASE ENDIF ELSE stop res fltarr grib_gds ni grib_gds nj n_elements recstart FOR i 0 n_elements recstart 1 DO BEGIN res i read_grib_bds num recstart i grib_gds ni grib_gds nj ENDFOR free_lun num IF keyword_set key_yreverse THEN res reverse res 2 RETURN res END"); 215 a[213] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_bds.html", "read_grib_bds.pro", "", "FUNCTION read_grib_bds num recstart ni nj offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 ddd bit2int binary a 27 binary a 28 checkneg offset offset sizepds IF gdsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizedds bit2int binary a 1 binary a 2 binary a 3 offset offset sizedds ENDIF IF bmsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizebms bit2int binary a 1 binary a 2 binary a 3 offset offset sizebms ENDIF a assoc num bytarr 1 nozero offset 1 sizebds bit2int binary a 1 binary a 2 binary a 3 flags binary a 4 BIT VALUE MEANING 1 0 Grid point data 1 Spherical Harmonic Coefficients 2 0 Simple packing 1 Second order Complex Packing 3 0 Original data were floating point values 1 Original data were integer values 4 0 No additional flags at octet 14 1 Octet 14 contains flag bits 5 12 5 Reserved set to 0 6 0 Single datum at each grid point 1 Matrix of values at each grid point 7 0 No secondary bit maps 1 Secondary bit maps present 8 0 Second order values have constant width 1 Second order values have different widths 9 12 Reserved set to 0 eee bit2int binary a 5 binary a 6 checkneg aaa bit2int binary a 7 checkneg bbb bit2int binary a 8 binary a 9 binary a 10 IF aaa LT 0 THEN rrr 2 24 bbb 16 aaa 64 ELSE rrr 2 24 bbb 16 aaa 64 nbits a 11 0 CASE 1 OF flags 0 EQ 0 AND flags 1 EQ 0:BEGIN CASE nbits OF 8 :a assoc num bytarr ni nj nozero offset 1 12 16:a assoc num uintarr ni nj nozero offset 1 12 32:a assoc num ulonarr ni nj nozero offset 1 12 64:a assoc num ulon64arr ni nj nozero offset 1 12 ELSE: ENDCASE END ENDCASE RETURN rrr a 0 2 eee 10 ddd END"); 216 a[214] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_end.html", "read_grib_end.pro", "", "PRO read_grib_end num offset a assoc num bytarr 4 nozero offset endcode string a 0 IF endcode NE 7777 THEN stop RETURN END"); 217 a[215] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_gds.html", "read_grib_gds.pro", "", "FUNCTION read_grib_gds num recstart offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 offset recstart 8 sizepds a assoc num bytarr 1 nozero offset 1 sizegds bit2int binary a 1 binary a 2 binary a 3 nv a 4 0 pv a 5 0 gridtype a 6 0 CASE 1 OF Latitude Longitude Grid Gaussian Latitude Longitude Grid gridtype EQ 0 OR gridtype EQ 4:BEGIN ni bit2int binary a 7 binary a 8 nj bit2int binary a 9 binary a 10 la1 bit2int binary a 11 binary a 12 binary a 13 checkneg 1000 lo1 bit2int binary a 14 binary a 15 binary a 16 checkneg 1000 resflags binary a 17 la2 bit2int binary a 18 binary a 19 binary a 20 checkneg 1000 lo2 bit2int binary a 21 binary a 22 binary a 23 checkneg 1000 di bit2int binary a 24 binary a 25 1000 IF di EQ 65 5350 THEN di 1 IF gridtype EQ 0 THEN BEGIN dj bit2int binary a 26 binary a 27 1000 IF dj EQ 65 5350 THEN dj 1 ENDIF ELSE BEGIN n bit2int binary a 26 binary a 27 ENDELSE scanflags binary a 28 res size:sizegds gridtype:gridtype ni:ni nj:nj la1:la1 la2:la2 lo1:lo1 lo2:lo2 di:di IF gridtype EQ 0 THEN res create_struct res dj dj ELSE res create_struct res n n RETURN res END Mercator Projection Grid gridtype EQ 1: Gnomonic Projection Grid gridtype EQ 2: Lambert Conformal secant or tangent conical or bipolar normal or oblique Projection Grid gridtype EQ 3: Polar Stereographic Projection Grid gridtype EQ 5: Oblique Lambert conformal secant or tangent conical or bipolar projection gridtype EQ 13: Spherical Harmonic Coefficients gridtype EQ 50: Space view perspective or orthographic grid gridtype EQ 90: reserved see Manual on Codes ELSE: ENDCASE RETURN 1 END"); 218 a[216] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_is.html", "read_grib_is.pro", "", "FUNCTION read_grib_is num offset infofile fstat num a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN stop a assoc num bytarr 1 nozero offset 4 sizerecord bit2int binary a 0 binary a 1 binary a 2 a assoc num bytarr 1 nozero offset 7 gribed a 0 IF gribed NE 1 THEN stop RETURN typefile:typefile sizerecord:sizerecord gribed:gribed 0 END"); 219 a[217] = new Array("./ToBeReviewed/LECTURE/GRIB/read_grib_pds.html", "read_grib_pds.pro", "", "FUNCTION read_grib_pds num recstart offset recstart 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 paramtableversion a 4 0 centerid a 5 0 procid a 6 0 gridid a 7 0 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 paramunitid a 9 0 levtype a 10 0 levalue1 a 11 0 levalue2 a 12 0 year a 13 0 month a 14 0 day a 15 0 hour a 16 0 minute a 17 0 timeunit a 18 0 p1 a 19 0 p2 a 20 0 timerange a 21 0 n1 a 22 0 n2 a 23 0 nbmiss a 24 0 century a 25 0 subcenterid a 26 0 d bit2int binary a 27 binary a 28 checkneg RETURN size:sizepds gdsnotomitted:gdsnotomitted bmsnotomitted:bmsnotomitted d:d END"); 220 a[218] = new Array("./ToBeReviewed/LECTURE/GRIB/read_gribtable.html", "read_gribtable.pro", "", " NAME: read_gribtable PURPOSE: Read contents of a gribtable Gribtables are located in the gribtables subdirectory of HIPHOP CATEGORY: HIPHOP GRIB ECMWF CALLING SEQUENCE: read_gribtable tablename parmtabl parmtabl EXAMPLE: tablename ectab_128 INPUTS: tablename : the full path name of a gribtable file OPTIONAL INPUT PARAMETERS: KEYWORD INPUT PARAMETERS: OUTPUTS: parmtable : the parameter table COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: MODIFICATION HISTORY: Dominik Brunner Apr 2000 PRO read_gribtable tablename parmtabl parmtabl center center subcenter subcenter tablnum tablnum ON_ERROR 2 parmtabl StrArr 3 256 center 1 subcenter 1 tablnum 1 First Subscript 3 is name description units Second 256 is defined size of a parameter table IF n_elements tablename EQ 0 THEN return openr lun tablename get line read first line which eventually contains information about center subcenter and table number readf lun line parts STR_SEP line : IF n_elements parts GT 3 THEN BEGIN center fix parts 1 subcenter fix parts 2 tablnum fix parts 3 ENDIF ELSE BEGIN IF n_elements parts GE 3 THEN parmtabl 0:1 fix parts 0 parts 1:2 ELSE IF n_elements parts EQ 2 THEN parmtabl 0 fix parts 0 parts 1 ENDELSE loop over remaining lines REPEAT BEGIN readf lun line parts STR_SEP line : IF n_elements parts GE 3 THEN parmtabl 0:1 fix parts 0 parts 1:2 ELSE IF n_elements parts EQ 2 THEN parmtabl 0 fix parts 0 parts 1 END UNTIL EOF lun free_lun lun fill up missing varible names index WHERE parmtabl 0 EQ count IF count GT 0 THEN parmtabl 0 index var strcompress index rem END"); 221 a[219] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_code.html", "scan_grib_code.pro", "", "FUNCTION scan_grib_code num recstart nrec n_elements recstart codes bytarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 8 9 1 codes i a 0 ENDFOR RETURN codes END"); 222 a[220] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_date.html", "scan_grib_date.pro", "", "FUNCTION scan_grib_date num recstart nrec n_elements recstart dates lonarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 8 1 dates i a 13 100L a 25 1 10000L a 14 100L a 15 ENDFOR RETURN dates END"); 223 a[221] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_messize.html", "scan_grib_messize.pro", "", "FUNCTION scan_grib_messize num recstart nrec n_elements recstart messize lonarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i a assoc num bytarr 1 nozero offset 4 messize i bit2int binary a 0 binary a 1 binary a 2 ENDFOR RETURN messize END"); 224 a[222] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_nbits.html", "scan_grib_nbits.pro", "", "FUNCTION scan_grib_nbits num recstart nrec n_elements recstart nbits bytarr nrec FOR i 0L nrec 1 DO BEGIN offset recstart i 8 a assoc num bytarr 1 nozero offset 1 sizepds bit2int binary a 1 binary a 2 binary a 3 flag binary a 8 gdsnotomitted flag 0 bmsnotomitted flag 1 ddd bit2int binary a 27 binary a 28 checkneg offset offset sizepds IF gdsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizedds bit2int binary a 1 binary a 2 binary a 3 offset offset sizedds ENDIF IF bmsnotomitted THEN BEGIN a assoc num bytarr 1 nozero offset 1 sizebms bit2int binary a 1 binary a 2 binary a 3 offset offset sizebms ENDIF a assoc num bytarr 1 nozero offset 1 nbits i a 11 ENDFOR RETURN nbits END"); 225 a[223] = new Array("./ToBeReviewed/LECTURE/GRIB/scan_grib_recstart.html", "scan_grib_recstart.pro", "", "FUNCTION scan_grib_recstart num infofile fstat num minimum size of one record minisize 8L 28L 4L 4L maxoffset infofile size minisize start 0L offset 0L previousrecsize 0L WHILE offset LT maxoffset DO BEGIN Every record must begin with GRIB However their is no rule to define the space between 2 records 1 we try space previousrecsize MOD 8 because for echam outputs the total size of the records is rounded to modulo 8 addoff 8 previousrecsize MOD 8 offset offset addoff IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN offset offset addoff 2 we try space previousrecsize MOD 120 because for ecmwf outputs the total size of the records is rounded to modulo 120 addoff 120 previousrecsize MOD 120 IF typefile NE GRIB THEN BEGIN offset offset addoff IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 IF typefile NE GRIB THEN offset offset addoff ENDIF 3 we try space 0 IF typefile NE GRIB THEN BEGIN a assoc num bytarr 4 nozero offset typefile string a 0 ENDIF 4 we try any value for space IF typefile NE GRIB THEN BEGIN REPEAT BEGIN CASE 1 OF array_equal a 0 3 byte G :offset offset 3 array_equal a 0 2:3 byte GR :offset offset 2 array_equal a 0 1:3 byte GRI :offset offset 1 else:offset offset 4 ENDCASE IF offset GE maxoffset THEN GOTO out a assoc num bytarr 4 nozero offset typefile string a 0 ENDREP UNTIL typefile EQ GRIB ENDIF start start offset a assoc num bytarr 1 nozero offset 4 recsize bit2int binary a 0 binary a 1 binary a 2 offset offset recsize previousrecsize recsize ENDWHILE out: RETURN start 1:n_elements start 1 END"); 226 a[224] = new Array("./ToBeReviewed/LECTURE/binary.html", "binary.pro", "", " Name: binary Purpose: Returns the binary representation of a number of any numerical type Argument: number scalar or array of numbers any numerical type Returns: Byte array with binary representation of numbers Examples: Binary representation of 11b: IDL print binary 11b 0 0 0 0 1 0 1 1 Binary representation of pi x86: Little endian IEEE representation : IDL print format z9 8 5x 4 1x 8i1 long pi 0 binary pi 40490fdb 01000000 01001001 00001111 11011011 x86 Linux 0fdb4149 00001111 11011011 01000001 01001001 Alpha OpenVMS IDL print format 8 1x 8i0 binary dpi 01000000 00001001 00100001 11111011 01010100 01000100 00101101 00011000 Some first tests before type double was added: print format 2a6 4x 2z9 8 4x 8z3 2 version arch version os long dpi 0 2 byte dpi 0 8 x86 linux 54442d18 400921fb 18 2d 44 54 fb 21 09 40 sparc sunos 400921fb 54442d18 40 09 21 fb 54 44 2d 18 alpha vms 0fda4149 68c0a221 49 41 da 0f 21 a2 c0 68 Beginning with IDL 5 1 Alpha VMS uses IEEE representation as well Modification history: 19 Dec 1997 Originally a news posting by David Fanning Re: bits from bytes 20 Dec 1997 Complete rewrite: eliminate loops 22 Dec 1997 Bit shift instead of exponentiation return byte array handle input arrays Think about double and complex types 22 Sep 1998 Complete rewrite: reduce every numerical type to single bytes Check that big and little endian machines return exactly the same results if IEEE 7 May 2003 Added newish data types unsigned and long64 BT function binary number s size number type s s 0 1 n_no s s 0 2 Numerical types: will have to be completed if IDL adds double long 1: byte 1 byte unsigned integer 2: integer 2 byte signed integer 3: long 4 byte signed integer 4: floating point 4 byte single precision 5: double precision 8 byte double precision 6: complex 2x4 byte single precision 9: double complex 2x8 byte double precision 12: uInt 2 byte unsigned integer 13: uLong 4 byte unsigned integer 14: Long64 8 byte signed integer 15: uLong64 8 byte unsigned integer Non numerical types: 0: undefined 7: string 8: structure 10: pointer 11: object reference nbyt 0 1 2 4 4 8 8 0 0 16 0 0 number of bytes per type code 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 nbyt 0 1 2 4 4 8 8 0 0 16 0 0 2 4 8 8 ntyp nbyt type if ntyp eq 0 then message Invalid argument must be numerical type bits 128 64 32 16 8 4 2 1 ishft 1b 7 indgen 8 For correct array handling and byte comparison number and bits require same dimensions numvalue and bitvalue bitvalue bits intarr ntyp intarr n_no little_endian byte 1 0 1 0 In case of complex type and little endian machine swap the two float values before the complete second dimension is reversed at returning if type eq 6 or type eq 9 and little_endian then type complex numvalue reform byte number 0 1 ntyp 2 2 n_no intarr 8 1 0 8 ntyp n_no else numvalue byte number 0 1 ntyp n_no intarr 8 On little endian machines the second dimension of the return value must be reversed if little_endian AND type NE 1 then return reverse numvalue and bitvalue ne 0 2 else return numvalue and bitvalue ne 0 end"); 227 a[225] = new Array("./ToBeReviewed/LECTURE/changeread.html", "changeread.pro", "", "FUNCTION changeread newread common newread must be two structures if size newread type NE 8 then return 0 we compare the two structure which caracterise the read case 1 of ccreadparameters funclec_name NE newread funclec_name: ccreadparameters jpidta NE newread jpidta: ccreadparameters jpjdta NE newread jpjdta: ccreadparameters jpkdta NE newread jpkdta: ccreadparameters ixmindta NE newread ixmindta: ccreadparameters ixmaxdta NE newread ixmaxdta: ccreadparameters iymindta NE newread iymindta: ccreadparameters iymaxdta NE newread iymaxdta: ccreadparameters izmindta NE newread izmindta: ccreadparameters izmaxdta NE newread izmaxdta: ELSE:return 0 endcase update the common paramaters ccreadparameters newread jpidta newread jpidta jpjdta newread jpjdta jpkdta newread jpkdta ixmindta newread ixmindta ixmaxdta newread ixmaxdta iymindta newread iymindta iymaxdta newread iymaxdta izmindta newread izmindta izmaxdta newread izmaxdta return 1 end"); 228 a[226] = new Array("./ToBeReviewed/LECTURE/inverse_binary.html", "inverse_binary.pro", "", " NAME: inverse_binary PURPOSE: inverse function of the binary pro function given a input array of 0 1 return its corresponding byte integer long representation CATEGORY: CALLING SEQUENCE: res inverse_binary binnum INPUTS: binnum must be a binary type array containing only 0 and 1 According to binary pro outputs binnum array must have the following dimensions values: 8 t d1 d2 t gives the output type: t 1 byte t 2 integer t 4 long d1 d2 are the output dimensions KEYWORD PARAMETERS: no OUTPUTS: a byte integer long array with d1 d2 dimensions COMMON BLOCKS: no RESTRICTIONS:the binary number can represent only byte integer long EXAMPLE: IDL a indgen 5 IDL b binary a IDL help b B BYTE Array 8 2 5 IDL print b 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 IDL help inverse_binary b INT Array 5 IDL print inverse_binary b 0 1 2 3 4 MODIFICATION HISTORY: Sebastien Masson smasson jamstec go jp July 2004 FUNCTION inverse_binary binnumb s size binnumb dimensions IF n_elements s EQ 1 THEN numbofbit 8 ELSE numbofbit 8 s 1 nvalues n_elements binnumb numbofbit bn reform long binnumb numbofbit nvalues CASE numbofbit OF 8:res byte total temporary bn 2b reverse indgen numbofbit replicate 1b nvalues 1 1 16:res fix total temporary bn 2 reverse indgen numbofbit replicate 1 nvalues 1 1 double 32:res long total temporary bn 2L reverse indgen numbofbit replicate 1L nvalues 1 1 double ENDCASE CASE n_elements s OF 1:res res 0 2:res res 0 3: ELSE:res reform res s 2:n_elements s 1 over ENDCASE return res end"); 229 a[227] = new Array("./ToBeReviewed/LECTURE/litchamp.html", "litchamp.pro", "", " NAME:litchamp PURPOSE:permet de lire un simple tableau ou une structure correspondant a un champ Si en entree on a : un simple tableau litchamp renvoie le tableau une stucture litchamp renvoie le premier element de la structure qui doit obligatoirement etre le champ sous forme d un tableau Au passage litchamp regarde les autres elements de la structure et met a jour si besoin les variables globales qui se rapportent au champ: vargrid varname varunit vardate varexp valmask et time CATEGORY:permet d appeler plt pltz pltt avec un tableau ou une structure et de mettre a jour les variables globales liees au champ CALLING SEQUENCE:res litchamp struct INPUTS: struct: c est soit un tableau soit une structure Si struct est une structure elle doit suivre les regles suivantes: le premier element est le tableau contenant le champ les autres elements sont des strings qui contiennent des informations sur le champ SAUF pour l element relatif a date Ce dernier peut etre soit un string pour designer une date particuliere ex: August 1999 ou bien un vecteur de jours juliens d IDL correspondant au calendrier a associer au champ si c est une serie temporelle l ordre des elements autre que le premier n a pas d importance les autres elements autre que le premier sont tous optionnels ils sont reconnus par la premiere lettre de leur nom: g pour actualiser vargrid u pour actualiser varunit e pour actualiser varexp d pour actualiser vardate n pour actualiser varname m pour actualiser valmask KEYWORD PARAMETERS: GRID: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par g si il existe et dans le cas contraire UNIT: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par u si il existe et dans le cas contraire EXP: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par e si il existe et dans le cas contraire DATE: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par d si il existe et dans le cas contraire NAME: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par n si il existe et dans le cas contraire LEVEL: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par l si il existe et 1 dans le cas contraire MASK: activer ce mot cle si on veut que litchamp renvoie la variable associee a l element de la structure commencant par m si il existe et 1 dans le cas contraire OUTPUTS:c est le tableau qui continent le champ COMMON BLOCKS: common pro SIDE EFFECTS: actualise au besion les variables globales vargrid varname varunit vardate varexp valmask et time RESTRICTIONS: EXAMPLE: IDL print vargrid varname varunit vardate varexp T 0 IDL help litchamp a:indgen 5 u: C name: toto INT Array 5 IDL print vargrid varname varunit vardate varexp T toto C 0 IDL help litchamp a:indgen 5 da: 1999 INT Array 5 IDL print vargrid varname varunit vardate varexp T toto C 1999 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 28 5 1999 FUNCTION litchamp struct GRID grid NAME name UNIT unit EXP exp DATE date LEVEL level MASK mask common if size struct type ne 8 then BEGIN alors contour n est pas une structure if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct ENDIF IF n_tags struct EQ 1 then BEGIN la structure n a qu un element if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct 0 ENDIF nomelements tag_names struct for i 1 n_tags struct 1 do begin case strlowcase strmid nomelements i 0 1 of g :BEGIN if keyword_set grid then return strupcase struct i vargrid strupcase struct i END n :BEGIN if keyword_set name then return struct i varname struct i END u :BEGIN if keyword_set unit then return struct i varunit struct i END e :BEGIN if keyword_set exp then return struct i varexp struct i END m :BEGIN if keyword_set mask then return struct i valmask struct i END d :BEGIN if size struct i type EQ 7 THEN BEGIN vardate struct i ENDIF ELSE BEGIN time struct i jpt n_elements time if jpt EQ 1 then vardate strtrim vairdate struct i 0 2 ELSE vardate strtrim vairdate struct i 0 2 strtrim vairdate struct i jpt 1 2 ENDELSE if keyword_set date then return vardate END h :BEGIN computehopegrid struct i xaxis struct i yaxis struct i zaxis struct i linetype FIRSTS struct i firsts LASTS struct i lasts FORTHEMASK struct 0 pttype struct i pttype END ELSE:BEGIN ras report Le nom nomelements i ne correspont a aucun element reconnu de la structure cf IDL xhelp litchamp end endcase endfor if keyword_set grid then return if keyword_set name then return if keyword_set unit then return if keyword_set exp then return if keyword_set date then return if keyword_set level then return 1 if keyword_set mask then return 1 return struct 0 end"); 230 a[228] = new Array("./ToBeReviewed/LECTURE/ncdf_lec.html", "ncdf_lec.pro", "", " NAME:ncdflec PURPOSE:donne des infos sur un fichier netcdf et permet de recupere les variables qui y sont ecrites CATEGORY:lecture de fichiers netcdf CALLING SEQUENCE: res ncdflec nom_de _fichier INPUTS:nom_de _fichier:nom d un fichier net cdf situe ds e repertoire stipule par iodir KEYWORD PARAMETERS: ATT: global ou au nom d une variable permet de voir tous les attributs rattaches a une variable DIM:donne la liste des dimensions VAR: 1 var: donne la liste des variables 2 var nom de variable : ds ce cas la fonction retourne la variable IODIR: string contenant le repertoire ou aller chercher le fichier a lire _EXTRA: permet de passer les mots cles definits par IDL pour les fonction NETCDF en particulier OFFSET et COUNT ds ncdf_varget OUTPUTS: 1 sauf si var nom de variable auquel cas la fonction retourne la variable REMARQUE:les noms des variables du programme sont similaires a ceux employes ds le manuel IDL scientific data formats MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 4 1 98 function ncdf_lec nom ATT att DIM dim VAR var IODIR iodir _extra ex res 1 if NOT keyword_set IODIR then iodir if not keyword_set att or keyword_set dim or keyword_set var then BEGIN att 1 dim 1 var 1 commande ncdump c iodir nom spawn commande goto fini endif ouverture du fichier nom cdfid ncdf_open iodir nom que contient le fichier wathinside ncdf_inquire cdfid print dans le fichier iodir nom il y a: if keyword_set dim then begin print nombre de dimensions: strtrim wathinside ndims 1 print numero de la dimension dont la valeur est infini: strtrim wathinside recdim 1 endif if keyword_set var then if size var type NE 7 then print nombre de variables : strtrim wathinside nvars 1 if keyword_set att then begin if strlowcase att ne global then goto nonglobal print nombre de attributs globaux : strtrim wathinside ngatts 1 endif attributs globaux if keyword_set att then begin print print ATTRIBUTS GLOBAUX for attiq 0 wathinside ngatts 1 do begin name ncdf_attname cdfid attiq global nom de l atribut ncdf_attget cdfid name value global valeur de l atribut print name : string value endfor endif nonglobal: affichage des differentes dimensions if keyword_set dim then begin print print DIMENSIONS endif nomdim strarr wathinside ndims tailledim lonarr wathinside ndims for dimiq 0 wathinside ndims 1 do begin ncdf_diminq cdfid dimiq name value nom et valeur de la dimension nomdim dimiq name tailledim dimiq value if keyword_set dim then begin print dimension numero strtrim dimiq 1 nom: nomdim dimiq valeur: strtrim tailledim dimiq 1 endif endfor affichage des differentes variables if keyword_set att or keyword_set var then begin vature de var string ou 1 help var output nature if strpos nature STRING 0 NE 1 then nature string ELSE nature 1 si on doit juste lire la variable if nature EQ string then begin ncdf_varget cdfid var res _extra ex GOTO sortie ENDIF si c est pour avoir des renseignements if not keyword_set att then att rien print for varid 0 wathinside nvars 1 do begin varcontent ncdf_varinq cdfid varid que contient la variable if strlowcase att eq strlowcase varcontent name or keyword_set var then begin print variable numero: strtrim varid 1 nom: varcontent name type: varcontent datatype dimensions: nomdim varcontent dim if strlowcase att eq strlowcase varcontent name then begin for attiq 0 varcontent natts 1 do begin name ncdf_attname cdfid varid attiq ncdf_attget cdfid varid name value print strtrim attiq name : strtrim string value 1 endfor goto sortie endif endif endfor endif sortie: ncdf_close cdfid fini: return res end"); 231 a[229] = new Array("./ToBeReviewed/LECTURE/read_ftp.html", "read_ftp.pro", "", " READ_FTP Syntax: READ_FTP remote_host files directory FILE DATA variable USER string PASS string PTR Arguments remote_host Name of the remote host ftp server that you want to connect to or a complete ftp location such as for example: ftp: ftp rsinc com pub gzip README GZIP directory Remote directory where the files reside on the ftp server files A single filename or an array of filenames to be retrieved Keywords FILE Set this keyword to make a local copy of the file to be transferred The local file will have the same name as the remote file and will be placed in the current working directory DATA Set this to a named variable that will contain either a byte array or an array of pointers to byte arrays with the transferred data If there is more than one file an array of pointers is returned one for each file Note that when downloading large files using FILE instead will require much less memory since the entire file is not stored in a variable in that case PTR Set this keyword to return an array of pointers even when there is only one file USER Specify user name to connect to server with Default is: anonymous PASS Specify password to use when connecting Default is: test test com Examples of use 1 Retrieve and print the contents of ftp: ftp rsinc com pub gzip README GZIP: IDL READ_FTP ftp: ftp rsinc com pub gzip README GZIP DATA data IDL help data DATA BYTE Array 2134 IDL print string data README file: Research Systems Anonymous FTP site ftp rsinc com pub directory gzip directory 2 Retrieve some files from podaac jpl nasa gov and store the files in the current working directory: IDL files string lindgen 10 50 format MGB370 3 3d gz IDL READ_FTP podaac jpl nasa gov files IDL pub sea_surface_height topex_poseidon mgdrb data MGB_370 FILE IDL spawn dir MGB log_output Volume in drive C is Local Disk Volume Serial Number is 34CE 24DF Directory of C: test test0307 07 28 2003 11:58a 362 167 MGB370 050 gz 07 28 2003 11:58a 333 005 MGB370 051 gz 07 28 2003 11:58a 310 287 MGB370 052 gz 07 28 2003 11:58a 358 771 MGB370 053 gz 07 28 2003 11:59a 387 282 MGB370 054 gz 07 28 2003 11:59a 361 633 MGB370 055 gz 07 28 2003 11:59a 383 075 MGB370 056 gz 07 28 2003 11:59a 365 844 MGB370 057 gz 07 28 2003 11:59a 383 918 MGB370 058 gz 07 28 2003 12:00p 372 712 MGB370 059 gz 10 File s 3 618 694 bytes These compressed files can cosequently be opened with OPENR and the COMPRESSED keyword pro ftp_post u cmd res out out count count compile_opt idl2 if cmd ne then begin printf u cmd format a comment out the following line to disable debug info print cmd endif if size out type eq 0 then out 2 catch err if err ne 0 then return line count 0 while arg_present res do begin readf u line if count eq 0 then res line else res res line count count 1 comment out the following line to disable debug info print line if strmatch line out then break endwhile end pro ftp_parse_pasv text host port t strtrim text 2 ind where strcmp t 227 3 i ind 0 if i ne 1 then begin sub stregex t i 0 9 extract p strsplit strmid sub 1 strlen sub 2 extract p strtrim p 2 host p 0 p 1 p 2 p 3 port 256 long p 4 long p 5 endif end pro read_ftp site files dir port data data file file user user pass pass ptr ptr compile_opt idl2 if n_elements port eq 0 then port ftp if n_elements files eq 0 then begin if strcmp site ftp: 6 then host strmid site 6 else host site pos strpos host dir strmid host pos host strmid host 0 pos pos strpos dir reverse_search files strmid dir pos 1 dir strmid dir 0 pos endif else host site if size user type eq 0 then user anonymous if size pass type eq 0 then pass test test com socket u host port connect_timeout 5 read_timeout 5 get_lun ftp_post u res ftp_post u USER user res out 3 ftp_post u PASS pass res ftp_post u TYPE I res if size dir type ne 0 then ftp_post u CWD dir res if keyword_set file or arg_present data then begin bufsize 512 buffer bytarr bufsize n n_elements files if arg_present data then dat ptrarr n for i 0 n 1 do begin ftp_post u SIZE files i res out 213 sz long64 strmid res n_elements res 1 4 if arg_present data then dat i ptr_new bytarr sz ftp_post u PASV res ftp_parse_pasv res host port ftp_post u RETR files i res out 1 socket v host port connect_timeout 5 read_timeout 5 get_lun rawio tc 0ll if keyword_set file then openw w files i get_lun while tc lt sz do begin if sz tc lt bufsize then begin bufsize sz tc buffer bytarr bufsize endif readu v buffer transfer_count dtc if arg_present data then dat i tc dtc eq bufsize buffer:buffer 0:dtc 1 if keyword_set file then writeu w dtc eq bufsize buffer:buffer 0:dtc 1 tc tc dtc endwhile free_lun v if keyword_set file then free_lun w ftp_post u res endfor if arg_present data then begin if n gt 1 or keyword_set ptr then data dat else data temporary dat 0 endif endif ftp_post u QUIT res free_lun u end"); 232 a[230] = new Array("./ToBeReviewed/LECTURE/read_ncdf.html", "read_ncdf.pro", "", " NAME: read_ncdf PURPOSE:fonction de lecture pour fichier net_cdf Ce programme est moins universel que ncdf_lec il fait appelle au variables declarees dans common pro mais il est du cop bcp plus facile d utilisation Il prend en compte la declaration des differents zoom qui ont ete definis ixminmesh premierx la declaration de la variable key_shift bref le resultat de read_ncdf peut dorectement etre utilise dans plt C est aussi ce programme qui est utilise par defaut dans mes widgets pour la partie lecture CATEGORY:lecture de fichiers NetCdf CALLING SEQUENCE:res read_ncdf name debut fin INPUTS: name: un string definissant le champ a lire debut et fin: sont relatifs a l axe des temps Ce peut etre 2 dates du type yyyymmdd et ds ce cas on selectionne les dates qui sont comprisent entre ces 2 dates 2 indices qui definissent entre quel et quel pas de temps on doit extraire la dimension temporelle exp: ne sert a rien KEYWORD PARAMETERS: utilisables hors du contexte des widgets BOXZOOM: contient la boxzoom sur laquelle on doit faire la lecture FILENAME: string contennant le nom du fichier INIT to call automatically initncdf filename and thus redefine all the grid parameters GRID UTVWF to specify the type of grid Defaut is 1 based on the name of the file if the file ends by GRID _ TUVFW NC not case sensible or 2 T if case 1 is not found IODIRECTORY a string giving the name of iodirectory see isafile pro for all possibilities default value is common variable iodir TIMESTEP:activer pour specifier que debut et fin font reference a des indices de l axe du temps et non pas a des dates TOUT: activer si on veut lire le ficher sur l ensemble du domaine sans tenir compte du sous domaine definit par boxzoom ou lon1 lon2 lat1 lat2 vert1 vert2 NOSTRUCT: activer si on ne veut pas que read_ncdf reourne une structure mais uniquement le tableau se rapportant au champ TIMEVAR: a string to define the name of the variable that contains the time axis This keyword can be usefull if there is no unlimited dimension or if the time axis selected by defaut the first 1D array with unlimited dimension is not the good one OUTPUTS:une stucture lisible par litchamp pro ou un simple tableau si NOSTRUCT est active COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS:le champ doit avoir une dimension temporelle EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 15 10 1999 FUNCTION read_ncdf name debut fin pour_etre_compatible BOXZOOM boxzoom FILENAME filename PARENTIN parentin TIMESTEP timestep TIMEVAR timevar TOUT tout NOSTRUCT nostruct CONT_NOFILL CONT_NOFILL INIT init GRID grid FBASE2TBASE fbase2tbase _EXTRA ex cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF we find the filename print filename is parent a valid widget if keyword_set parentin then BEGIN parent long parentin parent parent widget_info parent managed ENDIF filename isafile filename filename IODIRECTORY iodir _EXTRA ex ouverture du fichier nom if size filename type NE 7 then return report read_ncdf cancelled IF version OS_FAMILY EQ unix THEN spawn file filename dev null cdfid ncdf_open filename contient ncdf_inquire cdfid we check if the variable name exists in the file if ncdf_varid cdfid name EQ 1 then BEGIN ncdf_close cdfid return report variable name C not found in the file filename ENDIF varcontient ncdf_varinq cdfid name shall we redefine the grid parameters if keyword_set init THEN initncdf filename _extra ex check the time axis and the debut and fin dates if n_elements debut EQ 0 then begin debut 0 timestep 1 endif if keyword_set timestep then begin firsttps debut 0 if n_elements fin NE 0 then lasttps fin 0 ELSE lasttps firsttps jpt lasttps firsttps 1 time julday 1 1 1 lindgen jpt ENDIF ELSE BEGIN if keyword_set parent then BEGIN widget_control parent get_uvalue top_uvalue filelist extractatt top_uvalue filelist IF filelist 0 EQ many THEN filelist filename currentfile where filelist EQ filename 0 time extractatt top_uvalue fileparameters currentfile time_counter date1 date2jul debut 0 if n_elements fin NE 0 then date2 date2jul fin 0 ELSE date2 date1 firsttps where time EQ date1 firsttps firsttps 0 lasttps where time EQ date2 lasttps lasttps 0 ENDIF ELSE BEGIN IF keyword_set timevar THEN BEGIN timeid ncdf_varid cdfid timevar IF timeid EQ 1 THEN BEGIN ncdf_close cdfid return report the file filename as no variable timevar C Use the TIMESTEP keyword endif timecontient ncdf_varinq cdfid timeid contient recdim timecontient dim 0 ENDIF ELSE BEGIN we find the infinite dimension timedim contient recdim if timedim EQ 1 then BEGIN ncdf_close cdfid return report the file filename as no infinite dimension C Use TIMESTEP or TIMEVAR keyword endif we find the FIRST time axis timeid 0 repeat BEGIN tant que l on a pas trouve une variable qui n a qu une dimension: la dimension infinie timecontient ncdf_varinq cdfid timeid que contient la variable timeid timeid 1 endrep until n_elements timecontient dim EQ 1 AND timecontient dim 0 EQ contient recdim OR timeid EQ contient nvars 1 if timeid EQ contient nvars 1 then BEGIN ncdf_close cdfid return report the file filename as no time axis variable C Use the TIMESTEP keyword endif timeid timeid 1 ENDELSE we must found the time origin of the julian calendar used in the time axis does the attribut units an dcalendar exist for the variable time axis if timecontient natts EQ 0 then BEGIN ncdf_close cdfid return report the variable timecontient name has no attribut C Use the TIMESTEP keyword or add the attribut units to the variable endif attnames strarr timecontient natts for attiq 0 timecontient natts 1 do attnames attiq ncdf_attname cdfid timeid attiq if where attnames EQ units 0 EQ 1 then BEGIN ncdf_close cdfid return report Attribut units not found for the variable timecontient name C Use the TIMESTEP keyword ENDIF now we try to find the attribut called calendar the the attribute calendar exists If no we suppose that the calendar is gregorian calendar if where attnames EQ calendar 0 NE 1 then BEGIN ncdf_attget cdfid timeid calendar value value string value CASE value OF noleap :key_caltype noleap 360d :key_caltype 360d greg :IF n_elements key_caltype EQ 0 THEN key_caltype greg ELSE:BEGIN notused report Unknown calendar: value we use greg calendar key_caltype greg END ENDCASE ENDIF ELSE BEGIN notused report Unknown calendar we use key_caltype calendar IF n_elements key_caltype EQ 0 THEN key_caltype greg ENDELSE now we take acre of units attribut ncdf_attget cdfid timeid units value time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 we decript the units attribut to find the time origin value strtrim strcompress string value 2 mots str_sep value unite mots 0 depart str_sep mots 2 ncdf_varget cdfid timeid time time double time unite strlowcase unite IF strpos unite s strlen unite 1 NE 1 THEN unite strmid unite 0 strlen unite 1 IF strpos unite julian_ NE 1 THEN unite strmid unite 7 case unite of second :time julday depart 1 depart 2 depart 0 time 86400 d hour :time julday depart 1 depart 2 depart 0 time 24 d day :time julday depart 1 depart 2 depart 0 time month :BEGIN if total fix time NE time NE 0 then we switch to days with 30d m time julday depart 1 depart 2 depart 0 round time 30 ELSE for t 0 n_elements time 1 DO time t julday depart 1 time t depart 2 depart 0 END year :BEGIN if total fix time NE time NE 0 then we switch to days with 365d y time julday depart 1 depart 2 depart 0 round time 365 ELSE for t 0 n_elements time 1 do time t julday depart 1 depart 2 depart 0 time t END ELSE:BEGIN ncdf_close cdfid return report The units attribu of the time axis must be something like: C seconds since 0001 01 01 C days since 1979 01 01 C months since 1979 01 01 C years since 1979 01 01 end ENDCASE date1 date2jul debut 0 if n_elements fin NE 0 then date2 date2jul fin 0 ELSE date2 date1 time double time firsttps where time GE date1 firsttps firsttps 0 if firsttps EQ 1 THEN BEGIN ncdf_close cdfid return report date 1: strtrim jul2date date1 1 is not found in the time axis ENDIF lasttps where time LE date2 if lasttps 0 EQ 1 THEN BEGIN ncdf_close cdfid return report the time axis as no date before date 2: strtrim jul2date date2 1 endif lasttps lasttps n_elements lasttps 1 if lasttps LT firsttps then BEGIN ncdf_close cdfid return report the time axis as no dates between date1 and date 2: strtrim jul2date date1 1 strtrim jul2date date2 1 endif ENDELSE time time firsttps:lasttps jpt lasttps firsttps 1 ENDELSE nom de la grille a laquelle se rapporte le champ IF keyword_set grid THEN vargrid strupcase grid ELSE BEGIN vargrid T default definition IF finite glamu 0 EQ 1 THEN BEGIN pattern GRID GRID_ GRID UPID_ 30ID_ gdtype T U V W F fnametest strupcase filename FOR i 0 n_elements pattern 1 DO BEGIN FOR j 0 n_elements gdtype 1 DO BEGIN substr pattern i gdtype j pos strpos fnametest substr IF pos NE 1 THEN vargrid strmid fnametest pos strlen substr 1 1 ENDFOR ENDFOR ENDIF ENDELSE call the init function redefinition du domaine if keyword_set tout then begin nx jpi ny jpj nz jpk firstx 0 firsty 0 firstz 0 lastx jpi 1 lasty jpj 1 lastz jpk 1 case strupcase vargrid of T :mask tmask U :mask umask V :mask vmask W :mask tmask F :mask fmask endcase ENDIF ELSE BEGIN if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: BEGIN ncdf_close cdfid return report Wrong Definition of Boxzoom end ENDCASE savedbox 1b saveboxparam boxparam4rdncdf dat domdef bte GRIDTYPE T vargrid _extra ex ENDIF grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz undefine glam undefine gphi on libere un peu de memoire ENDELSE on initialise les ixmindta iymindta au besoin if n_elements jpidta EQ 0 THEN jpidta jpiglo if n_elements jpjdta EQ 0 THEN jpjdta jpjglo if n_elements jpkdta EQ 0 THEN jpkdta jpkglo if n_elements ixmindta EQ 0 THEN ixmindta 0 if n_elements ixmaxdta EQ 0 then ixmaxdta jpidta 1 if ixmindta EQ 1 THEN ixmindta 0 IF ixmaxdta EQ 1 then ixmaxdta jpidta 1 if n_elements iymindta EQ 0 THEN iymindta 0 IF n_elements iymaxdta EQ 0 then iymaxdta jpjdta 1 if iymindta EQ 1 THEN iymindta 0 IF iymaxdta EQ 1 then iymaxdta jpjdta 1 if n_elements izmindta EQ 0 THEN izmindta 0 IF n_elements izmaxdta EQ 0 then izmaxdta jpkdta 1 if izmindta EQ 1 THEN izmindta 0 IF izmaxdta EQ 1 then izmaxdta jpkdta 1 on va lire le fichier if n_elements key_stride LE 2 then key_stride 1 1 1 key_stride 1l long key_stride key_shift long testvar var key_shift IF n_elements key_yreverse EQ 0 THEN key_yreverse 0 IF keyword_set key_yreverse THEN BEGIN tmp jpj 1 firsty firsty jpj 1 lasty lasty tmp ENDIF IF keyword_set fbase2tbase THEN BEGIN case strupcase vargrid of U :BEGIN IF NOT keyword_set key_periodic THEN BEGIN firstx firstx 1 lastx lastx 1 ENDIF END V :BEGIN firsty firsty 1 lasty lasty 1 END F :BEGIN firsty firsty 1 lasty lasty 1 IF NOT keyword_set key_periodic THEN BEGIN firstx firstx 1 lastx lastx 1 ENDIF END ELSE: endcase ENDIF IF keyword_set fbase2tbase AND keyword_set key_periodic AND strupcase vargrid EQ U OR strupcase vargrid EQ F THEN key_shift key_shift 1 read_ncdf_varget IF keyword_set fbase2tbase AND keyword_set key_periodic AND strupcase vargrid EQ U OR strupcase vargrid EQ F THEN key_shift key_shift 1 on definit les variables globales rattachees a la variable varname varname name varunit if varcontient natts NE 0 then begin attnames strarr varcontient natts for attiq 0 varcontient natts 1 do attnames attiq ncdf_attname cdfid name attiq lowattnames strlowcase attnames found where lowattnames EQ units 0 IF found NE 1 then ncdf_attget cdfid name attnames found value ELSE value varunit strtrim string value 2 found where lowattnames EQ add_offset 0 if found NE 1 then ncdf_attget cdfid name attnames found add_offset ELSE add_offset 0 found where lowattnames EQ scale_factor 0 if found NE 1 then ncdf_attget cdfid name attnames found scale_factor ELSE scale_factor 1 missing_value no found where lowattnames EQ _fillvalue 0 if found NE 1 then ncdf_attget cdfid name attnames found missing_value found where lowattnames EQ missing_value 0 if found NE 1 then ncdf_attget cdfid name attnames found missing_value ENDIF ELSE BEGIN varunit add_offset 0 scale_factor 1 missing_value no ENDELSE vardate on construit une belle date lisible en fonction du langage specifie year long debut 0 10000 month long debut 0 100 MOD 100 day long debut 0 MOD 100 vardate string format C CMoA 31 month 1 strtrim day 1 strtrim year 1 varexp file_basename filename we apply reverse if keyword_set key_yreverse then res reverse temporary res 2 if keyword_set key_zreverse AND size res 0 EQ 3 AND jpt EQ 1 then res reverse temporary res 3 if keyword_set key_zreverse AND size res 0 EQ 4 THEN res reverse temporary res 3 on applique la valeur valmask sur les points terre if NOT keyword_set cont_nofill then begin valmask 1e20 case 1 of varcontient ndims eq 2:BEGIN xy array mask mask 0 earth where mask EQ 0 END varcontient ndims eq 3 AND where varcontient dim EQ contient recdim 0 EQ 1:BEGIN xyz array earth where mask EQ 0 END varcontient ndims eq 3 AND where varcontient dim EQ contient recdim 0 NE 1:BEGIN xyt array mask mask 0 earth where mask EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate nx ny n_elements earth lindgen jpt END END varcontient ndims eq 4:BEGIN xyzt array earth where mask EQ 0 if earth 0 NE 1 then BEGIN earth earth replicate 1 jpt replicate nx ny nz n_elements earth lindgen jpt END END endcase ENDIF ELSE earth 1 we look for missing_value IF size missing_value type NE 7 then BEGIN IF size missing_value type EQ 1 THEN BEGIN IF isnumber string missing_value tmp EQ 1 THEN missing_value tmp ENDIF if missing_value NE valmask then begin if abs missing_value LT 1e6 then missing where res EQ missing_value ELSE missing where abs res gt abs missing_value 10 ENDIF ELSE missing 1 ENDIF ELSE missing 1 on applique les add_offset scale_factor et missing_value if scale_factor NE 1 then res temporary res scale_factor if add_offset NE 0 then res temporary res add_offset if missing 0 NE 1 then res temporary missing values f_nan if earth 0 NE 1 then res temporary earth 1e20 ncdf_close cdfid if keyword_set savedbox THEN restoreboxparam boxparam4rdncdf dat if keyword_set nostruct then return res ELSE BEGIN IF keyword_set key_forgetold THEN BEGIN return arr:res grid:vargrid unit:varunit experiment:varexp name:varname ENDIF ELSE BEGIN return tab:res grille:vargrid unite:varunit experience:varexp nom:varname ENDELSE ENDELSE END "); 233 a[231] = new Array("./ToBeReviewed/LECTURE/read_ncdf_varget.html", "read_ncdf_varget.pro", "", ""); 234 a[232] = new Array("./ToBeReviewed/LECTURE/xncdf_lec.html", "xncdf_lec.pro", "", " La lecture de ce programme se fait de bas en haut: 1 xncdf_lec 2 xncdf_lec_event 3 wid_var wid_var_event pro wid_var_event event NAME:wid_var_event PURPOSE:procedure appele par xmanager qd on appuie sur un bouton du 2eme widget cree par wid_var INPUTS: event une structure caracterisant le type d evenement qui arrive au widget numero1 2 COMMON BLOCKS:wididbase resultat infovariable indicewid motcle COMMON wididbase base COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON indicewid_var widbase1 widbase2111 widbase212 widbase213 selectatt COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar quel est le type d evenement widget_control event id get_uvalue uval tailledimvar tailledim varcontient dim if n_elements uval EQ 0 then return case sur le type d evenement case uval OF 1:BEGIN on change des valeurs dans le tableau on controle que les valeurs mises dans le tableau ne sont pas completement fausses widget_control widbase1 get_value table agument du bon type si le type est mauvais on change automatiquement par des valeurs par defaut if event x GT size table 1 then return if event y GT size table 2 then return if size table event x event y type GE 6 OR size table event x event y type EQ 0 then BEGIN if event x EQ 1 then widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y ELSE widget_control widbase1 use_table_select event x event y event x event y set_value 0 endif agument avec une valeur nom debile table fix table case event x of 0:BEGIN on a touche a l offset: if table 0 event y LT 0 then BEGIN table 0 event y 0 widget_control widbase1 use_table_select 0 event y 0 event y set_value 0 endif si il depasse la dim du tableau on le met au max et le cont a 1 if table 0 event y GT tailledimvar event y table 3 event y then begin widget_control widbase1 use_table_select 0 event y 1 event y set_value tailledimvar event y table 3 event y 1 ENDIF ELSE BEGIN si avec le nouvel offset le count est trop grand on le diminue juste de ce qu il faut if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then begin widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif ENDELSE END 1:BEGIN on a touche au count if table 1 event y LT 1 then BEGIN table 1 event y 1 widget_control widbase1 use_table_select 1 event y 1 event y set_value 1 endif si il est trop grand on le diminue juste de ce qu il faut if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then BEGIN widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif END 2:BEGIN on a touche au shift widget_control widbase1 use_table_select 2 event y 2 event y set_value table 2 event y MOD tailledimvar event y table 3 event y END 3:BEGIN on touche au stride if table 3 event y LT 1 then BEGIN table 3 event y 1 widget_control widbase1 use_table_select 3 event y 3 event y set_value 1 endif if table 3 event y EQ 0 then il ne doit pas etre nul widget_control widbase1 use_table_select 3 event y 3 event y set_value 1 il ne doit pas etre trop grand if table 3 event y GT tailledimvar event y then widget_control widbase1 use_table_select 0 event y 3 event y set_value 0 1 0 tailledimvar event y ELSE BEGIN if table 1 event y GT tailledimvar event y table 3 event y table 0 event y then begin widget_control widbase1 use_table_select 1 event y 1 event y set_value tailledimvar event y table 3 event y table 0 event y endif ENDELSE END ELSE: endcase END 2111:BEGIN on a touche aux boutons oui non on actualise le vecteur selectatt a 0 ou 1 pour l attribut concerne numero event id selectatt where widbase2111 EQ event id event select end 31:BEGIN on a appuye sur get widget_control widbase1 get_value table table fix table mcshift where table 2 NE 0 mcoffset table 0 mccount table 1 mcstride table 3 if mcshift 0 NE 1 then BEGIN il y a des shifts on lit l integralite des dimensions pour lesquelles il y a un shift mcoffset mcshift 0 mccount mcshift tailledimvar mcshift on active pas stride qd il n y en a pas besoin car ca fait ecrire a l ecran qqch de louche if total mcstride EQ n_elements mcstride then ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount ELSE ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount STRIDE mcstride pour faire le shift mcshift table 2 mcoffset table 0 mccount table 1 on definit commende qui permet de faire un shift commande res shift res for dim 0 varcontient ndims 1 do commande commande string table 2 dim commande commande rien execute commande on redefinit commnade qui permet de couper les dimensions qui n ont pas ete encore coupees c est celles que l on shift commande res res initialisation de la commende for dim 0 varcontient ndims 1 do BEGIN if mcshift dim EQ 0 then commande commande ELSE commande commande string mcoffset dim : string mccount dim mcoffset dim 1 ENDFOR commande strmid commande 0 strlen commande 1 rien execute commande cas sans shift on lit directement le bon bout de tableau ENDIF ELSE BEGIN if total mcstride EQ n_elements mcstride then ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount ELSE ncdf_varget cdfid varid res OFFSET mcoffset COUNT mccount STRIDE mcstride ENDELSE faut il constituer une structure avec les attributs qui on ete selectionnes if total selectatt NE 0 then BEGIN il y a des attributs selectionnes res create_struct varcontient name res on cree la structure selectatt where selectatt EQ 1 on trouve les attributs selectiones for attid 0 n_elements selectatt 1 do BEGIN pour lesquels on prend widget_control widbase212 selectatt attid get_value attname le nom widget_control widbase213 selectatt attid get_value attvalue la valeur res create_struct res attname 0 attvalue 0 on concatene la structe endfor endif widget_control event top destroy on ferme le 2eme widget widget_control base destroy on ferme le 1eme widget ncdf_close cdfid END 32: cas de l affichage d un held avec xdisplayfile 33:widget_control event top destroy on ferme le 2eme widget ELSE: endcase return end PRO wid_var widid_pere NAME: wid_var PURPOSE: cette procedure gere le 2eme widget cree qd on appelle xncdf_lec ce widget concerne la lecture de la variable INPUTS: widid_pere: un scalere contenant l identite du widget pere qui a etait cree par xncdf_lec et qui a permis de selectionner la variable a lire OUTPUTS: indirectement res le tableau ou la structure resultat COMMON BLOCKS:resultat infovariable indicewid_var motcle COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON indicewid_var widbase1 widbase2111 widbase212 widbase213 selectatt COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar res 1 ouverture de la fenetre de base sous forme de colonnes widbase widget_base column title variable: varcontient name align_center group_leader widid_pere ouverture de sous fenetres de base widbase1 tableau des offsets rien widget_label widbase value on saute une ligne defintion des lables des lignes du tableau rowlab string tailledim varcontient dim for i 0 n_elements rowlab 1 do rowlab i strtrim rowlab i 1 rowlab nomdim varcontient dim replicate : n_elements varcontient dim rowlab definition des valeurs initiales du tableau valinit lonarr 4 n_elements varcontient dim colonne 0 : les offset if keyword_set mcoffset AND n_elements mcoffset EQ varcontient ndims THEN valinit 0 mcoffset ELSE valinit 0 0 colonne 1 : les counts if keyword_set mccount AND n_elements mccount EQ varcontient ndims THEN valinit 1 mccount ELSE valinit 1 tailledim varcontient dim colonne 2 : les shifts if keyword_set mcshift AND n_elements mcshift EQ varcontient ndims THEN valinit 2 mcshift ELSE valinit 2 0 colonne 3 : les strides if keyword_set mcstride AND n_elements mcstride EQ varcontient ndims THEN valinit 3 mcstride ELSE valinit 3 1 test des valeurs initiales du tableau valinit fix valinit valinit 3 1 valinit 3 valinit 0 valinit 1 tailledim varcontient dim valinit 3 valinit 0 valinit 2 valinit 2 MOD tailledim varcontient dim valinit 3 test des shifts declaration du tableau widbase1 widget_table widbase row_labels rowlab value valinit editable column_labels Offset Count Shift Stride uvalue 1 un petit blabla rien widget_label widbase value ATTENTION: Faire des return pour que les valeurs align_center rien widget_label widbase value du tableau ou des textes soient bien prises en compte align_center widbase2 choix des attributs rien widget_label widbase value on saute une ligne widbase2 widget_base widbase column pour chaque attribut on cree un widget widbase21 qui contient en ligne un bouton oui non widbase211 et deux wigdet text widbase212 widbase213 comportant le nom et la valeur de l attribut widbase21 lonarr varcontient natts widbase211 lonarr varcontient natts widbase2111 lonarr varcontient natts vecteur qui serviera a savoir quels boutons oui non sont selectiones cf wid_var_event selectatt lonarr varcontient natts selectatt 0 widbase212 lonarr varcontient natts widbase213 lonarr varcontient natts for attid 0 varcontient natts 1 do BEGIN boucle sur le nombre d attributs widbase21 attid widget_base widbase2 row name ncdf_attname cdfid varid attid ncdf_attget cdfid varid name value widbase211 attid widget_base widbase21 attid nonexclusive widbase2111 attid widget_button widbase211 attid value uvalue 2111 widbase212 attid widget_text widbase21 attid value name editable widbase213 attid widget_text widbase21 attid value strtrim string value 1 editable endfor widbase3 boutons du bas widbase3 widget_base widbase row align_center widbase31 widget_button widbase3 value GET uvalue 31 widbase32 widget_button widbase3 value Help uvalue 32 widbase33 widget_button widbase3 value DONE uvalue 33 execution de la fentre de base et des sous fenetres widget_control widbase realize xmanager wid_var widbase return end PRO xncdf_lec_event event NAME:xncdf_lec_event PURPOSE: procedure appele par xmanager qd on appuie sur un bouton du 1ere widget cree par xncdf_lec INPUTS: event une structure caracterisant le type d evenement qui arrive au widget numero1 COMMON BLOCKS:resultat infovariable motcle COMMON resultat res COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar quel est le type d evenement widget_control event id get_uvalue uval case sur le type d evenement case uval of 1:BEGIN on veut lire un autre fichier widget_control event id get_value nom on recupere le nom widget_control event top destroy on ferme le widget ncdf_close cdfid on ferme le mauvais fichier qui a ete ouvert on reapelle xncdf_lec res xncdf_lec nom 0 ATT mcatt COUNT mccount OFFSET mcoffset IODIR mciodir SHIFT mcshift STRIDE mcstride VAR mcvar return END 2:BEGIN une variable est selectionee varid event index on recupere son numero ds le fichier Netcdf varcontient ncdf_varinq cdfid varid wid_var event top on appelle le programme qui lance le 2eme widget cf haut END 3:BEGIN bouton done widget_control event top destroy on tue le widget ncdf_close cdfid on ferme le fichier END ELSE: endcase return end NAME: xncdf_lec PURPOSE: lecture d un fichier Net Cdf avec des widgets CATEGORY: lecture de fichiers avec widgets CALLING SEQUENCE: res xncdf_lec nom_fichier INPUTS: OPTIONNEL nom_fichier: c est un string qui donne le nom du fichier a ouvrir Si nomfichier ne contient pas le caractere separateur de repertoirte sous unix par ex Le fichier sera cherche ds le repertoire courant KEYWORD PARAMETERS: IODIR: string contenant le repertoire ou aller chercher le fichier a lire Si nomfichier ne contient pas le caractere separateur de repertoirte sous unix par ex Le fichier cherche s appelera iodir nom_fichier COUNT: An optional vector containing the counts to be used in reading Value COUNT is a 1 based vector with an element for each dimension of the data to be written The default matches the size of the variable so that all data is written out GROUP: The widget ID of the widget that calls XNCDF_LEC When this ID is specified a death of the caller results in a death of XNCDF_LEC OFFSET: An optional vector containing the starting position for the read The default start position is 0 0 SHIFT: un vecteur d entiers specifiant pour chaque dimension de combien il faut la shifter Par defaut c est 0 0 cf la fonction shift pour d explications ATTENTION le shift est effectue sur le tableau de taille maximum avant la reduction eventuelle determinee par OFFSET et COUNT Par contre il est effectue apres l extraction eventuelle cree par le STRIDE STRIDE: An optional vector containing the strides or sampling intervals between accessed values of the netCDF variable The default stride vector is that for a contiguous read 1 1 OUTPUTS: 2 cas possibles: 1 aucun attributs n a ete selectionne Dans ce cas res est le tableau que l on voulait lire 2 Des attributs ont ete selectionnes Dans ce cas res est une structre dont le premier element portant le nom de la variable est le tableau de valeurs et les autre auguments sont les arguments selectiones COMMON BLOCKS: wididbase infovariable resultat motcle SIDE EFFECTS: RESTRICTIONS: EXAMPLE: help xncdf_lec MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 24 8 1999 FUNCTION xncdf_lec nom ATT att COUNT count GROUP group OFFSET offset IODIR iodir SHIFT shift STRIDE stride VAR var COMMON wididbase base COMMON infovariable cdfid listename contient nomdim tailledim varid varcontient COMMON resultat res COMMON motcle mcatt mccount mcoffset mciodir mcshift mcstride mcvar bidouille pour utiliser les mots cles on passe par des variables declarees ds un common res 1 if keyword_set att then mcatt att ELSE mcatt 0 if keyword_set count then mccount count ELSE mccount 0 if keyword_set offset then mcoffset offset ELSE mcoffset 0 if keyword_set shift then mcshift shift ELSE mcshift 0 if keyword_set stride then mcstride stride ELSE mcstride 0 if keyword_set var then mcvar var ELSE mcvar 0 choix du nom du fichier Quel type de machine est utiliee thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :sep : WIN :sep ELSE: sep ENDCASE si iodir n est pas definit on l initialise au repertoire courant if NOT keyword_set iodir then cd current iodir mciodir iodir on complete iodir d un caractere separateur de repertoire si besoin est IF rstrpos iodir sep NE strlen iodir 1 THEN iodir iodir sep if n_elements nom EQ 0 then BEGIN si nom n est pas definit on en trouve un grace au programme dialog_pickfile nom dialog_pickfile filter iodir nc if nom 0 EQ then return 1 si on a rien trouve on sort on complete nom par iodir si nom ne contient pas de caractere separateur derepertoire ENDIF ELSE if strpos nom sep EQ 1 then nom iodir nom test findfile nom le nom cherche correspond bien a un fichier while test 0 EQ OR n_elements test GT 1 do BEGIN on en cherche un tant qu il ne correspond a rien test test 0 nom dialog_pickfile filter iodir nc if nom EQ then return 1 test findfile nom endwhile ouverture du fichier nom cdfid ncdf_open nom contient ncdf_inquire cdfid que contient le fichier ouverture de la fenetre de base sous forme de colonnes if n_elements group EQ 0 then base widget_base column title Fichier: nom align_left ELSE base widget_base column title Fichier: nom align_left GROUP_LEADER group ouverture de sous fenetres de base base 1 titre portant le nom du fichier base1 widget_base base column align_center rien widget_label base1 value Net Cdf filename align_center blabla rien widget_text base1 value nom align_center uvalue 1 editable nom du fichier que l on peut changer rien widget_label base1 value on saute une ligne base 2 informations generales sur le fichier base2 widget_base base column informations sur les attributs globaux if contient ngatts NE 1 then begin rien widget_label base2 value Nombre de attributs globaux: strtrim contient ngatts 1 align_left for attiq 0 contient ngatts 1 do BEGIN bouble sur le nombre d attributs globaux name ncdf_attname cdfid attiq global nom de l atribut ncdf_attget cdfid name value global valeur de l atribut rien widget_text base2 value name : strtrim string value 1 xsize 60 scroll wrap align_right endfor rien widget_label base2 value endif informations sur les dimensions rien widget_label base2 value Nombre de dimensions: strtrim contient ndims 1 align_left if contient recdim NE 1 then begin bouble sur le nombre de dimensions ncdf_diminq cdfid contient recdim name value nom et valeur de la dimension rien widget_label base2 value nom de la dimension infinie: name align_left endif nomdim strarr contient ndims vecteur contenant le nom des dimensions tailledim lonarr contient ndims vecteur contenant la valeur des dimensions for dimiq 0 contient ndims 1 do begin bouble sur le nombre de dimensions ncdf_diminq cdfid dimiq name value nom et valeur de la dimension nomdim dimiq name tailledim dimiq value rien widget_label base2 value name de taille: strtrim value 1 align_right ENDFOR rien widget_label base2 value on saute une ligne base 3 choix de la variable base3 widget_base base column rien widget_label base3 value Nombre de variables: strtrim contient nvars 1 align_left base31 widget_base base3 row align_center creation d un vecteur listename contenant le nom de toutes les variables du fichier listename strarr contient nvars for varid 0 contient nvars 1 do begin varcontient ncdf_varinq cdfid varid que contient la variable listename varid varcontient name endfor rien widget_label base31 value variable creation d un bouton a menu deroulant base311 widget_droplist base31 value listename uvalue 2 rien widget_label base3 value base 4 bouton done base4 widget_base base row base42 widget_button base4 value done uvalue 3 align_right execution de la fentre de base et des sous fenetres widget_control base realize xmanager xncdf_lec base return res end"); 235 a[233] = new Array("./ToBeReviewed/MATRICE/cmapply.html", "cmapply.pro", "", " NAME: CMAPPLY AUTHOR: Craig B Markwardt NASA GSFC Code 662 Greenbelt MD 20770 craigm lheamail gsfc nasa gov PURPOSE: Applies a function to specified dimensions of an array MAJOR TOPICS: Arrays CALLING SEQUENCE: XX CMAPPLY OP ARRAY DIMS DOUBLE TYPE TYPE DESCRIPTION: CMAPPLY will apply one of a few select functions to specified dimensions of an array Unlike some IDL functions you do have a choice of which dimensions that are to be collapsed by this function Iterative loops are avoided where possible for performance reasons The possible functions are: and number of loop iterations: Performs a sum as in TOTAL number of collapsed dimensions AND Finds LOGICAL AND not bitwise same OR Finds LOGICAL OR not bitwise same Performs a product LOG_2 no of collapsed elts MIN Finds the minimum value smaller of no of collapsed MAX Finds the maximum value or output elements USER Applies user defined function no of output elements It is possible to perform user defined operations arrays using CMAPPLY The OP parameter is set to USER:FUNCTNAME where FUNCTNAME is the name of a user defined function The user defined function should be defined such that it accepts a single parameter a vector and returns a single scalar value Here is a prototype for the function definition: FUNCTION FUNCTNAME x KEYWORD1 key1 scalar function of x or keywords RETURN scalar END The function may accept keywords Keyword values are passed in to CMAPPLY through the FUNCTARGS keywords parameter and passed to the user function via the _EXTRA mechanism Thus while the definition of the user function is highly constrained in the number of positional parameters there is absolute freedom in passing keyword parameters It s worth noting however that the implementation of user defined functions is not particularly optimized for speed Users are encouraged to implement their own array if the number of output elements is large INPUTS: OP The operation to perform as a string May be upper or lower case If a user defined operation is to be passed then OP is of the form USER:FUNCTNAME where FUNCTNAME is the name of the user defined function ARRAY An array of values to be operated on Must not be of type STRING 7 or STRUCTURE 8 OPTIONAL INPUTS: DIMS An array of dimensions that are to be collapsed where the the first dimension starts with 1 ie same convention as IDL function TOTAL Whereas TOTAL only allows one dimension to be added you can specify multiple dimensions to CMAPPLY Order does not matter since all operations are associative and transitive NOTE: the dimensions refer to the input array not the output array IDL allows a maximum of 8 dimensions DEFAULT: 1 ie first dimension KEYWORDS: DOUBLE Set this if you wish the internal computations to be done in double precision if necessary If ARRAY is double precision real or complex then DOUBLE 1 is implied DEFAULT: not set TYPE Set this to the IDL code of the desired output type refer to documentation of SIZE Internal results will be rounded to the nearest integer if the output type is an integer type DEFAULT: same is input type FUNCTARGS If OP is USER: then the contents of this keyword are passed to the user function using the _EXTRA mechanism This way you can pass additional data to your user supplied function via keywords without using common blocks DEFAULT: undefined i e no keywords passed by _EXTRA RETURN VALUE: An array of the required TYPE whose elements are the result of the requested operation Depending on the operation and number of elements in the input array the result may be vulnerable to overflow or underflow EXAMPLES: Shows how CMAPPLY can be used to total the second dimension of the array called IN This is equivalent to OUT TOTAL IN 2 IDL IN INDGEN 5 5 IDL OUT CMAPPLY IN 2 IDL HELP OUT OUT INT Array 5 Second example Input is assumed to be an 5x100 array of 1 s and 0 s indicating the status of 5 detectors at 100 points in time The desired output is an array of 100 values indicating whether all 5 detectors are on 1 at one time Use the logical AND operation IDL IN detector_status 5x100 array IDL OUT CMAPPLY AND IN 1 collapses 1st dimension IDL HELP OUT OUT BYTE Array 100 note that MIN could also have been used in this particular case although there would have been more loop iterations Third example Shows sum over first and third dimensions in an array with dimensions 4x4x4: IDL IN INDGEN 4 4 4 IDL OUT CMAPPLY IN 1 3 IDL PRINT OUT 408 472 536 600 Fourth example A user function MEDIAN is used: IDL IN RANDOMN SEED 10 10 5 IDL OUT CMAPPLY USER:MEDIAN IN 3 IDL HELP OUT OUT FLOAT Array 10 10 OUT i j is the median value of IN i j MODIFICATION HISTORY: Mar 1998 Written CM Changed usage message to not bomb 24 Mar 2000 CM Signficant rewrite for MIN and MAX inspired by Todd Clements FOR loop indices are now type LONG copying terms are liberalized CM 22 Aug 2000 More efficient MAX MIN inspired by Alex Schuster CM 25 Jan 2002 Make new MAX MIN actually work with 3d arrays CM 08 Feb 2002 Add user defined functions ON_ERROR CM 09 Feb 2002 Correct bug in MAX MIN initialization of RESULT CM 05 Dec 2002 Id: cmapply pro 31 2006 05 02 13:54:11Z pinsard Copyright C 1998 2000 2002 Craig Markwardt This software is provided as is without any warranty whatsoever Permission to use copy modify and distribute modified or unmodified copies is granted provided this copyright and disclaimer are included unchanged Utility function adapted from CMPRODUCT function cmapply_product x sz size x n sz 1 while n GT 1 do begin if n mod 2 EQ 1 then x 0 x 0 x n 1 n2 floor n 2 x x 0:n2 1 x n2: n n2 endwhile return reform x 0 overwrite end Utility function used to collect collaped dimensions pro cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep sz size newarr First task: rearrange dimensions so that the dimensions that are kept ie uncollapsed are at the back dimkeep where histogram dimapply min 1 max sz 0 ne 1 nkeep if nkeep EQ 0 then return newarr transpose temporary newarr dimapply 1 dimkeep totcol is the total number of collapsed elements totcol sz dimapply 0 for i 1 n_elements dimapply 1 do totcol totcol sz dimapply i totkeep sz dimkeep 0 1 for i 1 n_elements dimkeep 1 do totkeep totkeep sz dimkeep i 1 this new array has two dimensions: the first all elements that will be collapsed the second all dimensions that will be preserved the ordering is so that all elements to be collapsed are adjacent in memory newarr reform newarr totcol totkeep overwrite end Main function function cmapply op array dimapply double dbl type type functargs functargs nocatch nocatch if n_params LT 2 then begin message USAGE: XX CMAPPLY OP ARRAY 2 info message where OP is AND OR MIN MAX info return 1L endif if NOT keyword_set nocatch then on_error 2 else on_error 0 Parameter checking 1 the dimensions of the array sz size array if sz 0 EQ 0 then message ERROR: ARRAY must be an array 2 The type of the array if sz sz 0 1 EQ 0 OR sz sz 0 1 EQ 7 OR sz sz 0 1 EQ 8 then message ERROR: Cannot apply to UNDEFINED STRING or STRUCTURE if n_elements type EQ 0 then type sz sz 0 1 3 The type of the operation szop size op if szop szop 0 1 NE 7 then message ERROR: operation OP was not a string 4 The dimensions to apply default is to apply to first dim if n_params EQ 2 then dimapply 1 dimapply dimapply dimapply dimapply sort dimapply Sort in ascending order napply n_elements dimapply 5 Use double precision if requested or if needed if n_elements dbl EQ 0 then begin dbl 0 if type EQ 5 OR type EQ 9 then dbl 1 endif newop strupcase op newarr array newarr reform newarr sz 1:sz 0 overwrite case 1 of Addition newop EQ : begin for i 0L napply 1 do begin newarr total temporary newarr dimapply i i double dbl endfor end Multiplication newop EQ : begin Multiplication by summation of logarithms cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin newarr reform newarr n_elements newarr 1 overwrite return cmapply_product newarr 0 endif result cmapply_product newarr result reform result sz dimkeep 1 overwrite return result end LOGICAL AND or OR newop EQ AND OR newop EQ OR : begin newarr temporary newarr NE 0 totelt 1L for i 0L napply 1 do begin newarr total temporary newarr dimapply i i totelt totelt sz dimapply i endfor if newop EQ AND then return round newarr EQ totelt if newop EQ OR then return round newarr NE 0 end Operations requiring a little more attention over how to iterate newop EQ MAX OR newop EQ MIN : begin cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin if newop EQ MAX then return max newarr if newop EQ MIN then return min newarr endif Next task: create result array result make_array totkeep type type Now either iterate over the number of output elements or the number of collapsed elements whichever is smaller if totcol LT totkeep then begin Iterate over the number of collapsed elements result 0 reform newarr 0 totkeep overwrite case newop of MAX : for i 1L totcol 1 do result 0 result newarr i MIN : for i 1L totcol 1 do result 0 result newarr i endcase endif else begin Iterate over the number of output elements case newop of MAX : for i 0L totkeep 1 do result i max newarr i MIN : for i 0L totkeep 1 do result i min newarr i endcase endelse result reform result sz dimkeep 1 overwrite return result end User function strmid newop 0 4 EQ USER : begin functname strmid newop 5 if functname EQ then message ERROR: newop is not a valid operation cmapply_redim newarr dimapply dimkeep nkeep totcol totkeep if nkeep EQ 0 then begin if n_elements functargs GT 0 then return call_function functname newarr _EXTRA functargs return call_function functname newarr endif Next task: create result array result make_array totkeep type type Iterate over the number of output elements if n_elements functargs GT 0 then begin for i 0L totkeep 1 do result i call_function functname newarr i _EXTRA functargs endif else begin for i 0L totkeep 1 do result i call_function functname newarr i endelse result reform result sz dimkeep 1 overwrite return result end endcase newsz size newarr if type EQ newsz newsz 0 1 then return newarr Cast the result into the desired type if necessary castfns UNDEF BYTE FIX LONG FLOAT DOUBLE COMPLEX UNDEF UNDEF DCOMPLEX if type GE 1 AND type LE 3 then return call_function castfns type round newarr else return call_function castfns type newarr end "); 236 a[234] = new Array("./ToBeReviewed/MATRICE/cmset_op.html", "cmset_op.pro", "", " NAME: CMSET_OP AUTHOR: Craig B Markwardt NASA GSFC Code 662 Greenbelt MD 20770 craigm lheamail gsfc nasa gov PURPOSE: Performs an AND OR or XOR operation between two sets CALLING SEQUENCE: SET CMSET_OP A OP B DESCRIPTION: SET_OP performs three common operations between two sets The three supported functions of OP are: OP Meaning AND to find the intersection of A and B OR to find the union of A and B XOR to find the those elements who are members of A or B but not both Sets as defined here are one dimensional arrays composed of numeric or string types Comparisons of equality between elements are done using the IDL EQ operator The complements of either set can be taken as well by using the NOT1 and NOT2 keywords For example it may be desireable to find the elements in A but not B or B but not A they are different The following IDL expressions achieve each of those effects: SET CMSET_OP A AND NOT2 B A but not B SET CMSET_OP NOT1 A AND B B but not A Note the distinction between NOT1 and NOT2 NOT1 refers to the first set A and NOT2 refers to the second B Their ordered placement in the calling sequence is entirely optional but the above ordering makes the logical meaning explicit NOT1 and NOT2 can only be set for the AND operator and never simultaneously This is because the results of an operation with OR or XOR and any combination of NOTs or with AND and both NOTs formally cannot produce a defined result The implementation depends on the type of operands For integer types a fast technique using HISTOGRAM is used However this algorithm becomes inefficient when the dynamic range in the data is large For those cases and for other data types a technique based on SORT is used Thus the compute time should scale roughly as A B ALOG A B or better rather than A B for the brute force approach For large arrays this is a significant benefit INPUTS: A B the two sets to be operated on A one dimensional array of either numeric or string type A and B must be of the same type Empty sets are permitted and are either represented as an undefined variable or by setting EMPTY1 or EMPTY2 OP a string the operation to be performed Must be one of AND OR or XOR lower or mixed case is permitted Other operations will cause an error message to be produced KEYWORDS: NOT1 NOT2 if set and OP is AND then the complement of A for NOT1 or B for NOT2 will be used in the operation NOT1 and NOT2 cannot be set simultaneously EMPTY1 EMPTY2 if set then A for EMPTY1 or B for EMPTY2 are assumed to be the empty set The actual values passed as A or B are then ignored INDEX if set then return a list of indices instead of the array values themselves The slower set operations are always performed in this case The indices refer to the combined array A B To clarify in the following call: I CMSET_OP INDEX returned values from 0 to NA 1 refer to A I and values from NA to NA NB 1 refer to B I NA COUNT upon return the number of elements in the result set This is only important when the result set is the empty set in which case COUNT is set to zero RETURNS: The resulting set as a one dimensional array The set may be represented by either an array of data values default or an array of indices if INDEX is set Duplicate elements if any are removed and element order may not be preserved The empty set is represented as a return value of 1L and COUNT is set to zero Note that the only way to recognize the empty set is to examine COUNT SEE ALSO: SET_UTILS PRO by RSI MODIFICATION HISTORY: Written CM 23 Feb 2000 Added empty set capability CM 25 Feb 2000 Documentation clarification CM 02 Mar 2000 Incompatible but more consistent reworking of EMPTY keywords CM 04 Mar 2000 Minor documentation clarifications CM 26 Mar 2000 Corrected bug in empty_arg special case CM 06 Apr 2000 Add INDEX keyword CM 31 Jul 2000 Clarify INDEX keyword documentation CM 06 Sep 2000 Made INDEX keyword always force SLOW_SET_OP CM 06 Sep 2000 Added CMSET_OP_UNIQ and ability to select FIRST_UNIQUE or LAST_UNIQUE values CM 18 Sep 2000 Removed FIRST_UNIQUE and LAST_UNIQUE and streamlined CMSET_OP_UNIQ until problems with SORT can be understood CM 20 Sep 2000 thanks to Ben Tupper Still trying to get documentation of INDEX and NOT right CM 28 Sep 2000 no code changes Correct bug for AND case when input sets A and B each only have one unique value and the values are equal CM 04 Mar 2004 thanks to James B jbattat at cfa dot harvard dot edu Add support for the cases where the input data types are mixed but still compatible also attempt to return the same data type that was passed in CM 05 Feb 2005 Fix bug in type checking thanks to marit CM 10 Dec 2005 Work around a stupidity in the built in IDL HISTOGRAM routine which tries to help you by restricting the MIN MAX to the range of the input variable thanks to Will Maddox CM 16 Jan 2006 Id: cmset_op pro v 1 6 2006 01 16 19:45:22 craigm Exp Copyright C 2000 2004 2005 2006 Craig Markwardt This software is provided as is without any warranty whatsoever Permission to use copy modify and distribute modified or unmodified copies is granted provided this copyright and disclaimer are included unchanged Utility function similar to UNIQ but allowing choice of taking first or last unique element or non unique elements Unfortunately this doesn t work because of implementation dependent versions of the SORT function function cmset_op_uniq a first first non non count ct sort sortit if n_elements a LE 1 then return 0L sh 2L keyword_set first 1L 2L keyword_set non 1 if keyword_set sortit then begin Sort it manually ii sort a b a ii if keyword_set non then wh where b EQ shift b sh ct else wh where b NE shift b sh ct if ct GT 0 then return ii wh endif else begin Use the user s values directly if keyword_set non then wh where a EQ shift a sh ct else wh where a NE shift a sh ct if ct GT 0 then return wh endelse if keyword_set first then return 0L else return n_elements a 1 end Simplified version of CMSET_OP_UNIQ which sorts and takes the first value whatever that may mean function cmset_op_uniq a if n_elements a LE 1 then return 0L ii sort a b a ii wh where b NE shift b 1L ct if ct GT 0 then return ii wh return 0L end function cmset_op a op0 b not1 not1 not2 not2 count count empty1 empty1 empty2 empty2 maxarray ma index index on_error 2 return on error count 0L index0 1L Histogram technique is used for array sizes max2 nbins maxx minn 1 if maxx minn GT floor ma 0 then goto SLOW_SET_OP Work around a stupidity in the built in IDL HISTOGRAM routine if tp1 EQ 2 OR tp2 EQ 2 AND minn LT 32768 OR maxx GT 32767 then goto SLOW_SET_OP Following operations create a histogram of the integer values ha histogram a min minn max maxx 1 hb histogram b min minn max maxx 1 Compute NOT cases if keyword_set not1 then ha 1b ha if keyword_set not2 then hb 1b hb case op of Boolean operations AND : mask temporary ha AND temporary hb OR : mask temporary ha OR temporary hb XOR : mask temporary ha XOR temporary hb endcase wh where temporary mask count if count EQ 0 then return 1L result temporary wh minn if tp1 NE tp2 then return result szr size result tpr szr szr 0 1 Cast to the original type if necessary if tpr NE tp1 then begin fresult make_array n_elements result type tp1 fresult 0 temporary result result temporary fresult endif return result endelse return 1L DEFAULT CASE end Here is how I did the INDEX stuff with fast histogramming It works but is complicated so I forced it to go to SLOW_SET_OP ha histogram a min minn max maxx reverse ra 1 rr ra 0:nbins mask rr NE rr 1: ra ra rr mask 1L mask hb histogram b min minn max maxx reverse rb 1 rr rb 0:nbins mask rr NE rr 1: rb rb rr mask 1L mask AND OR XOR NOT masking here ra ra wh rb rb wh return ra ra GE 0 rb n1 ra LT 0 is last ra right "); 237 a[235] = new Array("./ToBeReviewed/MATRICE/colle.html", "colle.pro", "", " NAME:colle PURPOSE: Cette fonction de concatenation existe ds IDL avec cf ds le programme ds le case pour direc egale 1 2 3 tant que l on ne cherche pas a coller suivant une dimensionsuperieure ou egale a 4 CATEGORY:bidouillage de matrice CALLING SEQUENCE:res colle bableau_de_pointeur direc ou bien res colle tab1 tab2 tab3 tab4 direc INPUTS: CAS 1: tableau_de_pointeur:comme son nom l indique c est un tableau de pointeur dont chaque elements pointe sur tableau a coller par ex ds un programme on veut coller n tableaux entre eux tab ptrarr n allocate_heap for i 0 n 1 do begin tab n replicate n 2 3 endfor res colle tab 1 CAS 2: on donne directement les tableaux a coller rq: ds ce cas on peut au plus donner 20 tableaux en entree ATTENTION : sans le mot cle SAUVE les arguments en entree sont detruits lorsque l on construit res ds le cas 1 on detruit le tableau de pointeurs et les variables sur lesquelles on pointe direc: la direction suivant laquelle les coller 1 2 3 KEYWORD PARAMETERS: SAUVE: mot cle qui force a sauvegarder le tableau de pointeur et les tableaux a coller OUTPUTS:res matrice resultat RESTRICTIONS: EXAMPLE: IDL print colle replicate 1 2 2 2 indgen 2 2 2 2 1 1 1 1 0 1 2 3 1 1 1 1 4 5 6 7 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 13 1 98 pour suprimer une variable PRO UNDEFINE varname tempvar SIZE TEMPORARY varname END FUNCTION colle a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 SAUVE sauve res 1 on met en place ptrtab et direc en fonction des arguments en entree case 1 of n_params EQ 2:BEGIN cas ou l on donne directement le tableau de pointeurs ptrtab a0 direc a1 if NOT keyword_set sauve then undefine a0 on recupere le nombre de tableaux a coller nbretab size ptrtab 1 end n_params GT 2:BEGIN on recupere le nombre de tableaux a coller nbretab n_params 1 bidon execute direc a strtrim n_params 1 2 on ecrit le tableau de pointeur dont chaque element pointe sur un tableau ptrtab ptrarr nbretab allocate_heap for n 0 nbretab 1 do begin bidon execute ptrtab n a strtrim n 2 if NOT keyword_set sauve then bidon execute undefine a strtrim n 2 endfor sauve 0 end ELSE: endcase case sur la valeure de direc case direc of 1:BEGIN on colle suivant la dimension 1 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END 2:BEGIN on colle suivant la dimension 2 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END 3:BEGIN on colle suivant la dimension 3 res ptrtab 0 if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN res temporary res ptrtab n if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR END ELSE:BEGIN on transpose res de facon a mettre la dimension a coller numero 1 pour cela on contient le vecteur permute qui donne la place que doivent prendre les dimensions ds la matrice transposee siz size ptrtab 0 0 if siz LT direc then ptrtab 0 reform ptrtab 0 size ptrtab 0 1:siz replicate 1 direc siz over permute indgen size ptrtab 0 0 permute 0 direc 1 permute direc 1 0 res transpose ptrtab 0 permute if NOT keyword_set sauve then ptr_free ptrtab 0 FOR n 1 nbretab 1 DO BEGIN on colle suivant la dimension 1 if size ptrtab n 0 LT direc then ptrtab n reform ptrtab n size ptrtab n 1:siz replicate 1 direc siz res temporary res transpose ptrtab n permute if NOT keyword_set sauve then ptr_free ptrtab n ENDFOR res transpose temporary res permute END ENDCASE if NOT keyword_set sauve then undefine ptrtab sortie: return res END "); 238 a[236] = new Array("./ToBeReviewed/MATRICE/congridseb.html", "congridseb.pro", "", " NAME:CONGRIDSEB PURPOSE:meme chose que congrid mais qui marche cf par ex: IDL print congrid 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 3 4 4 1 1 1 2 2 2 3 3 3 3 4 4 5 5 5 6 6 6 7 7 7 7 8 8 5 5 5 6 6 6 7 7 7 7 8 8 IDL print rebin 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 4 4 4 3 3 3 4 4 4 5 5 5 6 6 6 5 5 5 6 6 6 7 7 7 8 8 8 5 5 5 6 6 6 7 7 7 8 8 8 IDL print congridseb 1 2 3 4 5 6 7 8 12 4 1 1 1 2 2 2 3 3 3 4 4 4 1 1 1 2 2 2 3 3 3 4 4 4 5 5 5 6 6 6 7 7 7 8 8 8 5 5 5 6 6 6 7 7 7 8 8 8 CATEGORY:bidouille matrices CALLING SEQUENCE:res congridseb tableau x y INPUTS:tableau:un tableau 1 ou 2d x:dim en x du resultat doit etre un multiple de dim en x de tableau y:dim en y du resultat doit etre un multiple de dim en y de tableau KEYWORD PARAMETERS: OUTPUTS:res un tableau de dim x y COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 20 3 98 18 6 1999 supression d une horrible boucle function congridseb tableau x y res tableau taille size tableau CASE N_PARAMS OF 2: begin res replicate 1 1 x taille 1 res return res end 3: begin res transpose res res replicate 1 1 y taille 2 res res reform res y taille 1 over res transpose res res replicate 1 1 x taille 1 res return reform res x y overwrite end else: return report Mauvais nombre de parametre dans l appel de CONGRIDSEB endcase end"); 239 a[237] = new Array("./ToBeReviewed/MATRICE/different.html", "different.pro", "", " NAME:different PURPOSE:calcule les elements differents de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res different a b INPUTS:a et b:arrays of positive integers which need not be sorted Duplicate elements are ignored as they have no effect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 different a b 4 8 Elements in A but not in B MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION different a b a and not b elements in A but not in B mina Min a Max maxa minb Min b Max maxb IF minb GT maxa OR maxb LT mina THEN RETURN a No intersection r Where Histogram a Min mina Max maxa 1 Histogram b Min mina Max maxa count IF count eq 0 THEN RETURN 1 ELSE RETURN r mina END"); 240 a[238] = new Array("./ToBeReviewed/MATRICE/extrait.html", "extrait.pro", "", " NAME:extrait PURPOSE:extraction de sous domaines de matrices Meme si le sous domaine est troue cf : l exemple Par defaut IDL peut faire des extractions de sous domaines: IDL a indgen 5 5 IDL print a 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 IDL print a 0 2 3 15 17 IDL print a 0 2 0 2 5 7 10 12 15 17 20 22 mais IDL print a 0 2 3 4 15 22 alors que IDL print extrait a 0 2 3 4 15 17 20 22 CATEGORY:bidouille avec les matrices CALLING SEQUENCE:res extrait tab indicex indicey indicez indicet INPUTS: tab: un tableau 1 2 3 ou 4 d indicex: indicex peut avoir deux formes: 1 un vecteur contenant les indices des lignes a garder 2 le string dans ce cas touts les lignes sont gardees indicey z t: la meme chose que indicex mais pour les dimensions 2 3 et 4 rq: il faut autant de vecteurs indice que tab a de dimensions KEYWORD PARAMETERS: OUTPUTS: res: une matice 1 2 3 ou 4d extraite a partir de tab COMMON BLOCKS: SIDE EFFECTS:res 1 en cas d erreur RESTRICTIONS: EXAMPLE: j ai une matrice A de dim 2 je veux en extraire une petite matrice 2d interscetion de la ligne 2 3 et 7 et de la colonne 0 et 1 res extrait A 2 3 7 0 1 autre ex: IDL print a a b c d e f g h i IDL print extrait a 0 2 0 2 a c g i MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 12 1 1999 29 4 1999: correction d un bug et complement de l en tete FUNCTION extrait tab indicex indicey indicez indicet taille size tab test du nombre de parametres et de la nature de indice pour LE cas x if n_params NE taille 0 1 THEN return report il faut autant d indices que de dimension du tableau IF n_params GE 5 THEN BEGIN if size indicet type EQ 7 then indicet lindgen taille 4 ELSE indicet long indicet nt n_elements indicet ENDIF IF n_params GE 4 THEN BEGIN if size indicez type EQ 7 then indicez lindgen taille 3 ELSE indicez long indicez nz n_elements indicez ENDIF IF n_params GE 3 THEN BEGIN if size indicey type EQ 7 then indicey lindgen taille 2 ELSE indicey long indicey ny n_elements indicey ENDIF IF n_params GE 2 THEN BEGIN if size indicex type EQ 7 then indicex lindgen taille 1 ELSE indicex long indicex nx n_elements indicex ENDIF construction du tableau d indice et du resultat suivant la taille de tab case taille 0 of 1:res tab indicex 2:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey res tab indice END 3:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey indice temporary indice replicate 1 nz taille 1 taille 2 replicate 1 nx ny indicez res tab reform indice nx ny nz over END 4:BEGIN indice indicex replicate 1 ny taille 1 replicate 1 nx indicey indice temporary indice replicate 1 nz taille 1 taille 2 replicate 1 nx ny indicez indice temporary indice replicate 1 nt taille 1 taille 2 taille 3 replicate 1 nx ny nz indicet res tab reform indice nx ny nz nz over END endcase return res end"); 241 a[239] = new Array("./ToBeReviewed/MATRICE/inter.html", "inter.pro", "", " NAME:inter PURPOSE:calcule l intersection de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res inter a b INPUTS:a et b:arrays of positive integers which need not to be sorted Duplicate elements are ignored as they have noeffect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 inter a b 2 6 Common elements MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION inter a b case 1 of n_elements a EQ 0:return 1 n_elements b EQ 0:return 1 n_elements a EQ 1 AND n_elements b NE 1: if where b EQ a 0 0 EQ 1 then return 1 ELSE return a 0 n_elements b EQ 1 AND n_elements a NE 1: if where a EQ b 0 0 EQ 1 then return 1 ELSE return b 0 n_elements a EQ 1 AND n_elements b EQ 1: if where a 0 EQ b 0 0 EQ 1 then return 1 ELSE return a 0 ELSE: ENDCASE minab Min a Max maxa Min b Max maxb Only need intersection of ranges maxab maxa maxb If either set is empty or their ranges don t intersect: result NULL IF maxab LT minab OR maxab LT 0 THEN RETURN 1 r Where Histogram a Min minab Max maxab Histogram b Min minab Max maxab count IF count EQ 0 THEN RETURN 1 ELSE RETURN r minab END"); 242 a[240] = new Array("./ToBeReviewed/MATRICE/make_selection.html", "make_selection.pro", "", " Id: make_selection pro 31 2006 05 02 13:54:11Z pinsard NAME: MAKE_SELECTION function PURPOSE: Convert an array of selected values to an index array that identifies the selected values in a list or data array CATEGORY: Tools CALLING SEQUENCE: index MAKE_SELECTION NAMES SELNAMES keywords INPUTS: NAMES A list or array of values to choose from SELNAMES A list of selected values KEYWORD PARAMETERS: ONLY_VALID Return only indices of found values Values not found are skipped Default is to return 1 index value for each SELNAME which is 1 if SELNAME is not contained in NAMES If ONLY_VALID is set the 1 values will be deleted and a value of 1 indicates that no SELNAME has been found at all REQUIRED Normally MAKE_SELECTION will return indices for all values that are found simply ignoring the selected values that are not in the NAMES array although an error message is displayed Set this keyword to return with 1 as soon as a selected value is not found QUIET Suppress printing of the error message if a selected value is not found the error condition will still be set OUTPUTS: A long array with indices to reference the selected values in the NAMES array SUBROUTINES: REQUIREMENTS: NOTES: If the NAMES array contains multiple entries of the same value only the index to the first entry will be returned A selection can contain multiple instances of the same value The index array will contain one entry per selected item See example below EXAMPLE: names Alfred Anton Peter John Mary index MAKE_SELECTION names Peter Mary print index prints 2 4 vals indgen 20 index MAKE_SELECTION vals 9 5 8 7 7 8 9 print index prints 9 1 8 7 7 8 9 index MAKE_SELECTION vals 9 5 8 7 7 8 9 ONLY_VALID print index prints 9 8 7 7 8 9 index MAKE_SELECTION vals 9 5 8 7 7 8 9 REQUIRED print index prints 1 MODIFICATION HISTORY: mgs 28 Aug 1998: VERSION 1 00 mgs 29 Aug 1998: changed behaviour and added ONLY_VALID keyword Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine make_selection function make_selection names selnames only_valid only_valid required required quiet quiet return an index array with a number for each element in selnames that is found in names Set the REQUIRED keyword to return 1 if one element is not found otherwise 1 will only be returned if no element is found reset error state to 0 message reset quiet keyword_set quiet result 1L for i 0 n_elements selnames 1 do begin test where names eq selnames i result result test 0 if test 0 lt 0 then begin if keyword_set ONLY_VALID OR keyword_set REQUIRED then message Selected name not found in names array strtrim selnames i 2 CONT NOPRINT quiet if keyword_set required then return 1L endif endfor if n_elements result gt 1 then result result 1: if keyword_set only_valid then begin ind where result ge 0 if ind 0 ge 0 then result result ind else result 1L endif return result end"); 243 a[241] = new Array("./ToBeReviewed/MATRICE/union.html", "union.pro", "", " NAME:union PURPOSE:calcule l union de 2 matrices D ENTIERS POSITIFS CATEGORY:calcule sur les matrices CALLING SEQUENCE:res union a b INPUTS:a et b:arrays of positive integers which need not be sorted Duplicate elements are ignored as they have no effect on the result KEYWORD PARAMETERS: OUTPUTS:tableau COMMON BLOCKS: SIDE EFFECTS: The empty set is denoted by an array with the first element equal to 1 RESTRICTIONS: These functions will not be efficient on sparse sets with wide ranges as they trade memory for efficiency The HISTOGRAM function is used which creates arrays of size equal to the range of the resulting set EXAMPLE: a 2 4 6 8 b 6 1 3 2 union a b 1 2 3 4 6 8 Elements in either set MODIFICATION HISTORY: http: www dfanning com tips set_operations html FUNCTION union a b IF a 0 LT 0 THEN RETURN b A union NULL a IF b 0 LT 0 THEN RETURN a B union NULL b RETURN Where Histogram a b OMin omin omin Return combined set END"); 244 a[242] = new Array("./ToBeReviewed/MATRICE/zeroun.html", "zeroun.pro", "", " NAME:zeroun PURPOSE:renvoie un vecteur ou une matrice constitue de o et de 1 en alternance CATEGORY:function matrices CALLING SEQUENCE:resultat zeroun n1 n2 INPUTS: n1 nombre d elements dans la premiere dimension n2 nombre d elements dans la deuxieme dimension KEYWORD PARAMETERS: OUTPUTS:resultat COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 1 12 98 function zeroun n1 n2 CASE N_PARAMS OF 1:return findgen n1 mod 2 2:BEGIN if fix n1 2 EQ n1 2 then BEGIN nombre pair de colonnes res findgen n1 1 n2 mod 2 return res 0:n1 1 ENDIF ELSE return findgen n1 n2 mod 2 nombre impair de colonnes END else: return report Mauvais nombre de parametre dans l appel de ZEROUN endcase end"); 245 a[243] = new Array("./ToBeReviewed/PLOTS/DESSINE/bar_plot.html", "bar_plot.pro", "", " Id: bar_plot pro 35 2006 05 02 14:44:47Z pinsard Copyright c 1990 2000 Research Systems Inc All rights reserved Unauthorized reproduction prohibited PURPOSE: Create a bar graph or overplot on an existing one CATEGORY: Graphics CALLING SEQUENCE: BAR_PLOT Values INPUTS: Values: A vector containing the values to be represented by the bars Each element in VALUES corresponds to a single bar in the output KEYWORD PARAMETERS: BASELINES: A vector the same size as VALUES that contains the base value associated with each bar If not specified a base value of zero is used for all bars COLORS: A vector the same size as VALUES containing the color index to be used for each bar If not specified the colors are selected based on spacing the color indices as widely as possible within the available colors specified by D N_COLORS BARNAMES: A string array containing one string label per bar If the bars are vertical the labels are placed beneath them If horizontal rotated bars are specified the labels are placed to the left of the bars TITLE: A string containing the main title to for the bar plot XTITLE: A string containing the title for the X axis YTITLE: A string containing the title for the Y axis BASERANGE: A floating point scalar in the range 0 0 to 1 0 that determines the fraction of the total available plotting area in the direction perpendicular to the bars to be used If not specified the full available area is used BARWIDTH: A floating point value that specifies the width of the bars in units of nominal bar width The nominal bar width is computed so that all the bars and the space between them set by default to 20 of the width of the bars will fill the available space optionally controlled with the BASERANGE keyword BARSPACE: A scalar that specifies in units of nominal bar width the spacing between bars For example if BARSPACE is 1 0 then all bars will have one bar width of space between them If not specified the bars are spaced apart by 20 of the bar width BAROFFSET: A scalar that specifies the offset to be applied to the first bar in units of nominal bar width This keyword allows for example different groups of bars to be overplotted on the same graph If not specified the default offset is equal to BARSPACE OUTLINE: If set this keyword specifies that an outline should be drawn around each bar OVERPLOT: If set this keyword specifies that the bar plot should be overplotted on an existing graph BACKGROUND: A scalar that specifies the color index to be used for the background color By default the normal IDL background color is used ROTATE: If set this keyword indicates that horizontal rather than vertical bars should be drawn The bases of horizontal bars are on the left Y axis and the bars extend to the right OUTPUTS: A bar plot is created or an existing one is overplotted EXAMPLE: By using the overplotting capability it is relatively easy to create stacked bar charts or different groups of bars on the same graph For example if ARRAY is a two dimensional array of 5 columns and 8 rows it is natural to make a plot with 5 bars each of which is a stacked composite of 8 sections First create a 2D COLORS array equal in size to ARRAY that has identical color index values across each row to ensure that the same item is represented by the same color in all bars With ARRAYS and COLORS defined the following code fragment illustrates the creation of stacked bars note that the number of rows and columns is arbitrary : Y RANGE 0 ymax Scale range to accommodate the total bar lengths BASE INTARR NROWS FOR I 0 NROWS 1 DO BEGIN BAR_PLOT ARRAY I COLORS COLORS I BASELINES BASE BARWIDTH 0 75 BARSPACE 0 25 OVER I GT 0 BASE BASE ARRAY I ENDFOR To plot each row of ARRAY as a clustered group of bars within the same graph use the BASERANGE keyword to restrict the available plotting region for each set of bars The sample code fragment below illustrates this method: FOR I 0 NROWS 1 DO BAR_PLOT ARRAY I COLORS COLORVECT BARWIDTH 0 8 BARSPACE 0 2 BAROFFSET I 1 0 BARSPACE NCOLS OVER I GT 0 BASERANGE 0 19 where NCOLS is the number of columns in ARRAY and COLORVECT is a vector containing the color indices to be used for each group of bars In this example each group uses the same set of colors but this could easily be changed MODIFICATION HISTORY: August 1990 T J Armitage RSI initial programming Replacement for PLOTBAR and OPLOTBAR routines written by William Thompson September 1990 Steve Richards RSI changed defaults to improve the appearance of the bar plots in the default mode Included spacing the bars slightly pro bar_plot values baselines baselines colors colors barnames barnames title title xtitle xtitle ytitle ytitle baserange baserange barwidth barwidth barspace barspace baroffset baroffset outline outline overplot overplot background background rotate rotate _EXTRA ex if n_params d eq 0 then begin Print call return if no parameters print bar_test values baselines baselines colors colors barnames barnames print title title xtitle xtitle ytitle ytitle baserange baserange print barwidth barwidth barspace barspace baroffset baroffset print outline outline overplot overplot background background print rotate rotate return endif nbars n_elements values Determine number of bars Baselines bars extend from baselines through values default 0 if not keyword_set baselines then baselines intarr nbars Default colors spaced evenly in current color table if not keyword_set colors then colors fix d n_colors float nbars indgen nbars 0 5 Labels for the individual bars none by default if not keyword_set barnames then barnames strarr nbars Main title if not keyword_set title then title Centered title under X axis if not keyword_set xtitle then xtitle Title for Y axis if not keyword_set ytitle then ytitle Fraction 0 1 of full X range to use if not keyword_set baserange then baserange 1 0 Space betw bars taken from nominal bar widths default is none If not keyword_set barspace then barspace 0 2 Bar width scaling factor relative to nominal if not keyword_set barwidth then barwidth 1 0 barspace barspace nbars Initial X offset in scaled bar widths default is none if not keyword_set baroffset then baroffset barspace barwidth Outline of bars default is none outline keyword_set outline Overplot do not erase the existing display default is to create new plot overplot keyword_set overplot Background color index defaults to 0 usually black if not specified if not keyword_set background then background 0 Rotate make horizontal bars default is vertical bars rotate keyword_set rotate mnB MIN baselines MAX mxB NAN mnV MIN values MAX mxV NAN range mnB mxV Maximum of bases values if rotate then begin Horizontal bars if x range 0 eq 0 and x range 1 eq 0 Determine range for X axis then xrange range else xrange x range Or use range specified if y range 0 eq 0 and y range 1 eq 0 Plot will calculate then defaults for X but not yrange 0 n_elements values for Ys so fill in here else yrange y range Axis perpend to bars yticks 1 Suppress ticks in plot ytickname strarr 2 xticks 0 xtickname strarr 1 endif else begin Vertical bars if y range 0 eq 0 and y range 1 eq 0 Determine range for Y axis then yrange range else yrange y range Or use range specified xrange x range Axis perpend to bars xticks 1 Suppress ticks in plot xtickname strarr 2 yticks 0 ytickname strarr 1 endelse if overplot eq 0 then Create new plot no data plot values nodata title title xtitle xtitle ytitle ytitle noerase overplot xrange xrange yrange yrange xticks xticks xtickname xtickname yticks yticks ytickname ytickname xstyle 1 ystyle 1 data background background _EXTRA ex if rotate then begin Horizontal bars base_win y window Window range in Y scal_fact x s Scaling factors tick_scal_fact y s Tick scaling factors endif else begin Vertical bars base_win x window Window range in X scal_fact y s Scaling factors tick_scal_fact x s Tick scaling factors endelse winrange baserange base_win 1 base_win 0 Normal window range barsize barwidth winrange nbars Normal bar width winoffset base_win 0 baroffset barsize Normal first offset bases scal_fact 0 scal_fact 1 baselines Baselines in normal coor normal scal_fact 0 scal_fact 1 values Values in normal coor barstart indgen nbars barsize barspace winrange nbars Coor at left edges tickv winoffset barstart 0 5 barsize Tick coor centered for i 0 nbars 1 do begin Draw the bars width winoffset barstart i barstart i Compute bar width barstart i barsize barstart i barsize length bases i normal i normal i bases i Compute bar length if rotate then begin Horizontal bars x length X axis is length axis y width Y axis is width axis endif else begin Vertical bars x width X axis is width axis y length Y axis is length axis endelse polyfill x y color colors i normal Polyfill with color if outline then plots x y normal Outline using p color endfor tickv tickv tick_scal_fact 0 tick_scal_fact 1 Locations of the ticks if rotate then Label the bars Y axis axis yaxis 0 ystyle 1 yticks nbars 1 ytickv tickv ytickname barnames yticklen 0 0 else Label the bars X axis axis xaxis 0 xstyle 1 xticks nbars 1 xtickv tickv xtickname barnames xticklen 0 0 return end"); 246 a[244] = new Array("./ToBeReviewed/PLOTS/DESSINE/plt.html", "plt.pro", "", " NAME: PLT PURPOSE: trace des graphes horizontaux cartes CATEGORY: Graphics trace des graphes horizontaux CALLING SEQUENCE: plt champ min max INPUTS: champ: le champ dont on veut faire la carte horizontale champ peut etre de 2 types: 1 an array if needed its mean along the z and t direction will be automatically performed 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp ces ARGUMENTS ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tab1 sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tab1 sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique sur laquelle doit etre faite la coupe Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom 0 max gdept gdepw 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 sont les variables globales definies lors du dernier domdef REALCONT:Permet de dessiner les continents definits ds IDL REALCONT peut prendre deux formes: REALCONT: on dessine les continents a la place du mask REALCONT 2 on dessine le contours des continents par dessus le dessin masque ceci permet de voir si le masque correspond bien aux continents reels CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations CMREF: la longeur en cm sur le papier que doit faire la fleche de norme normeref par defaut ajuste au dessin et compris entre 5 et 1 5 cm COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ repondant aux meme caracteristiques que l argument numero 1 de plt GRIDTYPE: U T V W ou F pour specifer eventuellement la grille a laquelle est rattache le champ Rq: il afaut mieux utiliser ds ce cas une structure comme champ INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilise pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot MAP:Mot cle a actine losque l on veut faire une projection Ce mot cle peut etre de 2 formes: MAP P0lat P0lon Rot Pour la description de ces 3 valeurs cf l aide en ligne de MAP_SET MAP: dans ce cas map est calcule tout seul et vaut: map 0 lon1 lon2 2 0 Rq: Un bon moyen de choisir sa projection est la valeur du vecteur MAP est d utiliser la demo d IDL5 2: IDL demo Puis choisir earth sciences et mapping Rq2: Par defaut c est une projection cylindrique qui est effectuee avec ou sans le mot cle map Si on veut une autre projection MAP doit etre active et il faut rajouter le mot cle: nom_projection par ex pour une projection polaire centree sur le pole sud: IDL domdef 180 180 90 45 IDL plt tab stereo map 90 0 0 labmap: corresponds to label keywords of map_set Defaut definition is labmap 1 MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre NORMEREF: la norme de la fleche de reference par defaut on essaie de faire qqch qui colle pas trop mal NOTRI: pour forcer a ne pas utiliser de triangulation Attention dans ce cas le trace ne marchera que si la grille est non deformee cad chaque pts d une longitude donnee a la meme latitude et chaque pts d une latitude donnee a la meme longitude sauf si on utilise le mot clef CELL_FILL 2 Rq si le champ contient des points a values f_nan alors on fait qd meme une triangulation OVERPLOT: pour faire un plt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR ou de VECTEUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours UNVECTSUR:un scalaire n on un tableau a 2 elements n1 n2 dans le premier cas on tracera un vecteur sur n suivant les x et les y dans le second cas on tracera un vecteur sur n1 suivant x et un vecteur sur n2 suivant y Rq pour tracer tous les vecteurs suivant y et 1 sur 2 suivant x mettre unvectsur 2 1 Rq: ce mot cle est passe ds _extra VECTCOLOR: la couleur de la fleche Par defaut noir couleur 0 VECTEUR: une structure a 2 elements contenant les 2 champs U et V des valeurs de la composante zonale et meridienne du champ de vecteurs a tracer Ces champs peuvent etre un tableau ou une structure par ex: vecteur matriceu:lec unsurface matricev:lec vnsurface rq:le nom des elements de vecteur n a aucune importance vecteur u:lec unsurface v:lec vnsurface convient aussi VECTMIN norme minimum des vecteurs a tracer VECTMAX norme maximum des vecteurs a tracer VECTTHICK l epaissuer de la fleche par defaut 1 WINDOW: numero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x par ex: 1 pour un repere orthonorme 2 si l axe des y est deux fois plus dilate que celui des x Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1999 Sebastien Masson 08 02 2000 checkfield and notri keyword or triangule 1 pro plt tab1 giventype givenmin givenmax REALCONT realcont CONTOUR contour INTERVALLE intervalle INV inv GRIDTYPE gridtype BOXZOOM boxzoom CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel VECTEUR vecteur MAP map MININ minin MAXIN maxin CONT_NOFILL cont_nofill USETRI usetri NOTRI notri MASKFILL maskfill DUPLICATE duplicate STRICTFILL strictfill OVERPLOT overplot DECIMATETRI decimatetri LABMAP labmap _extra ex include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I preparation de l environnement graphique et petites verifications I1 verification du type de grille associe a tab1 if keyword_set gridtype then vargrid gridtype if keyword_set vecteur AND NOT keyword_set gridtype then BEGIN vargrid litchamp tab1 grid if vargrid eq then BEGIN vargrid xquestion What is the grid associated to the data to contour T chkwidget vargrid strupcase vargrid endif ENDIF I2 lecture du champ et checkup if keyword_set boxzoom AND n_elements contour ne 4 then BEGIN savedbox 1b saveboxparam boxparam4plt dat END if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin checktypeminmax plt TYPE type MIN min MAX max _extra ex z2d checkfield tab1 plt TYPE type BOXZOOM boxzoom DIREC direc VECTEUR vecteur _extra ex if z2d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4plt dat return ENDIF IF n_elements usetri EQ 0 THEN BEGIN do we have holes in the triangulation holeintri n_elements triangles_list 3 LT jpi 1 keyword_set key_periodic jpj 1 2 the triangulation must be used to draw the data do we have a triangulation wehavetri triangles_list 0 NE 1 the triangulation must be used to draw the continents if we make a map are we periodic and nx jpi CASE strupcase vargrid OF T :nx nxt W :nx nxt U :nx nxu V :nx nxv F :nx nxf ENDCASE mapperio keyword_set map keyword_set key_periodic nx eq jpi usetri wehavetri wehavetri holeintri mapperio keyword_set key_irregular 2 notri ENDIF I3 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot then reinitplt z invert I4 attribution du mask et des tableaux de longitude et latitude IF strupcase vargrid EQ W THEN profond firstzw NE 0 ELSE profond firstzt NE 0 do we need to extract now the triangulation that will be use for contouring the data if keyword_set profond OR usetri EQ 0 AND vargrid EQ T OR vargrid EQ W OR usetri NE 2 AND vargrid NE T AND vargrid NE W THEN BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz forplt _extra ex ENDIF ELSE BEGIN grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz TRI trifield forplt _extra ex ENDELSE I5 determination du mi:min et du ma:max de z2d ainsi que de max: max et min: min pour le dessin masknan finite z2d nan total masknan NE n_elements z2d faudra t il faire un autoscale autoscale testvar var min EQ testvar var max AND NOT keyword_set intervalle determineminmax z2d mask mi ma glam gphi MININ min MAXIN max nan nan INTERVALLE intervalle usetri usetri _extra ex if z2d 0 EQ 1 THEN GOTO sortie on fait un autoscale si besoin if autoscale then autoscale min max intervalle II mise en place du dessin sur la fenetre ou la page et ouverture eventuelle de la fenetre et de la page if n_elements contour NE 4 AND NOT keyword_set overplot THEN placedessin plt posfenetre posbar CONTOUR contour VECTEUR vecteur MAP map DIREC direc _extra ex III habillage du dessin labels style axe III1 choix des labels if keyword_set intervalle AND NOT keyword_set label then label 1 if keyword_set label eq 0 then cas 0 else cas label label cas min max ncontour level_z2d colnumb NLEVEL nlevel INTERVALLE intervalle strictfill strictfill III2 choix de style if not keyword_set style then style 0 style style level_z2d linestyle thick if keyword_set inv then colnumb reverse colnumb III3 definition des axes if NOT keyword_set overplot THEN axe xy _EXTRA ex IV dessin extrapolation des donnees sur les terres et seuillage if keyword_set nan then begin z2d where masknan EQ 0 max ENDIF ELSE masknan 1 filling the mask values we fill only masknan or we fill mask masknan IF keyword_set nan AND keyword_set cont_nofill THEN z2d remplit z2d nite 1 vargrid NE T AND vargrid NE W mask masknan _extra ex ELSE z2d remplit z2d nite 1 vargrid NE T AND vargrid NE W keyword_set nan 1 keyword_set cont_nofill 1 n_elements maskfill NE 0 mask mask masknan _extra ex IF keyword_set strictfill EQ 0 AND n_elements maskfill EQ 0 then z2d min z2d max if n_elements maskfill NE 0 then BEGIN z2d temporary z2d mask masknan if maskfill NE 0 then z2d temporary z2d maskfill 1 mask masknan ENDIF check the mask and the triangulation according to the grid type and nan values si on fait un dessin en profondeur on redefinit une triangulation sur le zoom cette triangulation sera utilisee pour tracer le champ on utilise tmask pour que les trous de cette triangulation soient bien les memes que ceux utilises pour tracer le masque et correspondent bien au trous qu il y a a cette nouvelle profondeur if keyword_set profond OR keyword_set cont_nofill AND usetri GE 1 AND vargrid EQ T OR vargrid EQ W OR usetri EQ 2 AND vargrid NE T AND vargrid NE W then BEGIN trifield triangule tmask firstx:lastx firsty:lasty firstz coinmonte coinmontemask coindescend coindescendmask keep_cont cont_nofill _extra ex indicezoommask lindgen jpi jpj firstx:lastx firsty:lasty ENDIF triangulation for nan mask if keyword_set nan then BEGIN trinan triangule masknan keep_cont coinmonte coinmontenan coindescend coindescendnan indicezoomnan lindgen jpi jpj firstx:lastx firsty:lasty ENDIF IF n_elements twin_corners_up EQ 0 THEN coinmontemask 1 ELSE coinmontemask twin_corners_up IF n_elements twin_corners_dn EQ 0 THEN coindescendmask 1 ELSE coindescendmask twin_corners_dn if vargrid EQ T OR vargrid EQ W then BEGIN glammsk glam gphimsk gphi ENDIF ELSE begin decoupe terre: pour que le trace des cotes soit propre on essaye de prendre des points en pour la terre comme ca on ne voit pas le decalage des grilles c est ce que fait decoupeterre au passage on redefinit trimsk decoupeterre mask glammsk gphimsk type xy TRI trimsk usetri usetri indicezoom indicezoommask coinmonte coinmontemask coindescend coindescendmask _EXTRA ex ENDELSE IV1 choix du type de dessin typetrace classique if keyword_set map AND key_onearth then BEGIN appelle de mapset qd on veut faire des projections IF n_elements map NE 3 THEN map 0 lon1 lon2 2 MOD 360 0 typetrace projection map_lat map 0 map_lon map 1 map_rot map 2 if chkstru ex TITLE then begin maptitre ex title ex title endif map_set map_lat map_lon map_rot _extra ex position posfenetre iso limit lat1 lon1 lat2 lon2 noborder if n_elements maptitre ne 0 then ex title maptitre if n_elements trifield GE 2 then trifield ciseauxtri trifield glam gphi _EXTRA ex if n_elements trimsk GE 2 then trimsk ciseauxtri trimsk glammsk gphimsk _EXTRA ex if n_elements trinan GE 2 then BEGIN trinan ciseauxtri trinan glam gphi _EXTRA ex if trinan 0 EQ 1 then undefine trinan endif ENDIF ELSE BEGIN pour que les axes de coordonees soient pris en compte if x type EQ 0 AND n_elements contour LE 4 then plot 0 0 nodata xstyle 5 ystyle 5 title subtitle noerase if keyword_set key_periodic then BEGIN ds ce cas la triangulation est refermee en x et couvre toute la sphere il faut dont la couper au niveau ou l on coupe la sphere pour faire le dessin if n_elements trifield GE 2 then trifield ciseauxtri trifield glam gphi _EXTRA ex if n_elements trimsk GE 2 then trimsk ciseauxtri trimsk glammsk gphimsk _EXTRA ex if n_elements trinan GE 2 then trinan ciseauxtri trinan glam gphi _EXTRA ex ENDIF endelse IV2 coutours et coloriages if keyword_set duplicate then BEGIN pour marina uniquement ATTENTION C EST TRES MAL CODE lon glam 0 decalage max lon min lon lon shift lon 1 n_elements lon 1 x range 1 x range 1 duplicate 1 decalage for i 1 duplicate 1 do BEGIN z2d z2d z2d gphi gphi gphi mask mask mask gphimsk gphimsk gphimsk glam glam glam i decalage glammsk glammsk glammsk ENDFOR endif save glam gphi trifield file tri dat if keyword_set decimatetri then BEGIN tempsdeux systime 1 pour key_performance IF n_elements trimsk EQ 0 THEN trimsk trifield Verts transpose temporary glam temporary gphi temporary z2d Conn replicate 3 1 n_elements trifield 3 trifield Result mesh_decimate temporary verts temporary Conn Connout vertices Vertsout percent_vertices decimatetri connout reform connout 4 n_elements connout 4 over trifield temporary connout 1:3 glam reform Vertsout 0 gphi reform Vertsout 1 z2d reform Vertsout 2 undefine Vertsout print temps decimatetri systime 1 tempsdeux ENDIF pltbase z2d glam gphi mask glammsk gphimsk trichamp trifield trimsk trimsk forplt level_z2d colnumb contour contour usetri usetri realcont realcont overplot keyword_set overplot keyword_set map c_linestyle linestyle c_labels 1 indgen n_elements level_z2d MOD 2 c_thick thick cont_nofill cont_nofill nan nan coinmontemask coinmontemask coindescendmask coindescendmask coinmontenan coinmontenan coindescendnan coindescendnan indicezoommask indicezoommask indicezoomnan indicezoomnan masknan masknan trinan trinan _extra ex IV3 rappelle de plt en boucle qd contour est active if n_elements contour eq 4 then BEGIN c est la 2eme fois que je passe ds pltt contour mietma: mi ma unit:varunit inter:intervalle je renvoie le min le max et l unite return endif if keyword_set contour THEN BEGIN pourlegende 1 1 1 1 oldattributs saveatt oldcolnumb colnumb plt contour contmin contmax CONTOUR pourlegende NOERASE USETRI usetri INTERVALLE contintervalle LABEL contlabel STYLE style NLEVEL contnlevel DUPLICATE duplicate STRICTFILL strictfill MASKFILL maskfill _extra ex restoreatt oldattributs colnumb oldcolnumb ENDIF V petites finitions V1 ajout eventuel de vecteurs en surimpression if keyword_set vecteur then BEGIN oldattributs saveatt ajoutvect vecteur vectlegende _extra ex restoreatt oldattributs ENDIF if keyword_set overplot then GOTO fini V2 Trace de la ligne de changement de date l equateur et le meridien de greenwich if NOT keyword_set map AND key_onearth then meridienparallele xy V3 pour tracer les continents d IDL if keyword_set realcont then BEGIN si noease est passe de _extra on s assure qu il est a 1 if chkstru ex NOERASE then begin oldnoerase ex noerase ex noerase 1 ENDIF if chkstru ex coast_thick then mlinethick ex coast_thick ELSE mlinethick 1 if chkstru ex coast_color then mcolor ex coast_color ELSE mcolor 0 IF NOT keyword_set map THEN map_set 0 lon1 lon2 2 MOD 360 0 position posfenetre limit lat1 lon1 lat2 lon2 NOERASE noborder color 0 _extra ex if realcont NE 2 AND NOT keyword_set cont_nofill then BEGIN if chkstru ex cont_color then cntcol ex coast_color ELSE cntcol d n_colors 1 255 map_continents fill_continents color cntcol _extra ex noerase ENDIF map_continents continents color mcolor MLINETHICK mlinethick noerase _extra ex if chkstru ex NOERASE THEN ex noerase oldnoerase ENDIF V4 legendes affichage de celles ci legende mi ma xy CONTOUR pourlegende VECTLEGENDE vectlegende INTERVALLE intervalle DIREC direc _EXTRA ex if n_elements ex NE 0 then BEGIN pour garder les axes du cadre en noir if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR coast_color endif case typetrace of classique : plot 0 0 nodata noerase color 0 xstyle 1 ystyle 1 _extra ex projection : BEGIN if chkstru ex NOERASE then begin oldnoerase ex noerase ex noerase 1 endif if chkstru ex SUBTITLE then p subtitle ex SUBTITLE if n_elements maptitre ne 0 then ex title maptitre map_set map_lat map_lon map_rot _extra ex iso limit lat1 lon1 lat2 lon2 NOERASE noborder title p title color 0 map_proj_info numproj current map_proj_info numproj name nomproj if nomproj EQ Mercator OR nomproj EQ Cylindrical OR nomproj EQ LambertConic OR nomproj EQ Gnomic OR nomproj EQ AlbersEqualAreaConic OR nomproj EQ TransverseMercator OR nomproj EQ MillerCylindrical OR nomproj EQ LambertConicEllipsoid then map_grid box_axes 1 latdel 10 londel 10 ELSE map_grid charsize 0 75 label latalign 1 lonalign 1 latdel 10 londel 30 IF n_elements labmap EQ 0 THEN labmap 1 map_grid charsize 0 75 label labmap latalign 1 lonalign 1 latdel 10 londel 30 color 0 _extra ex if chkstru ex NOERASE THEN ex noerase oldnoerase end endcase V5 barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex VI impression eventuelle fini: terminedessin _extra ex sortie: if keyword_set savedbox THEN restoreboxparam boxparam4plt dat if keyword_set key_performance NE 0 THEN print temps plt systime 1 tempsun return end "); 247 a[245] = new Array("./ToBeReviewed/PLOTS/DESSINE/plt1d.html", "plt1d.pro", "", " NAME: PLT1D PURPOSE: trace des graphes 1d CATEGORY: Graphics trace des graphes 1d: x y z ou t mais ds ce cas on rapelle directement pltt CALLING SEQUENCE: plt1d champ type min max INPUTS: champ: le champ dont on veut faire le hovmoller champ peut etre de 2 types: 1 un tableu qui peut etre: 2d 3d ou 4d: tableau xy xyz xyt ou xyzt dans ce cas le tableau va passer dans moyenne ou grossemoyenne pour etre moyennee et devenir un tableau 1 1d 1d:type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 2 une structure repondant aux critaires specifies par litchamp pro cf IDL xhelp litchamp Le tableau contennu ds la structure repondant aux criteres du cas 1 cf ci dessus TYPE: un string: type de plot 1d que l on veut faire: trace suivant: x y z ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace du plot Par defaut on prend le max de tableau sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace du plot Par defaut on prend le min de tableau sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique 3d sur laquelle doit etre fait l extraction du champ pour faire le hovmoeller Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom vert1 vert2 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 vert1 vert2 sont les variables globales definies lors du dernier domdef COL1d: OBSOLETE numero de la couleur qd on fait un trace 1d par defaut 0 il faut mieux utiliser le mot cle COLOR utilise par plot ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre Rq: activer ds le cas d un Postscript de plusieurs traces de type t pour ne pas faire un Postscript de plusieurs pages OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin SIN: activer ce mot cle si l on veut que l axe des x soit trace en sinus de la latitude qd on fait un frace f y STY1D: OBSOLETE numero du style utilise lors d un trace 1d Il faut mieux utiliser le mot cle LINESTYLE qui est celui de plot Attention ce mot cle est encore utile si on veut faire des barres plutot qu un courbe mettre sty1d bar TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x Par defaut 1 Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: creation 24 6 99 Eric Guilyardi a partir routine pltt de Sebastien Masson 8 7 1999 Sebastien Masson smasson lodyc jussieu fr inspection des travaux finis 8 2 2000 Sebastien Masson: checkfield pro plt1d tab giventype givenmin givenmax BOXZOOM boxzoom SIN sin MININ minin MAXIN maxin TYPEIN typein ENDPOINTS endpoints COL1D col1d STY1D sty1d OV1D ov1d X x Y y Z z TT tt REVERSE_X reverse_x REVERSE_Y reverse_y SWITCHXY switchxy _extra ex include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance 1ere partie: initialisation et petits calculs verification de la valeur de type if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if keyword_set tt then typein t if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein endif checktypeminmax plt1d TYPE type MIN min MAX max ENDPOINTS endpoints XX keyword_set x YY keyword_set y ZZ keyword_set z if type EQ t then BEGIN pltt tab type min max BOXZOOM boxzoom SIN sin TYPEIN typein COL1D col1d STY1D sty1d OV1D ov1d ENDPOINTS endpoints _extra ex return endif I2 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt1d if NOT keyword_set ov1d then reinitplt I1 lecture du champ if keyword_set boxzoom OR keyword_set endpoints THEN BEGIN savedbox 1b saveboxparam boxparam4plt1d dat ENDIF if keyword_set endpoints then begin section tab z1d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc nx n_elements glam ny nx if strupcase vargrid EQ W then begin z gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN z gdept firstzt:lastzt nz nzt ENDELSE ENDIF ELSE BEGIN z1d checkfield tab plt1d TYPE type BOXZOOM boxzoom direc direc _extra ex grille mask glam gphi gdep nx ny nz ENDELSE if z1d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4plt1d dat return endif on construit le mask pour cela le tableau doit etre masque fait automatiquement a la valeure valmask si on passe ds moyenne ou grossemoyenne mask fltarr n_elements z1d if n_elements valmask EQ 0 then valmask 1e20 nan total finite z1d nan 1 if keyword_set nan then begin notanum where finite z1d EQ 0 z1d notanum 0 mask where z1d LT valmask 10 1 z1d notanum values f_nan ENDIF ELSE mask where z1d LT valmask 10 1 determination du min et du max apres la moyenne nan total finite z1d nan 1 determineminmax z1d mask mi ma MININ min MAXIN max nan nan INTERVALLE intervalle _extra ex if z1d 0 EQ 1 THEN return if NOT keyword_set ov1d THEN placedessin autre posfenetre posbar contour contour DIREC direc endpoints endpoints _extra ex 2eme partie: dessin definition des vecteurs abscisse et ordonee la triangulation est definie pour que le trace soit effectue du bas a gauche vers le haut a droite il faut donc la matrice e contourer se presente de cette maniere d ou certains transpose et reverse case type of y : begin yy z1d IF size gphi 0 EQ 1 then xx gphi ELSE BEGIN IF keyword_set key_irregular THEN BEGIN cln where gphi EQ max gphi 0 xx reform gphi cln MOD nx ENDIF ELSE xx reform gphi 0 ENDELSE if keyword_set sin then xx sin pi 180 xx min0 lat1 max0 lat2 END x :begin yy z1d xx glam 0 min0 lon1 max0 lon2 END z :begin yy reverse gdep 1 xx reverse z1d 1 min0 0 max0 0 case n_elements boxzoom of 0: y range vert1 vert2 1: y range 0 boxzoom 2: y range boxzoom 4: y range vert1 vert2 5: y range 0 boxzoom 4 6: y range boxzoom 4:5 endcase if NOT keyword_set ov1d then y range reverse y range END ENDCASE definition des axes if keyword_set integrationtps then axe type time 0 time jpt 1 SIN sin _extra ex ELSE axe type SIN sin if NOT keyword_set ov1d then axe type SIN sin dessin if type EQ z then begin idx where xx NE valmask if NOT keyword_set ov1d then BEGIN if min EQ mi then x range min abs max min 5 max abs max min 5 ELSE x range min max ENDIF ENDIF ELSE BEGIN idx where yy NE valmask if NOT keyword_set ov1d then BEGIN if min EQ mi then y range min abs max min 5 max abs max min 5 ELSE y range min max ENDIF ENDELSE if NOT keyword_set ov1d then BEGIN legende mi ma type CONTOUR contour DIREC direc ENDPOINTS endpoints _EXTRA ex ENDIF IF keyword_set switchxy THEN BEGIN tmp xx xx yy yy temporary tmp if NOT keyword_set ov1d then BEGIN tmp x x y y temporary tmp ENDIF ENDIF if NOT keyword_set ov1d then BEGIN if keyword_set reverse_x then x range reverse x range if keyword_set reverse_y then y range reverse y range ENDIF xx xx idx yy yy idx if not keyword_set col1d then col1d 0 if keyword_set sty1d then BEGIN si on veut faire des barres IF strlowcase strtrim sty1d EQ bar then begin y range y range 0 y range 1 y range 0 05 y range 1 bar_plot yy background d n_colors 1 255 baselines replicate y range 0 n_elements yy barnames colors replicate col1d n_elements yy outline if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 noerase nodata _extra ex GOTO fini ENDIF ENDIF if NOT keyword_set ov1d then BEGIN plot xx yy color col1d linestyle sty1d thick 2 title subtitle _extra ex if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur 0 et trace une ligne a y 0 if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 if where tag_names ex EQ LINESTYLE 0 NE 1 then ex LINESTYLE 0 if where tag_names ex EQ THICK 0 NE 1 then ex THICK 0 ENDIF plot x range 0 0 noerase nodata xstyle 1 4 keyword_set endpoints AND type EQ x AND lat1 NE lat2 OR type EQ y AND lon1 NE lon2 ystyle 1 _extra ex ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex trace une ligne a x 0 plot 0 0 y range noerase nodata title subtitle _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex 3eme partie: impression eventuelle fini: terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4plt1d dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps plt1d systime 1 tempsun return end "); 248 a[246] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltbase.html", "pltbase.pro", "", " NAME:pltbase PURPOSE: surcouche de contour pour tracer un champ eventuellement masque brique elementaire de plt pltz et pltt CATEGORY:un tarce vite fait et ou delestage de l ecriture de plt pltz pltt CALLING SEQUENCE: pltbase z2d x y mask xm ym levels colors INPUTS: z2d:le tableau a tracer x et y les axes vecteurs ou tableaux de meme taille que z2d Ce sont les coordonnees de z2d mask: le tableau qui masque z2d avec des 0 sur les points a masquer et des 1 sur les autres si z2d n est pas masque mettre cet argument egale a 1 xm et ym les axes du mask vecteurs ou tableaux de meme taille que mask Ce sont les coordonnees de mask levels et colors: optionnels les vecteurs qui contiennent les niveaus et les couleurs necessaires au contour S il ne sont pas donnes on prends 20 niveau entre le min et le max KEYWORD PARAMETERS: COLORTRICHAMP : la couleur que l on veut utiliser pour dessiner la triangulation qui est utilisee pour faire les contour du champ COLORTRIMASK : la couleur que l on veut utiliser pour dessiner la triangulation qui est utilisee pour faire les contour du mask COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 COLOR_C: to draw the contour in color instead of in black with filling in color CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white DESSTRICHAMP: pour dessiner la triangulation qui est utilisee pour faire les contour du champ DESSTRIMASK: pour dessiner la triangulation qui est utilisee pour faire les contour du mask FORPLT: a activer si on veut que le trace des cote soit realise par tracecote plutot que tracemask I_COLORS: un vecteur specifiant la couleur a utiliser pour tracer les contours C est la meme chose que c_colors qui ajit sur les contours MORE: chiffre a donner pour eviter les bug du style: Out of range subscript encountered: Execution halted at: PLTBASE 151 par defaut more 10 si le bug existe tjs augmenter la valeur de more l explication et la justification de cette methode n ont pas encore de fondements scientifiques NOFILL: pour faire juste les isolignes NOCONTOUR: pour faire juste les couleurs UNSUR2: pour tarcer une isoligne sur 2 UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n CONTOUR: pour etrte utilise depuis plt pltz ou pltt cf ces routines _EXTRA: mot cle magique d idl pour faire passer tous lse mots cles acceptes par les routines et fonctions utilises ds ce programme sans les declarer explicitement OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS:ds le cas ou z2d x et y sont des tableaux de meme taille il faut les metre sous forme de vecteur: z2d x y EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 8 2 2000 check if the tri array is not equal to 1 allow contour with out using a triangulation PRO pltbase z2d x y mask xm ym levels colors UNSUR2 unsur2 CONTOUR contour NOCONTOUR nocontour NOFILL nofill TRICHAMP trichamp TRIMSK trimsk REALCONT realcont NAN nan usetri usetri COLORTRICHAMP colortrichamp COLORTRIMASK colortrimask COLORTRINAN colortrinan COLORPOINTS colorpoints DRAWPOINTS drawpoints TH_TRICHAMP th_trichamp TH_TRIMASK th_trimask DESSTRICHAMP desstrichamp DESSTRIMASK desstrimask DESSTRINAN desstrinan COLOR_C color_c I_COLORS i_colors CONT_COLOR CONT_COLOR CONT_NOFILL cont_nofill UNLABSUR unlabsur COINMONTEMASK coinmontemask COINDESCENDMASK coindescendmask COINMONTENAN coinmontenan COINDESCENDNAN coindescendnan INDICEZOOMMASK indicezoommask INDICEZOOMNAN indicezoomnan MASKNAN masknan TRINAN trinan FORPLT forplt REALSECTION realsection MORE more EXCHANGE_XY exchange_xy _EXTRA ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF explication concernant contour Ce mot cle est active qd on on trace un contour en couleur different de celui en trait noir si il est active cas n_elements contour NE 0 on passe 2 fois ds pltbase: 1 on trace les couleurs puis on sort c est le cas: n_elements contour NE 0 AND n_elements contour NE 4 2 on trace les contour en trait puis les continents c est le cas n_elements contour NE 0 AND n_elements contour EQ 4 tempsun systime 1 pour key_performance if n_elements mask EQ 0 then mask 1b if n_elements masknan EQ 0 then masknan 1b IF total mask EQ n_elements z2d THEN mask 1b si les niveaux et les couleurs ne sont pas donnes if n_params EQ 4 then label 0 min z2d mask max z2d mask ncontour levels colors attention bidouille inexplicable pour que tout se passe bien avec les postcript ds pltz if n_elements contour LE 4 AND x type EQ 0 THEN plot 0 0 xstyle 5 ystyle 5 nodata noerase title subtitle si cell_fill fait partit de _extra on le desactive si il n est pas egale a 2 IF chkstru ex CELL_FILL THEN BEGIN cell_fill ex CELL_FILL if ex CELL_FILL NE 2 then ex CELL_FILL 0 ENDIF ELSE cell_fill 0 I remplissage des contours en palette de couleur if NOT keyword_set more then more 10 if NOT keyword_set nofill AND NOT keyword_set color_c then begin if n_elements contour NE 4 THEN BEGIN if usetri EQ 2 then BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size z2d 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size z2d 1 y contour z2d fltarr more x fltarr more y fltarr more levels levels c_color colors noerase fill TRIANGULATION trichamp _extra ex ENDIF ELSE BEGIN IF size x n_dimensions EQ 2 THEN x x 0 IF size y n_dimensions EQ 2 THEN y reform y 0 contour z2d x y levels levels c_color colors noerase fill _extra ex ENDELSE ENDIF ENDIF if n_elements contour NE 0 AND n_elements contour NE 4 THEN GOTO fini IF chkstru ex C_ORIENTATION THEN ex extractstru ex C_ORIENTATION IF chkstru ex C_SPACING THEN ex extractstru ex C_SPACING IF chkstru ex C_COLORS THEN ex extractstru ex C_COLORS II trace des contours en trait if n_elements contour EQ 4 OR n_elements contour EQ 0 THEN BEGIN we put the masked values to NaN IF n_elements mask GT 1 OR n_elements masknan GT 1 AND NOT keyword_set cont_nofill THEN BEGIN tonan where mask masknan EQ 0 count tonan where remplit mask masknan nite 1 mask mask masknan basique fillval 0 fillxdir keyword_set realsection EQ 0 count IF count NE 0 THEN z2d temporary tonan values f_nan ENDIF on ne passe pas si on doit faire des contours differents ds le cas on unsur2 est active on reduit levels if NOT keyword_set nocontour then begin IF keyword_set unsur2 THEN levels levels where zeroun n_elements levels eq 1 unlabsur est active C_LABEL est passe via _EXTRA if keyword_set unlabsur THEN IF chkstru ex C_LABELS THEN ex C_LABELS 1 indgen n_elements ex C_LABELS MOD unlabsur 1 pour ne pas filler qd cell_fill est impose IF chkstru ex CELL_FILL THEN ex CELL_FILL 0 CASE 1 OF keyword_set color_c :c_colors colors keyword_set i_colors :c_colors i_colors ELSE: ENDCASE IF usetri EQ 2 THEN BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size z2d 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size z2d 1 y contour z2d fltarr more x fltarr more y fltarr more levels levels overplot 1 keyword_set nofill noerase keyword_set nofill c_colors c_colors TRIANGULATION trichamp _extra ex ENDIF ELSE BEGIN IF size x n_dimensions EQ 2 THEN x x 0 IF size y n_dimensions EQ 2 THEN y reform y 0 contour z2d x y levels levels overplot 1 keyword_set nofill noerase keyword_set nofill c_colors c_colors _extra ex ENDELSE ENDIF III remplissage des continents de couleur IF chkstru ex CELL_FILL THEN ex CELL_FILL cell_fill 1 IF chkstru ex LEVELS THEN ex extractstru ex LEVELS IF chkstru ex NODATA THEN ex extractstru ex NODATA IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 si il y a des points a nan on trace en blanc les points a nan avant de dessiner les cotes avec un trait if keyword_set trinan THEN BEGIN IF size x n_dimensions EQ 1 THEN x x replicate 1 size masknan 2 IF size y n_dimensions EQ 1 THEN y replicate 1 size masknan 1 y contour 1b masknan fltarr more x fltarr more y fltarr more levels 0 5 overplot fill c_colors cont_color TRIANGULATION trinan _extra ex IF keyword_set forplt THEN completecointerre COINMONTE coinmontenan COINDESCEND coindescendnan INDICEZOOM indicezoomnan CONT_COLOR cont_color _EXTRA ex ELSE fillcornermask x 0 y 0 COINMONTE coinmontenan COINDESCEND coindescendnan CONT_COLOR cont_color _extra ex ENDIF remplissage des continents if keyword_set realcont then if realcont EQ 1 then mask 1b if n_elements mask NE 1 then BEGIN si mask 1 on saute if NOT keyword_set cont_nofill then BEGIN mask filling case 1 of keyword_set realsection :drawsectionbottom mask xm ym CONT_NOFILL cont_nofill CONT_COLOR cont_color _EXTRA ex usetri GE 1:BEGIN if n_elements trimsk eq 0 then trimsk trichamp IF size xm N_DIMENSIONS EQ 1 THEN xm xm replicate 1 size mask 2 IF size ym N_DIMENSIONS EQ 1 THEN ym replicate 1 size mask 1 ym contour 1b mask fltarr more xm fltarr more ym fltarr more LEVELS 0 5 OVERPLOT FILL C_COLORS cont_color TRIANGULATION trimsk _extra ex IF keyword_set forplt THEN completecointerre COINMONTE coinmontemask COINDESCEND coindescendmask INDICEZOOM indicezoommask CONT_COLOR cont_color _EXTRA ex ELSE fillcornermask xm 0 ym 0 COINMONTE coinmontemask COINDESCEND coindescendmask CONT_COLOR cont_color _extra ex END ELSE:BEGIN IF size xm n_dimensions EQ 2 THEN xm xm 0 IF size ym n_dimensions EQ 2 THEN ym reform ym 0 contour 1b mask xm ym LEVELS 0 5 OVERPLOT FILL C_COLORS cont_color _EXTRA ex END ENDCASE ENDIF NOT keyword_set cont_nofill IV trace les cotes en trait case 1 of keyword_set realsection AND NOT keyword_set cont_nofill : keyword_set realsection AND keyword_set cont_nofill : drawsectionbottom mask xm ym CONT_NOFILL cont_nofill _extra ex keyword_set forplt AND map projection GT 0 OR key_irregular OR keyword_set nan :tracecote _extra ex ELSE:tracemask mask xm ym _extra ex endcase ENDIF n_elements mask NE 1 ENDIF draw the triangulations if keyword_set desstrichamp then dessinetri trichamp x y color colortrichamp thick th_trichamp if keyword_set desstrimask then dessinetri trimsk xm ym color colortrimask thick th_trimask if keyword_set desstrinan then dessinetri trinan x y color colortrinan if keyword_set drawpoints then tracegrille x y color colorpoints fini: IF keyword_set key_performance THEN print temps pltbase systime 1 tempsun return end"); 249 a[247] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltsc.html", "pltsc.pro", "", "PRO pltsc tab1 tab2 min1 max1 min2 max2 varname2 BOXZOOM boxzoom COL1D col1d STY1D sty1d OV1D ov1d _extra ex scatter plot inspired from plt1d include common cm_4mesh cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF Rq: on ne reinitialise pas qd on rapelle pltsc if NOT keyword_set ov1d then reinitplt reduce data xyzt domain if keyword_set boxzoom then BEGIN Case 1 Of N_Elements Boxzoom Eq 1:bte lon1 lon2 lat1 lat2 0 boxzoom 0 N_Elements Boxzoom Eq 2:bte lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 N_Elements Boxzoom Eq 4:bte Boxzoom vert1 vert2 N_Elements Boxzoom Eq 5:bte Boxzoom 0:3 0 Boxzoom 4 N_Elements Boxzoom Eq 6:bte Boxzoom Else: Begin ras report Wrong Definition of Boxzoom return End endcase savedbox 1b saveboxparam boxparam4pltsc dat domdef bte GRIDTYPE vargrid ENDIF extract indexes to plot indexm where tab1 LE valmask 10 tab1 tab1 indexm tab2 tab2 indexm npts size indexm 1 deal with min and max of plot IF finite min1 EQ 0 THEN min1 min tab1 IF finite max1 EQ 0 THEN max1 max tab1 IF finite min2 EQ 0 THEN min2 min tab2 IF finite max2 EQ 0 THEN max2 max tab2 init plot if not overlay IF NOT keyword_set ov1d THEN placedessin yfx posfenetre posbar contour contour _extra ex yy tab1 xx tab2 axis range x range min2 abs max2 min2 5 max2 abs max2 min2 5 y range min1 abs max1 min1 5 max1 abs max1 min1 5 IF NOT keyword_set sty1d THEN sty1d 0 IF NOT keyword_set col1d THEN col1d 0 IF NOT keyword_set ov1d THEN BEGIN legende min1 max1 yfx VARNAME2 varname2 NPTS npts _EXTRA ex plot xx yy background 255 psym sty1d 1 color col1d thick 2 title subtitle _extra ex if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur 0 et trace une ligne a y 0 if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 if where tag_names ex EQ LINESTYLE 0 NE 1 then ex LINESTYLE 0 ENDIF plot x range 0 0 noerase nodata xstyle 1 ystyle 1 _extra ex trace une ligne a x 0 plot 0 0 y range noerase nodata title subtitle _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex 3eme partie: impression eventuelle fini: terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4pltsc dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps plt1d systime 1 tempsun return end "); 250 a[248] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltt.html", "pltt.pro", "", " NAME: PLTT PURPOSE: trace des graphes hovmoller CATEGORY: Graphics trace des graphes hovmoller: xt yt zt t CALLING SEQUENCE: pltt champ type min max datmin datmax INPUTS: champ: le champ dont on veut faire le hovmoller champ peut etre de 2 types: 1 un tableu qui peut etre: 3d ou 4d: la derniere composante etant le temps dans ce cas le tableau va passer dans grossemoyenne pour etre moyennee suivant et devenir un tableau 2d ou 1d 2d: si tableau est deja 2d il n est pas modifie attention les terres doivent etre masquees a la valeure valmask et type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 1d: uniquement pour les traces de type t Type doit qd meme etre specifie pour qu on sache de quel trace il sagit Pour avoir une legende correcte respecifier la zone d extraction via BOXZOOM 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp Le tableau contennu ds la structure repondant aux criteres du cas 1 cf ci dessus TYPE: type de hovmoller que l on veut faire: xt yt zt t ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tableau sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tableau sur les pts mer DATMIN: c est la borne inf de l axe temporel c est un longinteger de la forme yyyymmdd ou bien yymmdd DATMAX: c est la borne max de l axe temporel c est un longinteger de la forme yyyymmdd ou bien yymmdd KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique 3d sur laquelle doit etre fait l extraction du champ pour faire le hovmoeller Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom vert1 vert2 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 vert1 vert2 sont les variables globales definies lors du dernier domdef CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ reponadnt aux meme caracteristiques que l argument numero 1 de pltt ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees EXCHANGE_XY: permet d intervertir les axes FILTER: applique une moyenne glissante de largeur FILTER INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilise pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou le fenetre a l ecran a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot COL1d: OBSOLETE numero de la couleur qd on fait un trace 1d par defaut 0 il faut mieux utiliser le mot cle COLOR utilise par plot MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie CONTNLEVEL: nombre de contours a dessiner qd on utilise ajoutcontour active par le mot cle CONTOUR actif si CONTLABEL 0 par defaut 20 NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre Rq: activer ds le cas d un Postscript de plusieurs traces de type t pour ne pas faire un Postscript de plusieurs pages OV1D:permet de surimprimer un courbe 1d a un precedent trace 1d OVERPLOT: pour faire un pltt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur dans le cas d un plot 1d contrairement a ov1d on peut changer les axes et les ranges PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REPEAT_C n pour repeter une serie temporelle n fois REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin REVERSE_X: pour inverser l axe des x et aussi le dessin REVERSE_Y: pour inverser l axe des y et aussi le dessin STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro STY1D: OBSOLETE numero du style utilise lors d un trace 1d Il faut mieux utiliser le mot cle LINESTYLE qui est celui de plot Attention ce mot cle est encore utile si on veut faire des barres plutot qu une courbe mettre sty1d bar TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant TREND_TYPE: modify data by calling trends pro TYPEIN: permet de specifier la valeur type de hovmoller que l on veut faire: xt yt zt t a l aide d un mot cle plutot que par l argument type Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue USETRI: pour forcer a utiliser de triangulation UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 YXASPECT: rapport d echelle entre y et x Par defaut 1 Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 27 5 98 Jerome Vialard adapting plt to hovmoller drawing 2 7 98 Sebastien Masson 14 8 98 continents barres 15 1 98 adaptation pour les tableaux 3 et 4d pour que la moyenne soit faite dans pltt plutot que lors de la lecture Sebastien Masson 14 8 98 7 1999 Eric Guilyardi 29 7 99 FILTER TREND_TYPE REPEAT_C Sebastien Masson 08 02 2000 checkfield and usetri keyword pro pltt tab giventype givenmin givenmax datmin datmax BOXZOOM boxzoom CONTOUR contour ENDPOINTS endpoints INTERVALLE intervalle INV inv CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel COL1D col1d STY1D sty1d MININ minin MAXIN maxin OV1D ov1d FILTER filter TREND_TYPE trend_type REPEAT_C repeat_c TYPEIN typein XT XT YT YT ZT zt TT tt STRICTFILL strictfill OVERPLOT overplot EXCHANGE_XY exchange_xy _extra ex include common cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance I2 reinitialisation p x y Rq: on ne reinitialise pas qd on rapelle plt en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot AND NOT keyword_set ov1d then reinitplt I1 lecture du champ if keyword_set boxzoom OR keyword_set endpoints AND n_elements contour ne 4 THEN BEGIN savedbox 1b saveboxparam boxparam4pltt dat ENDIF if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein ENDIF checktypeminmax pltt TYPE type MIN min MAX max XT XT YT YT ZT zt TT tt ENDPOINTS endpoints _extra ex if keyword_set endpoints then begin section tab z2d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc nx n_elements glam ny nx if strupcase vargrid EQ W then begin z gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN z gdept firstzt:lastzt nz nzt ENDELSE ENDIF ELSE BEGIN z2d checkfield tab pltt TYPE type BOXZOOM boxzoom direc direc _extra ex if z2d 0 EQ 1 then BEGIN IF keyword_set savedbox THEN restoreboxparam boxparam4pltt dat return endif grille mask glam gphi gdep nx ny nz ENDELSE calcul de tendance anomaly suivant TREND_TYPE IF NOT keyword_set trend_type THEN trend_type 0 IF trend_type GT 0 THEN z2d trends z2d trend_type type filtrage des donnee dans le cas t IF type EQ t AND keyword_set filter THEN BEGIN print Applying a running mean filter of width string filter format I3 z2d smooth z2d filter z2d 0:filter 2 1 0 z2d size z2d 1 filter 2 1: size z2d 1 1 0 ENDIF repetition de la serie temporelle IF NOT keyword_set repeat_c THEN repeat_c 1 temps time 0:jpt 1 IF repeat_c GT 1 THEN BEGIN taille size z2d CASE taille 0 OF 1: z2d reform z2d replicate 1 repeat_c taille 1 repeat_c 2: BEGIN z2d z2d replicate 1 repeat_c z2d reform z2d taille 1 taille 2 repeat_c over END ELSE: ENDCASE temps temps lindgen jpt REPEAT_c 1 1 temps 1 temps 0 temps jpt 1 ENDIF selection du type de graphique taille size z2d case taille 0 of 2 : typdes 2d 1 : begin z1d z2d typdes 1d if keyword_set OV1D then begin yy z2d if n_elements datmin NE 0 then tempsmin date2jul datmin ELSE tempsmin temps 0 on shift l axe du temps pour des questions de precision sur les dates du calendier julien en long qui sont passes en float ds les axes xx temps tempsmin x range x range tempsmin x tickv x tickv tempsmin on fait un faux plot pour appliquer ces changements plot 0 0 noerase xstyle 5 ystyle 5 title subtitle ytitle xtitle goto trace1d endif end endcase on construit le mask pour cela le tableau doit etre masque fait automatiquement a la valeur valmask si on passe ds moyenne ou grossemoyenne nan total finite z2d nan z2d not very nice when xgridstyle 2 same if xticklen 0 5 not very nice in the middle so we draw the top right axis by hand using axis if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 nodata noerase _extra ex xstyle 1 4 keyword_set endpoints AND type EQ xt AND lat1 NE lat2 8 type EQ yt OR type EQ zt ystyle 1 4 keyword_set endpoints AND type EQ yt 8 type EQ xt call axis for the missing axis IF type EQ xt AND NOT keyword_set endpoints THEN BEGIN if n_elements ex NE 0 then if where tag_names ex EQ YTICKNAME 0 NE 1 then ex YTICKNAME replicate n_elements ex YTICKNAME axis yaxis 1 ystyle 1 yticklen 0 ytickname replicate y ticks 1 _extra ex ENDIF IF type EQ yt OR type EQ zt AND NOT keyword_set endpoints THEN BEGIN if n_elements ex NE 0 then if where tag_names ex EQ XTICKNAME 0 NE 1 then ex XTICKNAME replicate n_elements ex XTICKNAME axis xaxis 1 xstyle 1 xticklen 0 xtickname replicate x ticks 1 _extra ex ENDIF ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex endif 1d trace1d: if typdes eq 1d then begin if not keyword_set col1d then col1d 0 if keyword_set sty1d then BEGIN si on veut faire des barres IF strlowcase strtrim sty1d EQ bar then begin y range y range 0 y range 1 y range 0 05 y range 1 bar_plot yy background d n_colors 1 not very nice when xgridstyle 2 same if xticklen 0 5 not very nice in the middle so we draw the top axis by hand using axis if n_elements ex NE 0 then BEGIN pour avoir un cadre de la couleur noire if where tag_names ex EQ COLOR 0 NE 1 then ex COLOR 0 ENDIF plot 0 0 nodata noerase xstyle 1 8 1 keyword_set exchange_xy ystyle 1 8 keyword_set exchange_xy _extra ex call axis for the missing axis if n_elements ex NE 0 then BEGIN force tickname to blank array if where tag_names ex EQ YTICKNAME 0 NE 1 AND keyword_set exchange_xy then ex YTICKNAME replicate n_elements ex YTICKNAME if where tag_names ex EQ XTICKNAME 0 NE 1 AND NOT keyword_set exchange_xy then ex XTICKNAME replicate n_elements ex XTICKNAME ENDIF if keyword_set exchange_xy then axis yaxis 1 ystyle 1 yticklen 0 ytickname replicate y ticks 1 _extra ex ELSE axis xaxis 1 xstyle 1 xticklen 0 xtickname replicate x ticks 1 _extra ex ENDIF ELSE oplot xx yy color col1d linestyle sty1d thick 2 _extra ex endif fini: on remet l axe du temps en jours julien IDL et non pas en jours juliens comptes a partir tempsmin if type EQ xt then BEGIN y range y range tempsmin y tickv y tickv tempsmin ENDIF ELSE BEGIN x range x range tempsmin x tickv x tickv tempsmin ENDELSE on fait un faut plot pour que ces valeurs soient prises en consideration plot 0 0 nodata noerase xstyle 5 ystyle 5 title subtitle ytitle xtitle 3eme partie: impression eventuelle terminedessin _extra ex if keyword_set savedbox THEN restoreboxparam boxparam4pltt dat if n_elements key_performance NE 0 then IF key_performance EQ 1 THEN print temps pltt systime 1 tempsun return end "); 251 a[249] = new Array("./ToBeReviewed/PLOTS/DESSINE/pltz.html", "pltz.pro", "", " NAME: PLTZ PURPOSE: trace des graphes verticaux CATEGORY: Graphics CALLING SEQUENCE: pltz champ min max INPUTS: champ: le champ dont on veut faire la coupe verticale champ peut etre de 2 types: 1 un tableau 2d ou 3d Si le champ est 2d undiquer avec le mot cle boxzoom les delimitations geographiques de la boxzoom Si le chyamp est 3d on extrait la section et on moyenne eventuellement avant de faire le plot 2 une structure repondant aux critaire specifies par litchamp pro cf IDL xhelp litchamp le tableau contenu ds la structure doit etre 2 ou 3d cf cas 1 si dessus ces arguments ne sont pas obligatoires: MAX: valeur maximum que l on veut prendre en compte dans le trace des contours Par defaut on prend le max de tab1 sur les pts mer MIN: valeur minimum que l on veut prendre en compte dans le trace des contours Par defaut on prend le min de tab1 sur les pts mer KEYWORD PARAMETERS: BOXZOOM:vecteur indiquant la zone geographique sur laquelle doit etre faite la coupe Si BOXZOOM a : 1 element : l extraction est faite sur lon1 lon2 lat1 lat2 0 boxzoom 0 2 elements: l extraction est faite sur lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4 elements: l extraction est faite sur Boxzoom 0 200 5 elements: l extraction est faite sur Boxzoom 0:3 0 Boxzoom 4 6 elements: l extraction est faite sur Boxzoom Ou lon1 lon2 lat1 lat2 sont les variables globales definies lors du dernier domdef CB_TITLE: le titre de la colorbar CB_SUBTITLE: le soustitre de la colorbar CB_CHARSIZE: The character size of the color bar annotations CONTINTERVALLE: lorsque CONTOUR est active valeur d un intervalle entre deux isolignes traces par un trait Il peut ainsi etre different de celui specifie par INTERVALLE qui cas ce cas ne controle que les isolignes coloriees en couleurs Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max CONTLABEL: un entier n lorsque CONTOUR est active si n different de 0 choisit le type de label correspondant aux cas n pour les isolignes tracees par un trait Pour specifier le type de label du contour en couleur utiliser LABEL CONTMAX: lorsque CONTOUR est active valeur maximum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_NOFILL: activer pour ne pas remplir les points masques pour les laisser en transparent Rq: on trace qd meme le contour du mask CONT_COLOR: the color of the continent defaut value is d n_colors 1 white CONTMIN: lorsque CONTOUR est active valeur minimum que l on veut prendre en compte dans le trace des isolignes traces par un trait Par defaut on prend le max sur les pts mer du tableau passe ds le mot cle CONTOUR CONTNLEVEL: lorsque CONTOUR est active nombre de contours trace par un trait a dessiner actif si CONTLABEL 0 par defaut 20 CONTOUR: si on veut tracer les contours d un champ different que celui que l on dessin en couleur par ex E P en couleur et QSR en contours Doit etre un champ reponadnt aux meme caracteristiques que l argument numero 1 de pltz ENDPOINTS: mot clef specifiant que l on veut faire une coupe verticale en diagonale les coordonnees des extremites de celle ci sont alors definies les 4 elements du vecteur ENDPOINTS: x1 y1 x2 y2 qui sont les coordonnees INTERVALLE: valeur d un intervalle entre deux isolignes Si aucun min n est specifie on choisit un contour min qui va bien avec l intervalle specifie Si ce mot cle n est pas specifie on trace 20 isolignes du min au max Rq: Qd CONTOUR est active INTERVALLE ne specifie que intervalle entre 2 isolignes coloriees en couleur Pour specifier l intervalle entre 2 isolignes traces par un trait utiliser CONTINTERVALLE INV: inverse le vecteur couleur utilisee pour colorier le graphe sans toucher au noir au blanc et a la palette utilisee ZRATIO: lorsque le dessin presente une partie zoomee rapport de taille entre la partie zommee hz hauteur zoom et le dessin entier ht hauteur total Par defaut 2 3 LABEL: un entier n si n different de 0 choisit le type de label correspondant aux cas n cf label pro Rq: Qd CONTOUR est active ne specifie le type de label que pour les isolignes coloriees en couleur Pour celles tracees par un trait utiliser CONTLABEL LANDSCAPE: oblige la feuille ou la fenetre a etre en position allongee LCT: entier designant le numero de la palette de couleur que l on veut utiliser pour le plot MAXIN: permet de specifier la valeur maximum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument max Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue MININ: permet de specifier la valeur minimum que l on veut prendre en compte dans le trace des contours a l aide d un mot cle plutot que par l argument min Si l argument et le mot cle sont specifies en meme temps c est la valeur specifiee par le mot cle qui est retenue NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou n est pas specifie NOCOLORBAR: activer si on ne veut pas de colorbar NOCONTOUR: activer si on ne veut pas de contour mais juste les couleurs NOFILL: activer si on veut juste les contours en noir et blanc sur fond blanc NOERASE: activer pour faire un dessin a l ecran sans creer une nouvelle fenetre NOTRI: pour forcer a ne pas utiliser de triangulation OVERPLOT: pour faire un plt par dessus un autre Rq: contrairemnet a l utilisation de CONTOUR l utilisation de ce mot clef ne modifie pas la legende ou et la barre de couleur PETITDESSIN: vecteur de 3 ou 4 elements applique pour faire un dessin sur une petite portion de feuille ou d ecran il delimite la zone ds laquelle va etre fait le dessin si il a 4 elements: il est alors constitute des coordonnees exprime en cm reperes par rapport au coin en bas a gauche de la feuille ou de la fenetre en portrait comme en landscape du coin en bas a gauche et du coin en haut a droite de la zone de dessin si il a 3 elements: Ds ce cas on divise la fenetre ou l ecran en PETITDESSIN 0 colonnes en PETITDESSIN 1 lignes le dessin se faisant ds la case numero PETITDESSIN 2 La numerotation commencant en haut a gauche par le numero 1 et suivant apres dans le sens de l ecriture Par defaut on fait un dessin occupant la plus grande place possible tout en concervant le rapport d aspect sauf qd REMPLI est active PORTRAIT: oblige la feuille ou la fenetre a etre en position debout POST: faire une sortie postscript Ne marche que si on fait un seul dessin sur la feuille Si on fait plusieurs dessins utiliser ps ou plein2dessins REMPLI:oblige le dessin a occuper l espace maximum definit par petitdessin SIN: activer ce mot cle si l on veut que l axe des x soit trace en sinus de la latitude qd on fait une coupe yz STRICTFILL: activer ce mot clef pour que le remplissage des contours ce fasse precisement entre le min et le max specifie en laissant en banc les valeurs inferieurs au min specifie et superieurs au max specifie STYLE: style de tracer a adopter pour dessiner les isolignes par defaut style 0 cf style pro TRANS: fait un postscript active post automatiquement et l imprime si on le desire sur un transparant UNLABSUR: entier n specifant qu on ne labelle qu un contour sur n Par defaut unlabsur 2 UNSUR2: si on veut tracer un countour sur deux par defaut trace tous les contours WINDOW: nimero de la fenetre ou l on veut faire le graphe permet d ouvrir plusieurs fenetres par defaut on ouvre IDL0 WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W XZ: force a faire une coupe xz YZ: force a faire une coupe yz YXASPECT: rapport d echelle entre y et x par ex: 1 pour un repere presque orthonorme 2 si l axe des y est environ deux fois plus dilate que celui des x Par defaut on adapte pour occupe une grande partie de la feuille en sortie postScript ou pour cree une fenetre pas trop etiree WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W ZOOM: profondeur jusqu a laquelle on fait un zoom par defaut 200m ou la profondeur maximale si elle est inf a 200 ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1999 Sebastien Masson 08 02 2000 checkfield and notri keyword pro pltz tab giventype givenmin givenmax BOXZOOM boxzoom CONTOUR contour ENDPOINTS endpoints INTERVALLE intervalle INV inv ZRATIO zratio CONTINTERVALLE contintervalle LABEL label CONTLABEL contlabel STYLE style CONTMAX contmax SIN sin TYPEIN typein CONTMIN contmin NLEVEL nlevel CONTNLEVEL contnlevel NOTRI notri USETRI usetri FILLXDIR fillxdir ZOOM zoom XZ xz YZ yz MININ minin MAXIN maxin STRICTFILL strictfill OVERPLOT overplot MASKFILL maskfill WDEPTH wdepth REALSECTION realsection _EXTRA ex include common cm_4mesh cm_4data cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance 1ere partie: initialisation et petits calculs on ne reinitialise pas qd on rapelle pltz en boucle pour utiliser contour if n_elements contour ne 4 AND NOT keyword_set overplot then reinitplt if n_elements contour ne 4 THEN saveboxparam boxparam4pltz dat lecture du champ if n_elements giventype NE 0 then type giventype if n_elements givenmin NE 0 then min givenmin if n_elements givenmax NE 0 then max givenmax if n_elements minin NE 0 then min minin if n_elements maxin NE 0 then max maxin if n_elements realsection EQ 0 then realsection 1 IF n_elements usetri EQ 0 THEN BEGIN IF n_elements notri NE 0 THEN usetri 2 notri ELSE usetri 1 ENDIF no need of triangulation IF usetri EQ 1 AND keyword_set realsection THEN usetri 0 did we specify the type if keyword_set typein then BEGIN if size type type NE 7 AND size type type NE 0 then begin if n_elements min NE 0 then max min min type endif type typein ENDIF checktypeminmax pltz TYPE type MIN min MAX max XZ xz YZ yz ENDPOINTS endpoints _extra ex if keyword_set endpoints then begin section tab z2d glam gphi ENDPOINTS endpoints TYPE type BOXZOOM boxzoom DIREC direc WDEPTH wdepth _extra ex if z2d 0 EQ 1 AND n_elements contour ne 4 then BEGIN restoreboxparam boxparam4pltz dat return ENDIF nx n_elements glam ny nx if strupcase vargrid EQ W then begin gdep gdepw firstzw:lastzw nz nzw ENDIF ELSE BEGIN gdep gdept firstzt:lastzt nz nzt ENDELSE mask z2d LE valmask 10 ENDIF ELSE BEGIN z2d checkfield tab pltz TYPE type BOXZOOM boxzoom DIREC direc WDEPTH wdepth _extra ex if z2d 0 EQ 1 AND n_elements contour ne 4 then BEGIN restoreboxparam boxparam4pltz dat return ENDIF IF realsection EQ 1 THEN grille mask glam gphi gdep nx ny nz ifpltz type WDEPTH wdepth ELSE grille mask glam gphi gdep nx ny nz WDEPTH wdepth ENDELSE stop profmax y range 0 profmin y range 1 if not keyword_set zoom then zoom 200 zoom zoom 0 IF zoom LT profmin THEN zoom profmax if zoom GE vert2 then zoom profmax construction of the mask and of the axis axis4pltz type mask glam gphi gdep XXAXIS xxaxis ZZAXIS zzaxis SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex to draw from bottom to top avoid using cell_fill z2d reverse z2d 2 determination du mi:min et du ma:max de tab1 ainsi que de max: max et min: min pour le dessin nan total finite z2d nan z2d max if n_elements maskfill NE 0 then BEGIN z2d z2d mask masknan if maskfill NE 0 then z2d temporary z2d maskfill 1b mask masknan ENDIF check the mask and the triangulation according to the grid type and nan values find the coordinates of the mask if where mask EQ 0 0 EQ 1 AND NOT keyword_set nan then notri 1 if keyword_set notri then trifield 1 ELSE trifield triangule mask basic if usetri GE 1 AND vargrid EQ T OR vargrid EQ W OR usetri EQ 2 AND vargrid NE T AND vargrid NE W THEN trifield triangule mask basic IF NOT keyword_set endpoints THEN BEGIN if keyword_set nan then trinan triangule masknan basic coinmonte coinmontenan coindescend coindescendnan decoupeterre mask glammsk gphimsk gdepmsk type type WDEPTH wdepth REALSECTION realsection axis4pltz type mask glammsk gphimsk gdepmsk XXAXIS xmask ZZAXIS zmask SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex ENDIF ELSE BEGIN xmask xxaxis zmask zzaxis ENDELSE if usetri GE 1 AND vargrid NE T AND vargrid NE W THEN BEGIN IF keyword_set realsection THEN trimsk triangule mask basic ELSE trimsk triangule mask basic coinmonte coinmontemask coindescend coindescendmask ENDIF dessin en lui meme pltbase z2d xxaxis zzaxis mask xmask zmask level_z2d colnumb overplot overplot contour contour trichamp trifield trimsk trimsk c_linestyle linestyle c_labels 1 indgen n_elements level_z2d MOD 2 c_thick thick unsur2 unsur2 masknan masknan trinan trinan coinmontenan coinmontenan coindescendnan coindescendnan coinmontemask coinmontemask coindescendmask coindescendmask REALSECTION realsection USETRI usetri _extra ex rappelle de pltz en boucle qd contour est active if n_elements contour eq 4 then BEGIN c est la 2eme fois que je passe ds pltt contour mietma: mi ma unit:varunit inter:intervalle je renvoie le min le max et l unite return endif if keyword_set contour THEN BEGIN pourlegende 1 1 1 1 oldattributs saveatt oldcolnumb colnumb pltz contour contmin contmax CONTOUR pourlegende ZRATIO zratio INTERVALLE contintervalle LABEL contlabel STYLE style noerase NLEVEL contnlevel ZOOM zoom BOXZOOM boxzoom ENDPOINTS endpoints STRICTFILL strictfill REALSECTION realsection MASKFILL maskfill USETRI usetri WDEPTH wdepth _extra ex restoreatt oldattributs colnumb oldcolnumb ENDIF 3eme partie: dessin du cadre legendes colorbar if keyword_set overplot then BEGIN y range zoom profmin on repasse en coordonees physiques plot 0 0 nodata noerase title subtitle xstyle 5 ystyle 5 GOTO fini endif legendes affichage de celles ci legende mi ma type CONTOUR pourlegende INTERVALLE intervalle DIREC direc endpoints endpoints _EXTRA ex if type eq yz then xaxe lataxe else xaxe lonaxe if keyword_set sin OR NOT key_onearth then xaxe cadre applique par defaut plot xxaxis 0 xxaxis n_elements xxaxis 1 zratio zratio noerase xstyle 1 4 keyword_set endpoints AND type EQ xz AND lat1 NE lat2 OR type EQ yz AND lon1 NE lon2 xtickformat xaxe _extra ex ajout d un axe ds le cas ou l on utilise endpoints if keyword_set endpoints then addaxe endpoints type posfenetre _EXTRA ex axe y en 1 ou 2 parties if n_elements ex NE 0 then BEGIN pour ne plus mettre de titre if where tag_names ex EQ TITLE 0 NE 1 then ex TITLE pour ne plus mettre de sous titre if where tag_names ex EQ SUBTITLE 0 NE 1 then ex SUBTITLE pour n avoir q un ytitle if where tag_names ex EQ YTITLE 0 NE 1 then BEGIN ytitle ex YTITLE ex YTITLE endif ENDIF htotal posfenetre 3 posfenetre 1 hzoom 1 zratio htotal if zoom LT profmax then plot 0 0 nodata noerase ystyle 1 yrange profmax zoom 0 001 position posfenetre 0 0 0 hzoom _extra ex title subtitle ytitle y range zoom profmin on repasse en coordonees physiques plot 0 0 nodata noerase ystyle 1 _extra ex title subtitle ytitle position posfenetre 0 htotal hzoom 0 0 pour ecrire le ytitle if d name EQ PS then xs max page_size min mi 1 key_portrait mi key_portrait d x_px_cm ELSE xs d x_size if n_elements ytitle NE 0 then y title ytitle charsize chkstru ex ycharsize extract if charsize EQ 1 then charsize p charsize IF chkstru ex charsize THEN ex charsize charsize if chkstru ex ytitle extract NE then decalage string format e10 3 profmax decalage float strmid decalage strpos decalage e 1 posy posfenetre 1 1 htotal 2 posx posfenetre 0 decalage 3 d x_ch_size charsize xs xyouts posx posy y title normal orientation 90 color 0 ALIGNMENT 5 charsize charsize _extra ex barre de couleur colnumb colnumb 0:ncontour 1 keyword_set strictfill barrecouleur colnumb min max ncontour keyword_set strictfill 2 position posbar _extra ex 4eme partie: impression eventuelle fini: terminedessin _extra ex sortie: restoreboxparam boxparam4pltz dat if keyword_set key_performance NE 0 THEN print temps pltz systime 1 tempsun return end "); 252 a[250] = new Array("./ToBeReviewed/PLOTS/DESSINE/sbar_plot.html", "sbar_plot.pro", "", " NAME:sbar_plot super bar_plot PURPOSE: meme chose que bar_plot mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: sbar_plot y INPUTS: cd IDL bar_plot KEYWORD PARAMETERS: meme que ceux de bar_plot avec en plus: COLORS: un entier donnant la couleur de toutes les barres de couleurs contrairement a colors qui est en vecteur donnant le couleur de chaque barre de couleur NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: Si NOREINITPLT n est pas ective toutes les variables d environnemet p x y z sont reinitialisees par la procedure reinitplt RESTRICTIONS: EXAMPLE: IDL sbar_plot indgen 10 small 2 2 2 rempli IDL sbar_plot indgen 10 small 2 2 3 noerase IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 10 1999 PRO sbar_plot Values COLORS colors NOREINITPLT noreinitplt _extra ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript IF chkstru ex overplot EQ 0 THEN placedessin autre _extra ex 3 je fais mon joli dessin if n_elements COLORS NE 0 then BEGIN if n_elements COLORS EQ n_elements Values then col colors ELSE col replicate colors 0 n_elements Values ENDIF ELSE col congrid indgen d n_colors 256 n_elements Values bar_plot Values background p background colors col xstyle 1 ystyle 1 _extra ex 4 je termine le dessin terminedessin _extra ex return end"); 253 a[251] = new Array("./ToBeReviewed/PLOTS/DESSINE/scontour.html", "scontour.pro", "", " NAME:scontour super contour PURPOSE: meme chose que contour mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: scontour z x y INPUTS:cd IDL contour KEYWORD PARAMETERS: meme que ceux de bar_plot avec en plus: NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL z dist 100 IDL scontour z nlevels 10 small 1 2 1 xstyle 1 ystyle 1 IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 10 1999 PRO scontour x y z NOREINITPLT noreinitplt _EXTRA ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript if ex contains norease and c_orientation keywords we force ex noerase 0 IF chkstru ex overplot EQ 0 THEN placedessin autre _extra ex fiddle when noerase is used with c_orentation call contour with nodata to get the graphic envoronment then force noerase 0 and overplot 1 IF size ex type EQ 8 THEN BEGIN check if noerase is used with c_orentation alltags strlowcase tag_names ex dummy where alltags EQ noerase count1 dummy where alltags EQ c_orientation count2 IF count1 count2 NE 0 THEN BEGIN case n_params OF 1:contour x nodata _EXTRA ex 2:contour x y nodata _EXTRA ex 3:contour x y z nodata _EXTRA ex endcase ex noerase 0 ex get_extra overplot _extra ex noerase_orientation 1 ENDIF ENDIF 3 je fais mon joli dessin case n_params OF 1:contour x xstyle 1 ystyle 1 _EXTRA ex 2:contour x y xstyle 1 ystyle 1 _EXTRA ex 3:contour x y z xstyle 1 ystyle 1 _EXTRA ex ENDCASE fiddle when noerase is used with c_orentation draw the contour axis IF keyword_set noerase_orientation THEN BEGIN ex noerase 1 ex overplot 0 case n_params OF 1:contour x xstyle 1 ystyle 1 nodata _EXTRA ex 2:contour x y xstyle 1 ystyle 1 nodata _EXTRA ex 3:contour x y z xstyle 1 ystyle 1 nodata _EXTRA ex ENDCASE ENDIF 4 je termine le dessin terminedessin _extra ex return end"); 254 a[252] = new Array("./ToBeReviewed/PLOTS/DESSINE/splot.html", "splot.pro", "", " NAME:splot super plot PURPOSE: meme chose que plot mais compatible avec l ensemble de l environnement common pro est inclu CATEGORY:dessine CALLING SEQUENCE: PLOT X Y INPUTS:cd IDL plot KEYWORD PARAMETERS: meme que ceux de plot avec en plus: NOREINITPLT: a actier si on ne veut pas que les variables d environnemet p x y z soient reinitialisees par la procedure reinitplt OUTPUTS: Si NOREINITPLT n est pas ective toutes les variables d environnemet p x y z sont reinitialisees par la procedure reinitplt COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL splot indgen 10 ystyle 1 small 1 2 1 portrait IDL splot indgen 10 ystyle 1 small 1 2 2 noerase IDL ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 PRO splot x y NOREINITPLT noreinitplt _EXTRA ex common 1 je reinitialise l environnememt graphique les variables x y et p : if NOT keyword_set NOREINITPLT then reinitplt _extra ex 2 je place le dessin a l ecran comme sur le postcript placedessin autre _extra ex 3 je fais mon joli dessin if n_elements y EQ 0 then plot x xstyle 1 ystyle 1 _EXTRA ex ELSE plot x y xstyle 1 ystyle 1 _EXTRA ex 4 je termine le dessin terminedessin _extra ex return end"); 255 a[253] = new Array("./ToBeReviewed/PLOTS/DESSINE/tvplus.html", "tvplus.pro", "", " NAME: tvplus PURPOSE: enhanced version of tvscl CATEGORY: quick exploration of 2D arrays CALLING SEQUENCE: tvplus z2d cellsize INPUTS: z2d: 2D array to visualize cellsize: optional this is the size in pixel of the square representing 1 array element By default this size is computed automatically in order that the size of the plotting window do not exceed the screen size If the user specify a large value of cellsize that forces tvplus to create a window larger than the screen a scrolling window will be displayed instead of a regular window Unfortunately the nice fonctionnalities of tvplus are not coded for scrolling window case KEYWORD PARAMETERS: BOTTOM: The lowest color index of the colors to be loaded in the bar default is 0 C_NAN: The color number that should be used for the NaN values default value is d n_colors 1 e6 the test to find the masked value is ge abs mask 10 This is necessary to avoid the rounding errors MIN and MAX: scalars used to specify the min and max values of the color bar default is from 0 to d n_colors tvplus dist 100 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 18 12 98 Aug 2005: quick cleaning english PRO tvplus z2d cellsize BOTTOM bottom C_MASK c_mask C_NAN c_nan WINDOW window MIN min MAX max MASK mask OFFSET offset NOUSEINFOS NOUSEINFOS NCOLORS ncolors NOINTERP nointerp _EXTRA ex IF n_elements z2d EQ 0 THEN return arr reform float z2d check the size of the input array if size arr 0 NE 2 then begin ras report Input array must have only 2 dimensions and not strtrim size arr n_dimensions 1 return endif def of ncolmax bottom topcol et ncolors ncolmax d n_colors arr truemin min ENDIF ELSE truemin min arr if n_elements max NE 0 then BEGIN arr arr floor x cellsize floor y cellsize floor x cellsize floor y cellsize floor x2 cellsize floor y2 cellsize size arr 2 cellsize 1 x x x2 x x sort x y y y2 y y sort y IF keyword_set OFFSET THEN offset x 0 y 0 offset ELSE offset x 0 y 0 tvplus z2d x 0 :x 1 y 0 :y 1 WINDOW window MIN min MAX max MASK mask C_MASK c_mask C_NAN c_nan NOUSEINFOS OFFSET OFFSET NCOLORS ncolors NOINTERP nointerp BOTTOM bottom _EXTRA ex return END ELSE: endcase ENDWHILE x xenvsauve y yenvsauve p penvsauve x range 1 0 nx cellsize 5 offset 0 y range 1 0 ny cellsize 5 offset 1 return end"); 256 a[254] = new Array("./ToBeReviewed/PLOTS/DIVERS/addaxe.html", "addaxe.pro", "", " NAME:addaxe PURPOSE:ajoute un axe qd on fait une section oblique ds pltz pltt ou plt1d CATEGORY:autour de pltz pltt et plt1d CALLING SEQUENCE:addaxe type posfenetre INPUTS:endpoints:coordonnees des extremites de a section type: un string de 2 characteres specifiant qule type de plot on fait posfenetre: ler vecteur p posotion correspondant a a position du cadre de la partie dessin du plot KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO addaxe endpoints type posfenetre _EXTRA ex common IF strpos type x NE 1 THEN BEGIN IF endpoints 1 EQ endpoints 3 THEN return IF key_onearth THEN BEGIN formeaxe0 lonaxe formeaxe1 lataxe titreaxe latitude ENDIF ELSE BEGIN formeaxe0 formeaxe1 titreaxe j index ENDELSE range endpoints 1 endpoints 3 if endpoints 2 LT endpoints 0 THEN range reverse range ENDIF ELSE BEGIN IF endpoints 0 EQ endpoints 2 THEN return IF key_onearth THEN BEGIN formeaxe0 lataxe formeaxe1 lonaxe titreaxe longitude ENDIF ELSE BEGIN formeaxe0 formeaxe1 titreaxe i index ENDELSE range endpoints 0 endpoints 2 if endpoints 3 LT endpoints 1 THEN range reverse range ENDELSE if type EQ yt then BEGIN axis yaxis 0 ytickformat formeaxe0 color 0 ystyle 1 _EXTRA ex axis yaxis 1 ytickformat formeaxe1 color 0 ystyle 1 ytitle titreaxe yrange range _EXTRA ex ENDIF ELSE BEGIN axis xaxis 0 xtickformat formeaxe0 color 0 xstyle 1 _EXTRA ex axis xaxis 1 xtickformat formeaxe1 color 0 xstyle 1 xtitle titreaxe xrange range _EXTRA ex ENDELSE return end"); 257 a[255] = new Array("./ToBeReviewed/PLOTS/DIVERS/autoscale.html", "autoscale.pro", "", " NAME: autoscale PURPOSE: on donne un min et un max et la procedure renvoie le contour intevalle qui va bien et la valeur des labels CATEGORY: autour de CONTOUR CALLING SEQUENCE: autoscale min max ci INPUTS: min et max: 2 reels specifiants entre quel min et quel max on veut tracer un contour KEYWORD PARAMETERS: none OUTPUTS: ci et evenuellement levels ci est un reel qui donne le contour intevalle A utiliser ds CONTOUR avlec le mot clef LEVEL COMMON BLOCKS: SIDE EFFECTS: CI est un multiple de l unite en unite log de 10 force le nombre de contour a etre pair RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: G Roullet aout 99 gr lodyc jussieu fr PRO autoscale min max ci estimation d un premier CI notez la presence du floor arrondi inferieur ce CI est un multiple de l unite en unite log de 10 ci max min 20 ci 10 floor alog10 ci n 0 ci0 ci coef 2 2 5 5 10 test differents CI contour intervales i e 1 2 2 5 5 et 10 jusqu a ce que le nombre de contours soit inferieur a 30 WHILE ceil max min ci GE 30 DO BEGIN ci ci0 coef n n n 1 ENDWHILE min floor min ci 2 ci 2 max ceil max ci 2 ci 2 nlevels round max min ci force le nombre de contour a etre pair IF nlevels MOD 2 EQ 1 THEN BEGIN nlevels nlevels 1 max max ci END END "); 258 a[256] = new Array("./ToBeReviewed/PLOTS/DIVERS/axis4pltz.html", "axis4pltz.pro", "", " NAME:axis4pltz PURPOSE:compute the mask and the axis for a vertical section CATEGORY: CALLING SEQUENCE: INPUTS:mask: 3d mask glam gphi: 2d longitudes and latitudes z:1d depth KEYWORD PARAMETERS: XXAXIS to get the xaxis we need to use in pltbase ZZAXIS to get the yaxis we need to use in pltbase Others: see pltz OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 24 2002 PRO axis4pltz type mask glam gphi z XXAXIS xxaxis ZZAXIS zzaxis SIN sin ZRATIO zratio ZOOM zoom PROFMAX profmax PROFMIN profmin _extra ex include common cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF define the mask used for this section if mask 0 NE 1 AND size mask 0 NE 2 then begin if type EQ xz then mask total mask 2 1 ELSE mask total mask 1 1 endif define xxaxis and yyaxis the axis used for this section nx size glam 1 CASE size gphi 0 OF 1:ny size gphi 1 2:ny size gphi 2 ENDCASE CASE size z 0 OF 1:nz size z 1 2:nz size z 2 ENDCASE if type eq yz then BEGIN IF size gphi 0 EQ 1 then xxaxis gphi ELSE BEGIN IF keyword_set key_irregular THEN BEGIN cln where gphi EQ max gphi 0 xxaxis reform gphi cln MOD nx ENDIF ELSE xxaxis reform gphi 0 ENDELSE if keyword_set sin then xxaxis sin pi 180 xxaxis if size z 0 EQ 1 THEN zzaxis z ELSE zzaxis z ENDIF ELSE BEGIN xxaxis glam 0 if size z 0 EQ 1 then zzaxis z ELSE zzaxis z ENDELSE on projette l axe z dans 0 1 if not keyword_set zratio then zratio 2 3 if zoom ge profmax then zratio 1 if zoom LT profmax then begin mp projsegment profmin zoom 0 zratio mp zzaxis where zzaxis LE zoom mp 0 zzaxis where zzaxis LE zoom mp 1 mp projsegment zoom profmax zratio 1 mp zzaxis where zzaxis GE zoom mp 0 zzaxis where zzaxis GE zoom mp 1 ENDIF ELSE BEGIN mp projsegment profmin profmax 0 1 mp zzaxis mp 0 zzaxis mp 1 ENDELSE to draw from bottom to top avoid using cell_fill CASE size zzaxis n_dimensions OF 1:zzaxis reverse zzaxis 2:zzaxis reverse zzaxis 2 ENDCASE if mask 0 NE 1 then mask reverse mask 2 return end"); 259 a[257] = new Array("./ToBeReviewed/PLOTS/DIVERS/barrecouleur.html", "barrecouleur.pro", "", " NAME:barrecouleur PURPOSE:surcouche de colorbar CATEGORY:delestage de l ecriture de plt pltz pltt CALLING SEQUENCE:barrecouleur SIDE EFFECTS: passer tous les arguments que l on veut grace a _extra MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 23 12 98 PRO barrecouleur colnumb clbinf clbsup clbdiv NOCOLORBAR nocolorbar CB_TITLE cb_title NOFILL nofill COLOR_c color_c min min max max divisions divisions CB_SUBTITLE cb_subtitle POST post _extra ex cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF if keyword_set min then clbinf min if keyword_set max then clbsup min if keyword_set divisions THEN clbdiv divisions nocolorbar keyword_set nocolorbar keyword_set nofill keyword_set color_c def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used colorbarparam colnumb:colnumb clbinf:clbinf clbsup:clbsup clbdiv:clbdiv ENDIF ELSE BEGIN save colnumb clbinf clbsup clbdiv file myuniquetmpdir 4colorbar dat ENDELSE if keyword_set nocolorbar then return ancienx x ancieny y ancienp p reinitplt x style 1 y style 1 colorbar cb_color 0 cb_charsize ancienp charsize pscolor keyword_set post division clbdiv min clbinf max clbsup cb_title cb_title discret colnumb _extra ex x ancienx y ancieny p ancienp return end"); 260 a[258] = new Array("./ToBeReviewed/PLOTS/DIVERS/checkfield.html", "checkfield.pro", "", " NAME:checkfield PURPOSE:en entree de plt pltz pltt et plt1d verifie que le champ donne a bien une taille compatible avec le domaine et fait au besoin les moyennes pour ressortir en fin de fonction un tableau 2d si on fait un plot du type: xy xz xt yz yt zt ou un tableau 1d si on fait un plot du type x y z t CATEGORY:en entree de plt pltz pltt et plt1d CALLING SEQUENCE:res checkfield field procedure INPUTS: filed: un champ recomdant aux criteres de litchamp pro cf IDL xhelp litchamp KEYWORD PARAMETERS: WDEPTH: to specify that the field is at W depth instad of T depth automatically activated if vargrid eq W OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 08 02 2000 FUNCTION err_1d type n1 name n2 return report Error in type type plot with a 1D input array: the number of elements of the input vector strtrim n1 1 is not equal to name strtrim n2 1 simple END FUNCTION err_2d type sz nx ny nz cm_4mesh cm_4cal return report Error in type type plot with a 2D input array: the array dimensions tostr sz 1:2 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION err_3d type sz nx ny nz cm_4mesh cm_4cal return report Error in type type plot with a 3D input array: the array dimensions tostr sz 1:3 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION checkfield field procedure TYPE type BOXZOOM boxzoom DIREC direc NOQUESTION noquestion VECTEUR vecteur WDEPTH wdepth _EXTRA ex include commons cm_4mesh cm_4cal cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF I1 lecture du champ if n_elements field EQ 0 then return report field undefined arr litchamp field first check IF n_elements arr EQ 1 THEN BEGIN if arr EQ 1 then return report Error: input array 1 Maybe the reading did ont perform well simple ELSE return report Error: input array is a scalar simple ENDIF nan total finite arr nan firstzw 1 lastzw lastzw 1 firstzt 1 lastzt lastzt 1 jpk 1 nzt lastzt firstzt 1 ENDELSE updateold ENDIF make the automatic definition of type for pltz if type is not specified IF type EQ z AND procedure EQ pltz THEN if lon2 lon1 gt lat2 lat1 then type xz else type yz make the automatic definition of type for pltt if type is not specified IF type EQ unkownpltt AND procedure EQ pltt THEN if lon2 lon1 gt lat2 lat1 then type xt else type yt verification de la taille du tableau d entree et de la valeur de type grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth basic checks CASE 1 OF nx EQ 1: IF strpos type x NE 1 THEN return report Error: impossible to make a type type plot with nx 1 simple ny EQ 1: IF strpos type y NE 1 THEN return report Error: impossible to make a type type plot with ny 1 simple nz EQ 1: IF strpos type z NE 1 THEN return report Error: impossible to make a type type plot with nz 1 simple jpt EQ 1: IF strpos type t NE 1 THEN return report Error: impossible to make a type type plot with jpt 1 simple ELSE: ENDCASE is the size of the array compatible with teh domain arr fitintobox temporary arr nx ny nz firstx firsty firstz lastx lasty lastz sz size arr case sz 0 of 0:return arr 1:BEGIN nele n_elements arr case type of t :if jpt NE nele THEN return err_1d type nele jpt jpt x :IF nx NE nele THEN return err_1d type nele nx nx y :IF ny NE nele THEN return err_1d type nele ny ny z :IF nz NE nele THEN return err_1d type nele nz nx ELSE:return report Error: Impossible to make a type plot with a 1D array simple ENDCASE END 2:BEGIN case type of x :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny:direc y xy array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz:direc z x y z array sz 1 EQ nx AND sz 2 EQ jpt:direc t xt array ELSE:return err_2d type sz nx ny nz endcase end y :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny:direc x xy array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz:direc z x yz array sz 1 EQ ny AND sz 2 EQ jpt:direc t yt array ELSE:return err_2d type sz nx ny nz endcase END z :BEGIN case 1 of sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz:direc x x y z array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz:direc y x yz array sz 1 EQ nz AND sz 2 EQ jpt:direc t zt array ELSE:return err_2d type sz nx ny nz endcase END t :BEGIN case 1 OF sz 1 EQ nx AND sz 2 EQ jpt:direc x xt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpt:direc y x yt array nx EQ 1 AND ny EQ 1 AND sz 1 EQ nz AND sz 2 EQ jpt:direc z x y zt array ELSE:return err_2d type sz nx ny nz ENDCASE END xy :IF sz 1 NE nx OR sz 2 ne ny THEN return err_2d type sz nx ny nz xy array xz :IF sz 1 NE nx OR sz 2 ne nz THEN return err_2d type sz nx ny nz xz array yz :IF sz 1 NE ny OR sz 2 NE nz THEN return err_2d type sz nx ny nz yz array xt :IF sz 1 NE nx OR sz 2 NE jpt THEN return err_2d type sz nx ny nz xt array yt :IF sz 1 NE ny OR sz 2 NE jpt THEN return err_2d type sz nx ny nz yt array zt :IF sz 1 NE nz OR sz 2 NE jpt THEN return err_2d type sz nx ny nz zt array ENDCASE END 3:BEGIN case type of x :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc yz xyz array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc zt x y zt array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc yt xyt array ELSE:return err_3d type sz nx ny nz endcase END y :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc xz xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc zt x yzt array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc xt xyt array ELSE:return err_3d type sz nx ny nz endcase END z :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc xy xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc yt x yzt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc xt x y zt array ELSE:return err_3d type sz nx ny nz endcase END t :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc xy xyt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc yz x yzt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc xz x y zt array ELSE:return err_3d type sz nx ny nz endcase END xy :BEGIN case 1 OF sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc z xyz array sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc t xyt array ELSE:return err_3d type sz nx ny nz endcase END xz :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc y xyz array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc t x y zt ELSE:return err_3d type sz nx ny nz endcase END yz :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz:direc x xyz array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc t x yzt ELSE:return err_3d type sz nx ny nz endcase END xt :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc y xyt array sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc z x y zt array ELSE:return err_3d type sz nx ny nz endcase END yt :BEGIN case 1 of sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt:direc x xyt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc z x yzt array ELSE:return err_3d type sz nx ny nz endcase END zt :BEGIN case 1 of sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:direc x x y zt array nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt:direc y x yzt array ELSE:return err_3d type sz nx ny nz ENDCASE END ENDCASE END 4:BEGIN CASE type OF x :direc yzt y :direc xzt z :direc xyt t :direc xyz xy :direc zt xz :direc yt yz :direc xt xt :direc yz yt :direc xz zt :direc xy ENDCASE END ENDCASE IF keyword_set direc THEN BEGIN IF strpos direc t NE 1 OR strpos type t NE 1 THEN arr grossemoyenne temporary arr direc boxzoom localbox NAN nan NODOMDEF WDEPTH wdepth _extra ex ELSE arr moyenne temporary arr direc boxzoom localbox NAN nan NODOMDEF WDEPTH wdepth _extra ex ENDIF RETURN arr END"); 261 a[259] = new Array("./ToBeReviewed/PLOTS/DIVERS/checktypeminmax.html", "checktypeminmax.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO checktypeminmax procedure TYPE type MIN min MAX max XY xy XZ xz YZ yz XT XT YT YT ZT zt TT tt XX xx YY yy ZZ zz XINDEX xindex YINDEX yindex ENDPOINTS endpoints _extra ex common case size type type of 0: 7: ELSE:BEGIN vraimin type case size min type of 0:BEGIN min vraimin type 0 END 7:BEGIN type min min vraimin end ELSE:BEGIN case size max type of 0:BEGIN max min min vraimin type 0 END 7:BEGIN type max max min min vraimin end ELSE:BEGIN rien report Probleme dans la definition des arguments en entree de procedure chkwidget return end endcase end endcase end endcase if keyword_set xy then type xy if keyword_set xz then type xz if keyword_set yz then type yz if keyword_set xt then type xt if keyword_set yt then type yt if keyword_set zt then type zt if keyword_set tt then type t if keyword_set xx then type x if keyword_set yy then type y if keyword_set zz then type z if keyword_set type then begin if type EQ plt then type if type EQ pltz then type if type EQ pltt then type if type EQ plt1d then type endif determination du type de plot que l on veut faire if NOT keyword_set type then BEGIN case procedure of plt :type xy pltz :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 if lon2 lon1 gt lat2 lat1 then type xz else type yz ENDIF ELSE type z END pltt :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 lat2 max endpoints 1 endpoints 3 if lon2 lon1 gt lat2 lat1 then type xt else type yt ENDIF ELSE type unkownpltt END plt1d :BEGIN if keyword_set endpoints then BEGIN lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 if lon2 lon1 gt lat2 lat1 then type x else type y ENDIF ELSE BEGIN type WHILE type NE x AND type NE y AND type NE z DO BEGIN type xquestion Quel type de plot 1D voulez vous faire x y z ou t chkwidget type strlowcase type endwhile ENDELSE END endcase ENDIF WHILE type NE xy AND type NE xz AND type NE yz AND type NE xt AND type NE yt AND type NE zt AND type NE t AND type NE x AND type NE y AND type NE z AND type NE unkownpltt DO BEGIN type xquestion What kind of plot do you want to do xy xz yz xt yt zt t x y z chkwidget type strlowcase type ENDWHILE return end"); 262 a[260] = new Array("./ToBeReviewed/PLOTS/DIVERS/determineminmax.html", "determineminmax.pro", "", " NAME:determineminmax PURPOSE:determiner le min et le max d un tableau masque CATEGORY: delestage de l ecriture de plt pltz pltt CALLING SEQUENCE:determineminmax tab mask vraimin vraimax INPUTS: tab: le tableau dont il faut determiner le min et le max mask: le tableau de masque KEYWORD PARAMETERS: minin et maxin deux scalaire qui s il ne sont pas definits prennent la valeur de vraimin et vraimax ZEROMIDDLE: fo force the middle of the colorbar to be equal to 0 force max max abs min max and min max OUTPUTS: vraimin et vraimax: le min et le max du tableau COMMON BLOCKS: common pro SIDE EFFECTS:degarde si le champ est constant sur la mer RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 PRO determineminmax tab mask vraimin vraimax glam gphi MAXIN maxin MININ minin INTERVALLE intervalle usetri usetri ZEROMIDDLE zeromiddle _extra ex common type de grille verticale: if vargrid EQ W then nz nzw ELSE nz nzt liste des points mer if size mask 0 EQ 3 then mer mask 0 ELSE mer mask si key_irregular eq 1 on masque aussi les points qui ne rentrent pas ds le domaine geographique definit par lon1 lon2 lat1 lat2 if keyword_set key_irregular AND n_elements glam NE 0 AND n_elements gphi NE 0 then begin dom where glam LT lon1 OR glam GT lon2 OR gphi LT lat1 OR gphi GT lat2 if dom 0 NE 1 then mer dom 0 endif mer where mer eq 1 if mer 0 eq 1 then begin ras report Il n y a que de la terre sur le dessin vraimax 0 vraimin 0 maxin vraimax 1 minin vraimin 1 usetri 0 return endif ma et mi : max et min sur les points mer vraimax max tab mer min vraimin _extra ex sameminmax testvar var minin EQ testvar var maxin if n_elements maxin EQ 0 OR sameminmax then maxin vraimax if n_elements minin EQ 0 OR sameminmax then BEGIN if keyword_set intervalle then minin floor vraimin intervalle intervalle ELSE minin vraimin endif if vraimin eq vraimax then BEGIN IF size vraimin type EQ 1 THEN vraimin fix vraimin question Warning: constant filed same value everywhere : strtrim vraimin 2 Shall we make the plot answer report question default_no question if answer then begin maxin vraimax 1 minin vraimin 1 endif ELSE tab 1 ENDIF IF keyword_set zeromiddle THEN BEGIN maxin max abs minin maxin minin maxin ENDIF return end"); 263 a[261] = new Array("./ToBeReviewed/PLOTS/DIVERS/givewindowsize.html", "givewindowsize.pro", "", "FUNCTION givewindowsize include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF dimensions get_screen_size RESOLUTION resolution coef floor 1 resolution 0 if NOT keyword_set windowsize_scale then BEGIN windowsize_scale 1 IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF ENDIF coef windowsize_scale coef mipgsz min page_size max mapgsz xsize coef mipgsz key_portrait mapgsz 1 key_portrait ysize coef mipgsz 1 key_portrait mapgsz key_portrait return xsize ysize end"); 264 a[262] = new Array("./ToBeReviewed/PLOTS/DIVERS/meridienparallele.html", "meridienparallele.pro", "", " NAME:meridienparallele PURPOSE:trace certains medidiens ou paralles CATEGORY: CALLING SEQUENCE:meridienparallele coupe INPUTS:coupe: le type de dessin que l on traite COMMON BLOCKS: common pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 PRO meridienparallele coupe common case coupe of xy :BEGIN if lon1 lt 180 and lon2 gt 180 then plot 180 180 lat1 lat2 noerase color 0 if lon1 lt 0 and lon2 gt 0 then plot 0 0 lat1 lat2 noerase color 0 if lon1 lt 360 and lon2 gt 360 then plot 360 360 lat1 lat2 noerase color 0 if lat1 lt 0 and lat2 gt 0 then plot lon1 lon2 0 0 noerase color 0 END endcase return end"); 265 a[263] = new Array("./ToBeReviewed/PLOTS/DIVERS/placecolor.html", "placecolor.pro", "", " NAME:PLACECOLOR PURPOSE:permet de tracer la colorbar independammment d un graphe CATEGORY:graph CALLING SEQUENCE:placecolor pos INPUTS: pos:vecteur de 4 elements donnant les coordonnees du coin en bas a gauche et de celui en haut a droite en cm ds lequel on veut faire la barre de couleur KEYWORD PARAMETERS: tous ceux de colorbar pro par defaut trace une barre de couleur du meme type que celle presente ds plt et pltz si max min et divisions ne sont pas stipulees alors max sup min inf et divisions div OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS:utilisable que pour les POSTCRIPT effectues avec plein2dessin EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 5 98 pro placecolor pos _extra ex include commons cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF xsave x ysave y psave p reinitplt z invert pos 1 pos mipgsz min page_size max mapgsz if key_portrait eq 1 then begin pos 0 pos 0 mipgsz pos 1 pos 1 mapgsz pos 2 pos 2 mipgsz pos 3 pos 3 mapgsz endif else begin pos 0 pos 0 mapgsz pos 1 pos 1 mipgsz pos 2 pos 2 mapgsz pos 3 pos 3 mipgsz ENDELSE def_myuniquetmpdir IF lmgr demo EQ 1 THEN BEGIN if we are in demo mode we cannot save the parameters in a temporary file cm_demomode_used colnumb colorbarparam colnumb clbinf colorbarparam clbinf clbsup colorbarparam clbsup clbdiv colorbarparam clbdiv ENDIF ELSE BEGIN file myuniquetmpdir 4colorbar dat IF file_test file THEN BEGIN restore file if size ex type EQ 8 then BEGIN if where tag_names ex EQ MIN 0 NE 1 then clbinf ex MIN if where tag_names ex EQ MAX 0 NE 1 then clbsup ex MAX if where tag_names ex EQ DIVISIONS 0 NE 1 then clbdiv ex DIVISIONS ENDIF COLORBAR COLOR 0 DIVISIONS clbdiv DISCRET colnumb cb_color 0 POSITION pos MAX clbsup MIN clbinf cb_charsize p charsize _extra ex ENDIF ENDELSE x xsave y ysave p psave return end"); 266 a[264] = new Array("./ToBeReviewed/PLOTS/DIVERS/placedessin.html", "placedessin.pro", "", " NAME:placedessin PURPOSE: mise en place du dessin ouverture de la fenetre ou du PS CATEGORY: pour alleger les programmes plt pltz pltt CALLING SEQUENCE: placedessin typedessin posfenetre posbar INPUTS: typedessin: une chaine de charactere specifiant quelle procedure appelle placedessin: plt pltz pltt KEYWORD PARAMETERS: pleins ce de CALIBRE de WINDOW LCT: intier designant le numero de la palette de couleur que l on veut utiliser pour les plot OUTPUTS: posfenetre: un vecteur de 4 elements contenant la position de cadre contenant les legendes le graphe en coordonnes normalises Rq: pour positionner le dessin il faut apres l appelle de calibre faire p position posfenetre posbar: cf posfentre mais pour la barre de couleur meme remarque pour positionner la barre de couleur p position posbar COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 26 4 1999 PRO placedessin typedessin posfenetre posbar BARMARGES barmarges NOCOLORBAR nocolorbar NOFILL nofill COLOR_c color_c CONTOUR contour VECTEUR vecteur PORTRAIT portrait LANDSCAPE landscape SMALL small MARGES marges MAP map REMPLI REMPLI POST post WINDOW window ENDPOINTS endpoints TYPE type BASICMARGES basicmarges NOERASE noerase LCT lct DIREC direc CB_TITLE cb_title _extra ex include common cm_4ps cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF 1 determination de la taille des marges unite nbre de lignes ou colonnes a gauche a droite en bas en haut ATTENTION ds margebar le dernier element est le coint en haut a droite au lieu de la marge en haut if n_elements typedessin EQ 0 then typedessin autre if keyword_set basicmarges then begin marge 1 6 2 4 3 if keyword_set marges THEN marge marge marges margebar 1 marge 0 1 marge 1 1 marge 2 8 marge 2 6 if keyword_set barmarges then margebar margebar barmarges ENDIF ELSE BEGIN nocolorbar keyword_set nocolorbar keyword_set nofill keyword_set color_c case typedessin of plt :marge 1 6 2 4 3 pltt :marge 1 6 4 type EQ xt 2 4 4 pltz :marge 1 6 2 4 3 else:marge 1 6 2 4 3 ENDCASE if keyword_set marges THEN marge marge marges if NOT keyword_set barmarges then barmarges replicate 0 4 barmarges 3 barmarges 3 margebar 1 marge 0 1 marge 1 1 2 4 barmarges marge marge 0 0 4 0 keyword_set cb_title IF keyword_set direc THEN marge marge 0 0 2 0 strlowcase direc NE t marge marge 0 0 2 0 keyword_set contour marge marge 0 0 2 0 keyword_set vecteur if n_elements lon1 NE 0 and n_elements lon2 NE 0 and n_elements lat1 NE 0 and n_elements lat2 NE 0 then begin if keyword_set type then marge marge 0 3 type EQ yt AND lon1 NE lon2 0 2 type NE yt AND lat1 NE lat2 keyword_set endpoints ELSE marge marge 0 0 0 2 lat1 NE lat2 keyword_set endpoints endif marge marge 0 0 2 margebar 3 0 1 keyword_set nocolorbar ENDELSE portrair ou landscape IF NOT keyword_set noerase THEN BEGIN CASE 1 OF n_elements portrait NE 0:key_portrait portrait n_elements landscape NE 0:key_portrait 1 landscape ELSE: ENDCASE ENDIF Quel type de rapport d aspect sera ecrase si YXASPECT existe case typedessin of plt :yaspect 1 lat2 lat1 lon2 lon1 pltt :yaspect 1 pltz :yaspect 5 ELSE:yaspect 1 endcase 2 calcul de p position cf calibre pro IF NOT keyword_set small then small 1 1 1 if keyword_set map then rempli 1 calibre yaspect marge margebar small posfenetre posbar REMPLI rempli _extra ex p position posfenetre 3 ouverture de la fenetre graphique ou du postscript case 1 of cas du premier dessin sur un postcript keyword_set post AND d name ne PS :openps _extra ex cas du premier dessin sur un ecran keyword_set post EQ 0 AND keyword_set noerase EQ 0 AND d name ne PS AND d name ne Z :BEGIN if not keyword_set window then window 0 pour l utilisation de ps oups et de vzoom if lmgr demo EQ 0 then BEGIN on est en mode demo if journal NE 0 then journal on ferme le journal s il est ouvert homedir isadirectory io homedir title Bad definition of homedir def_myuniquetmpdir journal myuniquetmpdir idlsave pro on en ouvre un nouveau help recall_commands output listecommande on recupere la derniere commande listecommande strmid strcompress listecommande 1 2 journal listecommande on l ecrit dans le journal ENDIF windsize givewindowsize window window xsize windsize 0 ysize windsize 1 retain 2 _extra ex qd on utilise des couleurs codees sur 24 bit je n arrive pas a stipuler la couleur du fond d une fenetre a l aide de p background je suis oblige de faire cette bidouille if d n_colors gt 256 then begin device decomposed 1 p background ffffff x plot 0 0 nodata xstyle 4 ystyle 4 device decomposed 0 endif END ELSE: endcase if n_elements lct NE 0 then lct lct _extra ex return end"); 267 a[265] = new Array("./ToBeReviewed/PLOTS/DIVERS/projsegment.html", "projsegment.pro", "", " NAME: projsegment PURPOSE: projecte lineairement un segment un vecteur dont les bornes sont a b sur un vecteur dont les bornes sont c d CATEGORY: caculs a 2 francs CALLING SEQUENCE: res projsegment vecteur bornes INPUTS: vecteur: un vecteur dont le premier element doit etre le plus petit element et le dernier doit etre le plus grand bornes: les nouvelles bornes du vecteur KEYWORD PARAMETERS: MP: activer ce motcle pour que la fonction retourne un vecteur de 2 elements qui sont les coefficient m et p de la projection lineaire y mx p utilisee pour passer du segment a b au segment c d OUTPUTS:un vecteurs dont les nouvelles bornes sont specifiees par bornes COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL a indgen 9 IDL print a 0 1 2 3 4 5 6 7 8 IDL print projsegment a 0 80 0 10 20 30 40 50 60 70 80 IDL print projsegment a 0 80 0 10 20 30 40 50 60 70 80 IDL print projsegment a 80 0 80 70 60 50 40 30 20 10 0 MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 24 6 1999 FUNCTION projsegment vecteur bornes MP mp a1 float vecteur 0 b1 float vecteur n_elements vecteur 1 a2 float bornes 0 b2 float bornes 1 if a1 EQ b1 then return 1 m b2 a2 b1 a1 p a2 m a1 if keyword_set mp then return m p ELSE return m vecteur p end"); 268 a[266] = new Array("./ToBeReviewed/PLOTS/DIVERS/restoreatt.html", "restoreatt.pro", "", " NAME:restoreatt PURPOSE:permet de reattribuer les variables globales associees a un champ qd on donne une stucture cree par ex par saveatt pro CATEGORY:allegement d ecriture CALLING SEQUENCE:restoreatt structure INPUTS:une structure comme celle que lit litchamp cf IDL xhelp litchamp COMMON BLOCKS: common pro SIDE EFFECTS: change la valeur des variables globales attributs d un champ: vargrid varname varunit vardate varexp valmask et time MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 15 6 1999 PRO restoreatt struct common nomelements tag_names struct for i 0 n_tags struct 1 do begin case strlowcase strmid nomelements i 0 1 of g :vargrid strupcase struct i n :varname struct i u :varunit struct i e :varexp struct i m :valmask struct i d :BEGIN if size struct i type EQ 7 THEN BEGIN vardate struct i ENDIF ELSE BEGIN vardate time series time struct i ENDELSE end ELSE:BEGIN ras report Le nom nomelements i ne correspont a aucun element reconnu de la structure C cf IDL xhelp litchamp end endcase endfor return end"); 269 a[267] = new Array("./ToBeReviewed/PLOTS/DIVERS/rotation.html", "rotation.pro", "", " NAME: ROTATION PURPOSE: Rotate two vectors by a specified amount CALLING SEQUENCE: ROTATION X Y DEG NX NY INPUTS: X Y :orignal data point pairs DEG :degrees to rotate OUTPUTS: Nx Ny rotated point pairs MODIFICATION HISTORY: Jeff Bennett U of Colorado PRO ROTATION X Y DEG NX NY ang deg dtor convert to polar coordinates for rotation r sqrt x x y y theta r 0 get angle in for loop so that zero radii will be left as zero angle for i 0 n_elements r 1 do if r i ne 0 then theta i atan y i x i range from pi to pi add rotation angle theta theta ang convert back to rectangular coordinates now rotated nx r cos theta ny r sin theta return end"); 270 a[268] = new Array("./ToBeReviewed/PLOTS/DIVERS/saveatt.html", "saveatt.pro", "", " NAME:saveatt PURPOSE:permet de mettre dans une structure les attributs qui peuvent etre associes a une variable CATEGORY:allegement d ecriture CALLING SEQUENCE:res saveatt OUTPUTS: une stucture de la forme: n:varname g:vargrid d:vardate e:varexp u:varunit m:valmask l:niveau COMMON BLOCKS: common pro MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 15 6 1999 FUNCTION saveatt common return n:varname g:vargrid d:vardate e:varexp u:varunit m:valmask end"); 271 a[269] = new Array("./ToBeReviewed/PLOTS/DIVERS/terminedessin.html", "terminedessin.pro", "", " NAME:terminedessin PURPOSE:termnine le dessin si besion est qd c est un postcsript CATEGORY:mise en forme et allegement de l ecrityre de plt pltz et pltt CALLING SEQUENCE:terminedessin INPUTS: KEYWORD PARAMETERS:POST et SMALL cf l aide de plt OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 3 6 1999 PRO terminedessin POST post SMALL small _extra ex cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF if keyword_set post then BEGIN if keyword_set small then if total small NE page_margins 2 page_margins 0 total page_size page_margins 1 page_margins 3 then return closeps printps endif return end"); 272 a[270] = new Array("./ToBeReviewed/PLOTS/LABEL/label.html", "label.pro", "", " NAME:label PURPOSE:permet de choisir le stype de label que l on veut utiliser lors d un contour CATEGORY:graphique CALLING SEQUENCE:pro label cas min max ncontour level_z2d INPUTS: cas numero du type de label que l on veut tracer min et max valeures min et max entre lesquelles on veut faire des contours KEYWORD PARAMETERS: INTERVALLE: valeur d un intervalle entre deux isolignes par defaut est calcule pour tracer 20 isolighnes Dans tous les cas ce not cle doit etre retourne pour pouvoir avoir une belle legende Si les niveaux ne comportent pas d intevalle regulier le mettre a 1 NLEVEL: nombre de contours a dessiner par defaut 20 actif si LABEL 0 ou nest pas specifie OUTPUTS: ncontour nombre de contour a tracer level_z2d vecteur contenant les valeurs des contours que l on trace colnumb: un vecteur contenant le numero des couleurs qui serviront a remplir entre les contours COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 5 98 pro label cas min max ncontour level_z2d colnumb NLEVEL nlevel INTERVALLE intervalle STRICTFILL strictfill common if d name EQ PS OR d name EQ Z then BEGIN old_dname d name thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 ncontour level_z2d min max min findgen Ncontour Ncontour colnumb ncoul findgen Ncontour Ncontour ncoul 2 ncontour intervalle level_z2d 1 level_z2d 0 end 1: begin un certain nombre de label en partant du min jusqu au plus pres de max avec un pas fixe par intervalle ncontour fix max min intervalle ncontour 1 ncontour level_z2d min intervalle findgen Ncontour colnumb ncoul findgen Ncontour Ncontour ncoul 2 ncontour max level_z2d Ncontour 1 intervalle end label pour faire les memes sss que dessier 2: begin lct 63 file palette tbl level_z2d 20 25 30 31 32 33 33 5 34 25 findgen 16 ncontour 23 colnumb findgen 23 1 masx 37 75 intervalle 1 return end 3: begin lecture intervalles palette dans fichier GMT label_gmt min max intervalle ncoul ncontour level_z2d colnumb end else: begin ras report Le numero de label demande n existe pas end ENDCASE if keyword_set strictfill then begin ncontour ncontour 1 level_z2d level_z2d max colnumb colnumb ncoul 1 endif return end"); 273 a[271] = new Array("./ToBeReviewed/PLOTS/LABEL/label_date.html", "label_date.pro", "", " Id: label_date pro 39 2006 05 02 15:05:06Z pinsard Copyright c 1993 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: LABEL_DATE PURPOSE: This function labels axes with dates and times CATEGORY: Plotting CALLING SEQUENCE: To set up: dummy LABEL_DATE DATE_FORMAT string To use: PLOT x y XTICKFORMAT LABEL_DATE INPUTS: No explicit user defined inputs When called from the plotting routines the input parameters are Axis Index Value KEYWORD PARAMETERS: DATE_FORMAT: a format string which may contain the following: M for month 3 character abbr N for month 2 digit abbr D for day of month Y for 4 digit year Z for last two digits of year For time: H for Hours 2 digits I for mInutes 2 digits S for Seconds 2 digits is Other characters are passed directly thru For example M D Y prints DEC 11 1993 M 2Y yields DEC 93 D M yields 11 DEC D N Y yields 11 12 1993 M C Y yields DEC on the top line 1993 on the bottom C is the new line graphic command MONTHS: The names of the months a twelve element string array If omitted use Jan Feb Dec OFFSET: An optional starting offset of the plot Unfortunately single precision floating point is not accurate enough to properly represent Julian times This offset which may be double precision contains an offset that is added to all x values before conversion to Julian date and time OUTPUTS: The date string to be plotted COMMON BLOCKS: LABEL_DATE_COM RESTRICTIONS: Only one date axis may be simultaneously active PROCEDURE: Straightforward For an alternative way to label a plot axis with dates refer to the C format code accepted within format strings applicable via the XYZ TICKFORMAT keywords This new format code was introduced in IDL 5 2 EXAMPLE: For example to plot from Jan 1 1993 to July 12 1994: Start_date julday 1 1 1993 End_date julday 7 12 1994 Dummy LABEL_DATE DATE_FORMAT N D Simple mm dd x findgen end_date 1 start_date start_date Time axis PLOT x sqrt x XTICKFORMAT LABEL_DATE XSTYLE 1 Plot with X axis style set to exact Example with times: For example to plot from 3PM Jan 1 1993 to 5AM Jan 3 1993: Start_date Julday 1 1 1993 Also starting offset Start_time 3 12 24 Starting_time less offset End_time Julday 1 3 1993 Start_date 5 24 Ending date time offset note that the order of operations is important to avoid loss of precision Dummy LABEL_DATE DATE_FORMAT D M C H: I offset Start_date MMM NN HH:MM format x findgen 20 End_time Start_time 19 start_time Time axis PLOT x sqrt x XTICKFORMAT LABEL_DATE XSTYLE 1 MODIFICATION HISTORY: DMS RSI April 1993 Written DMS RSI March 1997 Added Time format FUNCTION LABEL_DATE axis index x DATE_FORMAT format MONTHS months OFFSET offs _EXTRA ex COMMON label_date_com fmt month_chr offset if keyword_set format then begin Save format string if n_elements offs ne 0 then offset double offs else offset 0 0d0 if keyword_set months then month_chr months else month_chr Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec fmt format return 0 endif if n_elements month_chr ne 12 or n_elements fmt le 0 or n_elements offset eq 0 then message Not initialized x1 x offset caldat long x1 month day year _EXTRA ex Get the calendar date from julian frac x1 long x1 time of day from 0 to 1 n strlen fmt out for i 0 n 1 do begin Each format character c strmid fmt i 1 The character if c eq then begin i i 1 c strmid fmt i 1 The function case c of format character M : out out month_chr month 1 N : out out string format i2 2 month D : out out string format i2 2 day Y : out out string format i4 year Z : out out string format i2 2 year mod 100 H : out out string format i2 2 floor 24 frac I : out out string format i2 2 floor 1440 frac mod 60 S : out out string format i2 2 86400L frac mod 60 : out out else : message Illegal character in date format string: fmt endcase endif else out out c endfor return out end"); 274 a[272] = new Array("./ToBeReviewed/PLOTS/LABEL/label_gmt.html", "label_gmt.pro", "", " Apply GMT palette into IDL color intervals system PRO label_gmt min max intervalle ncoul ncontour level_z2d coul common com_eg IF pal_type NE 2dom THEN BEGIN color defined in lec_pal_gmt pro ncontour ncont_gmt level_z2d levels_gmt coul coul_gmt max max_gmt intervalle 1 ENDIF ELSE BEGIN grey_shade palette case 1 in label IF finite min EQ 0 THEN read Grey shade needs a min max : min max ncontour fix max min intervalle level_z2d min intervalle findgen Ncontour max level_z2d Ncontour 1 intervalle print Number of contour intervals plotting min max ncontour min max print color index IF idx_pal EQ 0 THEN BEGIN build palette red lonarr 99 red 255 red 50:98 long 100 float grey_shade 100 255 IF field origin EQ diff THEN BEGIN difference plot : lighter below first negative interval red 51:98 long 100 float grey_shade_2 100 255 red 1:48 long 100 float grey_shade 100 255 red 50 255 ENDIF first color black last white red 0 red red 99 255 gray scale green red blue red tvlct red green blue ENDIF mid_index max where level_z2d LE fldatt mid coul findgen Ncontour 49 mid_index 2 ENDELSE END "); 275 a[273] = new Array("./ToBeReviewed/PLOTS/LABEL/lataxe.html", "lataxe.pro", "", " NAME:LATAXE PURPOSE:fonction appelee par XYZ TICKFORMAT cf l help pour voir comment l utiliser pour labeller les axes en latitude CATEGORY:graphe CALLING SEQUENCE: XYZ TICKFORMAT lataxe INPUTS:fournis et imposes automatiquement par IDL: axis index value: Axis is the axis number: 0 for X axis 1 for Y axis 2 for Z axis Index is the tick mark index which starts at 0 Value is the default tick mark value a floating point number KEYWORD PARAMETERS: OUTPUTS:un string utilise automatiquement pour labeller COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 10 1999 format des labels FUNCTION lataxe axis index value on ramenne value ds le segment 0 180 lat value mod 360 if lat lt 0 then lat lat 360 if lat gt 180 then lat lat 180 format des labels: case 1 of lat EQ round lat :fmt i4 10 lat EQ round 10 lat :fmt f6 1 ELSE:fmt f7 2 endcase on ecrit le label if lat le 90 and lat ne 0 then nom string lat format fmt N if lat gt 90 then nom string 180 lat format fmt S if lat eq 0 then nom string lat format fmt return nom end "); 276 a[274] = new Array("./ToBeReviewed/PLOTS/LABEL/lonaxe.html", "lonaxe.pro", "", " NAME:LONAXE PURPOSE:fonction appelee par XYZ TICKFORMAT cf l help pour voir comment l utiliser pour labeller les axes en longitude CATEGORY:graphe CALLING SEQUENCE: XYZ TICKFORMAT lonaxe INPUTS:fournis et imposes automatiquement par IDL: axis index value: Axis is the axis number: 0 for X axis 1 for Y axis 2 for Z axis Index is the tick mark index which starts at 0 Value is the default tick mark value a floating point number KEYWORD PARAMETERS: OUTPUTS:un string utilise automatiquement pour labeller COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 10 1999 format des labels FUNCTION lonaxe axis index value on ramenne value ds le segment 0 360 lon value mod 360 if lon lt 0 then lon lon 360 format des labels: case 1 of lon EQ round lon :fmt i4 10 lon EQ round 10 lon :fmt f6 1 ELSE:fmt f7 2 endcase on ecrit le label if lon lt 180 then nom string lon format fmt E if lon gt 180 then nom string 360 lon format fmt W if lon eq 180 then nom string lon format fmt return nom end "); 277 a[275] = new Array("./ToBeReviewed/PLOTS/VECTEUR/ajoutvect.html", "ajoutvect.pro", "", " NAME:ajoutvect PURPOSE:surimprimme des vecteur sur un champ tarce par plt CATEGORY:grafique CALLING SEQUENCE:ajoutvect vecteur INPUTS: vecteur: une structure a 2 elements contenant les 2 matrices U et V des valeurs de la composante zonale et meridienne du champ de vecteurs a tracer par ex: vecteur matriceu:lec unsurface matricev:lec vnsurface rq:le nom des elements de vecteur n a aucune importance vecteur u:lec unsurface v:lec vnsurface convient aussi KEYWORD PARAMETERS: UNVECTSUR:un scalaire n on un tableau a 2 elements n1 n2 dans le premier cas on tracera un vecteur sur n suivant les x et les y dans le second cas on tracera un vecteur sur n1 suivant x et un vecteur sur n2 suivant y Rq pour tracer tous les vecteurs suivant y et 1 sur 2 suivant x mettre unvectsur 2 1 VECTMIN norme minimun des vecteurs a tracer VECTMAX norme minimun des vecteurs a tracer OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 10 3 1999 11 6 1999 compatibilite avec NAN et la lecture des structures pro ajoutvect vecteur vectlegende UNVECTSUR unvectsur VECTMIN vectmin VECTMAX vectmax _EXTRA ex common tempsun systime 1 pour key_performance u litchamp vecteur 0 u checkfield u plt TYPE xy NOQUESTION v litchamp vecteur 1 v checkfield v plt TYPE xy NOQUESTION on recupere les eventuelles info sur les champs grilleu litchamp vecteur 0 grid if grilleu EQ then grilleu U grillev litchamp vecteur 1 grid if grillev EQ then grillev V IF grilleu EQ V AND grillev EQ U THEN inverse 1 IF grilleu EQ grillev THEN interpolle 0 ELSE interpolle 1 if keyword_set inverse then begin rien u u v v rien endif on trouve les points que u et v ont en communs if interpolle then begin indicexu lindgen jpi firstxu:firstxu nxu 1 indicexv lindgen jpi firstxv:firstxv nxv 1 indicex inter indicexu indicexv indiceyu lindgen jpj firstyu:firstyu nyu 1 indiceyv lindgen jpj firstyv:firstyv nyv 1 indicey inter indiceyu indiceyv nx n_elements indicex ny n_elements indicey indice2d lindgen jpi jpj indice2d indice2d indicex 0 :indicex 0 nx 1 indicey 0 :indicey 0 ny 1 extraction de u et v sur le domaine qui convient case 1 of size u 0 NE 2 OR size v 0 NE 2: return size u 1 EQ nxu AND size u 2 EQ nyu AND size v 1 EQ nxv AND size v 2 EQ nyv:BEGIN if nxu NE nx then if indicex 0 EQ firstxu then u u 0:nx 1 ELSE u u 1: nx IF nxv NE nx THEN if indicex 0 EQ firstxv then v v 0:nx 1 ELSE v v 1: nx IF nyu NE ny THEN if indicey 0 EQ firstyu then u u 0:ny 1 ELSE u u 1: ny IF nyv NE ny THEN if indicey 0 EQ firstyv then v v 0:ny 1 ELSE v v 1: ny END size u 1 EQ jpi AND size u 2 EQ jpj AND size v 1 EQ jpi AND size v 2 EQ jpj:BEGIN u u indice2d v v indice2d END ELSE:BEGIN ras report problemes d adequation entre la taille du domaine et la taille des matrices necessaires a tracer des vecteurs return end endcase on reform u et v pour s assurer qu aucune dimension n a ete ecrasee if ny EQ 1 then begin u reform u nx ny v reform v nx ny endif construction de u et v aux pts T a u 0 u u shift u 1 0 2 if NOT keyword_set key_periodic OR nx NE jpi then u 0 a a v 0 v v shift v 0 1 2 if NOT keyword_set key_periodic OR nx NE jpi then v 0 a attribution du mask et des tableau de longitude et latitude on recupere la grille complette pour etablir un grand mask etendu ds les 4 directions pour couvrir les points pour lesquels un pt terre a ete pris en compte faire un petit dessin vargrid T msku umask indice2d jpi jpj firstzt mskv vmask indice2d jpi jpj firstzt glam glamt indice2d gphi gphit indice2d if ny EQ 1 then begin msku reform msku nx ny mskv reform mskv nx ny glam reform glam nx ny gphi reform gphi nx ny endif on masque u et v le long des cotes la on l on ne peut pas calculer la moyenne extention du mask u u msku shift msku 1 0 v v mskv shift mskv 0 1 ENDIF ELSE BEGIN u u tmask firstxt:lastxt firstyt:lastyt firstzt v v tmask firstxt:lastxt firstyt:lastyt firstzt indice2d lindgen jpi jpj indice2d indice2d firstxt:lastxt firstyt:lastyt nx nxt ny nyt endelse tabnorme sqrt u 2 v 2 nan where finite u nan EQ 1 if nan 0 NE 1 then u nan 1e5 nan where finite v nan EQ 1 if nan 0 NE 1 then v nan 1e5 if keyword_set vectmin then BEGIN toosmall where tabnorme lt vectmin if toosmall 0 NE 1 then begin u toosmall 1e5 v toosmall 1e5 ENDIF endif if keyword_set vectmax then BEGIN toobig where tabnorme gt vectmax if toobig 0 NE 1 then begin u toobig 1e5 v toobig 1e5 ENDIF ENDIF remise d une grande valeur sur tous les points pour lesquelles on ne put faire le calcul if interpolle then t2 msku shift msku 1 0 mskv shift mskv 0 1 ELSE t2 tmask firstxt:lastxt firstyt:lastyt firstzt if NOT keyword_set key_periodic OR nx NE jpi then t2 0 0 t2 0 0 terre where t2 eq 0 if terre 0 ne 1 then begin u terre 1e5 v terre 1e5 ENDIF tracer qu un vecteur sur if keyword_set unvectsur then BEGIN indx est un vecteur contenant les numero des colonnes a selectionner indy est un vecteur contenant les numero des lignes a selectionner if n_elements unvectsur EQ 1 then begin indx where lindgen nx MOD unvectsur 0 eq 0 indy where lindgen ny MOD unvectsur 0 eq 0 ENDIF ELSE BEGIN indx where lindgen nx MOD unvectsur 0 eq 0 indy where lindgen ny MOD unvectsur 1 eq 0 ENDELSE a partir de indx et indy on va construire un tableau d indices 2d qui donnera les indices des points intersections des colonnes specifiee par indx indicereduit indx replicate 1 n_elements indy nx replicate 1 n_elements indx indy on reduit les tableaux qui vont etre passes a vecteur u u indicereduit v v indicereduit tabnorme tabnorme indicereduit endif if keyword_set inverse then begin rien u u v v rien endif trace des vecteurs vecteur u v tabnorme indice2d indicereduit missing 1e5 _extra ex on complete la legende if terre 0 ne 1 then mini min tabnorme where t2 eq 1 max maxi nan ELSE mini min tabnorme max maxi nan if litchamp vecteur 0 u NE then vectlegende minmax: mini maxi unite:litchamp vecteur 0 u ELSE vectlegende minmax: mini maxi unite:varunit sortie: if keyword_set key_performance NE 0 THEN print temps ajoutvect systime 1 tempsun return end "); 278 a[276] = new Array("./ToBeReviewed/PLOTS/VECTEUR/vecteur.html", "vecteur.pro", "", " NAME:vecteur PURPOSE: trace des vecteurs meme situees sur une grille tordue sur n importe quelle projection de telle sorte que tous les vecteurs aient une norme comparable sur le dessin en clair un vecteur qui doit faire 1cm le fait quelque soit la projection et sa position sur la sphere CATEGORY:trace de vecteur CALLING SEQUENCE:vecteur composanteu composantev normevecteur indice2d reduitindice2d INPUTS: COMPOSANTEU et COMPOSANTEV: ce sont les composantes des vecteurs a tracer Ces tableaux 2d ont la meme dimension que reduitindice2d cf apres INDICE2D: indice permettant de passer d un tableau jpi jpj au zoom surlequel on fait le dessin REDUITINDICE2D: indice permettant de passer d un tableau definit par indice2d au tableau pourlequel on a reelement des vecteurs a tracer en clair: c est par ex qd on ne trace par exemple que un vecteur sur 2 KEYWORD PARAMETERS: CMREF: la longeur en cm sur le papier que diot faire la fleche de norme normeref par defaut ajuste au dessin et compris entre 5 et 1 5 cm MISSING: la valeur d une missing value ne pas utilisder ce mot cle fixe a 1e5 par ajoutvect pro NORMEREF: la norme de la fleche de reference par defaut on essaie de faire qqch qui colle pas trop mal VECTCOLOR: la couleur de la fleche Par defaut noir couleur 0 VECTTHICK l epaissuer de la fleche par defaut 1 VECTREFPOS: vecteur de 2 elements specifiant la position en coordonnees DATA du debut du vecteur de reference Par defaut en bas a droite du dessin VECTREFFORMAT: format a utiliser pour specifier la norme du vecteur de reference NOVECTREF: pour supprimer l affichage du vecteur de reference OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Creation : 13 02 98 G Roullet grlod lodyc jussieu fr Modification : 14 01 99 realise la transformation spheriquecartesien G Roullet 12 03 99 verification de la routine G Roullet 8 11 1999: G Roullet et Sebastien Masson smasson lodyc jussieu fr adaptation pour les zoom reverification traitement separe de la direction et de la norme des vecteurs mots cles NORMEREF et CMREF FUNCTION cv_cm2normal angle donne la longeur en coordonnes normales d un trait ortiente de angle par rapport a l axe des x et qui doit faire 1 cm sur le dessin angle peut etre un tableau common quelle est la longeur en coordonnees normales d un trait qui fera 1 cm sur le parier et qui est parallele a x mipgsz min page_size max mapgsz sizexfeuille mipgsz key_portrait mapgsz 1 key_portrait sizeyfeuille mapgsz key_portrait mipgsz 1 key_portrait cm_en_normal 1 sizexfeuille si le rapport d aspect de la fenetre n est pas egale a 1 la longeur en coordonees normalise d un trait de 1cm varie suivant l angle polaire de ce trait aspect sizexfeuille sizeyfeuille cm_en_normal cm_en_normal sqrt 1 aspect 2 1 sin angle 2 return cm_en_normal END PRO normalise u v w normalise le vecteur IF n_elements w NE 0 THEN BEGIN norme sqrt u 2 v 2 w 2 ind where norme NE 0 u ind u ind norme ind v ind v ind norme ind w ind w ind norme ind ENDIF ELSE BEGIN norme sqrt u 2 v 2 ind where norme NE 0 u ind u ind norme ind v ind v ind norme ind ENDELSE END PRO vecteur composanteu composantev normevecteur indice2d reduitindice2d CMREF cmref MISSING missing NORMEREF normeref VECTCOLOR vectcolor VECTTHICK vectthick VECTREFPOS vectrefpos VECTREFFORMAT vectrefformat NOVECTREF novectref _extra extra common tempsun systime 1 pour key_performance taille size composanteu nx taille 1 ny taille 2 if n_elements reduitindice2d EQ 0 then reduitindice2d lindgen nx ny zu composanteu zv composantev norme normevecteur taille size indice2d nxgd taille 1 nygd taille 2 msk replicate 1 nx ny if keyword_set missing then terre where abs zu GE missing 10 ELSE terre 1 if terre 0 NE 1 then BEGIN msk terre 0 zu terre 0 zv terre 0 norme terre 0 ENDIF Etape 1: etant donne la direction et le sens que le vecteur a sur la sphere il faut se debrouiller pour determiner cette direction et le sens qu aura le vecteur sur l ecran ou la feuille une fois qu il aura ete projete En theorie: sur la sphere un vecteur en un point donne a pour direction la tangente au cercle qui passe par le centre de la terre et par le vecteur Donc trouver la direction une fois la projection faite ds le plan 2d c est trouver la tangente a la courbe representant la projection du cercle sur le plan 2d au point representant la projection du point de depart de la shere sur le plan 2d En pratique on ne connait pas la definition de la courbe que donne la projection d un cercle alors trouver sa tangente en un point Ce que l on fait: Ds un repere cartesien 3d a on trouve les coordonnees du point T debut de la fleche situe sur la shere b pour chaque point T on determine les directions locales definies par la grille en ce point et auxquelles se rapportent les coordonnes u v du vecteur Ces directions locales sont definies par les gradiants des glam et gphi Une fois ces directions obtenues on les considere comme orthogonales et en les normant on construit un repere orthonormal nu nv auquel se rapporte les coordonnes u v du vecteur Ds le repere cartesien 3d de depart le vecteur est definit par: V u nu v nv ou V nu et nv sont des vecteurs 3d et u et v des scalaires c pour approximer la tangente au cercle par la corde definie par le debut et la fin de la fleche on va normaliser V puis le diviser par 100 d ceci nous permet de determiner les coordonnees ds le repere cartesien 3d des extremites de la corde on les passe en coordonnes sphereriques de facon a recuperer les positions en latitude longitude de ces points sur la sphere e on passe les coordonnees de ces points en coordonnees normalise puis en corrdonnes polaire de facon a trouver l angle et la direction qu ils determinent sur le dessin etape 1 a coordonnes du point T debut de la fleche en coordonnes sheriques glam glamt indice2d reduitindice2d gphi gphit indice2d reduitindice2d coordonnes du point T debut de la fleche dans le repere cartesien on utilise comme shere une shere de rayon 1 radius replicate 1 nx ny coord_sphe transpose glam gphi radius r cv_coord from_sphere coord_sphe to_rect degrees x0 reform r 0 nx ny y0 reform r 1 nx ny z0 reform r 2 nx ny etape 1 b Construction du vecteur nu resp nv vecteur norme porte par l axe des points u i j et u i 1 j resp v i j et v i j 1 qui definissent pour chaque point sur la shere les directions locales associee a u et v ces vecteurs definissent un repere orthonorme local ces vecteurs sont construits dans un repere cartesien cv_coord on a choisit un rayon de la terre unite unit definition de nu radius replicate 1 nxgd nygd IF finite glamu 0 gphiu 0 NE 0 THEN coord_sphe transpose glamu indice2d gphiu indice2d radius ELSE coord_sphe transpose glamf indice2d gphit indice2d radius r cv_coord from_sphere coord_sphe to_rect degrees coordonnes de points de la grille u en cartesien ux reform r 0 nxgd nygd uy reform r 1 nxgd nygd uz reform r 2 nxgd nygd calcul de nu nux ux shift ux 1 0 nuy uy shift uy 1 0 nuz uz shift uz 1 0 conditions aux limites if NOT keyword_set key_periodic OR nxgd NE jpi then begin nux 0 nux 1 nuy 0 nuy 1 nuz 0 nuz 1 ENDIF reduction de la grille nux nux reduitindice2d nuy nuy reduitindice2d nuz nuz reduitindice2d definition de nv IF finite glamv 0 gphiv 0 NE 0 THEN coord_sphe transpose glamv indice2d gphiv indice2d radius ELSE coord_sphe transpose glamt indice2d gphif indice2d radius r cv_coord from_sphere coord_sphe to_rect degrees coordonnes de points de la grille v en cartesien vx reform r 0 nxgd nygd vy reform r 1 nxgd nygd vz reform r 2 nxgd nygd calcul de nv nvx vx shift vx 0 1 nvy vy shift vy 0 1 nvz vz shift vz 0 1 conditions aux limites nvx 0 nvx 1 nvy 0 nvy 1 nvz 0 nvz 1 reduction de la grille nvx nvx reduitindice2d nvy nvy reduitindice2d nvz nvz reduitindice2d normalisation normalise nux nuy nuz normalise nvx nvy nvz etape 1 c coordonnes du vecteur V ds le repere cartesion direcx zu nux zv nvx direcy zu nuy zv nvy direcz zu nuz zv nvz normalisation du vecteur v normalise direcx direcy direcz on divise par 100 direcx direcx 100 direcy direcy 100 direcz direcz 100 etape 1 d coordonnees de la pointe de la fleche dans le repere cartesien x1 x0 direcx y1 y0 direcy z1 z0 direcz coordonnees de la pointe en spherique coord_rect transpose x1 y1 z1 r cv_coord from_rect coord_rect to_sphere degrees glam1 reform r 0 nx ny gphi1 reform r 1 nx ny modif des glam tout se passe bien au niveau de la ligne de changement de date attention il ne faut pas couper les fleches qui sortent de la fenetre test: si il sort du cadre mais qu avec un 360 il y rentre on le modifie ind where glam1 LT x range 0 AND glam1 360 LE x range 1 if ind 0 NE 1 then glam1 ind glam1 ind 360 ind where glam1 GT x range 1 AND glam1 360 GE x range 0 if ind 0 NE 1 then glam1 ind glam1 ind 360 ind where glam LT x range 0 AND glam 360 LE x range 1 if ind 0 NE 1 then glam ind glam ind 360 ind where glam GT x range 1 AND glam 360 GE x range 0 if ind 0 NE 1 then glam ind glam ind 360 etape 1 e r convert_coord glam gphi data to_normal x0 r 0 coordonnes normales du debut de la fleche y0 r 1 r convert_coord glam1 gphi1 data to_normal x1 r 0 coordonnes normales de la fin de la fleche avant scaling y1 r 1 tests pour eviter que des fleches soient dessineees hors du domaine out where x0 LT p position 0 OR x0 GT p position 2 OR y0 LT p position 1 OR y0 GT p position 3 if out 0 NE 1 THEN x0 out values f_nan suivant les projections il peu y a voir des points a nan qd on passe en coordonnes normales on supprime ces points nan finite x0 y0 x1 y1 number where nan EQ 1 x0 x0 number x1 x1 number y0 y0 number y1 y1 number msk msk number norme norme number on definit le vecteur direction dans le repere normalise dirx x1 x0 diry y1 y0 on passe en polaire pour recuperer l angle qui etait le but de toute la partie 1 dirpol cv_coord from_rect transpose dirx diry to_polar dirpol msk dirpol 0 2eme etape maintenant on s occupe de la norme Mise a l echelle automatique if NOT keyword_set cmref then BEGIN mipgsz min page_size max mapgsz sizexfeuille mipgsz key_portrait mapgsz 1 key_portrait sizexfeuille 10 sizexfeuille cmref 5 floor sizexfeuille 10 15 cmref cmref 10 ENDIF if NOT keyword_set normeref then BEGIN value max norme puissance10 10 floor alog10 value normeref puissance10 floor value puissance10 endif cm 1 normeref cmref on modifie le tableau norme de facon a ce que un element qui a la valeur cm soit represente par un trait de longueur 1cm sur le papier norme contient la norme des vecteur que l on veut dessiner norme 1 1 cm norme cv_cm2normal dirpol 3eme etape maintenant qu on a l angle et la norme et bien on recupere les coordonnes en rectangulaire et on dessine les fleches r cv_coord from_polar transpose dirpol norme to_rect composantex r 0 composantey r 1 x1 x0 composantex y1 y0 composantey c est parti pour le trace if NOT KEYWORD_SET vectcolor then vectcolor 0 points where msk EQ 1 IF points 0 NE 1 THEN arrow x0 points y0 points x1 points y1 points norm hsize 2 COLOR vectcolor THICK vectthick Dessine une fleche en bas a droite de la figure en guise de legende if NOT keyword_set novectref then BEGIN dx cmref cv_cm2normal 0 longuer du vecteur de reference en coordonnes normalisees if keyword_set vectrefformat then normelegende strtrim string normeref format vectrefformat 1 ELSE normelegende strtrim normeref 1 if keyword_set vectrefpos then begin r convert_coord vectrefpos data to_normal x0 r 0 y0 r 1 ENDIF ELSE BEGIN x0 x window 1 dx r convert_coord d x_ch_size d y_ch_size device to_normal dy 3 r 1 p charsize y0 y window 0 dy ENDELSE arrow x0 y0 x0 dx y0 norm hsize 2 color 0 xyouts x0 y0 normelegende norm align 1 charsize p charsize color 0 endif if keyword_set key_performance NE 0 THEN print temps vecteur systime 1 tempsun return END "); 279 a[277] = new Array("./ToBeReviewed/PLOTS/VECTEUR/velovect.html", "velovect.pro", "", " Id: velovect pro 41 2006 05 02 15:12:07Z pinsard Copyright c 1983 1998 Research Systems Inc All rights reserved Unauthorized reproduction prohibited PRO VELOVECT U V X Y Missing Missing Length length Dots dots Color color CLIP clip NOCLIP noclip OVERPLOT overplot _EXTRA extra NAME: VELOVECT PURPOSE: Produce a two dimensional velocity field plot A directed arrow is drawn at each point showing the direction and magnitude of the field CATEGORY: Plotting two dimensional CALLING SEQUENCE: VELOVECT U V X Y INPUTS: U: The X component of the two dimensional field U must be a two dimensional array V: The Y component of the two dimensional field Y must have the same dimensions as X The vector at point i j has a magnitude of: U i j 2 V i j 2 0 5 and a direction of: ATAN2 V i j U i j OPTIONAL INPUT PARAMETERS: X: Optional abcissae values X must be a vector with a length equal to the first dimension of U and V Y: Optional ordinate values Y must be a vector with a length equal to the first dimension of U and V KEYWORD INPUT PARAMETERS: COLOR: The color index used for the plot DOTS: Set this keyword to 1 to place a dot at each missing point Set this keyword to 0 or omit it to draw nothing for missing points Has effect only if MISSING is specified LENGTH: Length factor The default of 1 0 makes the longest U V vector the length of a cell MISSING: Missing data value Vectors with a LENGTH greater than MISSING are ignored OVERPLOT: Set this keyword to make VELOVECT overplot That is the current graphics screen is not erased no axes are drawn and the previously established scaling remains in effect Note: All other keywords are passed directly to the PLOT procedure and may be used to set option such as TITLE POSITION NOERASE etc OUTPUTS: None COMMON BLOCKS: None SIDE EFFECTS: Plotting on the selected device is performed System variables concerning plotting are changed RESTRICTIONS: None PROCEDURE: Straightforward Unrecognized keywords are passed to the PLOT procedure MODIFICATION HISTORY: DMS RSI Oct 1983 For Sun DMS RSI April 1989 Added TITLE Oct 1990 Added POSITION NOERASE COLOR Feb 91 RES August 1993 Vince Patrick Adv Visualization Lab U of Maryland fixed errors in math August 1993 DMS Added _EXTRA keyword inheritance January 1994 KDB Fixed integer math which produced 0 and caused divide by zero errors December 1994 MWR Added _EXTRA inheritance for PLOTS and OPLOT June 1995 MWR Removed _EXTRA inheritance for PLOTS and changed OPLOT to PLOTS September 1996 GGS Changed denominator of x_step and y_step vars February 1998 DLD Add support for CLIP and NO_CLIP keywords June 1998 DLD Add support for OVERPLOT keyword on_error 2 Return to caller if an error occurs s size u t size v if s 0 ne 2 then begin baduv: message U and V parameters must be 2D and same size endif if total abs s 0:2 t 0:2 ne 0 then goto baduv if n_params 0 lt 3 then x findgen s 1 else if n_elements x ne s 1 then begin badxy: message X and Y arrays have incorrect size endif if n_params 1 lt 4 then y findgen s 2 else if n_elements y ne s 2 then goto badxy if n_elements missing le 0 then missing 1 0e30 if n_elements length le 0 then length 1 0 mag sqrt u 2 v 2 magnitude Subscripts of good elements nbad 0 of missing points if n_elements missing gt 0 then begin good where mag lt missing if keyword_set dots then bad where mag ge missing nbad endif else begin good lindgen n_elements mag endelse ugood u good vgood v good x0 min x get scaling x1 max x y0 min y y1 max y x_step x1 x0 s 1 1 0 Convert to float Integer math y_step y1 y0 s 2 1 0 could result in divide by 0 maxmag max max abs ugood x_step max abs vgood y_step sina length ugood maxmag cosa length vgood maxmag if n_elements title le 0 then title plot to get axes if n_elements color eq 0 then color p color if n_elements noclip eq 0 then noclip 1 x_b0 x0 x_step x_b1 x1 x_step y_b0 y0 y_step y_b1 y1 y_step if not keyword_set overplot then begin if n_elements position eq 0 then begin plot x_b0 x_b1 y_b1 y_b0 nodata xst yst color color _EXTRA extra endif else begin plot x_b0 x_b1 y_b1 y_b0 nodata xst yst color color _EXTRA extra endelse endif if n_elements clip eq 0 then clip x crange 0 y crange 0 x crange 1 y crange 1 r 3 len of arrow head angle 22 5 dtor Angle of arrowhead st r sin angle sin 22 5 degs length of head ct r cos angle for i 0 n_elements good 1 do begin Each point x0 x good i mod s 1 get coords of start end dx sina i x1 x0 dx y0 y good i s 1 dy cosa i y1 y0 dy xd x_step yd y_step plots x0 x1 x1 ct dx xd st dy yd xd x1 x1 ct dx xd st dy yd xd y0 y1 y1 ct dy yd st dx xd yd y1 y1 ct dy yd st dx xd yd color color clip clip noclip noclip _EXTRA extra endfor if nbad gt 0 then Dots for missing PLOTS x bad mod s 1 y bad s 1 psym 3 color color clip clip noclip noclip _EXTRA extra end"); 280 a[278] = new Array("./ToBeReviewed/PLOTS/axe.html", "axe.pro", "", " NAME:axe PURPOSE:gerre les axes pour les differents dessins crees par plt pltz et pltt CATEGORY:environnement graphique CALLING SEQUENCE:axe coupe tempsmin tempsmax INPUTS: coupe: un string qui designe le type de coupe auquel doit de raporter les axes que l on cree par ex: xy xt tempsmin et tempsmax: ds le cas ou l on fait une coupe contenant la dimension temps il faut specifier le debut et la fin de l axe des temps en jours julien KEYWORD PARAMETERS: SIN active qd on trace en sinus de la latitude SEPDATE: string separant les differents constituants de la date Par defaut c est un retour a la ligne qd on fait un yt zt ou t dans les autres cas c est un blanc DIGITSYEAR 2 to use Z format 2 digits to code years instead of Y format See help of label_date for more informations on Z and Y OUTPUTS:les variables globales d environnement graphique: x et y COMMON BLOCKS: common pro SIDE EFFECTS:modifie x et y RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 Eric Guilyardi types x y z amelioration de l axe temporel PRO axe coupe tempsmin tempsmax REVERSE_X reverse_x REVERSE_Y reverse_y SIN sin SEPDATE sepdate DIGITSYEAR digitsyear _EXTRA ex common tempsun systime 1 pour key_performance gestion des ticks de l axe des temps ds le ces ou tempsmin et tempsmax sont definits divday 0 if n_params EQ 3 then BEGIN if keyword_set sepdate then sep sepdate ELSE if coupe EQ yt OR coupe EQ zt OR coupe EQ t then sep C ELSE sep caldat tempsmin mmin dmin ymin hmin mnmin smin _EXTRA ex caldat tempsmax mmax dmax ymax hmax mnmax smax _EXTRA ex format used for the year 2 or 4 5 digits IF NOT keyword_set digitsyear THEN digitsyear 4 IF digitsyear EQ 2 THEN fmtyr Z ELSE fmtyr Y if ymax EQ ymin then BEGIN if mmin ne mmax then BEGIN meme annee mais plusieurs mois nticks mmax mmin 1 ticknom lonarr nticks for m 0 nticks 1 do ticknom m julday m mmin 1 ymin _EXTRA ex tminor 6 datfmt M sep fmtyr on verifie que les labels rentrent bien entre tempsmin et tempsmax ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom cas particulier ou l on est a cheval sur 2 mois if nticks LE 1 then begin nticks dmax jourdsmois mmin ymin 0 dmin 1 2 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d 2 dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M endif ENDIF ELSE BEGIN meme annee et meme mois IF dmax dmin 1 GT 4 THEN BEGIN more than 4 days nticks dmax dmin 1 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M ENDIF ELSE BEGIN less than 4 days : divday ticks per day divday 4 nticks dmax dmin divday 1 ticknom fltarr nticks for d 0 nticks 1 do ticknom d julday mmin d divday dmin ymin _EXTRA ex d MOD divday float divday tminor 2 datfmt H:00 ENDELSE ENDELSE ENDIF ELSE BEGIN plusieurs annees CASE 1 OF ymax ymin 1 LE 10: BEGIN freq 1 tminor 12 datfmt M sep fmtyr end ymax ymin 1 LE 20: BEGIN freq 2 tminor 6 datfmt M sep fmtyr end ymax ymin 1 LE 50: BEGIN freq 5 tminor 5 datfmt M sep fmtyr end ymax ymin 1 LE 100: BEGIN freq 10 tminor 10 datfmt fmtyr end ymax ymin 1 LE 1000: BEGIN freq 50 tminor 5 datfmt fmtyr end ELSE : BEGIN freq 100 tminor 50 datfmt Y end ENDCASE nticks floor ymax ymin freq 1 IF floor ymin freq NE ymin freq THEN yminf floor ymin freq 1 freq ELSE yminf floor ymin freq freq ticknom lonarr nticks for y 0 nticks 1 do ticknom y julday 1 1 yminf y freq _EXTRA ex on verifie que les labels rentrent bien entre tempsmin et tempsmax ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom cas particulier ou l on est a cheval sur 2 annees if nticks LE 1 then begin nticks mmax 12 mmin 1 ticknom lonarr nticks for m 0 nticks 1 do ticknom m julday m mmin 1 ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 6 datfmt M sep fmtyr cas particulier ou l on est a cheval sur 2 mois if nticks LE 1 then begin nticks dmax jourdsmois mmin ymin 0 dmin 1 2 ticknom lonarr nticks for d 0 nticks 1 do ticknom d julday mmin d 2 dmin ymin _EXTRA ex ticknom ticknom where ticknom GE tempsmin AND ticknom LE tempsmax AND ticknom NE 1 nticks n_elements ticknom tminor 2 datfmt D sep M endif endif ENDELSE toto label_date 0 0 0 DATE_FORMAT datfmt _EXTRA ex if chkstru ex DATE_FORMAT then ex DATE_FORMAT ENDIF definition des parametres des axes au cas par cas case coupe of xy :BEGIN if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range lat2 lat1 ELSE y range lat1 lat2 IF key_onearth THEN x tickformat lonaxe IF key_onearth THEN y tickformat lataxe END yz :BEGIN if keyword_set reverse_x then x range lat2 lat1 ELSE x range lat1 lat2 if keyword_set reverse_y then y range 0 1 ELSE y range 1 0 if keyword_set sin then BEGIN nombre de ticks par defaut plot 0 0 noerase nodata xtick_get xaxe on augmente ce nombre pour qu il soit autour de 10 ticks n_elements xaxe 1 ticks ticks 1 2 4 8 ticks ticks sort abs ticks 10 0 on recupere l axex pour ce nouveau nombre de ticks plot 0 0 xticks ticks noerase nodata xtick_get xaxe x ticks ticks x tickv sin pi 180 xaxe tickname strarr ticks 1 for i 0 ticks do tickname i lataxe 0 0 xaxe i x tickname tickname x range sin pi 180 x range endif end xz :BEGIN if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range 0 1 ELSE y range 1 0 end xt : begin if keyword_set reverse_x then x range lon2 lon1 ELSE x range lon1 lon2 if keyword_set reverse_y then y range tempsmax tempsmin tempsmin ELSE y range tempsmin tempsmax tempsmin IF key_onearth THEN x tickformat lonaxe result LABEL_DATE DATE_FORMAT M sep fmtyr y tickformat LABEL_DATE y tickname LABEL_DATE 1 0 ticknom _EXTRA ex y ticklen 1 y gridstyle 2 y ticks nticks 1 y tickv ticknom tempsmin y minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end yt : begin if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin if keyword_set reverse_y then y range lat2 lat1 ELSE y range lat1 lat2 IF key_onearth THEN y tickformat lataxe x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end zt : begin if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin if vargrid EQ W then gdep gdepw 0:nzw 1 ELSE gdep gdept 0:nzt 1 x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end t : BEGIN if keyword_set reverse_x then x range tempsmax tempsmin tempsmin ELSE x range tempsmin tempsmax tempsmin x tickname LABEL_DATE 0 0 ticknom _EXTRA ex x ticklen 1 x gridstyle 2 x ticks nticks 1 x tickv ticknom tempsmin x minor tminor IF divday GT 0 THEN y title Time from strtrim dmin 1 def_month 1m strtrim mmin 1 strtrim ymin 1 end x : begin x range lon1 lon2 IF key_onearth THEN x tickformat lonaxe END y : begin if keyword_set sin then BEGIN nombre de ticks par defaut plot 0 0 nodata noerase xstyle 5 ystyle 5 xtick_get xaxe on augmente ce nombre pour qu il soit autour de 10 ticks n_elements xaxe 1 ticks ticks 1 2 4 8 ticks ticks sort abs ticks 10 0 on recupere l axex pour ce nouveau nombre de ticks plot 0 0 xticks ticks nodata noerase xstyle 5 ystyle 5 xtick_get xaxe x ticks ticks x tickv sin pi 180 xaxe tickname strarr ticks 1 for i 0 ticks do tickname i lataxe 0 0 xaxe i x tickname tickname x range sin pi 180 x range ENDIF ELSE x range lat1 lat2 IF key_onearth THEN x tickformat lataxe END z : begin if vargrid EQ W then gdep gdepw 0:nzw 1 ELSE gdep gdept 0:nzt 1 if keyword_set reverse_y then y range gdep 0 gdep n_elements gdep 1 ELSE y range gdep n_elements gdep 1 gdep 0 END endcase if keyword_set key_performance THEN print temps axe systime 1 tempsun return end"); 281 a[279] = new Array("./ToBeReviewed/PLOTS/legende.html", "legende.pro", "", " NAME:legende pro PURPOSE:fournit les legendes CATEGORY:graph annexe CALLING SEQUENCE:legende mi ma coupe title subtitle xtitle ytitle INPUTS:mi et ma: le max et le min du dessin cf plt pro et pltz pro coupe caractere de 2 lettres donnant le type de coupe par ex: xz KEYWORD PARAMETERS: TITRE: chaine de caracteres qui doit etre le titre du dessin Par defaut le titre est le nom vairmer du champ ENDPOINTS:utilise qd on fait des coupes veticales en diagonale OUTPUTS:le titre sous titre titre de x et titre de y COMMON BLOCKS: common pro SIDE EFFECTS: l utilisation de la variable globale langage permet de changer de langue ou de facon de legender facilement On peut facilement personnaliser la chose en rajoutant un cas au case sur la valeur de langage RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 14 8 98 Eric Guilyardi ericg lodyc jussieu fr GB version 11 6 99 pro legende mi ma coupe CONTOUR contour ENDPOINTS endpoints DIREC direc VECTLEGENDE vectlegende INTERVALLE intervalle TYPE_YZ type_yz VARNAME2 varname2 NPTS npts _EXTRA ex common tempsun systime 1 pour key_performance grille 1 1 1 gdep nx ny nz English legends fmt_mm f12 2 fmt_bt f7 1 colorf contourf Contour plot vecteurf Vector norm expf datef fieldf depthf endpointsf Diag Section zonalf IF key_onearth THEN latintf latitudes in ELSE latintf j index in timintf time in onf depthf2 Depth m Meridf Zonal Mean IF key_onearth THEN lonintf longitudes in ELSE lonintf i in hovxt XT plot diaghovxt Diag XT plot depintf depths in timef Time hovyt YT plot diaghovyt Diag YT plot hovzt ZT plot hovt IF key_onearth THEN lontitle Longitude ELSE lontitle i index IF key_onearth THEN lattitle Latitude ELSE lattitle j index vertz depthf2 legniv m IF keyword_set TYPE_YZ THEN BEGIN IF type_yz EQ hPa THEN vertz hPa IF type_yz EQ hPa THEN legniv hPa ENDIF Start legende definition et complement eventuelle de p subtitle if n_elements varunit ne 0 then unite varunit else unite p subtitle colorf unite : Min strtrim string format fmt_mm mi 2 Max strtrim string format fmt_mm ma 2 if keyword_set intervalle then BEGIN if intervalle NE 1 then p subtitle p subtitle Int strtrim string format fmt_mm intervalle 2 endif if size contour type EQ 8 then BEGIN c est une structure unite contour 1 p subtitle p subtitle C contourf unite : Min strtrim string format fmt_mm contour 0 0 2 Max strtrim string format fmt_mm contour 0 1 2 if contour inter NE 1 then p subtitle p subtitle Int strtrim string format fmt_mm contour inter 2 ENDIF if size vectlegende type EQ 8 then begin unite vectlegende 1 p subtitle p subtitle C vecteurf unite : Min strtrim string format fmt_mm vectlegende 0 0 2 Max strtrim string format fmt_mm vectlegende 0 1 2 endif mise en forme des dimensions du sous domaine la1 strtrim string format fmt_bt lat1 2 la2 strtrim string format fmt_bt lat2 2 lo1 strtrim string format fmt_bt lon1 2 lo2 strtrim string format fmt_bt lon2 2 pr1 strtrim string format fmt_bt vert1 2 pr2 strtrim string format fmt_bt vert2 2 gestion de la date if n_elements vardate EQ 0 then vardate if NOT keyword_set direc then direc if strpos direc t NE 1 then begin svardate strtrim vairdate time 0 1 strtrim vairdate time jpt 1 1 ENDIF ELSE svardate vardate case sur le cas auquel s applique la legende case coupe of xy :begin if strupcase vargrid EQ W then firstz firstzw ELSE firstz firstzt if strpos direc z EQ 1 AND firstz NE 0 then BEGIN prof strtrim round gdep 0 1 p title expf varexp datef svardate fieldf varname depthf prof legniv ENDIF ELSE p title expf varexp datef svardate fieldf varname x title lontitle y title lattitle end xz :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim ny 1 IF long n LE 3 THEN zonalf Section if keyword_set endpoints AND lat1 NE lat2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title zonalf varexp datef svardate fieldf varname x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF y title depthf2 end yz :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx 1 IF long n LE 3 THEN meridf if keyword_set endpoints AND lon1 NE lon2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title meridf varexp datef svardate fieldf varname y title vertz x title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF end xt :begin IF keyword_set npts THEN n strtrim npts 1 if keyword_set endpoints AND lat1 NE lat2 then p title diaghovxt varexp fieldf varname ELSE p title hovxt varexp fieldf varname IF time size time 0 1 time 0 GE 10 THEN y title timef x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF end yt :begin IF keyword_set npts THEN n strtrim npts 1 if keyword_set endpoints AND lon1 NE lon2 then p title diaghovyt varexp fieldf varname ELSE p title hovyt varexp fieldf varname IF time size time 0 1 time 0 GE 10 THEN x title timef y title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF end zt :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny 1 p title hovzt varexp fieldf varname y title depthf2 IF time size time 0 1 time 0 GE 10 THEN x title timef end t :begin IF keyword_set npts THEN n strtrim npts 1 ELSE BEGIN if keyword_set integration3d then n strtrim nx ny nz 1 ELSE n strtrim nx ny 1 ENDELSE p title hovt varexp fieldf varname y title varname IF time size time 0 1 time 0 GE 10 THEN x title timef end x :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim ny nz 1 if keyword_set endpoints AND lat1 NE lat2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title varexp datef svardate fieldf varname x title lontitle if keyword_set endpoints AND lat1 EQ lat2 then BEGIN IF key_onearth THEN x title x title at strtrim lataxe 0 0 lat1 1 ELSE x title x title at j index strtrim lat1 1 ENDIF y title varname end y :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx nz 1 if keyword_set endpoints AND lon1 NE lon2 then p title endpointsf varexp datef svardate fieldf varname ELSE p title varexp datef svardate fieldf varname x title lattitle if keyword_set endpoints AND lon1 EQ lon2 then BEGIN IF key_onearth THEN x title x title at strtrim lonaxe 0 0 lon1 1 ELSE x title x title at i index strtrim lon1 1 ENDIF y title varname end z :begin IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny 1 p title varexp datef svardate fieldf varname y title depthf2 x title varname end yfx : BEGIN IF keyword_set npts THEN n strtrim npts 1 ELSE n strtrim nx ny nz 1 p title varexp datef svardate varunit x title varname2 y title varname END else: ENDCASE if keyword_set direc then BEGIN if strpos direc x NE 1 then p subtitle lonintf lo1 lo2 onf strtrim nx 1 points C p subtitle if strpos direc y NE 1 then BEGIN if strpos p subtitle EQ 1 then p subtitle latintf la1 la2 onf strtrim ny 1 points C p subtitle ELSE p subtitle latintf la1 la2 onf strtrim ny 1 points p subtitle ENDIF if strpos direc z NE 1 AND nz NE 1 OR coupe NE xy then BEGIN if strpos p subtitle EQ 1 then p subtitle depintf pr1 pr2 onf strtrim nz 1 points C p subtitle ELSE p subtitle depintf pr1 pr2 onf strtrim nz 1 points p subtitle ENDIF ENDIF if keyword_set endpoints AND coupe NE yt AND lat1 NE lat2 then p title p title C C if keyword_set key_performance THEN print temps legende systime 1 tempsun return end"); 282 a[280] = new Array("./ToBeReviewed/PLOTS/plotsym.html", "plotsym.pro", "", " NAME: plotsym PURPOSE: function to make plotting symbols much easier Usage: plot x y psym plotsym circle scale 2 fill CATEGORY: Graphics Keywords: circle circle symbol triangle triangle symbol diamond diamond symbold box box symbol line line symbol scale scales the symbol angle angle the symbol should be rotated _extra extra keywords for usersym These are thick color and fill Written by: Ronn Kling Ronn Kling Consulting 7038 Westmoreland Dr Warrenton VA 20187 klingrl juno com copyright 1999 all rights reserved function plotsym circle circle triangle triangle diamond diamond angle angle box box line line scale scale _extra extra if not keyword_set scale then scale 1 0 if not keyword_set angle then angle 0 0 if keyword_set circle then begin theta findgen 30 29 360 endif else if keyword_set triangle then begin theta 30 90 210 30 endif else if keyword_set diamond then begin theta 0 90 180 270 0 endif else if keyword_set box then begin theta 315 45 135 225 315 endif else if keyword_set line then begin theta 180 0 endif theta theta angle x cos theta dtor scale y sin theta dtor scale usersym x y _extra extra return 8 end"); 283 a[281] = new Array("./ToBeReviewed/PLOTS/reinitplt.html", "reinitplt.pro", "", " NAME: REINITPLT PURPOSE: This procedure will reinitialise all or a selection ofthe system plot variables CATEGORY: Plot Utility CALLING SEQUENCE: clearplt all clear the p x y z clearplt x z clear the x and z variables clearplt x only clear the x variable clearplt x invert clear all except the x INPUTS: KEYWORDS: x y z p clear the appropriate variable all clear all this is equivalent to x y z p invert invert the logic Clear all unselected variables Therefore clearplt all invert does nothing OUTPUTS: none COMMON BLOCKS: common pro SIDE EFFECTS: The sytem plot variables are changed MODIFICATION HISTORY: Written by: Trevor Harris Physics Dept University of Adelaide July 1990 Sebastien Masson 7 5 98 pro reinitplt all all x x y y z z p p invert invert clearx 0 cleary 0 clearz 0 clearp 0 if keyword_set x then clearx 1 if keyword_set y then cleary 1 if keyword_set z then clearz 1 if keyword_set p then clearp 1 if keyword_set all or not keyword_set x and not keyword_set y and not keyword_set z and not keyword_set p then begin clearx 1 cleary 1 clearz 1 clearp 1 endif if keyword_set invert then begin clearx not clearx cleary not cleary clearz not clearz clearp not clearp endif if clearx then begin x charsize 0 x GRIDSTYLE 0 X MARGIN 10 3 X MINOR 0 X OMARGIN 0 0 x region 0 X RANGE 0 x STYLE 5 x tick 1 x TICKFORMAT x TICKLEN 0 x tickname x ticks 0 X TICKV 0 X TICKV 1 x title x TYPE 0 endif if cleary then begin y charsize 0 y GRIDSTYLE 0 Y MARGIN 10 3 Y MINOR 0 Y OMARGIN 0 0 y region 0 Y RANGE 0 y STYLE 5 y tick 1 y TICKFORMAT y TICKLEN 0 y tickname y ticks 0 Y TICKV 0 Y TICKV 1 y title y TYPE 0 endif if clearz then begin z charsize 0 z GRIDSTYLE 0 Z MARGIN 10 3 Z MINOR 0 Z OMARGIN 0 0 z region 0 Z RANGE 0 z STYLE 1 z tick 1 z TICKFORMAT z TICKLEN 0 z tickname z ticks 0 Z TICKV 0 Z TICKV 1 z title z TYPE 0 endif if clearp then begin p BACKGROUND d n_colors 1 255 p CHARSIZE 1 p CHARTHICK 0 p LINESTYLE 0 p MULTI replicate 0 5 p NOERASE 0 p POSITION 0 p region 0 p title p subtitle p ticklen 0 02 p thick 0 1 p color 0 endif return end "); 284 a[282] = new Array("./ToBeReviewed/PLOTS/style.html", "style.pro", "", " NAME:style PURPOSE:choisit la facon de tracer les isolignes CATEGORY:graphique CALLING SEQUENCE:style labstyle level_z2d linestyle thick INPUTS:labstyle: nombre auquel se refaire le styel de trace choisit level_z2d:vecteur contenant les valeures des isolignes a tracer KEYWORD PARAMETERS: OUTPUTS: linestyle:vecteur utilise pour definir le style des isocontours rq: pour memoire: Index Linestyle 0 Solid 1 Dotted 2 Dashed 3 Dash Dot 4 Dash Dot Dot Dot 5 Long Dashes thick:vecteur definissant l epaisseur de l isoligne COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr pro style labstyle level_z2d linestyle thick case labstyle of 0: begin serie: deux lignes continues fines une ligne continue grasse thick 1 1 2 linestyle 0 return end 1: begin serie: avant le mileu des levels: tiret fin apres trait continu fin si le mileu est dessine il est en trait continu gras impair n_elements level_z2d 2 fix n_elements level_z2d 2 a replicate 0 fix n_elements level_z2d 2 b replicate 1 fix n_elements level_z2d 2 c replicate 2 fix n_elements level_z2d 2 if impair then begin thick b 2 b linestyle c 0 a endif else begin thick 0 linestyle c a endelse return end 2: begin serie: avant le seuil definit en repondant a une question : tiret fin apres trait continu fin si le seuil est dessine il est en trait continu gras seuil xquestion Quelle est la limite tirets trait continu 0 seuil float seuil rien where level_z2d lt seuil n a replicate 0 n_elements level_z2d n c replicate 2 n if seuil eq level_z2d n then begin thick replicate 1 n 2 replicate 1 n_elements level_z2d 1 n linestyle c a endif else begin thick 0 linestyle c a endelse return end 3: begin n n_elements level_z2d seuil level_z2d 1 n 2 thick intarr n thick indgen n 4 4 1 thick indgen n 4 4 1 1 thick indgen n 4 4 2 2 thick indgen n 4 4 3 1 linestyle intarr n linestyle indgen n 4 4 3 linestyle indgen n 4 4 1 0 linestyle indgen n 4 4 2 0 linestyle indgen n 4 4 3 0 labels intarr n labels indgen n 2 2 1 labels n 2 0 return end 4: begin trait continu gras pour 0 seuil 1 e 6 thick replicate 5 n_elements level_z2d linestyle 0 rien where abs level_z2d max abs level_z2d LT seuil if rien 0 NE 1 then thick rien 0 3 end else: begin ras report Le numero de labstyle demande n existe pas stop end endcase return end"); 285 a[283] = new Array("./ToBeReviewed/PLOTS/symbols.html", "symbols.pro", "", " NAME: SYMBOLS PURPOSE: Create custom plotting symbols CALLING SEQUENCE: SYMBOLS SYMBOL_NUMBER SCALE INPUTS: SYMBOL_NUMBER: 1 open circle 2 filled circle 3 arrow pointing right 4 arrow pointing left 5 arrow pointing up 6 arrow pointing down 7 arrow pointing up and left 45 degrees 8 arrow pointing down and left 9 arrow pointing down and right 10 arrow pointing up and right 11 through 18 are bold versions of 3 through 10 19 horizontal line 20 box 21 diamond 22 triangle 30 filled box 31 filled diamond 32 filled triangle SCALE size of symbols KEYWORD PARAMETERS: COLOR color of symbols SIDE EFFECTS: The desired symbol is stored in the user buffer and will be plotted if P PSYM 8 MODIFICATION HISTORY: Jeff Bennett U of Colorado 198 pro symbols nsym scale color col on_error 2 fill 0 case 1 of nsym le 2 : begin circles for large scales increase number of points for res if scale ge 4 then a findgen 25 else a findgen 13 a a 3 14159 6 0 12 or 24 pi 6 xarr cos a yarr sin a if nsym eq 2 then fill 1 end nsym ge 3 nsym le 18 : begin arrow heads xarr fltarr 5 yarr xarr xarr 1 10 xarr 2 6 yarr 2 2 nsyms greater than 10 should be filled arrows if nsym gt 10 then begin xarr 3 6 xarr 4 10 yarr 3 2 fill 1 endif else begin xarr 3 10 xarr 4 6 yarr 4 2 endelse case 1 of nsym eq 3 : dummy 0b nsym eq 4 : xarr 1 xarr nsym eq 11 nsym eq 12 : begin xarr extrac xarr 0 11 yarr extrac yarr 0 11 yarr 6 0 5 xarr 7 6 yarr 7 0 5 xarr 8 6 yarr 8 0 5 yarr 9 0 5 if nsym eq 12 then begin rotation xarr yarr 180 nx ny xarr nx yarr ny endif end nsym eq 5 nsym eq 13 : begin temp xarr xarr yarr yarr temp end nsym eq 6 nsym eq 14 : begin temp 1 xarr xarr yarr yarr temp end nsym ge 7 nsym le 10 nsym ge 15 nsym le 18 : begin case 1 of nsym eq 7 nsym eq 15 : deg 45 nsym eq 8 nsym eq 16 : deg 135 nsym eq 9 nsym eq 17 : deg 225 nsym eq 10 nsym eq 18 : deg 315 endcase rotation xarr yarr deg nx ny xarr nx yarr ny end end nsym ge 7 endcase end nsym between 3 and 18 nsym eq 20 nsym eq 21 nsym eq 30 nsym eq 31 : begin xarr fltarr 5 3 yarr xarr xarr 1 3 xarr 2 3 yarr 2 3 yarr 3 3 if nsym eq 21 nsym eq 31 then begin rotation xarr yarr 45 nx ny nx 0 70 nx shrink the x direction xarr nx yarr ny endif if nsym ge 30 then fill 1 end nsym 20 21 30 31 nsym eq 22 nsym eq 32 : begin side length 6 0 at centroid yarr fltarr 4 6 4 xarr fltarr 4 6 2 xarr 1 6 2 xarr 2 0 yarr 2 6 sqrt 3 2 6 4 if nsym eq 32 then fill 1 end else: begin xarr fltarr 2 1 yarr xarr 0 xarr 1 1 end endcase xarr xarr scale yarr yarr scale set symbol buffer if keyword_set col then usersym xarr yarr fill fill color col else usersym xarr yarr fill fill return end"); 286 a[284] = new Array("./ToBeReviewed/POSTSCRIPT/calibre.html", "calibre.pro", "", " NAME: calibre PURPOSE:a partir d un rapport d aspect et des valeurs en ligne de characteres des differentes marges calcul posfenetre et posbar qui servent a placer le dessin et la barre de couleur grace a p position sur une feuille ou sur une sortie ecran dont la fenetre a les memes proportions CATEGORY: positionnement du graphe CALLING SEQUENCE: calibre rapportyx marge margebar smalldraw posfenetre posbar INPUTS: rapportyx: rapport d echelle entre la longueur de l axe des y et celle des x par ex pour une carte xy rapportyx lat2 lat1 lon2 lon1 marge: vecteur de 4 elements contenant la taille des marges a gauche a droite en bas et en haut devant entourer le graphe tout est mesure en lignes de characteres margebar: vecteur de 4 elements contenant la taille des marges a gauche a droite en bas et ATTENTION le dernier element est cette fois ci la position de coin en haut a droite devant entourer la barre de couleur tout est mesure en lignes de characteres smalldraw: 2 possiblites un vecteur de 4 elements donnant en portrait ou en landscape la position de cadre ds lequel doit rentrer le dessin cette position est donne par les coordonnes des 2 coins du cadre: en bas a gauche et en haut a droite elle s exprime tjs pour un postscript ou une sortie ecran en cm l origine etant le coin en bas a gauche un vecteur de 3 elements donnant le nombre de colonnes a faire de le dessin le nombre de lignes et enfin le numero de la case que doit occuper le dessin cf matlab par ex pour faire 6 dessin en 2 colonnes et 3 lignes et occuper la 4 eme case small 2 3 4 KEYWORD PARAMETERS: REMPLI:oblige le dessin a occuper l espace maximum definit par smalldraw sans resperter le rapport y sur x YXASPECT: force le rapport y sur x a prendre la valeur rapportyx yxaspect ce mot cle est utile ds deux cas: 1 yxaspect 1 : oblige rapportyx a etre bien respecte sinon calibre se reserve le droit de changer un peu celui ci dans le cas ou le rapport d aspect de small dessin est trop different de celui de smalldraw 2 yxaspect n : multiplie par n le rapport d aspect donne par defaut par ex ds plt rapportyx est calcule pour que le repere soit orthonorme pour avoir un repere ou l axe des y est 2 fois plus dilate que celui des y YXASPECT 2 PORTRAIT et LANDSCAPE: mots cles plus utilises mais tjs fonctionnels OUTPUTS: posfenetre: un vecteur de 4 elements contenant la position de cadre contenant les legendes le graphe en coordonnes normalises Rq: pour positionner le dessin il faut apres l appelle de calibre faire p position posfenetre posbar: cf posfentre mais pour la barre de couleur meme remarque pour positionner la barre de couleur p position posbar COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 11 12 98 pro calibre rapportyx marge margebar smalldraw posfenetre posbar REMPLI rempli YXASPECT yxaspect PORTRAIT portrait LANDSCAPE lanscape _extra ex cm_4ps IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance if keyword_set portrait then key_portrait 1 if keyword_set landscape then key_portrait 0 if keyword_set yxaspect then begin rapportyx rapportyx yxaspect test2 0 endif else begin yxaspect 1 test2 1 ENDELSE mipgsz min page_size max mapgsz choix de Landscape ou Portrait if n_elements key_portrait eq 0 then begin if rapportyx ge 1 then key_portrait 1 if rapportyx lt 1 then key_portrait 0 endif si smalldraw est compte comme ds matlab if n_elements smalldraw EQ 3 then begin if n_elements page_margins EQ 0 then page_margins 1 1 1 1 smalldraw long smalldraw nbrecol smalldraw 0 nbrelig smalldraw 1 numero smalldraw 2 1 numlig numero nbrecol numcol numero numlig nbrecol bas mipgsz key_portrait mapgsz 1 key_portrait cote mapgsz key_portrait mipgsz 1 key_portrait poscol page_margins 0 findgen nbrecol 1 1 bas page_margins 0 page_margins 1 nbrecol poslig cote page_margins 3 findgen nbrelig 1 1 cote page_margins 2 page_margins 3 nbrelig smalldraw poscol numcol poslig numlig 1 poscol numcol 1 poslig numlig endif determination de la taille des characteres p charsize nombre_de_mots_ds_titre 60 p charsize 1 smalldraw 2 smalldraw 0 d x_px_cm nombre_de_mots_ds_titre d y_ch_size if p charsize gt 1 then p charsize 1 transfert de marge en cm cm 1 d x_px_cm marge 1 marge d y_ch_size p charsize cm margebar 1 margebar d y_ch_size p charsize cm definition de la portion de feuille ou on dessine if key_portrait eq 0 then begin big smalldraw 2 smalldraw 0 small smalldraw 3 smalldraw 1 endif else begin small smalldraw 2 smalldraw 0 big smalldraw 3 smalldraw 1 endelse if key_portrait eq 0 then rapportmax 1 small marge 3 marge 1 big marge 2 marge 0 else rapportmax 1 small marge 2 marge 0 big marge 3 marge 1 si yxaspect n est pas specifie on modifie la valeur de rapportyx pour que ca colle un peu plus aux proportions de la feuille if rapportyx le rapportmax then begin if test2 then begin rap 1 rapportmax rapportyx if rap ge 5 and rap lt 6 then rapportyx rapportyx 1 5 if rap ge 6 and rap lt 7 then rapportyx rapportyx 2 if rap ge 7 and rap lt 8 then rapportyx rapportyx 2 5 if rap ge 8 then rapportyx rapportyx 3 endif endif else begin if test2 then begin rap 1 rapportmax rapportyx if rap lt 1 5 and rap ge 1 6 then rapportyx rapportyx 1 5 if rap lt 1 6 and rap ge 1 7 then rapportyx rapportyx 2 if rap lt 1 7 and rap ge 1 8 then rapportyx rapportyx 2 5 if rap lt 1 8 then rapportyx rapportyx 3 endif endelse dans le cas ou on fait un Landscape: if key_portrait eq 0 then begin if keyword_set rempli then begin xs big ys small endif else begin if rapportyx le rapportmax then begin xs big ys 1 big marge 0 marge 1 rapportyx marge 2 marge 3 if ys gt small then begin xs 1 small marge 2 marge 3 rapportyx marge 0 marge 1 ys small endif endif else begin xs 1 small marge 2 marge 3 rapportyx marge 0 marge 1 ys small if xs gt big then begin xs big ys 1 big marge 0 marge 1 rapportyx marge 2 marge 3 endif endelse endelse xoff 1 small ys 2 smalldraw 1 yoff 1 big xs 2 xs mapgsz smalldraw 2 a 1 mapgsz yoff mapgsz b 1 xoff mipgsz c a 1 xs mapgsz d b 1 ys mipgsz endif dans le cas ou on fait un portrait: else begin if keyword_set rempli then begin xs small ys big endif else begin if rapportyx le rapportmax then begin xs small ys 1 small marge 0 marge 1 rapportyx marge 2 marge 3 if ys gt big then begin xs 1 big marge 2 marge 3 rapportyx marge 0 marge 1 ys big endif endif else begin xs 1 big marge 2 marge 3 rapportyx marge 0 marge 1 ys big if xs gt small then begin xs small ys 1 small marge 0 marge 1 rapportyx marge 2 marge 3 endif endelse endelse xoff 1 small xs 2 smalldraw 0 yoff 1 big ys 2 smalldraw 1 a 1 xoff mipgsz b 1 yoff mapgsz c a 1 xs mipgsz d b 1 ys mapgsz xset xoff yset yoff endelse bas mapgsz 1 key_portrait mipgsz key_portrait cote mipgsz 1 key_portrait mapgsz key_portrait posfenetre a b c d marge 0 bas marge 2 cote marge 1 bas marge 3 cote posbar a b c d margebar 0 bas margebar 2 cote margebar 1 bas ys margebar 3 cote if keyword_set key_performance THEN print temps calibre systime 1 tempsun IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF return end"); 287 a[285] = new Array("./ToBeReviewed/POSTSCRIPT/chcolps.html", "chcolps.pro", "", "PRO format_colortable_hexa table tvlct r g b get z strarr 256 y strarr 256 for k 0 255 do z k 00 strtrim string r k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 for k 0 255 do z k 00 strtrim string g k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 for k 0 255 do z k 00 strtrim string b k format Z 2 for k 0 255 do y k y k strmid z k strlen z k 2 2 table strlowcase y END PRO build_table tableout Fabrique le bloc de colortable format_colortable_hexa table tableout strarr 25 tableout 0 COLORTAB def END PRO chcolps n1 n2 file PALIT1 palit1 PALIT2 palit2 Modifie les couleurs d un fichier postscript Creation : G Roullet 1999 recupere les palettes lct n1 IF keyword_set palit1 THEN palit palit1 tvlct red green blue get lct n2 IF keyword_set palit2 THEN palit palit2 tvlct red1 green1 blue1 get filein file fileout file new openr numin filein get_lun openw numout fileout get_lun ligne nl 0 colortab 0 Scan le fichier WHILE NOT eof numin DO BEGIN readf numin ligne format A nl nl 1 Replace setrgbcolor statements pos strpos ligne setrgbcolor IF pos NE 1 THEN BEGIN r round float strmid ligne pos 18 6 255 g round float strmid ligne pos 12 6 255 b round float strmid ligne pos 6 6 255 ind where r EQ red AND g EQ green AND b EQ blue ind ind 0 IF ind 0 NE 1 THEN BEGIN r1 red1 ind 255 g1 green1 ind 255 b1 blue1 ind 255 color string r1 g1 b1 format 3 F5 3 : X strput ligne color pos 18 ENDIF ELSE BEGIN print erreur ligne : nl dist abs r red abs g green abs b blue ind where dist EQ min dist 0 ind ind 0 print je trouve long r g b print je remplace par red ind green ind blue ind r1 red1 ind 255 g1 green1 ind 255 b1 blue1 ind 255 color string r1 g1 b1 format 3 F5 3 : X strput ligne color pos 18 ENDELSE ENDIF Replace COLORTAB pos strpos ligne COLORTAB IF pos NE 1 THEN BEGIN build_table table n 0 colortab 1 ENDIF IF colortab THEN BEGIN ligne table n n n 1 IF n EQ 24 THEN colortab 0 ENDIF Ecrit le fichier de sorti printf numout ligne format A ENDWHILE close numin close numout free_lun numin free_lun numout spawn gs fileout END "); 288 a[286] = new Array("./ToBeReviewed/POSTSCRIPT/ps.html", "ps.pro", "", ""); 289 a[287] = new Array("./ToBeReviewed/STATISTICS/a_correlate2d.html", "a_correlate2d.pro", "", " NAME: A_CORRELATE2d PURPOSE: This function computes the autocorrelation Px K L or autocovariance Rx K L of a sample population X nx ny as a function of the lag K L CATEGORY: Statistics CALLING SEQUENCE: Result a_correlate2d X Lag INPUTS: X: an 2 dimension Array nx ny LAG: 2 element vector in the intervals nx 2 nx 2 ny 2 ny 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample autocovariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE: PROCEDURE: nx k 1 ny l 1 sigma sigma X i j Xmean X i k j l Ymean i 0 j 0 correlation X k l nx 1 ny 1 sigma sigma X i j Xmean 2 i 0 j 0 nx k 1 ny l 1 sigma sigma X i j Xmean Y i k j l Ymean i 0 j 0 covariance X k l nx ny Where Xmean is the mens of the sample population x x 0 0 x 1 0 x nx 1 ny 1 REFERENCE: MODIFICATION HISTORY: 28 2 2000 Sebastien Masson smasson lodyc jussieu fr Based on the A_CORRELATE procedure of IDL FUNCTION Auto_Cov2d X Lag Double Double zero2nan zero2nan XDim SIZE X dimensions nx XDim 0 ny XDim 1 Sample autocovariance function Xmean TOTAL X Double Double 1 nx ny res TOTAL X 0:nx 1 lag 0 0:ny 1 lag 1 Xmean X lag 0 :nx 1 lag 1 :ny 1 Xmean Double Double if keyword_set zero2nan AND res EQ 0 then res values f_nan RETURN res END FUNCTION A_Correlate2d X Lag Covariance Covariance Double Double Compute the sample autocorrelation or autocovariance of Xt Xt l as a function of the lag l ON_ERROR 2 XDim SIZE X dimensions XNDim SIZE X n_dimensions nx XDim 0 ny XDim 1 if XNDim NE 2 then MESSAGE X array must contain 2 dimensions Check length if nx lt 2 then MESSAGE first dimension of X array must contain 2 or more elements if ny lt 2 then MESSAGE second dimension of X array must contain 2 or more elements if n_elements Lag NE 2 THEN MESSAGE Lag array must contain 2 elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double SIZE X type eq 5 if KEYWORD_SET Covariance eq 0 then begin Compute Autocorrelation Auto Auto_Cov2d X ABS Lag Double Double Auto_Cov2d X 0L 0L Double Double zero2nan endif else begin Compute Autocovariance Auto Auto_Cov2d X ABS Lag Double Double n_elements X endelse if Double eq 0 then RETURN FLOAT Auto else RETURN Auto END"); 290 a[288] = new Array("./ToBeReviewed/STATISTICS/a_timecorrelate.html", "a_timecorrelate.pro", "", " NAME: A_TIMECORRELATE PURPOSE: Same function as A_CORRELATE but accept array until 4 dimension for input and do the autocorrelation or the autocovariance along the time dimension which must be the last one of the input array This function computes the autocorrelation Px L or autocovariance Rx L of a sample population X as a function of the lag L CATEGORY: Statistics CALLING SEQUENCE: Result a_timecorrelate X Lag INPUTS: X: an Array which last dimension is the time dimension os size n LAG: A scalar or n element vector in the interval n 2 n 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample autocovariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE Define an n element sample population x 3 73 3 67 3 77 3 83 4 67 5 87 6 70 6 97 6 40 5 57 Compute the autocorrelation of X for LAG 3 0 1 3 4 8 lag 3 0 1 3 4 8 result a_correlate x lag The result should be: 0 0146185 1 00000 0 810879 0 0146185 0 325279 0 151684 PROCEDURE: n L 1 sigma X k Xmean X k L Xmean k 0 correlation X L n 1 sigma X k Xmean 2 k 0 n L 1 sigma X k Xmean X k L Xmean k 0 covariance X L n Where Xmean is the Time mean of the sample population x x t 0 x t 1 x t n 1 REFERENCE: INTRODUCTION TO STATISTICAL TIME SERIES Wayne A Fuller ISBN 0 471 28715 6 MODIFICATION HISTORY: 24 2 2000 Sebastien Masson smasson lodyc jussieu fr Based on the A_CORRELATE procedure of IDL FUNCTION TimeAuto_Cov X M nT Double Double zero2nan zero2nan Sample autocovariance function TimeDim size X n_dimensions Xmean TOTAL X TimeDim Double Double nT if double then one 1 0d ELSE one 1 0 Xmean Xmean replicate one nT M case TimeDim of 1:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 2:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 3:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double 4:res TOTAL X 0:nT M 1L Xmean X M:nT 1L Xmean TimeDim Double Double ENDCASE if keyword_set zero2nan then begin zero where res EQ 0 if zero 0 NE 1 then res zero values f_nan endif RETURN res END FUNCTION A_TimeCorrelate X Lag COVARIANCE Covariance DOUBLE Double Compute the sample autocorrelation or autocovariance of Xt Xt l as a function of the lag l ON_ERROR 2 XDim SIZE X dimensions XNDim SIZE X n_dimensions nT XDim XNDim 1 Check length if nT lt 2 then MESSAGE Time axis of X array must contain 2 or more elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double SIZE X type eq 5 if n_elements lag EQ 0 then lag 0 nLag N_ELEMENTS Lag if nLag eq 1 then Lag Lag Create a 1 element vector case XNDim of 1:if Double eq 0 then Auto FLTARR nLag else Auto DBLARR nLag 2:if Double eq 0 then Auto FLTARR XDim 0 nLag else Auto DBLARR XDim 0 nLag 3:if Double eq 0 then Auto FLTARR XDim 0 XDim 1 nLag else Auto DBLARR XDim 0 XDim 1 nLag 4:if Double eq 0 then Auto FLTARR XDim 0 XDim 1 XDim 2 nLag else Auto DBLARR XDim 0 XDim 1 XDim 2 nLag endcase if KEYWORD_SET Covariance eq 0 then begin Compute Autocorrelation for k 0 nLag 1 do case XNDim of 1:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 2:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 3:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan 4:Auto k TimeAuto_Cov X ABS Lag k nT Double Double TimeAuto_Cov X 0L nT Double Double zero2nan endcase endif else begin Compute Autocovariance for k 0 nLag 1 do case XNDim of 1:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 2:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 3:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT 4:Auto k TimeAuto_Cov X ABS Lag k nT Double Double nT endcase endelse if Double eq 0 then RETURN FLOAT Auto else RETURN Auto END"); 291 a[289] = new Array("./ToBeReviewed/STATISTICS/c_timecorrelate.html", "c_timecorrelate.pro", "", " NAME: C_TIMECORRELATE PURPOSE: This function computes the time cross correlation Pxy L or the time cross covariance between 2 arrays this is some kind of c_correlate but for multidimenstionals arrays as a function of the lag L CATEGORY: Statistics CALLING SEQUENCE: Result c_timecorrelate X Y Lag INPUTS: X: an Array which last dimension is the time dimension of size n float or double Y: an Array which last dimension is the time dimension of size n float or double LAG: A scalar or n element vector in the interval n 2 n 2 of type integer that specifies the absolute distance s between indexed elements of X KEYWORD PARAMETERS: COVARIANCE: If set to a non zero value the sample cross covariance is computed DOUBLE: If set to a non zero value computations are done in double precision arithmetic EXAMPLE Define two n element sample populations x 3 73 3 67 3 77 3 83 4 67 5 87 6 70 6 97 6 40 5 57 y 2 31 2 76 3 02 3 13 3 72 3 88 3 97 4 39 4 34 3 95 Compute the cross correlation of X and Y for LAG 5 0 1 5 6 7 lag 5 0 1 5 6 7 result c_timecorrelate x y lag The result should be: 0 428246 0 914755 0 674547 0 405140 0 403100 0 339685 PROCEDURE: FOR L 0 n L 1 sigma X k Xmean Y k L Ymean k 0 correlation X Y L n 1 n 1 sqrt sigma X k Xmean 2 sigma Y k Ymean 2 k 0 k 0 n L 1 sigma X k Xmean Y k L Ymean k 0 covariance X Y L n FOR L 0 n L 1 sigma X k L Xmean Y k Ymean k 0 correlation X Y L n 1 n 1 sqrt sigma X k Xmean 2 sigma Y k Ymean 2 k 0 k 0 n L 1 sigma X k L Xmean Y k Ymean k 0 covariance X Y L n Where Xmean and Ymean are the time means of the sample populations x x t 0 x t 1 x t n 1 and y y t 0 y t 1 y t n 1 respectively REFERENCE: INTRODUCTION TO STATISTICAL TIME SERIES Wayne A Fuller ISBN 0 471 28715 6 MODIFICATION HISTORY: 01 03 2000 Sebastien Masson smasson lodyc jussieu fr Based on the C_CORRELATE procedure of IDL August 2003 Sebastien Masson update according to the update made in C_CORRELATE by W Biagiotti and available in IDL 5 5 FUNCTION TimeCross_Cov Xd Yd M nT Ndim Double Double ZERO2NAN zero2nan Sample cross covariance function compile_opt hidden case Ndim OF 1:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Double Double 2:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double 3:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double 4:res TOTAL Xd 0:nT M 1L Yd M:nT 1L Ndim Double Double ENDCASE if keyword_set zero2nan then begin zero where res EQ 0 if zero 0 NE 1 then res zero values f_nan ENDIF RETURN res END FUNCTION C_Timecorrelate X Y Lag Covariance Covariance Double Double Compute the sample cross correlation or cross covariance of Xt Xt l and Yt Yt l as a function of the lag l ON_ERROR 2 xsize SIZE X ysize SIZE Y nt float xsize xsize 0 NDim xsize 0 if total xsize 0:xsize 0 NE ysize 0:ysize 0 NE 0 then MESSAGE X and Y arrays must have the same size and the same dimensions Check length if nt lt 2 then MESSAGE Time dimension of X and Y arrays must contain 2 or more elements If the DOUBLE keyword is not set then the internal precision and result are identical to the type of input if N_ELEMENTS Double eq 0 then Double Xsize Xsize 0 1 eq 5 or ysize ysize 0 1 eq 5 if n_elements lag EQ 0 then lag 0 nLag N_ELEMENTS Lag Deviations if double then one 1 0d ELSE one 1 0 Ndim size X n_dimensions Xd TOTAL X Ndim Double Double nT Xd X Xd replicate one nT Yd TOTAL Y Ndim Double Double nT Yd Y Yd replicate one nT if nLag eq 1 then Lag Lag Create a 1 element vector case NDim of 1:if Double eq 0 then Cross FLTARR nLag else Cross DBLARR nLag 2:if Double eq 0 then Cross FLTARR Xsize 1 nLag else Cross DBLARR Xsize 1 nLag 3:if Double eq 0 then Cross FLTARR Xsize 1 Xsize 2 nLag else Cross DBLARR Xsize 1 Xsize 2 nLag 4:if Double eq 0 then Cross FLTARR Xsize 1 Xsize 2 Xsize 3 nLag else Cross DBLARR Xsize 1 Xsize 2 Xsize 3 nLag endcase if KEYWORD_SET Covariance eq 0 then begin Compute Cross Crossation for k 0 nLag 1 do begin if Lag k ge 0 then BEGIN case NDim of 1: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 2: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 3: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double 4: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double endcase ENDIF else BEGIN case NDim of 1: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 2: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 3: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double 4: Cross k TimeCross_Cov Yd Xd ABS Lag k nT Ndim Double Double endcase ENDELSE ENDFOR div sqrt TimeCross_Cov Xd Xd 0L nT Ndim Double Double zero2nan TimeCross_Cov Yd Yd 0L nT Ndim Double Double zero2nan Cross temporary Cross temporary div replicate one nLag endif else begin Compute Cross Covariance for k 0 nLag 1 do begin if Lag k ge 0 then BEGIN case NDim of 1: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 2: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 3: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT 4: Cross k TimeCross_Cov Xd Yd Lag k nT Ndim Double Double nT ENDCASE ENDIF else BEGIN case NDim of 1: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 2: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 3: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT 4: Cross k TimeCross_Cov yd xd ABS Lag k nT Ndim Double Double nT ENDCASE ENDELSE endfor endelse if Double eq 0 then RETURN FLOAT Cross else RETURN Cross END "); 292 a[290] = new Array("./ToBeReviewed/STRING/chkeywd.html", "chkeywd.pro", "", " NAME: chkeywd change keyword PURPOSE: ds un string qui contient une commande a executer avec EXECUTE par ex On change la valeur d un des mot cle Plus generalement ds un string on cherche la chaine de chacarteres: keywdname et on change la valeur de CATEGORY: pour bidouiller des commandes passees par execute CALLING SEQUENCE: stringout chkeywd stringin keywdname keywdvalue INPUTS: stringin: un string keywdname: un string designant le nom du mot clef a chercher keywdvalue: nouvelle valeur du mot clef a considerer ds stringin KEYWORD PARAMETERS: pour chercher le mot cle on cherche le premier signe qui suit la position de keywdname on substitue pardefaut tout le bout de string qui suit jusqu a la prochaine virgule avec les mots cles SEPARATOR et AFTER on peut modifier cette decoupe du string: SEPARATOR donne un chatactere avant ou apres si AFTER est active lequel il faut chercher la virgule qui delimite le mot cle ds le string cf les exemples OUTPUTS:stringout stringin modifie si keywdname a ete trouve ds stringin COMMON BLOCKS:common pro SIDE EFFECTS: Si keywdvalue est un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des mots clefs de grosse taille avec bcp d elements et avec des elements etant de gros tableaux le mot clef en entree ne doit pas contenir de Complex floating de structure de Double precision complex de Pointer de Object reference de Unsigned Integer de Unsigned Longword Integer de 64 bit Integer de Unsigned 64 bit Integer EXAMPLE: IDL b ok 111 year 1997 1998 1999 age_capitaine 35 IDL print b ok 111 year 1997 1998 1999 age_capitaine 35 IDL print chkeywd b ok c est bon ok c est bon year 1997 1998 1999 age_capitaine 35 IDL print chkeywd b YEAR indgen 5 sep ok 111 year 0 1 2 3 4 age_capitaine 35 IDL print chkeywd b YEAR indgen 5 sep after ok 111 year 0 1 2 3 4 age_capitaine 35 IDL b ok 111 year age_capitaine IDL print chkeywd b year c est bon ok 111 year c est bon age_capitaine MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 24 11 1999: adaptation pour les mots cles commencant par FUNCTION chkeywd stringin keywdname keywdvalue SEPARATOR separator AFTER after stringout stringin poskeywd strpos strlowcase stringout strlowcase keywdname if poskeywd EQ 1 then return stringout while poskeywd NE 1 do BEGIN changer un mot cle qui commence par toto if strmid stringout poskeywd 1 1 EQ then BEGIN ajoute keywdname tostr keywdvalue stringout strmid stringout 0 poskeywd 1 ajoute strmid stringout poskeywd strlen keywdname poskeywd poskeywd strlen ajoute poskeywd strpos stringout keywdname poskeywd ENDIF ELSE BEGIN changer un mot cle qui commence par toto posegal strpos stringout poskeywd if posegal EQ 1 then return stringout if NOT keyword_set separator then separator posvirgule strpos stringout separator posegal 1 if keyword_set after then posvirgule strpos stringout posvirgule 1 ELSE posvirgule rstrpos stringout posvirgule 1 if posvirgule EQ 1 then posvirgule strlen stringout stringout strmid stringout 0 posegal 1 tostr keywdvalue strmid stringout posvirgule poskeywd strpos stringout keywdname posvirgule 1 ENDELSE endwhile return stringout end"); 293 a[291] = new Array("./ToBeReviewed/STRING/delchr.html", "delchr.pro", "", " NAME: DELCHR PURPOSE: Delete all occurrences of a character from a text string CATEGORY: CALLING SEQUENCE: new delchr old char INPUTS: old original text string in char character to delete in KEYWORD PARAMETERS: OUTPUTS: new resulting string out COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 5 Jul 1988 Johns Hopkins Applied Physics Lab RES 11 Sep 1989 converted to SUN R Sterner 27 Jan 1993 dropped reference to array Copyright C 1988 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt FUNCTION DELCHR OLD C help hlp if n_params 0 lt 2 or keyword_set hlp then begin print Delete all occurrences of a character from a text string print new delchr old char print old original text string in print char character to delete in print new resulting string out return 1 endif B BYTE OLD convert string to a byte array CB BYTE C convert char to byte w where b ne cb 0 if w 0 eq 1 then return Nothing left return string b w Return new string END"); 294 a[292] = new Array("./ToBeReviewed/STRING/getfile.html", "getfile.pro", "", " NAME: GETFILE PURPOSE: Read a text file into a string array CATEGORY: CALLING SEQUENCE: s getfile f INPUTS: f text file name in KEYWORD PARAMETERS: Keywords: ERROR err error flag: 0 ok 1 file not opened 2 no lines in file QUIET means give no error message FIND search te file in the all path directories use find pro OUTPUTS: s string array out COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 20 Mar 1990 S Masson smasson lodyc jussieu fr 4 Feb 2002 search te file in the all path directories use find pro when using find keyword Use spawn cat for unix os Copyright C 1990 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt function getfile filein error err help hlp quiet quiet find find if n_params 0 lt 1 or keyword_set hlp then begin print Read a text file into a string array print s getfile f print f text file name in print s string array out print Keywords: print ERROR err error flag: 0 ok 1 file not opened print 2 no lines in file print QUIET means give no error message return 1 endif if keyword_set find then begin file find filein file file 0 if file EQ NOT FOUND then begin print Error in getfile: File filein not fouond return 1 endif ENDIF ELSE file filein if version os_family EQ unix then begin spawn cat file res if res 0 NE then return res ELSE return endif get_lun lun on_ioerror err openr lun file s t while not eof lun do begin readf lun t s s t endwhile close lun free_lun lun if n_elements s eq 1 then begin if not keyword_set quiet then print No lines in file err 2 return 1 endif err 0 return s 1: err: if err eq 168 then begin if not keyword_set quiet then print Non standard text file format free_lun lun return s 1: endif if not keyword_set quiet then print Error in getfile: File file not opened free_lun lun err 1 return 1 end"); 295 a[293] = new Array("./ToBeReviewed/STRING/getwrd.html", "getwrd.pro", "", " NAME: GETWRD PURPOSE: Return the n th word from a text string CATEGORY: CALLING SEQUENCE: wrd getwrd txt n m INPUTS: txt text string to extract from in n word number to get first 0 def in m optional last word number to get in KEYWORD PARAMETERS: Keywords: LOCATION l Return word n string location DELIMITER d Set word delimiter def space tab LAST means n is offset from last word So n 0 gives last word n 1 gives next to last If n 2 and m 0 then last 3 words are returned NOTRIM suppresses whitespace trimming on ends NWORDS n Returns number of words in string OUTPUTS: wrd returned word or words out COMMON BLOCKS: getwrd_com NOTES: Note: If a NULL string is given txt then the last string given is used This saves finding the words again If m n wrd will be a string of words from word n to word m If no m is given wrd will be a single word n n wrd will be a string of words from word n to print word m If no m is given wrd will be a single word print n 0 Smaller of in and im im im 0 to zero if in gt lst and im gt lst then return Out of range in in lst Larger of in and im im im lst to be last ll loc in Nth word start return strtrim strmid txtstr0 ll loc im loc in len im 2 endif N ABS NTH Allow nth 0 IF N GT NWDS 1 THEN RETURN out of range null ll loc n N th word position IF NTH LT 0 THEN GOTO NEG Handle nth 0 IF MTH GT NWDS 1 THEN MTH NWDS 1 Words to end if keyword_set notrim then begin RETURN STRMID TXTSTR0 ll LOC MTH LOC NTH LEN MTH endif else begin RETURN strtrim STRMID TXTSTR0 ll LOC MTH LOC NTH LEN MTH 2 endelse NEG: if keyword_set notrim then begin RETURN STRMID TXTSTR0 ll 9999 endif else begin RETURN strtrim STRMID TXTSTR0 ll 9999 2 endelse END"); 296 a[294] = new Array("./ToBeReviewed/STRING/isnumber.html", "isnumber.pro", "", " NAME: ISNUMBER PURPOSE: Determine if a text string is a valid number CATEGORY: CALLING SEQUENCE: i isnumber txt x INPUTS: txt text string to test in KEYWORD PARAMETERS: OUTPUTS: x optionaly returned numeric value if valid out i test flag: out 0: not a number 1: txt is a long integer 2: txt is a float 1: first word of txt is a long integer 2: first word of txt is a float COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 15 Oct 1986 Johns Hopkins Applied Physics Lab R Sterner 12 Mar 1990 upgraded Richard Garrett 14 June 1992 fixed bug in returned float value Copyright C 1986 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt FUNCTION ISNUMBER TXT0 X help hlp if n_params 0 lt 1 or keyword_set hlp then begin print Determine if a text string is a valid number print i isnumber txt x print txt text string to test in print x optionaly returned numeric value if valid out print i test flag: out print 0: not a number print 1: txt is a long integer print 2: txt is a float print 1: first word of txt is a long integer print 2: first word of txt is a float return 1 endif TXT STRTRIM TXT0 2 trim blanks X 0 define X IF TXT EQ THEN RETURN 0 null string not a number SN 1 IF NWRDS TXT GT 1 THEN BEGIN get first word if more than one SN 1 TXT GETWRD TXT 0 ENDIF f_flag 0 Floating flag b byte txt w where b eq 43 cnt if cnt gt 1 then return 0 t delchr txt w where b eq 45 cnt if cnt gt 1 then return 0 t delchr t w where b eq 46 cnt if cnt gt 1 then return 0 May only be 1 if cnt eq 1 then f_flag 1 If one then floating t delchr t w where b eq 101 cnt e if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t e w where b eq 69 cnt E if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t E w where b eq 100 cnt d if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t d w where b eq 68 cnt D if cnt gt 1 then return 0 if cnt eq 1 then f_flag 1 t delchr t D if total b eq 101 b eq 69 b eq 100 b eq 68 gt 1 then return 0 b byte t if total b ge 65 and b le 122 ne 0 then return 0 c strmid t 0 1 if c lt 0 or c gt 9 then return 0 First char not a digit x txt 0 0 Convert to a float if f_flag eq 1 then return 2 sn Was floating if x eq long x then begin x long x return sn endif else begin return 2 sn endelse END"); 297 a[295] = new Array("./ToBeReviewed/STRING/lenstr.html", "lenstr.pro", "", " ROUTINE: lenstr USEAGE: result lenstr str input: str a single string or string array output: result length of the string s in normalized units the number of elements of RESULT matches the number of elements of STRING procedure: This function returns the physical length of the string on the output device not the number of characters This is done by first switching to X and writing the string s with XYOUTS in graphics mode 5 which disables display to the screen but does not interfere with operation of XYOUTS The WIDTH keyword parameter of XYOUTS is used to retrieve the physical length of the string s author: Paul Ricchiazzi 7apr93 Institute for Computational Earth System Science University of California Santa Barbara function lenstr str dsave d name thisOS VERSION OS_FAMILY thisOS STRMID thisOS 0 3 thisOS STRUPCASE thisOS CASE thisOS of MAC : SET_PLOT thisOS WIN : SET_PLOT thisOS ELSE: SET_PLOT X ENDCASE p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x device get_graphics oldg set_graphics 5 if keyword_set charsize eq 0 then charsize 1 nn n_elements str case nn of 0:w 0 1:xyouts 0 0 device str width w else:begin w fltarr nn for i 0 nn 1 do begin xyouts 0 0 device str i width ww w i ww endfor end endcase fac1 float d x_ch_size d x_vsize ratio of char width to device1 width device set_graphics oldg set_plot dsave IF dsave EQ X OR dsave EQ MAC OR dsave EQ WIN then BEGIN p BACKGROUND d n_colors 1 255 p color 0 if d n_colors gt 256 then p background ffffff x ENDIF fac2 float d x_ch_size d x_vsize ratio of char width to device2 width return w fac2 fac1 string width adjusted for device width end "); 298 a[296] = new Array("./ToBeReviewed/STRING/nwrds.html", "nwrds.pro", "", " NAME: NWRDS PURPOSE: Return the number of words in the given text string CATEGORY: CALLING SEQUENCE: n nwrds txt INPUTS: txt text string to examine in KEYWORD PARAMETERS: Keywords: DELIMITER d Set delimiter character def space OUTPUTS: n number of words found out COMMON BLOCKS: NOTES: Notes: See also getwrd MODIFICATION HISTORY: R Sterner 7 Feb 1985 Johns Hopkins University Applied Physics Laboratory RES 4 Sep 1989 converted to SUN Copyright C 1985 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt function nwrds txtstr help hlp delimiter delim if n_params 0 lt 1 or keyword_set hlp then begin print Return the number of words in the given text string print n nwrds txt print txt text string to examine in print n number of words found out print Keywords: print DELIMITER d Set delimiter character def space print Notes: See also getwrd return 1 endif if strlen txtstr eq 0 then return 0 A null string has 0 words ddel Default word delimiter is a space if n_elements delim ne 0 then ddel delim Use given word delimiter tst byte ddel 0 Delimiter as a byte value tb byte txtstr String to bytes if ddel eq then begin Check for tabs w where tb eq 9B cnt Yes if cnt gt 0 then tb w 32B Convert any to space endif x tb ne tst Locate words x 0 x 0 Pad ends with delimiters y x shift x 1 eq 1 Look for word beginnings n fix total y Count word beginnings return n end"); 299 a[297] = new Array("./ToBeReviewed/STRING/putfile.html", "putfile.pro", "", " NAME: PUTFILE PURPOSE: Write a text file from a string array CATEGORY: CALLING SEQUENCE: putfile f s INPUTS: f text file name in s string array in KEYWORD PARAMETERS: Keywords: ERROR err error flag: 0 ok 1 invalid string array OUTPUTS: COMMON BLOCKS: NOTES: MODIFICATION HISTORY: R Sterner 20 Mar 1990 R Sterner 4 Nov 1992 allowed scalar strings Copyright C 1990 Johns Hopkins University Applied Physics Laboratory This software may be used copied or redistributed as long as it is not sold and this copyright notice is reproduced on each copy made This routine is provided as is without any express or implied warranties whatsoever Other limitations apply as described in the file disclaimer txt pro putfile file s error err help hlp if n_params 0 lt 1 or keyword_set hlp then begin print Write a text file from a string array print putfile f s print f text file name in print s string array in print Keywords: print ERROR err error flag: 0 ok 1 invalid string array return endif if lmgr demo then begin print you are in Demo mode It is impossible to write a file return endif if size s type ne 7 then begin print Error in putfile: argument must be a string array err 1 return endif get_lun lun openw lun file for i 0 n_elements s 1 do begin t s i if t eq then t printf lun t endfor close lun free_lun lun err 0 return end"); 300 a[298] = new Array("./ToBeReviewed/STRING/str_size.html", "str_size.pro", "", " Id: str_size pro 18 2006 05 02 09:32:05Z pinsard NAME: STR_SIZE PURPOSE: The purpose of this function is to return the proper character size to make a specified string a specifed width in a window The width is specified in normalized coordinates The function is extremely useful for sizing strings and labels in resizeable graphics windows CATEGORY: Graphics Programs Widgets CALLING SEQUENCE: thisCharSize STR_SIZE thisSting targetWidth INPUTS: thisString: This is the string that you want to make a specifed target size or width OPTIONAL INPUTS: targetWidth: This is the target width of the string in normalized coordinates in the current graphics window The character size of the string returned as thisCharSize will be calculated to get the string width as close as possible to the target width The default is 0 25 KEYWORD PARAMETERS: INITSIZE: This is the initial size of the string Default is 1 0 STEP: This is the amount the string size will change in each step of the interative process of calculating the string size The default value is 0 05 OUTPUTS: thisCharSize: This is the size the specified string should be set to if you want to produce output of the specified target width The value is in standard character size units where 1 0 is the standard character size EXAMPLE: To make the string Happy Holidays take up 30 of the width of the current graphics window type this: XYOUTS 0 5 0 5 ALIGN 0 5 Happy Holidays CHARSIZE STR_SIZE Happy Holidays 0 3 MODIFICATION HISTORY: Written by: David Fanning 17 DEC 96 Added a scaling factor to take into account the aspect ratio of the window in determing the character size 28 Oct 97 DWF FUNCTION STR_SIZE string targetWidth INITSIZE initsize STEP step ON_ERROR 1 Check positional parameters np N_PARAMS CASE np OF 0: MESSAGE One string parameter is required 1: targetWidth 0 25 ELSE: ENDCASE Check keywords Assign default values IF N_ELEMENTS step EQ 0 THEN step 0 05 IF N_ELEMENTS initsize EQ 0 THEN initsize 1 0 Calculate a trial width size initsize XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL Size is perfect IF thisWidth EQ targetWidth THEN RETURN size Float D Y_Size D X_Size Initial size is too big IF thisWidth GT targetWidth THEN BEGIN REPEAT BEGIN XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL size size step ENDREP UNTIL thisWidth LE targetWidth RETURN size Float D Y_Size D X_Size ENDIF Initial size is too small IF thisWidth LT targetWidth THEN BEGIN REPEAT BEGIN XYOUTS 0 5 0 5 ALIGN 0 5 string WIDTH thisWidth CHARSIZE size NORMAL size size step ENDREP UNTIL thisWidth GT targetWidth size size step Need a value slightly smaller than target RETURN size Float D Y_Size D X_Size ENDIF END"); 301 a[299] = new Array("./ToBeReviewed/STRING/strcnt.html", "strcnt.pro", "", " NAME: STRCNT PURPOSE: Count number of occurrences of a substring in a string CATEGORY: text strings CALLING SEQUENCE: num strcnt strn substring pos INPUTS: string The string in which to count occurences in substring The substring to count occurrences of in pos the position at which to begin the search in If not supplied start at beginning of string KEYWORD PARAMETERS: HELP Print useful message and return OUTPUTS: num Number of occurances of substring in string out COMMON BLOCKS: SIDE EFFECTS: NOTES: Overlapping occurances are not counted separately For example counting occurances of bb in blah bbb returns one occurance EXAMPLE: MODIFICATION HISTORY: Id: strcnt pro 18 2006 05 02 09:32:05Z pinsard Log: strcnt pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added fast processing using BYTE arrays if we are counting occurences of a single character Added error handling Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strcnt strn substrn startpos HELP Help Return to caller if error On_error 2 Help user if needed IF n_params LT 2 OR keyword_set Help THEN BEGIN offset print offset Count number of occurrences of a substring in a string print offset num strcnt strn substring pos print offset Inputs: print offset offset string The string in which to count occurences in print offset offset substring The substring to count occurrences of in print offset offset pos the position at which to begin the search in print offset offset If not supplied start at beginning of print offset offset string print offset Keywords: print offset offset HELP Print useful message and return print offset Outputs: print offset offset num Number of occurances of substring in string out return 1 ENDIF IF n_params EQ 2 THEN startpos 0 return if we weren t really given a substring to search for IF strlen substrn EQ 0 THEN BEGIN print Error: Can t count occurances of null string return 1 ENDIF or if we were told to start at the end of the string tmpstrn strmid strn startpos strlen strn IF strlen tmpstrn EQ 0 THEN return 0 If looking for occurences of single character process using BYTE array IF strlen substrn EQ 1 THEN BEGIN tmpstrn byte TmpStrn count n_elements where TmpStrn EQ byte substrn 0 ENDIF ELSE BEGIN count 0L pos rstrpos tmpstrn substrn WHILE pos GE 0 DO BEGIN count count 1 pos rstrpos tmpstrn substrn pos ENDWHILE ENDELSE return count END "); 302 a[300] = new Array("./ToBeReviewed/STRING/string2struct.html", "string2struct.pro", "", " This is a really really cool way to turn keywords into a structure function too_cool _extra extra return extra end NAME: stringToStructure PURPOSE: Takes an input string set up as keywords and returns an anonymous structure This is particularly useful for taking keywords entered by a user in a text field and passing then to other routines CATEGORY: Utility CALLING SEQUENCE: extra stringToStructure xrange 0 10 linestyle 2 plot findgen 100 _extra extra INPUTS: String set up as keywords Keywords require a little special treatment Such as plot findgen 100 _extra stringToStructure title testing KEYWORD PARAMETERS: None OUTPUTS: This function returns the string as an anonymous structure If an error was found then this function returns a structure with a null field COMMON BLOCKS: None EXAMPLE: The code below creates a widget that uses this routine pro tPlot event widget_control event top get_uvalue field widget_control field get_value strVal extra stringToStructure strVal plot findgen 100 _extra extra wshow return end pro testWid enter any keyword to plot and see how it works base widget_base col field cw_field base title test value ax 0 string void widget_button base value plot event_pro tPlot widget_control base realize set_uvalue field xmanager testWid base no_block return end MODIFICATION HISTORY: Written by: RLK Ronn Kling Consulting ronn rlkling com www rlkling com May 1999 function string2struct strVal r execute extra too_cool strVal 0 if r 0 then user did not enter keywords correctly so return a structure with a null field if r eq 0 then begin print Error in input string return null:0 endif return extra end "); 303 a[301] = new Array("./ToBeReviewed/STRING/strkeywd.html", "strkeywd.pro", "", " NAME: strkeywd string keywords PURPOSE: traduit une sturcture en un string pouvant etre utilise pour specifier des keywords ds l appelle d une fonction qd on utilise execute cf l exemple CATEGORY: pour passer des mots cles avec execute CALLING SEQUENCE:res strkeywd struct INPUTS:struct: une structure KEYWORD PARAMETERS: OUTPUTS:un string compose de la facon suivante: pour chaque element de la structure on ecrit une partie du string sous la forme: nom_de_l element contennu de l element COMMON BLOCKS: SIDE EFFECTS: Si un element de la structure contient un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des structure de grosse taille avec bcp d elements et avec des elements etant de gros tableaux la structure en entree ne doit pas contenir de Complex floating de structure de Double precision complex de Pointer de Object reference de Unsigned Integer de Unsigned Longword Integer de 64 bit Integer de Unsigned 64 bit Integer EXAMPLE: on cree une structure IDL b get_extra ok 111 year 1997 1998 1999 age_capitaine 35 IDL help b struct Structure 3 tags length 10 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT Array 3 on met cette structure sous forme de string IDL a strkeywd b IDL print a AGE_CAPITAINE 35 OK 111 YEAR 1997 1998 1999 maintenant on peut utiliser le string a pour passer des mots cles ds une fonction a l aide de execute IDL test execute c get_extra a IDL help c struct Structure 3 tags length 10 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT Array 3 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 11 10 1999 FUNCTION strkeywd struct if size struct type NE 8 then return tname tag_names struct if n_elements tname EQ 0 then return on s occupe du premier element res strlowcase tname 0 tostr struct 0 if n_elements tname EQ 1 then return res on s occupe des autres elements for n 1 n_elements tname 1 do res res strlowcase tname n tostr struct n return res end"); 304 a[302] = new Array("./ToBeReviewed/STRING/strrepl.html", "strrepl.pro", "", " Id: strrepl pro 18 2006 05 02 09:32:05Z pinsard NAME: STRREPL function PURPOSE: replace one or more character s string s in a string CATEGORY: string routines CALLING SEQUENCE: Result STRREPL str index rchar INPUTS: STR the string to be changed INDEX position of the character s to be replaced or a string to be changed in STR RCHAR replacement character string KEYWORD PARAMETERS: none OUTPUTS: another string SUBROUTINES: REQUIREMENTS: NOTES: Known shortcoming: if index is an array it must contain all valid elements only the first entry is checked EXAMPLE: Convert one letter into upper case abc abcdefghijklmnopqrstuvwxyz print strrepl abc strpos abc m M prints abcdefghijklMnopqrstuvwxyz Use with strwhere function a abcabcabc print strrepl a strwhere a a prints bc bc bc bc bc IDL print strrepl a bc eeee a eeee a eeee a eeee IDL print strrepl a b 0000 a0000ca0000ca0000 IDL print strrepl a toto 0000 abcabcabc MODIFICATION HISTORY: mgs 02 Jun 1998: VERSION 1 00 sebastien Masson smlod ipsl jussieu fr Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strrepl function strrepl str agument1 rchar if n_elements str eq 0 then return convert strign and replace character to byte BStr byte str new byte rchar if size agument1 type EQ 7 then begin old byte agument1 index strpos str agument1 pos index while strpos str agument1 pos 1 NE 1 do BEGIN pos strpos str agument1 pos 1 index index pos ENDWHILE make sure index is in range if index 0 lt 0 OR index 0 ge n_elements BStr THEN return Str ENDIF ELSE BEGIN index agument1 if index 0 lt 0 OR index 0 ge n_elements BStr then return Str old BStr index 0 ENDELSE replace indexed characters in string nelenew n_elements new neleold n_elements old nindex n_elements index if nelenew neleold NE 1 then begin if index 0 EQ 0 then BStr NEW BStr index 0 neleold: n_elements BStr 1 ELSE BStr BStr 0:index 0 1 NEW BStr index 0 neleold: n_elements BStr 1 if nindex EQ 1 then return string BStr if nindex GT 2 then for i 1 nindex 2 do BStr BStr 0:index i i nelenew neleold 1 NEW BStr index i i nelenew neleold neleold: n_elements BStr 1 BStr BStr 0:index n_elements index 1 nindex 1 nelenew neleold 1 NEW ENDIF ELSE BStr index NEW return result as string return string BStr end"); 305 a[303] = new Array("./ToBeReviewed/STRING/strright.html", "strright.pro", "", " Id: strright pro 18 2006 05 02 09:32:05Z pinsard NAME: STRRIGHT PURPOSE: return right subportion from a string CATEGORY: string handling CALLING SEQUENCE: res STRRIGHT string nlast INPUTS: STRING the string to be searched NLAST the number of characters to be returned Default is 1 If NLAST is ge strlen STRING the complete string is returned KEYWORD PARAMETERS: OUTPUTS: The portion of NLAST characters of STRING counted from the back SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: if strright path ne then path path MODIFICATION HISTORY: mgs 19 Nov 1997: VERSION 1 00 Copyright C 1997 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strright function strright s lastn on_error 2 return to caller if n_elements s le 0 then return 1L l strlen s if n_elements lastn le 0 then lastn 1 if lastn gt l then lastn l result strmid s l lastn l return result end"); 306 a[304] = new Array("./ToBeReviewed/STRING/strsci.html", "strsci.pro", "", " Id: strsci pro 18 2006 05 02 09:32:05Z pinsard NAME: STRSCI function PURPOSE: Given a number returns a string of that B number in scientific notation format e g A x 10 CATEGORY: String Utilities CALLING SEQUENCE: Result STRSCI DATA keywords INPUTS: DATA A floating point or integer number to be converted into a power of 10 KEYWORD PARAMETERS: FORMAT The format specification used in the string conversion for the mantissa i e the A of A x 10 B Default is f12 2 POT_ONLY Will return only the power of 10 part of the string i e the 10 B Default is to return the entire string e g A x 10 B MANTISSA_ONLY return only mantissa of the string SHORT return 10 0 as 1 and 10 1 as 10 TRIM don t insert blanks i e return Ax10 B OUTPUTS: None SUBROUTINES: None REQUIREMENTS: None NOTES: This function does not evaluate the format statement thoroughly which can result in somewhat quirky strings Example: print strsci 9 999 results in 10 0x10 0 instead of 1 0x10 1 Need a better symbol than the x for the multiplier EXAMPLE: Result STRSCI 2000000 format i1 print result 6 prints 2 x 10 u6 n which gets plotted as 2 x 10 Result STRSCI 0 0001 print result 4 prints 1 00 x 10 u 4 n which gets plotted as 1 00 x 10 Result STRSCI 0d0 format f13 8 print result prints 0 00000000 MODIFICATION HISTORY: bmy 28 May 1998: VERSION 1 00 B now returns string of the form A x 10 mgs 29 May 1998: bug fix: now allows negative numbers keyword MANTISSA_ONLY added default format changed to f12 2 bmy 02 Jun 1998: renamed to STRSCI STRing SCIentific notation mgs 03 Jun 1998: added TRIM keyword mgs 22 Sep 1998: added SHORT keyword modified handling of TRIM keyword mgs 24 Sep 1998: bug fix with SHORT flag bmy mgs 02 Jun 1999: now can handle DATA 0 0 correctly updated comments mgs 03 Jun 1999: can now also handle values lt 1 and doesn t choke on arrays Copyright C 1998 1999 Bob Yantosca and Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to bmy io harvard edu or mgs io harvard edu with subject IDL routine strsci function StrSci Data Format Format POT_Only POT_Only MANTISSA_ONLY MANTISSA_ONLY SHORT SHORT TRIM TRIM Error checking Keyword settings on_error 2 if n_elements Data eq 0 then begin return endif if not Keyword_Set Format then Format f12 2 POT_Only keyword_set POT_Only MANTISSA_Only keyword_set MANTISSA_Only Short Keyword_Set Short Trim Keyword_Set Trim NDat n_elements Data Result strarr NDat for i 0 NDat 1 do begin If ABS DATA 0 then we can proceed to take the common log For DATA 0 place a sign in front of the number if Abs Data i ne 0 0 then begin take the common log and store in LOG10DATA Log10Data ALog10 Abs Data i Boolean flag if data 0 sign Data i lt 0 0 Compute the characteristic int part Add the 1d 6 to prevent roundoff errors Characteristic Fix Log10Data 1 0d 6 if Log10Data lt 0 then Characteristic Characteristic 1 Compute the Mantissa frac part and take its antilog Mantissa Log10Data Characteristic Mantissa 10 0 Mantissa print data i log10data mantissa characteristic format 3f24 14 i8 String for the coefficient part The coefficient is just antilog of the Mantissa Add the minus sign if DATA 0 0 A StrTrim String Mantissa Format Format 2 if Sign then A A String for the power of 10 part B 10 u strtrim string Characteristic 2 n if Short then begin if Characteristic eq 0 then B 1 if Characteristic eq 1 then B 10 endif composite string Result i A x B if Short AND B eq 1 then Result i A If DATA 0 then we cannot take the common log so return zeroes for the result strings Use the FORMAT string endif else begin A String 0d0 Format Format B A Result i A endelse Return result to calling program depending on keyword settings Eliminate blanks if TRIM keyword is set if POT_Only then Result i B if MANTISSA_Only then Result i A if Trim then Result i StrCompress Result i Remove_All endfor if n_elements Result eq 1 then Result Result 0 return Result end"); 307 a[305] = new Array("./ToBeReviewed/STRING/strtok.html", "strtok.pro", "", " NAME: STRTOK PURPOSE: Retrieve portion of string up to token CATEGORY: text strings CALLING SEQUENCE: new strtok old token INPUTS: old String to be split Contains text after in out token on output token Token to use in splitting old in KEYWORD PARAMETERS: TRIM set to remove leading blanks from old before returning HELP print useful message and exit OUTPUTS: new portion of string up to token out old portion of old after token out in COMMON BLOCKS: SIDE EFFECTS: Input parameter old is modified NOTES: Token may be one or more characters If token is not found returns old and sets old to EXAMPLE: If old is foo44 bar then strtok old 44 would return foo and upon return old will be left with bar If TRIM were set old would be bar on return If old xyz then new strtok old a would return with new xyz and old THANKS: To D Linder who wrote GETTOK part of the goddard library upon which this is based MODIFICATION HISTORY: Id: strtok pro 18 2006 05 02 09:32:05Z pinsard Log: strtok pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Added built in help Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION Strtok string token TRIM trim HELP Help Back to the caller if error occurs On_error 2 IF n_params NE 2 OR keyword_set Help THEN BEGIN offset print offset Retrieve portion of string up to token print offset new strtok old token print offset Inputs: print offset offset old String to be split Contains text after in out print offset offset token on output print offset offset token Token to use in splitting old in print offset Keywords: print offset offset TRIM set to remove leading blanks from old print offset offset before returning print offset offset HELP print useful message and exit print offset Outputs: print offset offset new portion of string up to token out print offset offset old portion of old after token out in print offset Side effects: print offset offset Input parameter old is modified print offset Notes: print offset offset Token may be one or more characters print offset offset If token is not found returns old and sets old to print offset Examples: print offset offset If old is foo44 bar then strtok old 44 would return print offset offset foo and upon return old will be left with bar If TRIM print offset offset were set old would be bar on return print offset offset If old xyz then new strtok old a would return with print offset offset new xyz and old return 1 ENDIF pos strpos string token IF pos GE 0 THEN BEGIN front strmid string 0 pos string strmid string pos strlen token strlen string IF keyword_set trim THEN string strtrim string 1 return front ENDIF front string string return front END "); 308 a[306] = new Array("./ToBeReviewed/STRING/strtrans.html", "strtrans.pro", "", " NAME: STRTRANS PURPOSE: Translate all occurences of one substring to another CATEGORY: text strings CALLING SEQUENCE: new strtrans oldstr from to ned INPUTS: oldstr string on which to operate in May be an array from substrings to be translated May be in an array to what strings in from should be in translated to May be an array KEYWORD PARAMETERS: HELP Set this to print useful message and exit OUTPUTS: new Translated string Array if oldstr is out an array ned number of substitutions performed in out oldstr Array if oldstr is an array COMMON BLOCKS: SIDE EFFECTS: NOTES: Any of old from and to can be arrays from and to must have the same number of elements EXAMPLE: inp Many bad chars in_here from _ to out strtrans inp from to ned Will produce out Many bad chars in here and set ned to 4 MODIFICATION HISTORY: Id: strtrans pro 18 2006 05 02 09:32:05Z pinsard Log: strtrans pro v Revision 1 3 1996 06 14 20:00:27 mcraig Updated Copyright info Revision 1 2 1996 05 09 00:22:17 mcraig Sped up significantly by using str_sep to handle the translation No longer relies on routines fromother user libraries Revision 1 1 1996 01 31 18:47:37 mcraig Initial revision RELEASE: Name: Rel_1_2 COPYRIGHT: Copyright C 1996 The Regents of the University of California All Rights Reserved Written by Matthew W Craig See the file COPYRIGHT for restrictions on distrubting this code This code comes with absolutely NO warranty see DISCLAIMER for details FUNCTION strtrans InputString from to ned HELP Help Bomb out to caller if error On_error 2 Offer help if we don t have at least InputString from and to or if the user asks for it IF n_params LT 3 OR keyword_set help THEN BEGIN offset print offset Translate all occurences of one substring to another print offset new strtrans oldstr from to ned print offset Inputs: print offset offset oldstr string on which to operate in print offset offset May be an array print offset offset from substrings to be translated May be in print offset offset an array print offset offset to what strings in from should be in print offset offset translated to May be an array print offset Outputs: print offset offset new Translated string Array if oldstr is out print offset offset an array print offset offset ned number of substitutions performed in out print offset offset oldstr Array if oldstr is an array print offset Notes: print offset offset Any of old from and to can be arrays print offset offset from and to must have the same number of elements return 1 ENDIF strn InputString Check that From To have same number of elements RETURN if they don t NFrom n_elements from NTo n_elements to IF NFrom EQ 0 OR NTo EQ 0 THEN return strn IF NFrom NE NTo THEN BEGIN print Error: Number of elements in from to unequal return 1 ENDIF Make sure there are no null strings in From RETURN if there are FromLen strlen From IF total FromLen EQ 0 GT 0 THEN BEGIN print Error: elements of From must have nonzero length return 1 ENDIF NStrings n_elements strn ned lonarr NStrings tmpned 0L Say strn a b c from and to Then the approach here is to first split strn at all occurances of then recombine the pieces with inserted instead Do this for all elements of strn and all elements of from FOR i 0L NStrings 1 DO BEGIN ned i 0L FOR j 0L NFrom 1 DO BEGIN SepStr str_sep strn i from j NSubs n_elements SepStr 1 strn i SepStr 0 FOR k 1L NSubs DO strn i strn i To j SepStr k ned i ned i NSubs ENDFOR ENDFOR return strn END "); 309 a[307] = new Array("./ToBeReviewed/STRING/strwhere.html", "strwhere.pro", "", " Id: strwhere pro 18 2006 05 02 09:32:05Z pinsard NAME: STRWHERE function PURPOSE: return position array for occurence of a character in a string CATEGORY: string tools CALLING SEQUENCE: pos STRWHERE str schar Count INPUTS: STR the string SCHAR the character to look for KEYWORD PARAMETERS: none OUTPUTS: COUNT optional The number of matches that were found The function returns an index array similar to the result of the where function SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: ind strwhere abcabcabc a returns 0 3 6 MODIFICATION HISTORY: mgs 02 Jun 1998: VERSION 1 00 bmy 30 Jun 1998: now returns COUNT the number of matches that are found this is analogous to the WHERE command Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine strwhere function strwhere str schar Count if n_elements str eq 0 then return 1 convert to byte BStr byte Str BSC byte schar 0 Search for matches Ind where Bstr eq BSC Count bmy return where BStr eq BSC return Ind end "); 310 a[308] = new Array("./ToBeReviewed/STRING/tostr.html", "tostr.pro", "", " NAME: tostr to string PURPOSE: convertit un input en un string CATEGORY: CALLING SEQUENCE: res tostr input INPUTS: input ne peut pas contenir ou etre de type: Complex floating structure Double precision complex Pointer Object reference Unsigned Integer Unsigned Longword Integer 64 bit Integer Unsigned 64 bit Integer KEYWORD PARAMETERS: none OUTPUTS: un string COMMON BLOCKS: SIDE EFFECTS: Si un element de input contient un tableau il sera convertit en vecteur RESTRICTIONS: attention cette fonction comporte des boucles des if et des cases ds tous les sens Elle ne doit donc pas etre utilisee avec des inputs de grosse taille avec bcp d elements et avec des elements etant de gros tableaux EXAMPLE: IDL help tostr 1 tostr a tostr indgen 4 tostr a jkfjo STRING 1 STRING a STRING 0 1 2 3 STRING a jkfjo IDL print tostr c est bon c est bon c est bon c est bon MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 18 10 1999 FUNCTION tostr input case 1 of size input type LE 5:BEGIN if size input type EQ 1 then input long input if n_elements input EQ 1 then res strtrim input 1 ELSE BEGIN res strtrim input 0 1 for i 1 n_elements input 1 do res res strtrim input i 1 res res ENDELSE END size input type eq 7:BEGIN if n_elements input EQ 1 then BEGIN sinput strrepl input res sinput ENDIF ELSE BEGIN res strrepl input 0 for i 1 n_elements input 1 do res res strrepl input i res res ENDELSE END ELSE:BEGIN ras report la fonction tostr ne marche pas pour input qui est de type size input tname res END ENDCASE return res end"); 311 a[309] = new Array("./ToBeReviewed/STRUCTURE/chkstru.html", "chkstru.pro", "", " Id: chkstru pro 27 2006 05 02 13:10:05Z pinsard NAME: CHKSTRU function PURPOSE: check validity of a structure and test if necessary fields are contained CATEGORY: tools CALLING SEQUENCE: res CHKSTRU STRUCTURE FIELDS VERBOSE INPUTS: STRUCTURE the structure to be tested If STRUCTURE is not of type structure the function will return 0 FIELDS a string or string array with field names to be contained in STRUCTURE CHKSTRU returns 1 true only if all field names are contained in STRUCTURE The entries of FIELDS may be upper or lowercase KEYWORD PARAMETERS: INDEX a named variable that will contain the indices of the required field names in the structure They can then be assessed through structure index i Index will contain 1 for all fields entries that are not in the structure VERBOSE set this keyword to return an error message in case of an error EXTRACT set this keyword to extract a fields from the structure 1 is return is fields or structure are incorrect OUTPUTS: CHKSTRU returns 1 if successful otherwise 0 SUBROUTINES: REQUIREMENTS: NOTES: EXAMPLE: test a:1 b:2 c:3 required a c if CHKSTRU test required then print found a and c IDL print CHKSTRU test b 1 IDL print CHKSTRU test b extract 2 MODIFICATION HISTORY: mgs 02 Mar 1998: VERSION 1 00 mgs 07 Apr 1998: second parameter FIELDS now optional 12 Jan 2001: EXTRACT keyword by S Masson smasson lodyc jussieu fr Copyright C 1998 Martin Schultz Harvard University This software is provided as is without any warranty whatsoever It may be freely used copied or distributed for non commercial purposes This copyright notice must be kept with any copy of this software If this software shall be used commercially or sold as part of a larger package please contact the author to arrange payment Bugs and comments should be directed to mgs io harvard edu with subject IDL routine chkstru function chkstru structure fields index index verbose verbose extract extract default index index 1 first check number of parameters must be at least 1 if n_params lt 1 then begin if keyword_set verbose then ras report CHKSTRU: invalid number of parameters if keyword_set extract THEN return 1 ELSE return 0 endif check if the user really passed a structure s size structure if s 1 s 0 ne 8 then begin if keyword_set verbose then ras report CHKSTRU: No structure passed if keyword_set extract THEN return 1 ELSE return 0 endif only one parameter: then we are finished if n_params eq 1 then return 1 see if required field names are contained in the structure and return indices of these fields names tag_names structure index intarr n_elements fields 1 default index to not found for i 0 n_elements fields 1 do begin ind where names eq strupcase fields i if ind 0 lt 0 then begin if keyword_set verbose then ras report CHKSTRU: Cannot find field fields i endif else index i ind 0 endfor check minimum value of index field: 1 indicates error if keyword_set extract then BEGIN if index 0 NE 1 THEN return structure index 0 ELSE return 1 ENDIF ELSE return min index ge 0 end "); 312 a[310] = new Array("./ToBeReviewed/STRUCTURE/extractstru.html", "extractstru.pro", "", " NAME:extractstru PURPOSE:extrait des elements d une structure pour constituer une nouvelle structure CATEGORY: dibouille sur les structures CALLING SEQUENCE: res extractstru stru liste INPUTS: stru: une structure liste: un vecteur de string comportant les noms des elements de stru a virer par DEFAUT ou a garder si GARDE est active KEYWORD PARAMETERS: GARDE: specifie que la liste donnee concerne les elements de stru a garder VIRE: specifie que la liste donnee concerne les elements de stru a virer Ce mot cle est active par defaut OUTPUTS:une stucture ou 1 en cas de pb COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: none liste peut contenir des noms d elements qui ne sont pas ds stru le programme se debrouille avec EXAMPLE: IDL extra get_extra ok year 1999 age_capitaine 35 IDL help extra struct Structure 3 tags length 6 refs 1: AGE_CAPITAINE INT 35 OK INT 1 YEAR INT 1999 IDL help extractstru extra ok hhuihi YEAR stru Structure 1 tags length 2 refs 1: AGE_CAPITAINE INT 35 IDL help extractstru extra ok hhuihi YEAR garde stru Structure 2 tags length 4 refs 1: OK INT 1 YEAR INT 1999 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 10 1999 FUNCTION extractstru stru liste GARDE garde VIRE vire if size stru type NE 8 then return 1 if size liste type NE 7 then return 1 cheking for garde and vire keywords garde keyword_set garde 1 keyword_set vire vire keyword_set vire 1 keyword_set garde keyword_set vire EQ garde tname tag_names stru index make_selection tname strupcase liste only_valid quiet if garde then BEGIN on garde que la liste if index 0 EQ 1 then return 1 if n_elements index EQ n_elements tname then return stru res create_struct tname index 0 stru index 0 if n_elements index GT 1 then for i 1 n_elements index 1 do res create_struct res tname index i stru index i ENDIF ELSE BEGIN on vire la liste if n_elements index EQ n_elements tname then return 1 if index 0 EQ 1 then return stru on prend le complementaire de index pour obtenir les indices que l on garde index different indgen n_elements tname index res create_struct tname index 0 stru index 0 if n_elements index GT 1 then for i 1 n_elements index 1 do res create_struct res tname index i stru index i ENDELSE return res end"); 313 a[311] = new Array("./ToBeReviewed/STRUCTURE/mixstru.html", "mixstru.pro", "", " NAME: mixstru PURPOSE: concatene 2 structures ensemble La difference avec CREATE_STRUCT etant que si les 2 stuctures ont les memes noms d elements alors mixstru ne plante pas mais choisit pour valeur de l element commun celle specifiee par la premiere structure CATEGORY: structure CALLING SEQUENCE: rs mixstru stru1 stru2 INPUTS: stru1 et stu2 sont 2 structures qui peuvent avoir des elements portant le meme nom mais avec une valeur differente KEYWORD PARAMETERS: none OUTPUTS: une stucture COMMON BLOCKS: SIDE EFFECTS: si stru1 ou stru2 ne sont pas des structures mixstru renvoie 1 RESTRICTIONS: EXAMPLE: IDL a get_extra toto ok 123 IDL b get_extra ok 111 year 1999 age_capitaine 35 IDL help a b struct Structure 2 tags length 4 refs 1: OK INT 123 TOTO INT 1 Structure 3 tags length 6 refs 1: AGE_CAPITAINE INT 35 OK INT 111 YEAR INT 1999 IDL help mixstru a b struct Structure 4 tags length 8 refs 1: AGE_CAPITAINE INT 35 YEAR INT 1999 OK INT 123 TOTO INT 1 IDL help mixstru b a struct Structure 4 tags length 8 refs 1: TOTO INT 1 AGE_CAPITAINE INT 35 OK INT 111 YEAR INT 1999 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 7 10 1999 FUNCTION mixstru stru1 stru2 cm_general IF size stru1 type EQ 0 AND size stru2 type EQ 8 THEN return stru2 IF size stru2 type EQ 0 AND size stru1 type EQ 8 THEN return stru1 if size stru1 type NE 8 then return 1 if size stru2 type NE 8 then return 1 tname tag_names stru2 str FOR i 0 n_tags stru2 1 DO str str tname i stru2 strtrim i 2 res createfunc get_extra str _extra stru1 kwdlist stru1 stru1 stru2 stru2 stru1 stru1 stru2 stru2 filename myuniquetmpdir for_createfunc pro return res end"); 314 a[312] = new Array("./ToBeReviewed/STRUCTURE/struct2string.html", "struct2string.pro", "", " NAME:struct2string PURPOSE:convert a structure to an executable string CATEGORY:bidouille CALLING SEQUENCE:sting struct2string struct INPUTS:struct: a structure KEYWORD PARAMETERS: MAX_STRUCT_LENGTH : the maximum length of the structure permetted to convert the structure to string Default is 10000l DIRECT2STRING: to get a string instead an executable string CUT_IN_STRING: try it OUTPUTS: SIDE EFFECTS:use tostr pro cf this function header RESTRICTIONS:use tostr pro cf this function header EXAMPLE: IDL print struct2string d create_struct NAME X X_SIZE 891 Y_SIZE 630 X_VSIZE 891 Y_VSIZE 630 X_CH_SIZE 6 Y_CH_SIZE 10 X_PX_CM 40 0000 Y_PX_CM 40 0000 N_COLORS 16777216 TABLE_SIZE 256 FILL_DIST 1 WINDOW 32 UNIT 0 FLAGS 328124 ORIGIN 0 0 ZOOM 1 1 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 07 03 FUNCTION struct2string struct CUT_IN_STRING cut_in_string MAX_STRUCT_LENGTH max_struct_length DIRECT2STRING direct2string if size struct type NE 8 then return if NOT keyword_set max_struct_length then max_struct_length 10000l if n_tags struct length GT max_struct_length then begin rien report The structure is too big to be converted to string C See the MAX_STRUCT_LENGTH keyword return endif names tag_names struct case 1 of keyword_set direct2string :BEGIN res names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res names i tostr struct i endfor endif END keyword_set CUT_IN_STRING :BEGIN res create_struct names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res create_struct res names i tostr struct i endfor endif END ELSE:BEGIN res create_struct names 0 tostr struct 0 if n_tags struct GT 1 then begin FOR i 1 n_tags struct 1 do begin res res names i tostr struct i endfor endif res res END endcase return res end"); 315 a[313] = new Array("./ToBeReviewed/STRUCTURE/where_tag.html", "where_tag.pro", "", " NAME: WHERE_TAG PURPOSE: Like WHERE but works on structure tag names EXPLANATION: Obtain subscripts of elements in structure array for which a particular Tag has values in a range or matching specified values Like the WHERE function but for use with structures CATEGORY: Structures CALLING SEQUENCE: w where_tag struct Nfound TAG_NAME TAG_NUMBER RANGE VALUES RANGE ISELECT NOPRINT INPUTS: Struct structure array to search INPUT KEYWORDS: User must specify 1 TAG_NAME or TAG_NUMBER to search and 2 the VALUES or RANGE to search on TAG_NAME Scalar string specifying Tag Name TAG_NUMBER otherwise give the Tag Number RANGE min max range to search for in Struct VALUES one or array of numbers to match for in Struct ISELECT specifies indices to select only part of structure array use it to recycle subscripts from previous searches NOPRINT suppress informational messages about nothing found OUTPUTS: Nfound of occurences found RESULT: Function returns subscripts indices to desired elements EXAMPLES: Suppose STR is a structure with tags CAT_NO:indgen 10 and NAME:strarr 10 Find the indices where STR CAT_NO is between 3 and 5 IDL print WHERE_TAG str TAG_NAME CAT_NO VALUE 3 4 5 or IDL print WHERE_TAG str TAG_NUM 0 RANGE 3 5 PROCEDURE: Get tag number and apply the WHERE function appropriately MODIFICATION HISTORY: written 1990 Frank Varosi STX NASA GSFC Stop printing Tag not found with NOPRINT CD Pike 8 Jun 93 function where_Tag Struct Nfound TAG_NAME Tag_Name TAG_NUMBER Tag_Num ISELECT ipart NOPRINT noprint RANGE range VALUES values First check required parameters Ntag N_tags Struct if Ntag LE 1 then begin message expecting a Structure Array try again CONTIN return 1 endif if N_elements Tag_Num NE 1 AND N_elements Tag_Name NE 1 then begin message specify TAG_NAME or TAG_NUMBER to search CONTIN return 1 endif Tags Tag_names Struct if N_elements Tag_Name EQ 1 then begin Tag_Name strupcase Tag_Name Tag_Num where Tags EQ Tag_Name Tag_Num Tag_Num 0 if Tag_Num LT 0 then begin if NOT keyword_set noprint then message Tag not found CONTIN return 2 endif endif if Tag_Num LT 0 OR Tag_Num GE Ntag then begin message Tag strtrim Tag_Num 2 exceeds Max Tag strtrim Ntag 1 2 in structure CONTIN return 1 endif if N_elements ipart GT 0 then begin check if any searching on a subset of input w where ipart GE 0 nf if nf LE 0 then return 1 if nf LT N_elements ipart then ipart ipart w endif Now find out where for RANGE : if N_elements range EQ 2 then begin if N_elements ipart GT 0 then begin w where Struct ipart Tag_Num GE range 0 AND Struct ipart Tag_Num LE range 1 Nfound if Nfound GT 0 then windex ipart w else windex w endif else windex where Struct Tag_Num GE range 0 AND Struct Tag_Num LE range 1 Nfound if Nfound LE 0 AND NOT keyword_set noprint then begin strnums strtrim range 2 string strnums 0 strnums 1 message NO values of found in the Range string CONTIN endif where Values: endif else if N_elements values GE 1 then begin Nval N_elements values vals values Nfound 0 if N_elements ipart GT 0 then begin for v 0 Nval 1 do begin w where Struct ipart Tag_Num EQ vals v Nf if Nf GT 0 then begin if Nfound GT 0 then ww ww w else ww w endif Nfound Nfound Nf endfor if Nfound GT 0 then windex ipart ww sort ww else windex w endif else begin for v 0 Nval 1 do begin w where Struct Tag_Num EQ vals v Nf if Nf GT 0 then begin if Nfound GT 0 then ww ww w else ww w endif Nfound Nfound Nf endfor if Nfound GT 0 then windex ww sort ww else windex w endelse if Nfound LE 0 AND NOT keyword_set noprint then begin strnums strtrim vals 2 string strnums 0 for i 1 Nval 1 do string string strnums i message NO values of found Equaling string CONTIN endif endif else begin message must specify a RANGE or VALUES s CONTIN windex 1 endelse return windex end"); 316 a[314] = new Array("./ToBeReviewed/TRIANGULATION/ciseauxtri.html", "ciseauxtri.pro", "", " NAME: PURPOSE:vire les tableaux qui ne doivent pas etre dessines grace a 2 tests: 1 les coins du tableau doivent etre ds la fenetre 2 les clongeurs des cotes des triangfles exprimes en coordonnees normalisesne doivent pas depasser une certaine longueur seuil CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 20 2 99 FUNCTION ciseauxtri triang glam gphi TOUT tout _EXTRA ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF IF NOT keyword_set key_periodic AND NOT keyword_set key_irregular AND NOT map projection LE 7 AND map projection NE 0 AND NOT map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 THEN return triang tempsun systime 1 pour key_performance taille size glam nx taille 1 ny taille 2 tempdeux systime 1 pour key_performance 2 z convert_coord glam gphi data to_normal x z 0 y z 1 tempvar SIZE TEMPORARY z delete z IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: convert_coord data to_normal systime 1 tempdeux attention suivant la projection certains points x ou y peuvent devenir NaN cf points deriere la terre ds une projection orthographique il faut dans ce cas enlever tous les triangles qui contiennent un de ces points if map projection LE 7 AND map projection NE 0 OR map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 then begin tempdeux systime 1 pour key_performance 2 test x y triang test finite temporary test nan test total temporary test 1 ind where temporary test EQ 0 if ind 0 NE 1 then triang triang temporary ind ELSE return 1 trichanged 1b IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: recherche points a NAN systime 1 tempdeux endif seuil 5 indxtriang2 indxtriang indxmin nx 1 indxmin EQ 0 AND indxmax EQ nx 1 ENDIF ELSE indxtriang indxmin listrect nx indytriang indxtriang IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: liste des rectangles systime 1 tempdeux maintenant qu on a cette liste on va s assuter que l on a pas de triangles qui n ont qu on sommet en commun test bytarr nx ny test listrect 1 dejavire 1b test tempdeux systime 1 pour key_performance 2 vire1 0 vire2 0 while vire1 0 NE 1 OR vire2 0 NE 1 ne 0 do begin vire1 where test shift test 1 1 1 shift test 0 1 1 shift test 1 0 EQ 1 if vire1 0 NE 1 THEN test vire1 0 on vire le rectangle vire2 where 1 test 1 shift test 1 1 shift test 0 1 shift test 1 0 EQ 1 on vire le rectangle du dessus meme indice x mais egale a 1 if vire2 0 NE 1 THEN test vire2 nx 0 ENDWHILE stop test test temporary dejavire avirer where temporary test EQ 0 IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: determinationdes rectangles a virer systime 1 tempdeux if avirer 0 NE 1 then begin tempdeux systime 1 pour key_performance 2 indnx n_elements listrect indny n_elements avirer ind listrect replicate 1l indny ind ind EQ replicate 1 indnx avirer if indny GT 1 then ind total ind 2 ind where ind EQ 0 if ind 0 NE 1 then triang triang ind ELSE return 1 endif IF testvar var key_performance EQ 2 THEN print temps ciseauxtri: derniere retouche de la triangulation systime 1 tempdeux endif if keyword_set key_performance THEN print temps ciseauxtri systime 1 tempsun return triang end"); 317 a[315] = new Array("./ToBeReviewed/TRIANGULATION/completecointerre.html", "completecointerre.pro", "", " NAME: COMPLETECOINTERRE PURPOSE: pour colorier proprement les continents c est une longue histoire CATEGORY: pour plt CALLING SEQUENCE: completecointerre INPUTS: non KEYWORD PARAMETERS: _EXTRA CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: non COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 01 10 1999 PRO draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex cm_4mesh the triangle must not be out of the domain IF min lons max maxlon GE lon1 AND maxlon LE lon2 AND min lats max maxlat GE lat1 AND maxlat LE lat2 then BEGIN the triangle must not be too big z convert_coord lons lats data to_normal alldist z 0 2 z 0 0 2 z 1 2 z 1 0 2 z 0 0 z 0 1 2 z 1 0 z 1 1 2 z 0 1 z 0 2 2 z 1 1 z 1 2 2 IF max alldist LT seuil 2 THEN polyfill lons lats color cont_color _extra ex return ENDIF end PRO completecointerre COINMONTE coinmonte COINDESCEND coindescend CONT_COLOR cont_color INDICEZOOM indicezoom _extra ex common if NOT keyword_set coinmonte then return if NOT keyword_set coindescend then return if NOT keyword_set indicezoom then return tempsun systime 1 pour key_performance definitions des vecteurs coinmont et coindesc if keyword_set coinmonte then coinmont coinmonte ELSE coinmont twin_corners_up if keyword_set coindescend then coindesc coindescend ELSE coindesc twin_corners_dn IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 definition descoordonnees des points numerotes 1 2 3 4 5 6 cf les schemas en dessous tempdeux systime 1 pour key_performance 2 if coinmont 0 NE 1 OR coindesc 0 NE 1 then BEGIN if keyword_set indicezoom then BEGIN if we use key_stide the t u v and f points are no more related to the same cell because glamf and gphif has be recomputed to be in the middle of two t points IF total key_stride EQ 3 AND finite glamv 0 gphiv 0 NE 0 THEN BEGIN long1 glamv indicezoom lati1 gphiv indicezoom ENDIF ELSE BEGIN long1 glamt indicezoom lati1 gphif indicezoom ENDELSE IF total key_stride EQ 3 AND finite glamu 0 gphiu 0 NE 0 THEN BEGIN long2 glamu indicezoom lati2 gphiu indicezoom ENDIF ELSE BEGIN long2 glamf indicezoom lati2 gphit indicezoom ENDELSE long3 glamf indicezoom lati3 gphif indicezoom ENDIF ELSE BEGIN IF total key_stride EQ 3 AND finite glamv 0 gphiv 0 NE 0 THEN BEGIN long1 glamv lati1 gphiv ENDIF ELSE BEGIN long1 glamt lati1 gphif ENDELSE IF total key_stride EQ 3 AND finite glamu 0 gphiu 0 NE 0 THEN BEGIN long2 glamu lati2 gphiu ENDIF ELSE BEGIN long2 glamf lati2 gphit ENDELSE long3 glamf lati3 gphif ENDELSE nx size long1 dimensions 0 ny size long1 dimensions 1 seuil 5 min nx ny 2 seuil min p position 2 p position 0 seuil p position 3 p position 1 seuil ENDIF IF testvar var key_performance EQ 2 THEN print temps completecointerre: positions des points systime 1 tempdeux cas coin terre en montee: 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante 4 t i nx 1 u i nx t i nx 1 0 1 3 5 v i f i v i 1 t i 0 2 u i t i 1 1 if coinmont 0 NE 1 then BEGIN tempdeux systime 1 pour key_performance 2 for id 0 n_elements coinmont 1 do BEGIN i coinmont id ii i MOD nx ij i nx bottom triangle lons long1 i long2 i long3 i lats lati1 i lati2 i lati3 i draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex upper triangle IF ii NE nx 1 AND ij NE ny 1 THEN BEGIN lons long3 i long1 i 1 long2 i nx lats lati3 i lati1 i 1 lati2 i nx draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex ENDIF ENDFOR IF testvar var key_performance EQ 2 THEN print temps completecointerre: trace de cointerremonte systime 1 tempdeux ENDIF cas coin terre en descendante : 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante 4 t i nx 1 u i nx t i nx 1 0 3 5 v i f i v i 1 1 t i 0 2 u i t i 1 1 if coindesc 0 NE 1 then begin tempdeux systime 1 pour key_performance 2 for id 0 n_elements coindesc 1 do BEGIN i coindesc id ii i MOD nx ij i nx IF ii NE nx 1 AND ij NE ny 1 THEN BEGIN left triangle lons long1 i long3 i long2 i nx lats lati1 i lati3 i lati2 i nx draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex right triangle lons long3 i long2 i long1 i 1 lats lati3 i lati2 i lati1 i 1 draw_corner_triangle lons lats seuil CONT_COLOR cont_color _extra ex ENDIF ENDFOR IF testvar var key_performance EQ 2 THEN print temps completecointerre: trace de cointerredescend systime 1 tempdeux ENDIF IF keyword_set key_performance THEN print temps completecointerre systime 1 tempsun return end"); 318 a[316] = new Array("./ToBeReviewed/TRIANGULATION/definetri.html", "definetri.pro", "", " NAME:definetri PURPOSE:Define a triangulation array like TRIANGULATE But in a VERY SIMPLE CASE: the points are regulary gridded on nx ny array Find a Delaunay triangulation for this set of points is easy: Points define nx 1 ny 1 rectangles which we can cut in 2 triangles cf figure above ny 1 ny 2 1 0 0 1 2 nx 3 nx 2 nx 1 You have 2 ways to cut a rectangle: 1 the upward diagonal 2 the downward diagonal CATEGORY: to understand how TRIANGULATE and TRIANGULATION work CALLING SEQUENCE:triangles definetri nx ny downward INPUTS: nx and ny are the array dimensions OPTIONAL INPUTS: downward: When downward is undefine all rectangles are cut in using the upward diagonal Downward is a vector which contains the rectangles numbers which are cut in using the downward diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle KEYWORD PARAMETERS: OUTPUTS: triangles is a 2d array and is dimensions are 3 and 2 nx 1 ny 1 triangles is define like in the TRIANGULATE procedure OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: triangles definetri 3 3 1 3 triangles will be a this kind of triangulation: MODIFICATION HISTORY: sebastien Masson smlod ipsl jussieu fr 4 3 1999 FUNCTION definetri nx ny downward nx long nx ny long ny if n_elements downward NE 0 THEN BEGIN if n_elements downward GT nx 1 ny 1 then begin print downward a trop d elements par rapport a nx et ny return 1 endif downward long downward ENDIF we define triangles triangles lonarr 3 2 nx 1 ny 1 we cut the rectangles with the upward diagonal if n_elements downward NE nx 1 ny 1 then BEGIN there is some rectangle to cut we define upward: upward is a vector which contains the rectangles numbers which are cut in using the upward diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle upward bytarr nx ny 1 upward ny 1 0 upward nx 1 0 if n_elements downward NE 0 then upward downward 0 upward where upward EQ 1 n1 n_elements upward 4 corners indexes of a rectangle number i are i nx i nx 1 i i 1 trinumber 2 upward upward nx we define the right triangles triangles 0 trinumber upward triangles 1 trinumber upward 1 triangles 2 trinumber upward 1 nx we define the left triangles triangles 0 trinumber 1 upward 1 nx triangles 1 trinumber 1 upward nx triangles 2 trinumber 1 upward ENDIF ELSE n1 0 we cut the rectangles with the downward diagonal if n_elements downward NE 0 then BEGIN n2 n_elements downward trinumber 2 downward downward nx we define the right triangles triangles 0 trinumber downward 1 triangles 1 trinumber downward nx 1 triangles 2 trinumber downward nx we define the left triangles triangles 0 trinumber 1 downward nx triangles 1 trinumber 1 downward triangles 2 trinumber 1 downward 1 endif return triangles end"); 319 a[317] = new Array("./ToBeReviewed/TRIANGULATION/definetri_e.html", "definetri_e.pro", "", "function numtri index nx ny y index nx x index y nx numtri y NE 0 nx 1 2 y 1 1 2 y EQ ny 1 OR y EQ ny 1 x return numtri end NAME:definetri PURPOSE:Define a triangulation array like TRIANGULATE but for a E grid type CATEGORY: make contours with E grid type CALLING SEQUENCE:triangles definetri nx ny vertical INPUTS: nx and ny are the array dimensions OPTIONAL INPUTS: vertical: When vertical is undefine all rectangles are cut in using the horizontal diagonal Vertical is a vector which contains the rectangles numbers which are cut in using the vertical diagonal The rectangle number is define by the index in a nx ny vector of the lower left corner of the rectangle KEYWORD PARAMETERS: OUTPUTS: triangles is a 2d array and is dimensions are 3 and 2 nx 1 ny 1 triangles is define like in the TRIANGULATE procedure OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: MODIFICATION HISTORY: sebastien Masson smlod ipsl jussieu fr June 2001 FUNCTION definetri_e nx ny singular SHIFTED shifted nx long nx ny long ny triangles lonarr 3 2 nx 1 ny 1 build the base triangulation with the diamond cut in two triangles by the vertical diagonal first line index lindgen nx 1 trinumber index triangles 0 trinumber index triangles 1 trinumber index 1 triangles 2 trinumber index nx 1 shifted last line index ny 1 nx lindgen nx 1 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx index nx 1 shifted MOD 2 triangles 2 trinumber index 1 other lines if ny GT 2 then begin index lindgen nx ny index index 0:nx 2 1:ny 2 index index oddeven index nx 1 shifted MOD 2 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx oddeven triangles 2 trinumber index nx oddeven triangles 0 trinumber 1 index nx oddeven triangles 1 trinumber 1 index nx oddeven triangles 2 trinumber 1 index 1 endif cut the diamond specified by singular in two triangles by the horizontal diagonal IF keyword_set singular then BEGIN yindex singular nx otherline where yindex NE 0 AND yindex NE ny 1 if otherline 0 NE 1 then begin index singular otherline oddeven index nx 1 shifted MOD 2 trinumber numtri index nx ny triangles 0 trinumber index triangles 1 trinumber index nx oddeven triangles 2 trinumber index 1 triangles 0 trinumber 1 index triangles 1 trinumber 1 index 1 triangles 2 trinumber 1 index nx oddeven endif endif return triangles end "); 320 a[318] = new Array("./ToBeReviewed/TRIANGULATION/dessinetri.html", "dessinetri.pro", "", " NAME:dessinetri PURPOSE:dessine la triangulation CATEGORY:pour comprendre comment ca marche CALLING SEQUENCE:dessinetri tri x y INPUTS:optionnels par defaut on choisit la triangulation qui est utilise pour les plots et on la trace aux points definites par vargrid sinon il faut fournir les tableaux tri definissant la triangulation fournis par triangule pro ou triangulate x et y qui sont les positions de points a laquelle se raporte la triangulation cf les tableau x et y fournis ds triangulate KEYWORD PARAMETERS: All plots or polyfill keywords WAIT x to call wait x second between each triangle draw ONEBYONE: to draw the triangles one by one FILL: to fill the triangles using polyfill instead of plotting them CHANGECOLOR n to change the color of each traingle n colors will be used and repeted if necessary OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO dessinetri tri x y WAIT wait ONEBYONE onebyone FILL fill CHANGECOLOR changecolor _extra ex common tempsun systime 1 pour key_performance a if n_params EQ 3 then BEGIN CASE size x n_dimensions size y n_dimensions OF 2:BEGIN nx n_elements x ny n_elements y glam x replicate 1 ny gphi replicate 1 nx y END 4:BEGIN glam x gphi y END ELSE:BEGIN dummy report x and y inputs of dessinetri must have the same number of dimensions 1 or 2 return END ENDCASE ENDIF ELSE BEGIN grille mask glam gphi tri tri undefine mask tri ciseauxtri tri glam gphi ENDELSE IF keyword_set changecolor THEN BEGIN oldname d name if d name EQ PS OR d name EQ Z then BEGIN thisos strupcase strmid version os_family 0 3 CASE thisOS of MAC : set_plot thisOS WIN : set_plot thisOS ELSE: set_plot X ENDCASE ncolors d n_colors 1 255 set_plot oldname ENDIF ELSE ncolors d n_colors 1 255 color 1 indgen changecolor ncolors changecolor 1 ENDIF ELSE color 0 color color replicate 1 n_elements tri 3 n_elements color 1 tempdeux systime 1 pour key_performance 2 for i 0L n_elements tri 3 1 do begin t tri i tri 0 i IF keyword_set fill THEN polyfill glam t gphi t color color i _extra ex ELSE plots glam t gphi t color color i _extra ex IF keyword_set wait THEN wait wait IF keyword_set onebyone THEN read a prompt press a key ENDFOR IF testvar var key_performance EQ 2 THEN print temps dessinetri: trace des triangles systime 1 tempdeux if keyword_set key_performance THEN print temps dessinetri systime 1 tempsun return end"); 321 a[319] = new Array("./ToBeReviewed/TRIANGULATION/drawcoast_c.html", "drawcoast_c.pro", "", "PRO drawcoast_c mask xf yf nx ny COAST_COLOR coast_color COAST_THICK coast_thick YSEUIL yseuil XSEUIL xseuil _extra ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance on trace les segments verticaux: if NOT keyword_set yseuil then yseuil 5 min nx ny 2 distanceseuil p position 3 p position 1 yseuil liste: liste des points i pourlesquels on va tracer un segment entre le point i j 1 et i j tempdeux systime 1 pour key_performance 2 liste where mask shift mask 1 0 EQ 1 AND xf shift xf 0 1 2 yf shift yf 0 1 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN on recupere lx et ly qui sont les indices ds un tableau 2d des points donnes par liste ly liste nx lx temporary liste nx ly indice where ly NE 0 on ne prend pas les points concernant if indice 0 NE 1 then begin la premiere ligne car ds ce cas le pt j 1 n est pas definit lx lx indice ly ly temporary indice boucle sur les points concernes et trace du segment rq: on utilise plost au lieu de plot car plots est bcp plus rapide IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner liste des points concernes par un trait vertical systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i j 1 xf i j yf i j 1 yf i j color coast_color thick coast_thick normal _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracecote: trace des traits verticaux systime 1 tempdeux endif ENDIF pour le trace des segments horizontaux c est la meme chose sauf qu il faut faire attention si on est periodique: si on est periodique on duplique la premiere colonne et on la met a la fin ceci est fait non pas pour le shift qui est par defaut periodique mais pour le plots tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic AND nx EQ jpi then begin mask mask mask 0 xf xf xf 0 yf yf yf 0 nx nx 1 ENDIF if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste where mask shift mask 0 1 EQ 1 AND xf shift xf 1 0 2 yf shift yf 1 0 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN ly liste nx lx temporary liste nx ly indice where ly NE ny 1 AND lx NE 0 if indice 0 NE 1 then begin on ne prend pas les points de la premiere colonne et de la derniere ligne car on l a rajoute artificiellement lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner liste des points concernes par un trait horizontal systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i 1 j xf i j yf i 1 j yf i j color coast_color thick coast_thick normal _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracecote: trace des traits horizontaux systime 1 tempdeux endif endif if keyword_set key_performance THEN print temps drawcoast_c systime 1 tempsun return end"); 322 a[320] = new Array("./ToBeReviewed/TRIANGULATION/drawcoast_e.html", "drawcoast_e.pro", "", "PRO drawcoast_e mask xf yf nx ny COAST_COLOR coast_color COAST_THICK coast_thick YSEUIL yseuil XSEUIL xseuil onemore onemore _extra ex cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF tempsun systime 1 pour key_performance if keyword_set key_periodic AND nx EQ jpi then begin mask mask mask 0 xf xf xf 0 yf yf yf 0 nx nx 1 ENDIF we plot the borders of the diamond in this sense : if NOT keyword_set onemore then onemore 0 if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste: liste des points i pourlesquels on va tracer un segment index lindgen nx ny index index 0:nx 2 1:ny 1 indexbis index nx index nx onemore MOD 2 liste where mask index 1 mask indexbis EQ 1 AND xf index xf indexbis 2 yf index yf indexbis 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN index index liste indexbis indexbis liste for pt 0 n_elements index 1 do begin plots xf index pt xf indexbis pt yf index pt yf indexbis pt color coast_color thick coast_thick normal _extra ex endfor ENDIF we plot the borders of the diamond in this sense : if NOT keyword_set xseuil then xseuil 5 min nx ny 2 distanceseuil p position 2 p position 0 xseuil liste: liste des points i pourlesquels on va tracer un segment index lindgen nx ny 1 index index 0:nx 2 indexbis index nx index nx onemore MOD 2 liste where mask index 1 mask indexbis EQ 1 AND xf index xf indexbis 2 yf index yf indexbis 2 LE distanceseuil 2 IF liste 0 NE 1 THEN BEGIN index index liste indexbis indexbis liste for pt 0 n_elements index 1 do begin plots xf index pt xf indexbis pt yf index pt yf indexbis pt color coast_color thick coast_thick normal _extra ex endfor ENDIF if keyword_set key_performance THEN print temps drawcoast_e systime 1 tempsun return end"); 323 a[321] = new Array("./ToBeReviewed/TRIANGULATION/drawsectionbottom.html", "drawsectionbottom.pro", "", " NAME:drawsectionbottom PURPOSE:fill and draw the bottom continents for a real section CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: the thickness of the coastline defaut value is 1 CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS:simple way to fill continents for a section using the fact that continents are wider at the bottom than at the top EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr June 14 2002 PRO drawsectionbottom maskin xxaxisin depthsin COAST_COLOR coast_color COAST_THICK coast_thick CONT_COLOR cont_color CONT_NOFILL cont_nofill OVERPLOT overplot _extra ex cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF if keyword_set overplot then return mask is from bottom to top boundaries conditions: nx size maskin 1 nz size maskin 2 1 IF size xxaxisin n_dimensions EQ 1 THEN xxaxisin temporary xxaxisin replicate 1 nz IF size depthsin n_dimensions EQ 1 THEN depthsin replicate 1 nx temporary depthsin for the mask : we add ocean at the top then it is always possible to find one ocean point on each water column mask maskin replicate 1 nx for x axis we also add one level xxaxis xxaxisin xxaxisin 0 x axis must cover nx 1 points because we will draw the edge of the mask if it was mot possible in decoupeterre pro to extend the xxaxis we do it now by hand xxaxis xxaxisin 0 if size xxaxis 1 EQ nx then begin if n_elements xxaxis EQ nx then begin deltax abs x range 1 x range 0 10 xxaxis xxaxis 0 deltax xxaxis x0 xxaxis 0 deltax xxaxis replicate x0 1 nz xxaxis ENDIF for the depth usepartial total depthsin 2 usepartial total usepartial NE usepartial 0 GE 1 depths depthsin 0:nx 1 we add one level according to the ocean level we had to the mask deltaz abs y range 1 y range 0 10 zmax max depthsin deltaz depths depths replicate zmax nx 1 depths depths replicate zmax nx if min depths gt 1 then we must add one line at the bottom this appens when the bottom limit is defined between T k and W k points IF min depthsin GT 1 THEN BEGIN zmin min y range deltaz depths replicate zmin nx depths mask replicate 0 nx mask nz nz 1 ENDIF xleft xxaxis 0:nx 1 xright xxaxis 1:nx looking for the position of the bottom of the ocean pos nz 1 total mask 2 depths depths lindgen nx nx pos xx transpose xleft xright xx x range 0 xx zz max y range xx float xx zz float zz filling of the continents IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 if NOT keyword_set cont_nofill then polyfill min xx max maxx xx maxx min zz max mazz zz mazz color cont_color if NOT keyword_set cont_nofill then polyfill min xx max maxx xx maxx y range 0 zz y range 0 color cont_color drawing of the coast bottom line we could have plot directly xx and yy but if countout ne 0 doing this will draw an non existing bottom line along y range values which is not so good we thus do this ugly for if loops to make sure that we don t draw these lines but we keep all vertical lines IF countout NE 0 THEN BEGIN FOR i 0 countout 1 DO BEGIN CASE 1 OF out i EQ 0:BEGIN if we start with a out point xxx values f_nan zzz values f_nan END i EQ 0:BEGIN i eq 0 but out i ne 0 xxx xx 0:out i values f_nan zzz zz 0:out i values f_nan END ELSE:BEGIN two consecutive out values at the same depth: we just keep values f_nan values until the next change of depth IF out i 1 EQ out i 1 AND zz out i 1 EQ zz out i THEN BEGIN xxx xxx values f_nan zzz zzz values f_nan ENDIF ELSE BEGIN we keep everything inbetween the out values including themselves for the vertical lines but we had values f_nan to remove the horizontal lines xxx xxx xx out i 1 :out i values f_nan zzz zzz zz out i 1 :out i values f_nan ENDELSE END ENDCASE IF i EQ countout 1 AND out i NE n_elements xx 1 THEN BEGIN xxx xxx xx out i : zzz zzz zz out i : ENDIF ENDFOR plots xxx zzz color coast_color thick coast_thick _extra ex ENDIF ELSE plots xx zz color coast_color thick coast_thick _extra ex return end "); 324 a[322] = new Array("./ToBeReviewed/TRIANGULATION/fillcornermask.html", "fillcornermask.pro", "", " NAME: FILLCORNERMASK PURPOSE: pour colorier proprement les continents c est une longue histoire CATEGORY: pour plt CALLING SEQUENCE: completecointerre INPUTS: non KEYWORD PARAMETERS: _EXTRA CONT_COLOR: the color of the continent defaut value is d n_colors 1 white OUTPUTS: non COMMON BLOCKS: common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 8 8 2002 PRO fillcornermask xin yin COINMONTE coinmonte COINDESCEND coindescend CONT_COLOR cont_color INDICEZOOM indicezoom _extra ex common if NOT keyword_set coinmonte AND NOT keyword_set coindescend then return tempsun systime 1 pour key_performance IF NOT keyword_set cont_color THEN cont_color d n_colors 1 255 definition descoordonnees des points numerotes 1 2 3 4 5 6 cf les schemas en dessous x1 reform xin y1 reform yin IF size x1 0 EQ 2 THEN x1 x1 0 IF size y1 0 EQ 2 THEN y1 y1 0 x2 5 x1 shift x1 1 y2 5 y1 shift y1 1 nx n_elements x1 ny n_elements y1 cas coin terre en montee: 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante 3 t i nx 1 u i nx t i nx 1 0 1 4 v i f i v i 1 t i 0 2 u i t i 1 1 if keyword_set coinmonte then BEGIN if coinmonte 0 NE 1 then BEGIN iup coinmonte MOD nx jup coinmonte nx for id 0 n_elements coinmonte 1 do BEGIN i iup id j jup id IF i NE nx 1 AND j NE ny 1 THEN BEGIN polyfill x1 i x2 i x2 i x1 i 1 x1 i y2 j y1 j y1 j 1 y2 j y2 j color cont_color _extra ex ENDIF endfor endif endif cas coin terre en descendante : 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante 4 t i nx 1 u i nx t i nx 1 0 3 5 v i f i v i 1 1 t i 0 2 u i t i 1 1 if keyword_set coindescend then BEGIN if coindescend 0 NE 1 then begin idw coindescend MOD nx jdw coindescend nx for id 0 n_elements coindescend 1 do BEGIN i idw id j jdw id IF i NE nx 1 AND j NE ny 1 THEN BEGIN polyfill x1 i x2 i x2 i x1 i 1 x1 i y2 j y1 j 1 y1 j y2 j y2 j color cont_color _extra ex ENDIF endfor endif endif IF keyword_set key_performance THEN print temps fillcornermask systime 1 tempsun return end"); 325 a[323] = new Array("./ToBeReviewed/TRIANGULATION/section.html", "section.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO section field res glamaxe gphiaxe ENDPOINTS endpoints BOXZOOM boxzoom TYPE type WDEPTH wdepth DIREC direc SHOWBUILD showbuild ONLYBOX onlybox _extra ex include common cm_4mesh cm_4data cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF definition de boxzoom en fonction de endpoints puis redefinition du domaine boxzoom2d min endpoints 0 endpoints 2 max ma02 ma02 min endpoints 1 endpoints 3 max ma13 ma13 minprof 0 profdefault 200 if n_elements type EQ 0 then type nothing Case N_Elements Boxzoom OF 0:localbox boxzoom2d minprof profdefault 1:localbox boxzoom2d minprof boxzoom 0 2:localbox boxzoom2d boxzoom 0 4:if strpos type z NE 1 THEN localbox boxzoom2d minprof profdefault ELSE localbox boxzoom2d 5:localbox boxzoom2d minprof boxzoom 4 6:localbox boxzoom2d boxzoom 4:5 Else:BEGIN print report Bad definition of the box stop END ENDCASE nelbox n_elements localbox if keyword_set wdepth then grillechoice vargrid W ELSE grillechoice vargrid domdef localbox GRIDTYPE grillechoice findalways _extra ex grille 1 1 1 1 nx ny if less than 10 points where found we apply domdef over the whole domain problem why 10 points as a test value how can we find a good test value IF nx ny LE 10 THEN domdef GRIDTYPE grillechoice _extra ex on redefinit lon1 au cas ou findalways ait ete utilise ds domdef lon1 min endpoints 0 endpoints 2 max lon2 lat1 min endpoints 1 endpoints 3 max lat2 we extend the box along the z axis i that way the plot will be drawn until its bottom part if strpos type z NE 1 THEN BEGIN on garde les yranges axe z avant de changer la boxzoom y range localbox nelbox 1 localbox nelbox 2 if vargrid EQ W OR keyword_set wdepth then BEGIN firstzw 0 firstzw 1 lastzw lastzw 1 firstzt 1 lastzt lastzt 1 firstx 1 lastx lastx 1 firsty 1 lasty lasty 1 jpj 1 domdef firstx lastx firsty lasty firstz lastz index gridtype vargrid IF keyword_set onlybox THEN return grille mask glam gphi gdep nx ny nz firstx firsty firstz lastx lasty lastz on definit la triangulation qui va nous permetre de determiner la section on la recalcule car elle doit etre definie sur la terre aussi bien que sur la mer suivant le sens de la section plutot longitude ou plutot latitude on definit la facon de trianguler if strpos type x NE 1 then BEGIN downward lindgen nx ny 0:nx 2 0:ny 2 tri definetri nx ny downward ENDIF ELSE tri definetri nx ny If we have an irregular grid that is periodic then it is possible that some of the triangle have a very large size neighborg points on the sphere but far away when doing the projection and should not be taken into account IF keyword_set key_irregular AND keyword_set key_periodic THEN BEGIN glamtri glam tri glamtri abs glamtri shift glamtri 1 0 good temporary glamtri LT 10 max glam nx good where total temporary good 1 EQ 3 tri temporary tri temporary good ENDIF equation de la droite suivant laquelle on fait la section abc linearequation endpoints 0:1 endpoints 2:3 glamtri glam tri gphitri gphi tri quels sont les points de la triangulation qui sont au dessus et au dessous de la droite if abc 1 NE 0 THEN test temporary gphitri GE abc 0 abc 1 temporary glamtri abc 2 abc 1 ELSE test temporary glamtri GE abc 1 abc 0 temporary gphitri abc 2 abc 0 zero123 total test 1 to keep: triangles de la triangulation qui sont a cheval sur la droite tokeep1 where zero123 EQ 1 tokeep2 where temporary zero123 EQ 2 tokeep tokeep1 tokeep2 test test tokeep tri tri tokeep quel est le sommet du triangle qui est seul d un cote de la droite single1 where test 0:n_elements tokeep1 1 EQ 1 single1 single1 single1 3 3 single2 where test n_elements tokeep1 :n_elements tokeep 1 EQ 0 single2 single2 single2 3 3 undefine tokeep undefine tokeep1 undefine tokeep2 undefine test single temporary single1 temporary single2 points1 le point du triangles qui est seul d un cote de la droite point2 l autre point du triangle de l autre cote de la droite point1 single single point2 single EQ 0 1 single LE 1 undefine single ntri size tri 2 index lindgen ntri lindgen ntri points1 tri point1 index points2 tri point2 temporary index points : complexe contenant les couples de points de part et d autre de la droite Ils faut supprimer les doublons points dcomplex points1 points2 points points uniq points sort points symetrique dcomplex imaginary points double points points points where points shift temporary symetrique 1 NE 0 points1 les coordnnees du point du triangles qui est seul d un cote de la droite point2 les coordnnees de l autre point du triangle de l autre cote de la droite points1 complex glam double points gphi double points points2 complex glam imaginary points gphi imaginary points droites les equations des droites dont on cherche l intersection avec la section droites linearequation points1 points2 inter lineintersection droites abc replicate 1 n_elements points1 les ccordonnes geographiques des points que l on cherche sur la section glamaxe float inter gphiaxe imaginary inter on les range ds l ordre croissant entre les bornes de la section if strpos type x NE 1 then BEGIN sort sort glamaxe glamaxe glamaxe sort inbox where glamaxe GE lon1 AND glamaxe LE lon2 glamaxe glamaxe inbox sort sort inbox gphiaxe gphiaxe sort ENDIF ELSE BEGIN sort sort gphiaxe gphiaxe gphiaxe sort inbox where gphiaxe GE lat1 AND gphiaxe LE lat2 gphiaxe gphiaxe inbox sort sort inbox glamaxe glamaxe sort ENDELSE points points sort points1 points1 sort points2 points2 sort inter inter sort poids abs points2 inter abs points2 points1 array litchamp field array fitintobox array if array 0 EQ 1 THEN BEGIN res 1 return ENDIF if n_elements valmask EQ 0 THEN valmask 1e20 taille size array if jpt GT 1 AND taille 0 GE 3 AND strpos type t EQ 1 then BEGIN direc t array grossemoyenne array t taille size array jpt 1 ENDIF case 1 of xy taille 0 EQ 2:BEGIN value1 array double points terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan value2 array imaginary points terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan res poids value1 1 poids value2 END xyz taille 0 EQ 3 AND jpt EQ 1:BEGIN npoints n_elements points index double points replicate 1 nz replicate nx ny npoints lindgen nz value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 nz replicate nx ny npoints lindgen nz value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 nz res poids value1 1 poids value2 moyenne suivant z if strpos type z EQ 1 then begin nan where finite res EQ 0 if vargrid EQ W then e3 e3w firstzw:lastzw ELSE e3 e3t firstzt:lastzt weight replicate 1 npoints e3 if nan 0 NE 1 then weight nan values f_nan totalweight total weight 2 nan zero where totalweight EQ 0 if zero 0 NE 1 then totalweight zero values f_nan res total res weight 2 nan totalweight direc z string byte testvar var toto endif END xyt taille 0 EQ 3 AND jpt NE 1:BEGIN npoints n_elements points index double points replicate 1 jpt replicate nx ny npoints lindgen jpt value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 jpt replicate nx ny npoints lindgen jpt value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 jpt res poids value1 1 poids value2 END xyzt taille 0 EQ 4:BEGIN npoints n_elements points index double points replicate 1 nz jpt replicate nx ny npoints lindgen nz jpt index reform index npoints nz jpt over value1 array index terre where value1 GT valmask 10 if terre 0 NE 1 then value1 terre values f_nan index imaginary points replicate 1 nz jpt replicate nx ny npoints lindgen nz jpt index reform index npoints nz jpt over value2 array index terre where value2 GT valmask 10 if terre 0 NE 1 then value2 terre values f_nan poids poids replicate 1 nz jpt poids reform poids npoints nz jpt over res poids value1 1 poids value2 moyenne suivant z if strpos type z EQ 1 then begin nan where finite res EQ 0 if vargrid EQ W then e3 e3w firstzw:lastzw ELSE e3 e3t firstzt:lastzt weight replicate 1 npoints e3 weight weight replicate 1 jpt weight reform weight npoints nz jpt over if nan 0 NE 1 then weight nan values f_nan totalweight total weight 2 nan zero where totalweight EQ 0 if zero 0 NE 1 then totalweight zero values f_nan res total res weight 2 nan totalweight direc z string byte testvar var toto endif END endcase terre where finite res EQ 0 if terre 0 NE 1 then res terre valmask if n_elements showbuild then BEGIN winsave window psave p xsave x ysave y plt findgen nx ny nodata nofill rempli title subtitle coast_thick 2 window showbuild p title p subtitle plots endpoints 0 endpoints 2 endpoints 1 endpoints 3 color 50 plots endpoints 0 endpoints 2 endpoints 1 endpoints 3 color 50 psym 2 thick 2 FOR i 0 n_elements points1 1 DO plots float points1 i float points2 i imaginary points1 i imaginary points2 i color 150 plots float points1 imaginary points1 color 150 psym 1 plots float points2 imaginary points2 color 150 psym 1 plots float inter imaginary inter color 250 psym 1 IF terre 0 NE 1 THEN plots float inter terre imaginary inter terre color 0 psym 1 dummy read dummy prompt press return to continue IF d name EQ PS THEN erase ELSE wset winsave p psave x xsave y ysave ENDIF restoreboxparam boxparam4section dat return end"); 326 a[324] = new Array("./ToBeReviewed/TRIANGULATION/tracecote.html", "tracecote.pro", "", " NAME:tracecote PURPOSE: dessine les cotes ds plt CATEGORY: pour faire un joli dessin CALLING SEQUENCE:tracecote mask INPUTS:mask le tableau mask sur la zone consideree pour le dessin KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: l epaisseur du trait pour tracer les continents par defaut c est 1 SURFACE_COASTLINE: to draw the furface coast line instead of the coast line at level firstz tw Usefull only for deep plots XSEUIL: pour eliminer les segments de cote qui sont trop grand qui relient des points qui peuvent etre tres proches sur la sphere mais tres eloignes sur le dessin on supprime tous les egments dot la taille depasse: taille de la fenetre suivant X xseuil Par defaut xseuil est egale a 5 masi peut etre trop grand si on fait un fort zoom ou trout petit pour certaines projections le specifier alors a l aide de ce mot cle YSEUIL: cf xseuil OUTPUTS: rien COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 30 9 1999 PRO tracecote SURFACE_COASTLINE surface_coastline _EXTRA ex include commons cm_4data cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance if n_elements key_gridtype EQ 0 then key_gridtype c on agrandi un peu le cadre definit par les premier dernier de facon a bien recuperer les bords de cote qui sont en bordure du domaine a tracer tempdeux systime 1 pour key_performance 2 firstx 0 min firstxt firstxf 1 lastx max lastxt lastxf 1 min firstyt firstyf 1 lasty max lastyt lastyf 1 jpj 1 nx lastx firstx 1 ny lasty firsty 1 quel niveau vertical choisir IF keyword_set surface_coastline THEN firstz 0 ELSE IF strupcase vargrid eq W THEN firstz firstzw ELSE firstz firstzt attribution du masque et des coordonnes delimitant les limites de la terre coordonnees f mask tmask firstx:lastx firsty:lasty firstz xf glamf firstx:lastx firsty:lasty yf gphif firstx:lastx firsty:lasty IF testvar var key_performance EQ 2 THEN print temps tracecote: determiner mask xf yf systime 1 tempdeux if key_gridtype EQ e then onemore xf 0 0 gT xf 0 1 on passe en coordonnee normaliser pour pouvoir s affranchir du type de projection choisie et du suport surlequel on fait le dessin ecran ou postscript z convert_coord xf yf data to_normal xf reform z 0 nx ny yf reform z 1 nx ny tempvar SIZE TEMPORARY z attention suivant la projection certains points x ou y peuvent devenir NaN cf points deriere la terre ds une projection orthographique on met les points a eliminer a une tres gande valeur comme ca il ne passerons pas le test avec distanceseuil cf plus bas if map projection LE 7 AND map projection NE 0 OR map projection EQ 14 OR map projection EQ 15 OR map projection EQ 18 then begin ind where finite xf yf EQ 0 IF ind 0 NE 1 THEN BEGIN xf ind 1e5 yf ind 1e5 ENDIF ENDIF ind where xf LT p position 0 OR xf GT p position 2 IF ind 0 NE 1 THEN xf ind 1e5 ind where yf LT p position 1 OR yf GT p position 3 IF ind 0 NE 1 THEN yf ind 1e5 tempvar SIZE TEMPORARY ind on efface ind if n_elements key_gridtype EQ 0 then key_gridtype c case key_gridtype of c :drawcoast_c mask xf yf nx ny _extra ex e :drawcoast_e mask xf yf nx ny onemore onemore _extra ex endcase if keyword_set key_performance THEN print temps tracecote systime 1 tempsun return end"); 327 a[325] = new Array("./ToBeReviewed/TRIANGULATION/tracemask.html", "tracemask.pro", "", " NAME:tracemask PURPOSE:dessiner des contour d un mask CATEGORY:plus simple que tracecote car ne s occuppe pas du type de projection et de la periodicite de la grille CALLING SEQUENCE: tracemask maskentree xentree yentree INPUTS:maskentree xentree yentree tableaux 2d specifiant le mask et ses coordonees en longitude te latitude KEYWORD PARAMETERS: COAST_COLOR: the color of the coastline defaut value is 0 black COAST_THICK: l epaisseur du trait pour tracer les continents par defaut c est 1 OUTPUTS: none COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO tracemask maskentree xin yin COAST_COLOR coast_color COAST_THICK coast_thick OVERPLOT overplot _extra ex if keyword_set overplot then return cm_general IF NOT keyword_set key_forgetold THEN BEGIN updatekwd ENDIF tempsun systime 1 pour key_performance on s afranchit des problemes de bord: tempdeux systime 1 pour key_performance 2 tailleentree size maskentree nx tailleentree 1 1 ny tailleentree 2 1 we check the input axis IF n_elements xin EQ 0 THEN xentree findgen nx 1 ELSE xentree xin IF size xentree 0 EQ 1 THEN xentree xentree replicate 1 ny 1 IF n_elements yin EQ 0 THEN yentree findgen ny 1 ELSE yentree yin IF size yentree 0 EQ 1 THEN yentree replicate 1 nx 1 yentree on agrandi le mask de une colonne a gauche et de une colonne en bas mask intarr tailleentree 1 1 tailleentree 2 1 mask 1:tailleentree 1 1:tailleentree 2 maskentree les 2 premieres colonnes sont identiques mask 0 1:tailleentree 2 maskentree 0 les 2 premieres lignes sont identiques mask 1:tailleentree 1 0 maskentree 0 on calcul la position suivant x des points qui seviront a tracer le masque ils sont situes entre chaque points du masque sauf pour la derniere colonne que l on ne peut pas calculer et que l on met donc a max x range xrange x range sort x range si reverse_x est utilise xentree 5 xentree shift xentree 1 0 IF not keyword_set overplot THEN xentree nx 2 xrange 1 ELSE xentree nx 2 xentree nx 3 on seuil xentree xrange 0 xentree yentree yrange 1 yf fltarr nx ny yf 1:nx 1 1:ny 1 yentree yf 0 1:ny 1 yentree 0 IF not keyword_set overplot THEN BEGIN if yinverse then yf 0 yrange 1 ELSE yf 0 yrange 0 ENDIF ELSE yentree 0 yentree 1 IF testvar var key_performance EQ 2 THEN print temps tracemask: determination du mask et des ses coordonnes systime 1 tempdeux on trace les segments verticaux: tempdeux systime 1 pour key_performance 2 liste where mask shift mask 1 0 EQ 1 IF liste 0 NE 1 THEN BEGIN on recupere lx et ly qui sont les indices ds un tableau 2d des points donnes par liste ly liste nx lx temporary liste nx ly indice where ly NE 0 on ne prend pas les points concernant la premiere ligne car ds ce cas le pt j 1 n est pas definit if indice 0 NE 1 then begin lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracemask: liste traits verticaux systime 1 tempdeux tempdeux systime 1 pour key_performance 2 boucle sur les points concernes et trace du segment rq: on utilise plots au lieu de plot car plots est bcp plus rapide for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i j 1 xf i j yf i j 1 yf i j color coast_color thick coast_thick _extra ex if pt LT 5 then begin endif endfor IF testvar var key_performance EQ 2 THEN print temps tracemask: trace traits verticaux systime 1 tempdeux endif ENDIF on trace les segments horizontaux: tempdeux systime 1 pour key_performance 2 liste where mask shift mask 0 1 EQ 1 IF liste 0 NE 1 THEN BEGIN ly liste nx lx temporary liste nx ly indice where lx NE 0 on ne prend pas les points de la premiere colonne if indice 0 EQ 1 then return lx lx indice ly ly temporary indice IF testvar var key_performance EQ 2 THEN print temps tracemask: liste traits horizontaux systime 1 tempdeux tempdeux systime 1 pour key_performance 2 for pt 0L n_elements lx 1 do BEGIN i lx pt j ly pt plots xf i 1 j xf i j yf i 1 j yf i j color coast_color thick coast_thick _extra ex endfor IF testvar var key_performance EQ 2 THEN print temps tracemask: trace traits horizontaux systime 1 tempdeux endif if keyword_set key_performance THEN print temps tracemask systime 1 tempsun return end "); 328 a[326] = new Array("./ToBeReviewed/TRIANGULATION/triangule.html", "triangule.pro", "", "FUNCTION triangule maskentree BASIC basic COINMONTE coinmonte COINDESCEND coindescend _extra ex common IF jpi EQ 1 OR jpj EQ 1 THEN return 1 IF arg_present coinmonte THEN coinmonte 1 IF arg_present coindescend THEN coindescend 1 if keyword_set basic then return triangule_c maskentree BASIC COINMONTE coinmonte COINDESCEND coindescend _extra ex if n_elements key_gridtype EQ 0 then key_gridtype c if n_elements maskentree EQ 0 then maskentree tmask 0 case key_gridtype of e :res triangule_e maskentree _extra ex c :res triangule_c maskentree COINMONTE coinmonte COINDESCEND coindescend _extra ex endcase return res end"); 329 a[327] = new Array("./ToBeReviewed/TRIANGULATION/triangule_c.html", "triangule_c.pro", "", " NAME:triangule_c PURPOSE:construit le tableau de triangulation L idee est de construire une liste de triangles qui relient les points entre eux Ceci est fait automatiquement avec la fonction TRIANGULATE ICI: on tient compte du fait que les points sont disposes sur une grille reguliere ou pas mais pas destructuree cad que les points sont ecrits suivant une matrice rectangulaire Un moyen tres simple de faire des triangles entre tous les points est alors: pour chaque point i j de la matrice sauf ceux de la derniere ligne et de la derniere colonne on on appelle le rectangle i j le rectangle forme par les 4 points i j i 1 j i j 1 i 1 j 1 Pour tracer tous les triangles il suffit de tracer les 2 triangles contenus ds les rectangles i j au passage on remarque que chaque rectangle i j possede 2 diagonales si si faites un dessin c est vrai il y a donc 2 choix possibles pour chaque rectangles qd on veut le couper en 2 triangles C est grace a ce choix que l on va pouvoir tracer les cotes avec des angles droits A chaque angle de cote remarquable par l existance d un unique point terre ou d un unique point mer sur les 4 cotes d un rectangle i j il faut couper le rectangle suivant la diagonale qui qui passe par le point singulier CATEGORY:pour faire de beaux graphiques masques CALLING SEQUENCE:res triangule mask INPUTS:optionnel:mask c est le tableau 2d qui sevira a masquer le champ que l on tracera apres avec CONTOUR TRIANGULATION triangule mask si cet argument n est pas specifie la function utilise tmask KEYWORD PARAMETERS: BASIC: specifie que le masque est sur une grille basice utiliser pour la triangulation ds les coupes verticales et des hovmoellers KEEP_CONT: to keep the triangulation even on the continents COINMONTE tableau pour obtenir le tableau de coins de terre montant a traiter avec completecointerre pro ds la variable tableau plutot que de la faire passer par la variable globale twin_corners_up COINDESCEND tableau cf COINMONTE OUTPUTS: res: tableau 2d 3 nbre de triangles chaque ligne de res represente les indices des points constituants les sommets d un triangle cf comment on trace les triangles ds dessinetri pro COMMON BLOCKS: common pro different pro definetri pro SIDE EFFECTS: RESTRICTIONS:les donnees dont un veut ensuite faire le contour doivent etre disposees dans une matrice Par contre dans la matrice la disposition des points peut ne pas etre irreguliere Si les donnees sont disposees completement de facon irreguliere utiliser TRIANGULE EXAMPLE: MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 26 4 1999 FUNCTION triangule_c maskentree COINMONTE coinmonte COINDESCEND coindescend BASIC basic KEEP_CONT keep_cont tempsun systime 1 pour key_performance cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF le masque est donne ou il faut prendre tmask msk maskentree taille size msk nx taille 1 ny taille 2 IF n_elements keep_cont EQ 0 THEN keep_cont 1 key_irregular if keyword_set key_periodic nx EQ jpi AND NOT keyword_set basic then BEGIN msk msk msk 0 nx nx 1 ENDIF on va trouver la liste des rectangles i j reperes par leur coin en bas a gauche qu il faut couper suivant une diagonale descendante on appellera cette liste : pts_downward pts_downward 0 on construit le test qui permet de trouver un tel triangle: shift msk 0 1 shift msk 1 1 msk shift msk 1 0 sum1 msk shift msk 1 0 shift msk 1 1 pts qui entourrent le pt en haut a gauche sum2 msk shift msk 0 1 shift msk 1 1 pts qui entourrent le pt en bas a droite tempdeux systime 1 pour key_performance 2 pt terre en haut a gauche entoure de pts mer liste where 4 sum1 1 shift msk 0 1 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt mer en haut a gauche entoure de pts terre liste where 1 sum1 shift msk 0 1 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt terre en bas a droite entoure de pts mer liste where 4 sum2 1 shift msk 1 0 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste pt mer en bas a droite entoure de pts terre liste where 1 sum2 shift msk 1 0 EQ 1 if liste 0 NE 1 THEN pts_downward pts_downward liste undefine liste IF testvar var key_performance EQ 2 THEN print temps triangule: trouver pts_downward systime 1 tempdeux if NOT keyword_set basic OR keyword_set coinmonte OR keyword_set coindescend then begin tempdeux systime 1 pour key_performance 2 2 points terre en diagonale montante avec 2 points mer sur la diagonale descendante coinmont where 1 msk 1 shift msk 1 1 shift msk 0 1 shift msk 1 0 EQ 1 if coinmont 0 NE 1 THEN pts_downward pts_downward coinmont IF testvar var key_performance EQ 2 THEN print temps triangule: trouver coinmont systime 1 tempdeux tempdeux systime 1 pour key_performance 2 2 points terre en diagonale descendante avec 2 points mer sur la diagonale montante coindesc where 1 shift msk 0 1 1 shift msk 1 0 msk shift msk 1 1 EQ 1 IF testvar var key_performance EQ 2 THEN print temps triangule: trouver coindesc systime 1 tempdeux ENDIF if n_elements pts_downward EQ 1 then BEGIN tempdeux systime 1 pour key_performance 2 triang definetri nx ny IF testvar var key_performance EQ 2 THEN print temps triangule: definetri systime 1 tempdeux coinmont 1 coindesc 1 ENDIF ELSE BEGIN tempdeux systime 1 pour key_performance 2 pts_downward pts_downward 1:n_elements pts_downward 1 pts_downward pts_downward uniq pts_downward sort pts_downward aucun rectangle ne peut avoir comme coin en bas a gauche un element de la derniere colonne ou de la derniere ligne il faut donc enlever ces points si ils ont ete selectionnes dans pts_downward derniere_colonne lindgen ny 1 nx 1 derniere_ligne lindgen nx ny 1 nx pts_downward different pts_downward derniere_colonne pts_downward different pts_downward derniere_ligne if NOT keyword_set basic OR keyword_set coinmonte OR keyword_set coindescend then begin if coinmont 0 NE 1 then begin coinmont different coinmont derniere_colonne coinmont different coinmont derniere_ligne endif if coindesc 0 NE 1 then begin coindesc different coindesc derniere_colonne coindesc different coindesc derniere_ligne endif ENDIF ELSE BEGIN coinmont 1 coindesc 1 ENDELSE IF testvar var key_performance EQ 2 THEN print temps triangule: menage ds pts_downward coinmont et coindesc systime 1 tempdeux tempdeux systime 1 pour key_performance 2 if pts_downward 0 EQ 1 then triang definetri nx ny ELSE triang definetri nx ny pts_downward IF testvar var key_performance EQ 2 THEN print temps triangule: definetri systime 1 tempdeux ENDELSE on vire les triangles qui ne contiennent que des points terre tres bonne idee qui ne marche pas encore a 200 avec IDL 5 2 ca devrait aller mieux dans les prochaines versions d IDL if NOT keyword_set basic AND NOT keyword_set keep_cont then begin tempdeux systime 1 pour key_performance 2 on enleve les rectangles qui sont entierement dans la terre recdsterre where 1 msk 1 shift msk 1 0 1 shift msk 0 1 1 shift msk 1 1 EQ 1 IF testvar var key_performance EQ 2 THEN print temps triangule: tous les recdsterre systime 1 tempdeux en attendant une version qui marche parfaitement on est contraint de faire un nouveau tri: il ne faut pas enlever les rectangles qui n ont qu un sommet en commun t1 systime 1 indice intarr nx ny trimask intarr nx ny trimask 0:nx 2 0:ny 2 1 IF recdsterre 0 NE 1 then BEGIN tempdeux systime 1 pour key_performance 2 indice recdsterre 1 if NOT keyword_set basic then begin vire1 0 vire2 0 while vire1 0 NE 1 OR vire2 0 NE 1 ne 0 do begin vire sont les rectangles qu il faut retirer de recsterre en fait qu il faut garder bien qu ils soient entirement dans la terre vire1 where indice shift indice 1 1 1 shift indice 0 1 1 shift indice 1 0 trimask EQ 1 if vire1 0 NE 1 THEN BEGIN indice vire1 0 indice vire1 nx 1 0 endif vire2 where 1 indice 1 shift indice 1 1 shift indice 0 1 shift indice 1 0 trimask EQ 1 if vire2 0 NE 1 THEN BEGIN indice vire2 1 0 indice vire2 nx 0 endif endwhile IF testvar var key_performance EQ 2 THEN print temps triangule: trier les recdsterre systime 1 tempdeux endif indice ny 1 1 la deriere colonne te la derniere ligne indice nx 1 1 ne peuvent definir de rectangle tempdeux systime 1 pour key_performance 2 recgarde where indice EQ 0 on recupere les numeros des triangles que l on va garder trigarde 2 recgarde recgarde nx trigarde transpose temporary trigarde trigarde trigarde trigarde 1 triang triang temporary trigarde IF testvar var key_performance EQ 2 THEN print temps triangule: virer les triangle de la liste systime 1 tempdeux endif endif print temps tri triangles systime 1 t1 quand key_periodic eq 1 triang est une liste d indice d un tableau qui a une colonne de trop il faut ramener ca a la matrice initiale en mettant les indivces de la derniere colonne egaux a ceux de la derniere colonne tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic nx 1 EQ jpi AND NOT keyword_set basic then BEGIN indicey triang nx indicex triang indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 then indicex liste 0 triang indicex nx indicey nx nx 1 if coinmont 0 NE 1 then begin indicey coinmont nx indicex coinmont indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coinmont indicex nx indicey nx nx 1 endif if coindesc 0 NE 1 then begin indicey coindesc nx indicex coindesc indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coindesc indicex nx indicey nx nx 1 endif endif IF testvar var key_performance EQ 2 THEN print temps triangule: finitions systime 1 tempdeux if keyword_set coinmonte THEN coinmonte coinmont ELSE twin_corners_up coinmont if keyword_set coindescend THEN coindescend coindesc ELSE twin_corners_dn coindesc IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF IF keyword_set key_performance THEN print temps triangule systime 1 tempsun return triang END "); 330 a[328] = new Array("./ToBeReviewed/TRIANGULATION/triangule_e.html", "triangule_e.pro", "", " NAME:triangule_e PURPOSE:buid the triangulation for a E grid type CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr june 2001 FUNCTION triangule_e maskentree COINMONTE coinmonte COINDESCEND coindescend SHIFTED shifted BASIC basic cm_4mesh IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF tempsun systime 1 pour key_performance le masque est donne ou il faut prendre tmask msk maskentree sizem size msk nx sizem 1 ny sizem 2 if keyword_set key_periodic nx EQ jpi AND NOT keyword_set basic then BEGIN msk msk msk 0 nx nx 1 ENDIF we will find the diamond that must be cut in two triangle using the horizontal diagonal index lindgen nx ny index index 0:nx 2 1:ny 2 if n_elements shifted EQ 0 then shifted 1 oddeven index nx 1 shifted MOD 2 msk1 msk index msk2 msk index 1 sum msk index nx oddeven msk index nx oddeven sum1 msk2 sum sum2 msk1 sum horizontal singularpoint where msk1 EQ 0 AND sum1 EQ 3 OR msk1 EQ 1 AND sum1 EQ 0 OR msk2 EQ 0 AND sum2 EQ 3 OR msk2 EQ 1 AND sum2 EQ 0 OR sum EQ 0 AND msk1 msk2 EQ 2 if singularpoint 0 NE 1 then begin horizontal index singularpoint triang definetri_e nx ny horizontal SHIFTED shifted ENDIF ELSE triang definetri_e nx ny SHIFTED shifted coinmont index where sum EQ 2 AND msk1 msk2 EQ 0 coindesc index where sum EQ 0 AND msk1 msk2 EQ 2 we keep only the triangles which are outside the land but for some reasons we will in fact delete the land diamond allrecinland where sum1 msk1 EQ 0 indexallinland index allrecinland otherrec lindgen nx ny 0:nx 2 1:ny 2 otherrec different otherrec indexallinland index lindgen nx ny index index 0:nx 3 2:ny 3 out inter index indexallinland IF out 0 NE 1 THEN begin out inter out 1 indexallinland IF out 0 NE 1 THEN begin out out 1 oddeven out nx 1 shifted MOD 2 out inter out nx oddeven otherrec IF out 0 NE 1 THEN begin out inter out 2 nx otherrec IF out 0 NE 1 THEN begin out out nx out nx shifted MOD 2 endif endif endif ENDIF help out index lindgen nx ny index index 0:nx 3 2:ny 3 out inter index otherrec IF out 0 NE 1 THEN begin out inter out 1 otherrec IF out 0 NE 1 THEN begin out out 1 oddeven out nx 1 shifted MOD 2 out inter out nx oddeven indexallinland IF out 0 NE 1 THEN begin out inter out 2 nx indexallinland IF out 0 NE 1 THEN begin out out nx out nx shifted MOD 2 endif endif endif endif help out IF out 0 EQ 1 THEN out different indexallinland out ELSE out indexallinland triout numtri out nx ny triout triout triout 1 goodtri lindgen 2 nx 1 ny 1 goodtri different goodtri triout triang triang temporary goodtri quand key_periodic eq 1 triang est une liste d indice d un tableau qui a une colonne de trop il faut ramener ca a la matrice initiale en mettant les indivces de la derniere colonne egaux a ceux de la derniere colonne tempdeux systime 1 pour key_performance 2 if keyword_set key_periodic nx 1 EQ jpi AND NOT keyword_set basic then BEGIN indicey triang nx indicex triang indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 then indicex liste 0 triang indicex nx indicey nx nx 1 if coinmont 0 NE 1 then begin indicey coinmont nx indicex coinmont indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coinmont indicex nx indicey nx nx 1 endif if coindesc 0 NE 1 then begin indicey coindesc nx indicex coindesc indicey nx nx nx 1 liste where indicex EQ nx if liste 0 NE 1 THEN indicex liste 0 coindesc indicex nx indicey nx nx 1 endif endif IF testvar var key_performance EQ 2 THEN print temps triangule: finitions systime 1 tempdeux if arg_present coinmonte THEN coinmonte coinmont ELSE twin_corners_up coinmont if arg_present coindescend THEN coindescend coindesc ELSE twin_corners_dn coindesc IF NOT keyword_set key_forgetold THEN BEGIN updateold ENDIF IF keyword_set key_performance THEN print temps triangule systime 1 tempsun return triang END "); 331 a[329] = new Array("./ToBeReviewed/UTILITAIRE/fitintobox.html", "fitintobox.pro", "", " NAME:fitintobox PURPOSE: check that the input array has size and dimensions compatible with the domain that was defined with the previous call of domdef CATEGORY: domain compatibility CALLING SEQUENCE: res fitintobox field nx ny nz firstx firsty firstz lastx lasty lastz INPUTS: field: an array or a structure that can be read by the function litchamp pro nx ny nz firstx firsty firstz lastx lasty lastz: optional parameters If not given they will be define with a call to the procedure grille pro KEYWORD PARAMETERS: none OUTPUTS: an array with dimensions matching the domain or 1 if there is an error COMMON BLOCKS: cm_4mesh and cm_4cal SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL help fitintobox findgen jpi jpj FLOAT Array 41 3 IDL help fitintobox findgen jpi jpj 78 Error: the array dimensions 180 148 78 are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt 180 41 148 3 31 31 1 INT 1 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 June 2005: S Masson rewrite all FUNCTION err_mess sz jpi nx jpj ny jpk nz jpt IF n_elements sz EQ 1 THEN RETURN report Error: the vector size tostr sz is incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple RETURN report Error: the array dimensions tostr sz are incompatible with the the domain dimensions jpi nx jpj ny jpk nz jpt strtrim jpi 1 strtrim nx 1 strtrim jpj 1 strtrim ny 1 strtrim jpk 1 strtrim nz 1 strtrim jpt 1 simple END FUNCTION fitintobox field nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth include commons cm_4mesh cm_4cal IF NOT keyword_set key_forgetold THEN BEGIN updatenew ENDIF arr litchamp field IF n_params EQ 1 THEN grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz WDEPTH wdepth case according the number of dimensions of the array sz size arr case sz 0 of 0:BEGIN scalar return report Error: scalar value strtrim arr 1 simple END 1:BEGIN 1D arrays CASE 1 OF x arrays sz 1 EQ jpi :arr temporary arr firstx:lastx sz 1 EQ nx : y arrays sz 1 EQ jpj :arr temporary arr firsty:lasty sz 1 EQ ny : z arrays sz 1 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ nz : t arrays sz 1 EQ jpt : ELSE:return err_mess sz 1 jpi nx jpj ny jpk nz jpt ENDCASE END 2:BEGIN 2D arrays CASE 1 OF xy arrays sz 1 EQ jpi AND sz 2 EQ jpj :arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny :arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj :arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny :arr temporary arr x y z arrays sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ jpk :arr temporary arr firstx:lastx firstz:lastz sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ nz :arr temporary arr firstx:lastx sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz : x yz arrays nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ jpk :arr temporary arr firsty:lasty firstz:lastz nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ nz :arr temporary arr firsty:lasty nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpk :arr temporary arr firstz:lastz nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz : xt arrays sz 1 EQ jpi AND sz 2 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpt: yt arrays sz 1 EQ jpj AND sz 2 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ ny AND sz 2 EQ jpt: zt arrays sz 1 EQ jpk AND sz 2 EQ jpt:arr temporary arr firstz:lastz sz 1 EQ nz AND sz 2 EQ jpt: ELSE:return err_mess sz 1:2 jpi nx jpj ny jpk nz jpt ENDCASE END 3:BEGIN 3D arrays CASE 1 OF xyz arrays sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ jpk :arr temporary arr firstx:lastx firsty:lasty firstz:lastz sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ jpk :arr temporary arr firstx:lastx firstz:lastz sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ jpk :arr temporary arr firsty:lasty firstz:lastz sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpk :arr temporary arr firstz:lastz sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ nz :arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ nz :arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ nz :arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz : xyt arrays sz 1 EQ jpi AND sz 2 EQ jpj AND sz 3 EQ jpt:arr temporary arr firstx:lastx firsty:lasty sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpt: x yzt arrays 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 nx EQ 1 AND sz 1 EQ jpj AND sz 2 EQ nz AND sz 3 EQ jpt:arr temporary arr firsty:lasty nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ jpk AND sz 3 EQ jpt:arr temporary arr firstz:lastz nx EQ 1 AND sz 1 EQ ny AND sz 2 EQ nz AND sz 3 EQ jpt: x y zt arrays 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 sz 1 EQ jpi AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ jpk AND sz 3 EQ jpt:arr temporary arr firstz:lastz sz 1 EQ nx AND ny EQ 1 AND sz 2 EQ nz AND sz 3 EQ jpt: ELSE:return err_mess sz 1:3 jpi nx jpj ny jpk nz jpt ENDCASE END 4:BEGIN 4D arrays CASE 1 OF xyzt arrays 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 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 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 sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ jpk AND sz 4 EQ jpt:arr temporary arr firstz:lastz 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 sz 1 EQ jpi AND sz 2 EQ ny AND sz 3 EQ nz AND sz 4 EQ jpt:arr temporary arr firstx:lastx sz 1 EQ nx AND sz 2 EQ jpj AND sz 3 EQ nz AND sz 4 EQ jpt:arr temporary arr firsty:lasty sz 1 EQ nx AND sz 2 EQ ny AND sz 3 EQ nz AND sz 4 EQ jpt: ELSE:return err_mess sz 1:4 jpi nx jpj ny jpk nz jpt ENDCASE END ELSE:return report Error: fitintobox is managing arrays with a maximum of 4 dimensions simple ENDCASE return arr end"); 332 a[330] = new Array("./ToBeReviewed/UTILITAIRE/get_extra.html", "get_extra.pro", "", " elle fait quoi elle permet : soit de creer une variable extra contenant les mots clefs que tu desires soit de completer une variable extra avec des mots clefs que tu rajoutes imagine : tu es dans une routine et tu veux passer un mot clef en extra car la routine que tu appelles ne le connait pas mais la routine suivante oui tu fais extra get_extra ok year 1999 age_capitaine 35 et tu obtiens la bonne variable extra fait un help extra struc ou alors tu completes un extra existant : extra get_extra _extra extra name Guillaume FUNCTION get_extra _extra extra return extra END "); 333 a[331] = new Array("./ToBeReviewed/UTILITAIRE/linearequation.html", "linearequation.pro", "", " NAME: linearequation PURPOSE:calcule une equation de droite du type ax by c 0 a partir des coordonnees de 2 points Rq: on peut avoir un tableau de couple de points CATEGORY:petit truc qui peut etre utile sans boucles ca va de soit CALLING SEQUENCE:abc linearequation point1 point2 INPUTS: point1 et point2 dont deux point de s la droite s dont on veut calculer l es equations s deux possibilites sont possibles: 1 point est un complexe ou un tableau de complexes ou chaque element du complexe est les coordonnees du point 2 points est un tableau de reels de dimensions 2 nbre_de_droite ou pour chaque ligne du tableau on a les coordonnees du point KEYWORD PARAMETERS: OUTPUTS:abc c est un tableau de dimensions 3 nbre_de_droite ou pour chaque ligne du tableau on obtient les 3 parametres a b c de l equation de la droite ax by c 0 COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL abc linearequation complex 1 2 3 4 IDL print abc 0 1 abc 1 2 abc 2 0 00000 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 FUNCTION linearequation point1 point2 if size point1 type EQ 6 OR size point1 type EQ 9 then begin x1 float point1 y1 imaginary point1 ENDIF ELSE BEGIN x1 float reform point1 0 y1 float reform point1 1 ENDELSE if size point2 type EQ 6 OR size point2 type EQ 9 then begin x2 float point2 y2 imaginary point2 ENDIF ELSE BEGIN x2 float reform point2 0 y2 float reform point2 1 ENDELSE vertical where x1 EQ x2 novertical where x1 NE x2 abc fltarr 3 n_elements x1 IF novertical 0 NE 1 then BEGIN y mx p nele n_elements novertical m y2 novertical y1 novertical x2 novertical x1 novertical p x2 novertical y1 novertical y2 novertical x1 novertical x2 novertical x1 novertical abc novertical reform m 1 nele replicate 1 1 nele reform p 1 nele ENDIF IF vertical 0 NE 1 then BEGIN x ny p nele n_elements vertical n x2 vertical x1 vertical y2 vertical y1 vertical p y2 vertical x1 vertical x2 vertical y1 vertical y2 vertical y1 vertical abc vertical replicate 1 1 nele reform n 1 nele reform p 1 nele ENDIF return abc end"); 334 a[332] = new Array("./ToBeReviewed/UTILITAIRE/lineintersection.html", "lineintersection.pro", "", " NAME: lineintersection PURPOSE: Calcule les coordonnees de l intersection de 2 droites ou d une serie de 2 droites CATEGORY:petit truc qui peut etre utile sans boucles ca va de soit CALLING SEQUENCE: point lineintersection abc1 abc2 INPUTS: abc est un tableau de dimensions 3 nbre_de_couple_de_droites dont chaque ligne contient les 3 parametres a b c de l equation de droite du type ax by c 0 KEYWORD PARAMETERS: FLOAT: pour retourner l output sous forme de tableau de reel plutot que de vecteur decomplexes par defaut OUTPUTS:2 possibilites: 1 par defaut: c est une vecteur de complexe dont chaque element est les coordonnees du point d intersection d un couple de droites 2 si FLOAT est active c est un tableau de reels de dimensiones 2 nbre_de_couple_de_droites dont chaque ligne est les coordonnees du point d intersection d un couple de droites COMMON BLOCKS: SIDE EFFECTS:si les deux droites dont paralleles on retourne les coordonnes values f_nan values f_nan RESTRICTIONS:attention a la precision de la machine qui fait que les coordonnees calcules de verifient peut etre pas exactement les equations du couple de droites EXAMPLE: IDL abc1 linearequation complex 1 2 3 4 IDL abc2 linearequation complex 1 2 8 15 IDL print lineintersection abc1 abc2 1 00000 2 00000 IDL print lineintersection abc1 abc2 float 1 00000 2 00000 MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 10 juin 2000 FUNCTION lineintersection abc1 abc2 FLOAT float a1 float reform abc1 0 b1 float reform abc1 1 c1 float reform abc1 2 a2 float reform abc2 0 b2 float reform abc2 1 c2 float reform abc2 2 determinant a1 b2 a2 b1 nan where determinant EQ 0 if nan 0 NE 1 THEN determinant values f_nan x b1 c2 c1 b2 determinant y c1 a2 a1 c2 determinant if keyword_set float then begin npts n_elements x res reform x 1 npts over reform y 1 npts over ENDIF ELSE res complex x y return res end"); 335 a[333] = new Array("./ToBeReviewed/UTILITAIRE/oups.html", "oups.pro", "", ""); 336 a[334] = new Array("./ToBeReviewed/UTILITAIRE/pwd.html", "pwd.pro", "", " NAME:pwd PURPOSE:print the current directory CATEGORY:like unix function CALLING SEQUENCE:pwd MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO pwd cd current pwd print pwd return end"); 337 a[335] = new Array("./ToBeReviewed/UTILITAIRE/report.html", "report.pro", "", " NAME:report PURPOSE: comme dialog_message pro si il y a deja des widgets actives ou comme message pro si il n y a pas de widgets actives pour poser des question dont la reponse n est pas oui non utiliser xquestion CATEGORY: CALLING SEQUENCE:res report text INPUTS: text: un string on un vecteur de string Si le string ne comporte qu un element on cherche les eventuels characteres de retour a la ligne: C If text is set to an array of strings each array element is displayed as a separate line of text KEYWORD PARAMETERS: SIMPLE: activate to print only the message without the name and the line of the routine defined by calling routine_name ceux dialog_message pro et message pro avec en PARENT qui fait la meme chose que DIALOG_PARENT de dialog_message pro OUTPUTS: 1 si le mot cle QUESTION n est pas activer si le mot cle est active la fonction retourne 1 pour yes et 0 pour no COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: si aucun widget n est active: IDL help report toto tata MAIN : toto tata INT 1 IDL help report ca marche question ca marche y n default answer is y BYTE 1 IDL help report question1: C ca marche question question1: ca marche y n default answer is y BYTE 1 si des widgets sont deja actives c est la meme chose mais avec des widgets MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 21 10 1999 FUNCTION report text DEFAULT_NO default_no PARENT parent QUESTION question SIMPLE simple _extra ex res 1 on separe le texte en differentes lignes separees par C si ce n est pas deja fait if n_elements text EQ 1 then text str_sep text C trim il y a des widgets actifs c est facile on appelle dialog_massage if widget_info managed 0 NE 0 then BEGIN res dialog_message text dialog_parent parent QUESTION question title routine_name 1 DEFAULT_NO default_no _extra ex if keyword_set question THEN res res EQ Yes ELSE res 1 ENDIF ELSE BEGIN aucun widget n est actif on pose une question if keyword_set question then BEGIN quelle est la reponse par defaut if keyword_set default_no then answer n ELSE answer y default_answer answer if n_elements text GT 1 THEN for i 0 n_elements text 2 do print text i read text n_elements text 1 y n default answer is default_answer answer answer strlowcase answer si la reponse ne convient pas while answer NE and answer NE y and answer NE n do begin read text n_elements text 1 y n default answer is default_answer answer answer strlowcase answer ENDWHILE on ajuste res en fonction de la reponse case answer of :res default_answer EQ y y :res 1 n :res 0 endcase endif ELSE BEGIN si on ne pose pas de question on fait juste un print IF keyword_set simple THEN prefix ELSE prefix routine_name 1 : if n_elements text GT 1 THEN for i 0 n_elements text 2 do print prefix text i print prefix text n_elements text 1 ENDELSE ENDELSE return res end"); 338 a[336] = new Array("./ToBeReviewed/UTILITAIRE/routine_name.html", "routine_name.pro", "", " NAME:routine_name remonte PURPOSE:retourne le nom de la routine procedure ou function ds lequel on se trouve CATEGORY:utilitaire CALLING SEQUENCE:res routine_name remonte INPUTS: remonte: un entier qui donne de combien de niveau on doit remonter ds l empillement des routines ewt sous routines pour retrouver le nom de la routine cherchee KEYWORD PARAMETERS: OUTPUTS:un string donnant soit le nom de la routine en entier avec le path soit MAIN COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: cette fonction utilise le mot cle OUTPUT ds help pro et il est specifie ds l aide en ligne que la syntaxe du retour de ce mot cle peut changer suivant la version du code Cette version marche avec IDL 5 2 EXAMPLE: IDL print routine_name usr1 com smasson IDL_RD UTILITAIRE report pro IDL print routine_name 1 usr1 com smasson IDL_RD PLOTS DIVERS determineminmax pro IDL print routine_name 2 usr1 com smasson IDL_RD PLOTS DESSINE plt pro IDL print routine_name 3 MAIN IDL print routine_name 4 MAIN MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 21 10 1999 FUNCTION routine_name remonte help traceback output name name strtrim name 1 on enleve les blancs en debut de ligne on va mettre les elements du vecteur bout a bout pour former un unique sring allnames for i 0 n_elements name 1 do allnames allnames name i name str_sep allnames on le redecoupe name strtrim name 2 on eleve les blancs devant et derriere name strcompress name on compresse les blancs on ne retient pas les 2 premiers elements qui sont 1 un vide et la ligne concernant routine_name name name 2: n_elements name 1 on choisit la ligne qui nous concerne if NOT keyword_set remonte then remonte 0 if remonte GE n_elements name then return MAIN name name remonte if strpos name MAIN NE 1 then return MAIN name str_sep name if n_elements name LT 3 then name name 0 ELSE name L name 1 name 2 return name end"); 339 a[337] = new Array("./ToBeReviewed/UTILITAIRE/test.html", "test.pro", "", "pro test ok ok if keyword_set ok then print OK else print No return end"); 340 a[338] = new Array("./ToBeReviewed/UTILITAIRE/testvar.html", "testvar.pro", "", " NAME:testvar PURPOSE:une sorte de keyword_set mais qd la valeur existe renvoie celle ci CATEGORY:comme keyword_set CALLING SEQUENCE:res testvar var variable INPUTS:rien KEYWORD PARAMETERS:var : n importe quoi OUTPUTS:0 si la variable n existe pas COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: IDL print testvar var toto 0 IDL print testvar var toto toto MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 14 12 1999 FUNCTION testvar var var if keyword_set var then return var ELSE return 0 end"); 341 a[339] = new Array("./ToBeReviewed/UTILITAIRE/text_box.html", "text_box.pro", "", " Name : text_box Purpose : Writes a text message within a box in a graphics window Description: This procedure writes a short text message within a box shaped area in a graphics window The message may be split at word boundaries into several lines and the character size and orientation may be adjusted for the text to fit within the box Useage: text_box text pos pos color color justify justify vert_space vert_space Inputs TEXT ASCII text string containing the message keywords pos 4 element vector specifying the box position and size pos 0 pos 1 specify the lower left corner coordinate pos 2 pos 3 specify the upper right corner coordinate data window normalized coordinates are use fg_color color of box and legend titles default 0 bg_color background color Setting BG_COLOR erases the area covered by the text box filling it with color BG_COLOR prior to writing the text If both BG_COLOR and p color are zero then the background color is reset to 255 to gaurantee a readability right if set right justify text center if set center the text vert_space vertical spacing of lines in units of character height default 1 5 author: Paul Ricchiazzi 7Jul93 Institute for Computational Earth System Science University of California Santa Barbara PRO text_box text pos pos fg_color fg_color bg_color bg_color center center right right box box vert_space vert_space _EXTRA ex ON_ERROR 2 Check the number of parameters justify 1 if keyword_set right ne 0 then justify 1 if keyword_set center ne 0 then justify 0 if keyword_set vert_space eq 0 then vert_space 1 5 IF n_elements text eq 0 then message must specify text nnx x window d x_vsize nny y window d y_vsize nnx 0 1 d x_vsize nny 0 1 d y_vsize if n_elements pos eq 0 then begin box_cursor xx1 yy1 nx ny xx2 xx1 nx yy2 yy1 ny pos xx1 nnx 0 nnx 1 nnx 0 yy1 nny 0 nny 1 nny 0 xx2 nnx 0 nnx 1 nnx 0 yy2 nny 0 nny 1 nny 0 posstring string form a 4 f5 2 a pos pos 0 pos 1 pos 2 pos 3 print strcompress posstring remove_all endif else begin xx1 nnx 0 pos 0 nnx 1 nnx 0 xx2 nnx 0 pos 2 nnx 1 nnx 0 yy1 nny 0 pos 1 nny 1 nnx 0 yy2 nny 0 pos 3 nny 1 nnx 0 endelse calculate the height and width of the box in characters width xx2 xx1 d x_ch_size height yy2 yy1 d y_ch_size decompose the message into words words str_sep text print f 20a words nwords n_elements words wordlen lenstr words d x_vsize blanklen lenstr d x_vsize maxcharsize xx2 xx1 4 blanklen max wordlen charsize 1 lpnt intarr nwords nomore 0 ntries 0 repeat begin ntries ntries 1 if ntries gt 20 then message Can not fit message into box ychsiz vert_space d y_ch_size charsize wlen wordlen charsize blen blanklen charsize n_lines fix yy2 yy1 ychsiz 1 sum 0 ilines 0 print f 8a8 charsz i ilines n_lines lpnt wlen sum xwdth for i 0 nwords 1 do begin sum sum wlen i blen if sum 3 blen gt xx2 xx1 then begin ilines ilines 1 sum wlen i blen endif lpnt i ilines print f f8 2 4i8 3f8 2 charsize i ilines n_lines lpnt i wlen i blen sum 3 blen xx2 xx1 endfor case 1 of ilines 1 lt n_lines: if charsize 1 1 gt maxcharsize then vert_space yy2 yy1 n_lines 1 d y_ch_size charsize else charsize charsize 1 1 ilines 1 eq n_lines: nomore 1 ilines 1 gt n_lines: charsize charsize 9 endcase endrep until nomore lines strarr n_lines maxlen 0 for i 0 n_lines 1 do begin ii where lpnt eq i nc maxlen total wlen ii nc blen maxlen lines i string f 200a words ii print i words ii print i lines i endfor align 5 1 justify case justify of 1:xx xx1 5 xx2 xx1 maxlen 0:xx 0 5 xx1 xx2 1:xx xx2 5 xx2 xx1 maxlen endcase dy d y_ch_size charsize vert_space yy yy2 0 5 dy xbox xx1 xx2 xx2 xx1 xx1 ybox yy1 yy1 yy2 yy2 yy1 if n_elements bg_color ne 0 then begin if p color eq 0 and bg_color eq 0 then bgc 255 else bgc bg_color polyfill xbox ybox color bgc device endif if n_elements fg_color eq 0 then color 0 else color fg_color for i_line 0 n_lines 1 do begin yy yy dy print xx yy lines i_line charsize xyouts xx yy lines i_line device charsize charsize alignment align color color font 1 _extra ex endfor if keyword_set box then plots xbox ybox color color device return end "); 342 a[340] = new Array("./ToBeReviewed/UTILITAIRE/undefine.html", "undefine.pro", "", " NAME: undefine PURPOSE: effacer une variable meme chose que delvar mais utiulisable ds un programme et utilisable que pour une variable a la fois CATEGORY: CALLING SEQUENCE: UNDEFINE varname INPUTS: varname: la variable a detruire EXAMPLE: IDL a 1 IDL undefine a Compiled module: UNDEFINE IDL help a A UNDEFINED MODIFICATION HISTORY: trouve sur la page web de D Fanning http: www dfanning com : QUESTION: How do I make an IDL variable have a type undefined ANSWER: At the main IDL level you can use the IDL procedure DELVAR to delete an IDL variable and make it undefined Inside of procedures and functions I use this little program named UNDEFINE that I got from Andrew Cool at the DSTO High Frequency Radar Division in Adelaide Australia PRO UNDEFINE varname tempvar SIZE TEMPORARY varname END "); 343 a[341] = new Array("./ToBeReviewed/UTILITAIRE/vzoom.html", "vzoom.pro", "", ""); 344 a[342] = new Array("./ToBeReviewed/UTILITAIRE/xfile.html", "xfile.pro", "", " NAME: xfile PURPOSE: affiche ds un widget un fichier ASCII c est la meme chose que xdisplaydife mais ici on l utilise pour visualiser le contenu d une procedure ou d une fonction meme si elle n est pas ds le repertoire courant grace a path CATEGORY: help CALLING SEQUENCE: xfile nom_fichier INPUTS: nom_fichier:le nom d une procedure ou d une fonction a visualiser avec ou sans le pro a la fin KEYWORD PARAMETERS:ceux de xdisplayfile EXAMPLE:xfile plt MODIFICATION HISTORY: Sebastien Masson smasson lodyc jussieu fr 7 1 99 6 7 1999: compatibilite mac et windows PRO xfile filename _extra ex pfile strlowcase filename il faut trouver le nom complet if strpos pfile pro lt 0 then pfile pfile pro thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos pfile sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep if rstrpos multipath 0 sep NE strlen multipath 0 1 then multipath multipath sep pfile current multipath pfile ENDIF i 0 repeat begin res findfile pfile i i i 1 endrep until res 0 NE OR i EQ n_elements pfile if res 0 NE then BEGIN on ouvre le fichier ds un widget xdisplayfile pfile i 1 _extra ex ENDIF ELSE ras report le fichier demande n existe pas return end"); 345 a[343] = new Array("./ToBeReviewed/UTILITAIRE/xhelp.html", "xhelp.pro", "", " NAME: xhelp PURPOSE: Display an IDL procedure header using widgets and the widget manager CATEGORY: Widgets CALLING SEQUENCE: xhelp Filename _extra ex INPUTS: Filename: A scalar string that contains the filename of the file to display If FILENAME does not include a complete path specification xhelp will search for the file in the current working directory and then each of the directories listed in PATH environment variable The pro file suffix will be appended if it is not supplied KEYWORD PARAMETERS: Ceux de xdisplayfile OUTPUTS: No explicit outputs A file viewing widget is created SIDE EFFECTS: Triggers the XMANAGER if it is not already in use RESTRICTIONS: None PROCEDURE: Open a file and create a widget to display its contents MODIFICATION HISTORY: Written By Steve Richards December 1990 Graceful error recovery DMS Feb 1992 Modified to extract pro documentation headers PJR ESRG mar94 author: Paul Ricchiazzi jun93 Institute for Computational Earth System Science University of California Santa Barbara 7 1 99 : legeres mofification par Sebastien Masson : utilisation de xdisplayfile de findfile et de _extra 6 7 1999: compatibilite mac et windows PRO xhelp filename _extra ex filename est bien un string cquoidonc size filename type if cquoidonc NE 7 then begin ras report Input parameter must be a string and not a size filename tname return endif il faut trouver le nom complet pfile FILENAME if strpos pfile pro lt 0 then pfile pfile pro thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :BEGIN sep : pathsep end WIN :BEGIN sep pathsep end ELSE: BEGIN sep pathsep : end ENDCASE cd current current if strpos pfile sep lt 0 then BEGIN if rstrpos current sep NE strlen current 1 then current current sep multipath str_sep path pathsep if rstrpos multipath 0 sep NE strlen multipath 0 1 then multipath multipath sep pfile current multipath pfile ENDIF on test tous les noms possibles pour trouver ou est le fichier nfile n_elements pfile n 0 repeat begin res findfile pfile n n n 1 endrep until res 0 NE OR n EQ n_elements pfile if res 0 NE then BEGIN openr unit pfile n 1 get_lun ouverture du fichier on selectionne le morceaux en tete a strarr 1000 Maximum of lines xsize 0 i 0 c readon 0 while not eof unit do begin readf unit c if strpos c eq 0 then readon 0 if readon then begin dum where byte c eq 9b ntab count tab characters xsize xsize strlen c 8 ntab a i strmid c 1 200 i i 1 endif if strpos c eq 0 then readon 1 endwhile if i EQ 0 then ras report le programme a etait mal ecrit il n y a pas d en tete utiliser xfile pro ELSE BEGIN a a 0:i 1 on ecrit le contenu de a ds un widget xdisplayfile toto text a title pfile n 1 _extra ex ENDELSE FREE_LUN unit free the file unit ENDIF ELSE ras report le fichier demande n existe pas return end "); 346 a[344] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/buildcmd.html", "buildcmd.pro", "", " NAME:buildcmd PURPOSE:cette fonction reourne un string qui contient la commande de lecture et les parametres du trace CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION buildcmd base BOXZOOM boxzoom FORCETYPE forcetype we get back the ids of the widget parts txtcmdid widget_info base find_by_uname txtcmd domainid widget_info base find_by_uname domain actionid widget_info base find_by_uname action optionid widget_info base find_by_uname option widget_control base get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait strtrim optionsflag where options EQ Portrait Landscape 0 1 0 on determine quelle procedure on va etre appele pour faire le dessin et le type IF keyword_set forcetype THEN type forcetype ELSE type widget_info actionid combobox_gettext case type of plt :procedure plt pltz :procedure pltz pltz diag up :procedure pltz pltz diag dn :procedure pltz pltt :procedure pltt pltt diag up :procedure pltt pltt diag dn :procedure pltt xy :procedure plt xz :procedure pltz yz :procedure pltz xt :procedure pltt yt :procedure pltt zt :procedure pltt x :procedure plt1d y :procedure plt1d z :procedure plt1d t :procedure pltt endcase recherche des options options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag flags optionsflag numdessinin xindex flags where options EQ Longitude x index 0 yindex flags where options EQ Latitude y index 0 drawvecteur flags where options EQ Vecteur 0 procedure eq plt drawover flags where options EQ Overlay 0 alreadyread extractatt top_uvalue alreadyread alreadyvector extractatt top_uvalue alreadyvector alreadyover extractatt top_uvalue alreadyoer que devons nous lire case 1 of alreadyover NE 1:BEGIN toread alreadyover 1 readswitch over END alreadyvector NE 1 AND alreadyvector NE pi:BEGIN toread alreadyvector 1 readswitch vector END alreadyread NE 1 AND alreadyread NE pi AND alreadyread NE 2 pi:BEGIN toread alreadyread 1 readswitch classic END else:BEGIN case 1 of alreadyvector eq pi:BEGIN toread alreadyover 1 readswitch over END alreadyread EQ pi:BEGIN toread alreadyvector 1 readswitch vector END alreadyread EQ 2 pi:BEGIN toread alreadyover 1 readswitch over END ELSE:BEGIN toread alreadyread 1 readswitch classic END endcase END ENDCASE widget_control txtcmdid get_value widcmd widcmd strtrim widcmd 2 IF widcmd 0 EQ THEN widcmd zzz cutcmd widcmd 0 toread numberofread prefix nameexp ending readcmd buildreadcmd base nameexp procedure type BOXZOOM boxzoom complete readswitch EQ classic AND alreadyread EQ 1 we look for the line containing funclec_name currentfile extractatt top_uvalue currentfile readparameters extractatt top_uvalue readparameters currentfile i 0 while strpos readcmd i readparameters funclec_name EQ 1 do i i 1 case readswitch of classic :BEGIN if alreadyread 1 EQ 0 then BEGIN we start the reading command readcmd beginning of reading the field to draw readcmd readcmd i 1 field prefix readcmd i 1 ENDIF ELSE BEGIN we complet the reading command oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE exit if we have to read other fields if alreadyread 1 NE numberofread 1 THEN BEGIN top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyread alreadyread 1 top_uvalue 1 findline top_uvalue noticebase xnotice Select the field number strtrim alreadyread 3 1 return ENDIF we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd field create_struct arr:temporary field grid:vargrid unit:varunit experiment:varexp name:varname end of reading the field to draw we get back _EXTRA: extra extractatt top_uvalue extra if xindex NE 0 then extra create_struct extra xindex xindex if yindex NE 0 then extra create_struct extra yindex yindex exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd temporary readcmd extra sextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd case 1 of drawvecteur:BEGIN we have to read the vectors top_uvalue 1 findline top_uvalue alreadyread pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the zonal component of vector return END drawover:BEGIN we have to read the field to overlay top_uvalue 1 findline top_uvalue alreadyread 2 pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the field to overlay return END finished we draw the plot ELSE: top_uvalue 1 findline top_uvalue alreadyread 1 endcase END vector :BEGIN for the vectors there is 2 components we read u when alreadyvector is a interger and v when alreadyvector is a interger 0 5 if floor alreadyvector 1 EQ 0 then begin if floor alreadyvector EQ alreadyvector then begin readcmd beginning of reading the zonal component of vector readcmd readcmd i 1 fieldu prefix readcmd i 1 ENDIF ELSE BEGIN readcmd beginning of reading the meridional component of vector readcmd readcmd i 1 fieldv prefix readcmd i 1 ENDELSE readcmd extractatt top_uvalue currentreadcmd temporary readcmd ENDIF ELSE BEGIN oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE case alreadyvector 1 of numberofread 1:BEGIN we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd fieldu create_struct arr:temporary fieldu grid:vargrid unit:varunit experiment:varexp name:varname end of reading the zonal component of vector top_uvalue 1 findline top_uvalue currentreadcmd readcmd we finished zonal component reading we know switch to meridional component top_uvalue 1 findline top_uvalue alreadyvector 5 top_uvalue 1 findline top_uvalue noticebase xnotice Select the meridional component of vector return END numberofread 0 5:BEGIN we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF readcmd temporary readcmd fieldv create_struct arr:temporary fieldv grid:vargrid unit:varunit experiment:varexp name:varname end of reading the meridional component of vector we finished meridional component reading we get back _EXTRA of the vector and we complet extra already build extra extractatt top_uvalue extra exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd readcmd vectorextra sextra extra mixstru extra vectorextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd if drawover then BEGIN shall we do an overlay top_uvalue 1 findline top_uvalue alreadyvector pi top_uvalue 1 findline top_uvalue noticebase xnotice Select the field to overlay return ENDIF ELSE BEGIN it is done know top_uvalue 1 findline top_uvalue alreadyread 1 top_uvalue 1 findline top_uvalue alreadyvector 1 ENDELSE END ELSE:BEGIN we still need to read some vector components top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyvector alreadyvector 1 if floor alreadyvector EQ alreadyvector then text zonal ELSE text meridional top_uvalue 1 findline top_uvalue noticebase xnotice Select the strtrim floor alreadyread 3 1 text component of vector return END endcase END over :BEGIN if alreadyover 1 EQ 0 then begin we start the reading readcmd beginning of reading the field to overdraw readcmd readcmd i 1 fieldover prefix readcmd i 1 readcmd extractatt top_uvalue currentreadcmd temporary readcmd ENDIF ELSE BEGIN oldrdcmd extractatt top_uvalue currentreadcmd nl n_elements oldrdcmd oldrdcmd nl 1 oldrdcmd nl 1 readcmd i prefix readcmd i readcmd temporary oldrdcmd temporary readcmd ENDELSE if alreadyover 1 NE numberofread 1 THEN BEGIN we still need to read some files top_uvalue 1 findline top_uvalue currentreadcmd readcmd top_uvalue 1 findline top_uvalue alreadyover alreadyover 1 top_uvalue 1 findline top_uvalue noticebase xnotice Select the field number strtrim alreadyover 3 1 to overlay return ENDIF we finalize the reading command IF ending NE THEN BEGIN nl n_elements readcmd readcmd nl 1 readcmd nl 1 readcmd temporary readcmd ending ENDIF on finalise la commande de lecture readcmd readcmd fieldover create_struct arr:temporary fieldover grid:vargrid unit:varunit experiment:varexp name:varname end of reading the field to overdraw we get back _EXTRA of over and we complet extra already build extra extractatt top_uvalue extra exextra cw_specifie_get_value base extra mixstru exextra extra sextra struct2string extra readcmd readcmd overextra sextra extra mixstru extra overextra top_uvalue 1 findline top_uvalue currentreadcmd readcmd we reinitialize top_uvalue 1 findline top_uvalue alreadyread 1 top_uvalue 1 findline top_uvalue alreadyvector 1 top_uvalue 1 findline top_uvalue alreadyover 1 END endcase determination du nom de la boxzoom if NOT keyword_set boxzoom then widget_control domainid get_value boxzoom ecriture de celle ci sous forme d un string box strtrim boxzoom 0 1 for i 1 n_elements boxzoom 1 3 2 strpos type z EQ 1 do box box strtrim boxzoom i 1 pour les plots en z box doit avoir par defaut 0 profmax if strpos type z NE 1 then BEGIN si de 1 niveau est selectionne: widget_control widget_info base find_by_uname dthlv1 get_value niv1 niv1 niv1 combobox_index widget_control widget_info base find_by_uname dthlv2 get_value niv2 niv2 niv2 combobox_index if niv1 NE niv2 then begin box box strtrim boxzoom 4 1 strtrim boxzoom 5 1 ENDIF ELSE BEGIN if chkstru exextra profmax then pmax exextra profmax ELSE pmax 200 box box 0 strtrim pmax 1 ENDELSE endif box box IF strpos type diag up NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 2 1 strtrim boxzoom 1 1 strtrim boxzoom 3 1 ENDIF IF strpos type diag dn NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 3 1 strtrim boxzoom 1 1 strtrim boxzoom 2 1 ENDIF on determine typein IF strpos type diag NE 1 THEN typein strmid type 0 4 ELSE typein type determination de small ssmall tostr smallout on va definir le string qui contiendra la commande a executer par widgetdessine pro Cmd readCmd procedure field boxzoom box findalways typein typein small ssmall IF drawvecteur then Cmd Cmd vecteur u: fieldu v: fieldv IF drawover then Cmd Cmd contour fieldover IF n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints Cmd Cmd _extra mixstru ex extra portrait portrait NOERASE noerase print for i 0 n_elements Cmd 1 do print Cmd i print on complete et ou actualise la structure top_uvalue top_uvalue 1 findline top_uvalue nameprocedures numdessinout procedure top_uvalue 1 findline top_uvalue types numdessinout type top_uvalue 1 findline top_uvalue domaines numdessinout boxzoom top_uvalue 1 findline top_uvalue txtcmd numdessinout widcmd top_uvalue 1 findline top_uvalue optionsflag numdessinout flags top_uvalue 1 findline top_uvalue exextra numdessinout extra return Cmd end "); 347 a[345] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/buildreadcmd.html", "buildreadcmd.pro", "", " NAME:buildreadcmd PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: KEYWORD PARAMETERS: OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr FUNCTION buildreadcmd base snameexp procedure type BOXZOOM boxzoom COMPLETE complete NAMEFIELD namefield cm_4cal for key_caltype get back widgets IDs vlstid widget_info base find_by_uname varlist date1id widget_info base find_by_uname calendar1 date2id widget_info base find_by_uname calendar2 domainid widget_info base find_by_uname domain optionid widget_info base find_by_uname option widget_control base get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 numdessinout extractatt top_uvalue smallout 2 1 name of the file currentfile extractatt top_uvalue currentfile filelist extractatt top_uvalue filelist filename filelist currentfile sfilename filename name of the variable if keyword_set namefield then namevar namefield ELSE namevar widget_info vlstid combobox_gettext snamevar namevar get the options options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags numdessinin xindex flags where options EQ Longitude x index 0 yindex flags where options EQ Latitude y index 0 extra extractatt top_uvalue extra if xindex NE 0 then extra create_struct extra xindex xindex if yindex NE 0 then extra create_struct extra yindex yindex exextra cw_specifie_get_value base exextra extractstru exextra min max inter lct if size exextra type EQ 8 then extra mixstru exextra extra sextra struct2string extra find date1 and date2 key_caltype extractatt top_uvalue fileparameters currentfile caltype widget_control date1id get_value date1 widget_control date2id get_value date2 if procedure EQ pltt AND date1 EQ date2 then BEGIN we redefine the dates to the begining and end of the calendar calendar extractatt top_uvalue fileparameters currentfile time_counter date1 jul2date calendar 0 date2 jul2date calendar n_elements calendar 1 widget_control date1id set_value date1 widget_control date2id set_value date2 endif fakecal extractatt top_uvalue fileparameters currentfile fakecal IF keyword_set fakecal THEN BEGIN date1 date2jul date1 fakecal date2 date2jul date2 fakecal ENDIF sdate1 strtrim date1 1 sdate2 strtrim date2 1 find boxzoom if NOT keyword_set boxzoom then widget_control domainid get_value boxzoom put boxzoom into a string box strtrim boxzoom 0 1 for i 1 n_elements boxzoom 1 3 2 strpos type z EQ 1 do box box strtrim boxzoom i 1 if strpos type z NE 1 then BEGIN common min min gdept gdepw max max box box strtrim floor min 1 strtrim ceil max 1 endif box box IF strpos type diag up NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 2 1 strtrim boxzoom 1 1 strtrim boxzoom 3 1 ENDIF IF strpos type diag dn NE 1 THEN BEGIN sendpoints strtrim boxzoom 0 1 strtrim boxzoom 3 1 strtrim boxzoom 1 1 strtrim boxzoom 2 1 ENDIF find funclec_name readparameters meshparameters readparameters extractatt top_uvalue readparameters currentfile funclec_name readparameters funclec_name if keyword_set complete then begin sreadparameters struct2string readparameters meshparameters extractatt top_uvalue meshparameters currentfile smeshparameters struct2string meshparameters on va definir le string qui contiendra la commande a executer pour la lecture Cmd Definition of extra structure: extra sextra Definition of readparameters structure: readparameters sreadparameters Do we change of reading : dummy changeread readparameters Definition of meshparameters structure: meshparameters smeshparameters Do we change the grid : dummy changegrid meshparameters Read the data if n_elements date1in ne 0 then date1 date1in else date1 sdate1 if n_elements date2in ne 0 then date2 date2in else date2 sdate2 funclec_name snamevar date1 date2 snameexp timestep strtrim keyword_set fakecal 1 parent strtrim base 2 boxzoom box findalways filename sfilename if n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints type type Cmd Cmd _extra mixstru ex extra nostruct top_uvalue 1 findline top_uvalue varinfo numdessinout filename namevar top_uvalue 1 findline top_uvalue dates numdessinout date1 date2 ENDIF ELSE BEGIN Cmd funclec_name snamevar date1 date2 snameexp parent strtrim base 1 boxzoom box filename sfilename if n_elements sendpoints NE 0 then Cmd Cmd endpoints sendpoints type type Cmd Cmd _extra mixstru ex extra nostruct ENDELSE print :::::::::::::::::::::: for i 0 n_elements Cmd 1 do print Cmd i print :::::::::::::::::::::: return cmd end"); 348 a[346] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/changefield.html", "changefield.pro", "", "PRO changefield base newfieldname BOXZOOM boxzoom widget_control base get_uvalue top_uvalue Change exextra : exextra definedefaultextra newfieldname specifieid widget_info base find_by_uname specifie widget_control specifieid set_value exextra Change the variable Do we need to change the vertical axis according to the tye of points T or W dthlv1id widget_info base find_by_uname dthlv1 widget_control dthlv1id get_uvalue dthlv1_uval oldzgridt dthlv1_uval grid_t get the type of point currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar for i 0 n_elements listvar 1 do print listvar i listgrid i indexvar where listvar EQ newfieldname indexvar 0 indexvar 0 zgridt strupcase listgrid indexvar NE W if we change the type of point if zgridt NE oldzgridt then BEGIN update dthlv1_uval grid_t dthlv1_uval grid_t zgridt widget_control dthlv1id set_uvalue dthlv1_uval update cw_domain if NOT keyword_set boxzoom THEN widget_control widget_info base find_by_uname domain get_value boxzoom widget_control widget_info base find_by_uname domain set_value boxzoom endif return end"); 349 a[347] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/changefile.html", "changefile.pro", "", "PRO changefile base newfilename BOXZOOM boxzoom DATE1 date1 DATE2 date2 FIELDNAME fieldname widget_control base hourglass widget_control base get_uvalue top_uvalue filelist extractatt top_uvalue filelist IF size newfilename type EQ 7 THEN newfile where filelist EQ newfilename 0 ELSE newfile newfilename it is already the index of the new file if newfile EQ 1 then begin nothing report invalid filename return endif oldfile extractatt top_uvalue currentfile oldfilename filelist oldfile did we really change the file if oldfile EQ newfile AND NOT keyword_set BOXZOOM OR keyword_set DATE1 OR keyword_set DATE2 OR keyword_set FIELDNAME then return widget_control base update 0 we update currentfile element of the top_uvalue top_uvalue 1 findline top_uvalue currentfile newfile Calendar oldcalendar extractatt top_uvalue fileparameters oldfile time_counter newcalendar extractatt top_uvalue fileparameters newfile time_counter Did we change the calendar if array_equal oldcalendar newcalendar NE 1 then begin cm_4cal for key_caltype key_caltype extractatt top_uvalue fileparameters newfile caltype fake or real calendar fakecal extractatt top_uvalue fileparameters newfile fakecal Which dates were selected date1id widget_info base find_by_uname calendar1 if NOT keyword_set date1 then widget_control date1id get_value date1 jdate1 date2jul date1 if where newcalendar EQ jdate1 0 EQ 1 then jdate1 newcalendar 0 date2id widget_info base find_by_uname calendar2 if NOT keyword_set date2 then widget_control date2id get_value date2 jdate2 date2jul date2 if where newcalendar EQ jdate2 0 EQ 1 then jdate2 date1 if jdate2 LT jdate1 THEN jdate2 jdate1 widget_control date1id destroy widget_control date2id destroy basecal widget_info base find_by_uname basecal rien cw_calendar basecal newcalendar jdate1 uname calendar1 FAKECAL fakecal uvalue name: calendar1 frame rien cw_calendar basecal newcalendar jdate2 uname calendar2 FAKECAL fakecal uvalue name: calendar2 frame ENDIF ELSE BEGIN if keyword_set date1 then begin date1id widget_info base find_by_uname calendar1 widget_control date1id set_value date1 endif if keyword_set date2 then begin date2id widget_info base find_by_uname calendar2 widget_control date2id set_value date2 endif ENDELSE Grid parameters and domain newgrid extractatt top_uvalue meshparameters newfile change changegrid newgrid if change OR keyword_set boxzoom then BEGIN if NOT keyword_set boxzoom then boxzoom 1 domainid widget_info base find_by_uname domain widget_control domainid set_value boxzoom endif file name IF oldfile NE newfile THEN BEGIN flstid widget_info base find_by_uname filelist widget_control flstid set_combobox_select newfile ENDIF Variables name vlstid widget_info base find_by_uname varlist oldfieldname widget_info vlstid combobox_gettext did we really change the liste of variables oldlistvar extractatt top_uvalue fileparameters oldfile listvar newlistvar extractatt top_uvalue fileparameters newfile listvar if array_equal oldlistvar newlistvar NE 1 THEN widget_control vlstid set_value newlistvar set the liste of variables to the new variable name if keyword_set fieldname then newfieldname fieldname ELSE newfieldname oldfieldname indexvar where newlistvar EQ newfieldname indexvar 0 indexvar 0 widget_control vlstid set_combobox_select indexvar newfieldname newlistvar indexvar did we change the name of the variable if newfieldname NE oldfieldname then BEGIN changefield base newfieldname BOXZOOM boxzoom ENDIF widget_control base update 1 return end"); 350 a[348] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/createhistory.html", "createhistory.pro", "", "PRO createhistory base small we save globalcommand in globaloldcommand widget_control base get_uvalue top_uvalue globalcommand extractatt top_uvalue globalcommand top_uvalue 1 findline top_uvalue globaloldcommand globalcommand portrait or landscape options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait optionsflag where options EQ Portrait Landscape 0 0 composition du text contennu ds history pro texte common if keyword_set postscript then begin noerase 1 openps infowidget infowidget portrait strtrim portrait 2 endif beginning of 1 end of 1 if small 0 small 1 GT 1 then begin for draw 1 small 0 small 1 1 do begin texte texte beginning of strtrim draw 1 2 noerase 1 end of strtrim draw 1 2 endfor ENDIF texte texte if keyword_set postscript then begin closeps infowidget infowidget printps endif the new globalcommand top_uvalue 1 findline top_uvalue globalcommand texte for i 0 n_elements texte 1 do print texte i return end"); 351 a[349] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/cutcmd.html", "cutcmd.pro", "", "PRO cutcmd widcmd toread numberofread prefix nameexp ending dummy where byte widcmd EQ byte 0 nbdblquote CASE 1 OF nbdblquote MOD 2: stop odd numbers are impossibles nbdblquote GT 0: nbdblquote EQ 0:BEGIN widcmd is an expression of type: numb1 a numb2 b numb we will change into the form numb1 a numb2 b numb in order to suits the new method of cutcmd widcmd strtrim widcmd 2 we force to start with a or case 1 of strpos widcmd EQ 0: strpos widcmd EQ 0: ELSE:widcmd widcmd ENDCASE separator strsplit widcmd extract regex other strsplit widcmd extract IF n_elements separator NE n_elements other THEN stop widcmd FOR i 0 n_elements other 1 DO BEGIN IF isnumber other i LT 1 THEN other i other i widcmd widcmd separator i other i ENDFOR print widcmd END ENDCASE cutted strsplit widcmd extract IF strpos widcmd EQ 0 THEN start 0 ELSE start 1 nameexp cutted start: :2 numberofread n_elements nameexp IF toread GE numberofread then begin dummy report toread cannot be larger than numberofread stop ENDIF other cutted 1 start: :2 make sure that we have a prefix for each nameexp IF start EQ 0 THEN other other nameexp nameexp toread prefix other toread IF n_elements other EQ numberofread 1 THEN ending other numberofread ELSE ending help prefix nameexp ending return end"); 352 a[350] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/definedefaultextra.html", "definedefaultextra.pro", "", "FUNCTION definedefaultextra nomvariable case strlowcase nomvariable of sn :BEGIN return get_extra min 31 max 37 inter 2 lct 33 nocontout END tn :BEGIN return get_extra min 20 max 31 inter 5 lct 39 END un :BEGIN return get_extra min 1 max 1 inter 1 lct 64 END vn :BEGIN return get_extra min 1 max 1 inter 1 lct 64 END ELSE: ENDCASE return get_extra min max inter lct 39 end"); 353 a[351] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/doubleclickaction.html", "doubleclickaction.pro", "", "PRO doubleclickaction event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue on active la bonne fenetre widget_control event id get_value win wset win quel est le dessin selectionne smallin extractatt top_uvalue smallin smallout extractatt top_uvalue smallout x convert_coord uval x 0 uval y 0 device to_normal 0 y convert_coord uval x 0 uval y 0 device to_normal 1 numcolonne n_elements where findgen smallin 0 smallin 0 lt x 1 numligne n_elements where findgen smallin 1 smallin 1 lt 1 y 1 numdessin numcolonne numligne smallin 0 1 choix du type d action case uval press of 1:BEGIN if top_uvalue smallin 2 NE numdessin then begin tracecadre smallin erase if total smallin EQ smallout EQ 3 then tracecadre smallout out smallin smallin 0:1 numdessin top_uvalue 1 findline top_uvalue smallin smallin tracecadre smallin p extractatt top_uvalue penvs numdessin 1 x extractatt top_uvalue xenvs numdessin 1 y extractatt top_uvalue yenvs numdessin 1 END 2:BEGIN if top_uvalue smallout 2 NE numdessin then begin tracecadre smallout erase if total smallin EQ smallout EQ 3 then tracecadre smallin smallout smallin 0:1 numdessin top_uvalue 1 findline top_uvalue smallout smallout tracecadre smallout out endif END 4:BEGIN tracecadre smallin 0:1 numdessin fill inserthistory event top beginning of strtrim numdessin 2 end of strtrim numdessin 2 remise a 0 des attributs de la uvalue concernant ce dessin: numdessin numdessin 1 top_uvalue 1 findline top_uvalue varinfo numdessin top_uvalue 1 findline top_uvalue dates numdessin 0l 0l top_uvalue 1 findline top_uvalue nameprocedures numdessin top_uvalue 1 findline top_uvalue types numdessin top_uvalue 1 findline top_uvalue domaines numdessin fltarr 6 top_uvalue 1 findline top_uvalue txtcmd numdessin if numdessin EQ smallin 2 then tracecadre smallin if numdessin EQ smallout 2 then tracecadre smallout out END ELSE: endcase updatewidget event top return end"); 354 a[352] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/extractatt.html", "extractatt.pro", "", "FUNCTION extractatt top_uvalue name taille size top_uvalue j 1 repeat BEGIN j j 1 if j EQ size top_uvalue 2 then return 1 endrep until top_uvalue 0 j EQ name return top_uvalue 1 j end"); 355 a[353] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/findline.html", "findline.pro", "", "FUNCTION findline top_uvalue name taille size top_uvalue j 1 repeat BEGIN j j 1 if j EQ size top_uvalue 2 then return 1 endrep until top_uvalue 0 j EQ name return j end"); 356 a[354] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/identifyclick.html", "identifyclick.pro", "", "FUNCTION identifyclick event widget_control event id get_uvalue uval no_copy thisEvent TAG_NAMES event Structure if thisEvent EQ WIDGET_TIMER then press 0 ELSE press event press d 0 1 t 1 0 d 2 0 long click d 1 0 t 2 0 click normal d 2 1 d 3 0 t 0 0 double click t 3 0 d 0 0 double click type inutile case 1 OF d 0 0 1er remonte thisEvent EQ WIDGET_DRAW AND uval click EQ 0 AND press EQ 0: d 0 1 1er appuie de la serie thisEvent EQ WIDGET_DRAW AND uval click EQ 0 AND press ge 1:BEGIN uval x event x 0 uval y event y 0 uval press press uval click 1 widget_control event id timer 3 END d 1 0 1er remonte thisEvent EQ WIDGET_DRAW AND uval click EQ 1 AND press EQ 0:uval click 2 d 2 0 fin long click thisEvent EQ WIDGET_DRAW AND uval click EQ 2 AND press EQ 0:BEGIN type long uval x uval x 0 event x uval x uval x sort uval x uval y uval y 0 event y uval y uval y sort uval y uval click 0 uval press event release END d 2 1 thisEvent EQ WIDGET_DRAW AND uval click EQ 2 AND press ge 1:BEGIN type double uval press press uval click 3 END d 3 0 remonte et fin de double click thisEvent EQ WIDGET_DRAW AND uval click EQ 3 AND press EQ 0:uval click 0 t 0 0 fin de double click thisEvent EQ WIDGET_TIMER AND uval click EQ 0 AND press EQ 0: t 1 0 long click thisEvent EQ WIDGET_TIMER AND uval click EQ 1 AND press EQ 0:uval click 2 t 2 0 click normal thisEvent EQ WIDGET_TIMER AND uval click EQ 2 AND press EQ 0:BEGIN type single press uval press uval click 0 END t 3 0 fin de double click thisEvent EQ WIDGET_TIMER AND uval click EQ 3 AND press EQ 0:uval click 0 cas normalement impossible: ELSE:BEGIN print thisEvent uval click press print Probleme cas normalement impossible END endcase widget_control event id set_uvalue uval no_copy return type:type end"); 357 a[355] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/inserthistory.html", "inserthistory.pro", "", "PRO inserthistory base text line1 line2 widget_control base get_uvalue top_uvalue globalcommand extractatt top_uvalue globalcommand top_uvalue 1 findline top_uvalue globaloldcommand globalcommand for i 0 n_elements globalcommand 1 do print globalcommand i we insert text between line1 and line2 index1 where globalcommand EQ line1 index1 index1 0 1 if index1 EQ 1 then begin rien report line1 n est pas trouve ds globalcommand return endif index2 where globalcommand EQ line2 index2 index2 0 if index2 EQ 1 then begin rien report line2 n est pas trouve ds globalcommand return ENDIF the new text: globalcommand globalcommand 0:index1 text globalcommand index2:n_elements globalcommand 1 the new globalcommand top_uvalue 1 findline top_uvalue globalcommand globalcommand return end"); 358 a[356] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/letsdraw.html", "letsdraw.pro", "", " NAME:widgetdessine PURPOSE: c est la procedure qui lance le dessin Si on ne le lui donne pas de commande elle appelle construitcommande pour savoir quoi tracer CATEGORY: CALLING SEQUENCE:widgetdessine base INPUTS:base: l id du widget ou appliquer le dessin KEYWORD PARAMETERS: COMMANDE: un string du style: read_data sst OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO letsdraw base COMMANDE commande _extra ex common on recupere la uvalue de base widget_control base get_uvalue top_uvalue print help top_uvalue struct help top_uvalue exextra struct if NOT keyword_set commande then commande buildcmd base _extra ex if commande 0 EQ then return on recupere la uvalue de base widget_control base hourglass widget_control base get_uvalue top_uvalue print help top_uvalue struct print help top_uvalue exextra struct help top_uvalue extra struct print print commande help mixstru top_uvalue exextra top_uvalue extra struct on recuperel id de la fenetre graphique associee au widget d id base graphid extractatt top_uvalue graphid widget_control graphid get_value win on la selectionne c est a elle que sera passe toutes les commandes concernant une fenetre wset win erase 255 on netoie la fenetre on s assure que si on travaille avec un ecran codant les couleurs sur 24 bits la couleur de fond specifiee p background est bien appliquee if d n_colors gt 256 then begin device decomposed 1 p background ffffff x plot 0 0 device decomposed 0 ENDIF smallout long extractatt top_uvalue smallout numdessinout smallout 2 1 tracecadre smallout fill options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait strtrim optionsflag where options EQ Portrait Landscape 0 1 0 createpro common noerase 1 key_portrait portrait Commande filename myuniquetmpdir xxx_oneplot pro inserthistory base Commande beginning of strtrim smallout 2 1 end of strtrim smallout 2 1 top_uvalue 1 findline top_uvalue penvs numdessinout p top_uvalue 1 findline top_uvalue xenvs numdessinout x top_uvalue 1 findline top_uvalue yenvs numdessinout y return end"); 359 a[357] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/loadgrid.html", "loadgrid.pro", "", "PRO loadgrid meshfilein _extra ex cm_4mesh ccmeshparameters filename meshfilein split the name according to delimiter meshfile strsplit meshfilein extract meshfile strtrim meshfile 2 try to find a pro file with this name filepro find meshfile 0 firstfound onlypro 0 if this is an idl batch file or a procedure if filepro NE NOT FOUND THEN BEGIN CASE protype filepro OF this is a procedure proc :listing file_basename filepro pro this is a function this case is not coded func :stop this is an IDL batch file batch :listing file_basename filepro pro ENDCASE ENDIF ELSE BEGIN filenc find meshfile 0 firstfound onlync 0 if filenc EQ NOT FOUND THEN stop listing initncdf filenc ENDELSE add the arguments and keywords if necessary IF n_elements meshfile GT 1 AND strmid listing 0 1 NE THEN BEGIN FOR i 1 filepro NE NOT FOUND n_elements meshfile 1 DO listing listing meshfile i ENDIF IF strmid listing 0 1 NE THEN listing listing strcalling meshfilein _extra ex createpro listing filename myuniquetmpdir for_createpro pro _extra ex return END "); 360 a[358] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/longclickaction.html", "longclickaction.pro", "", "PRO longclickaction event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue quel est le dessin selectionne smallout extractatt top_uvalue smallout smallin extractatt top_uvalue smallin small smallin x convert_coord uval x 0 uval y 0 device to_normal 0 y convert_coord uval x 0 uval y 0 device to_normal 1 numcolonne n_elements where findgen small 0 small 0 lt x 1 numligne n_elements where findgen small 1 small 1 lt 1 y 1 numdessin numcolonne numligne small 0 we put on numdessin as the leader plot tracecadre smallin erase if total smallin EQ smallout EQ 3 then tracecadre smallout out smallin smallin 0:1 numdessin 1 top_uvalue 1 findline top_uvalue smallin smallin tracecadre smallin p extractatt top_uvalue penvs numdessin x extractatt top_uvalue xenvs numdessin y extractatt top_uvalue yenvs numdessin Change the domain box: coor convert_coord uval x uval y device to_data x coor 0 0 coor 0 1 y coor 1 0 coor 1 1 domainid widget_info event top find_by_uname domain boxzoom x y faut il passer la boxzoom en indexes currentplot extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags currentplot changex flags where options EQ Longitude x index 0 EQ 1 changey flags where options EQ Latitude y index 0 EQ 1 if changex OR changey then begin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar domdef boxzoom gridtype vargrid grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz if changex then boxzoom 0:1 firstx lastx if changey then boxzoom 2:3 firsty lasty endif widget_control domainid set_value boxzoom actionid widget_info event top find_by_uname action type widget_info actionid combobox_gettext case uval press of 1:BEGIN nodates type EQ xt OR type EQ yt OR type EQ zt OR type EQ t updatewidget event top noboxzoom nodates nodates notype type NE plt letsdraw event top END 2:BEGIN IF type EQ plt THEN BEGIN top_uvalue 1 findline top_uvalue types smallout 2 1 pltz forcetype pltz ENDIF updatewidget event top noboxzoom letsdraw event top END 4:BEGIN IF type EQ plt THEN BEGIN top_uvalue 1 findline top_uvalue types smallout 2 1 pltt forcetype pltt ENDIF updatewidget event top noboxzoom nodates letsdraw event top forcetype forcetype END endcase return end"); 361 a[359] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/read_vermair.html", "read_vermair.pro", "", "FUNCTION read_vermair name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex common if name EQ un then name vozocrtx if name EQ vn then name vomecrty if debut EQ fin then begin res lec name debut nomexp BOXZOOM boxzoom _EXTRA ex ENDIF ELSE res lect name debut fin nomexp BOXZOOM boxzoom _EXTRA ex return tab:res grille:vargrid unite: experience:varexp nom:varname end"); 362 a[360] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/scanfile.html", "scanfile.pro", "", " liste des presupposes: 1 le fichier a lire est un fichier netcdf 2 le nom de ce fichier finit par U nc V nc W nc T nc ou F nc la lettre avant le nc designant la grille a laquelle se rapporte la champ Si tel n est pas la cas le fichier est attribue a la grille T 3 ce fichier contient une dimension infinie qui doit etre celle qui se rapporte au temps et au mois 2 autres dimensions dont les noms sont x lon xi_ et y lat ou eta_ ou bien en majuscule 4 il doit exiter ds ce fichier une unique variable n ayant qu une dimension et etant la dimension temporelle cette variable sera prise comme axe des temps Rq: si plusieurs variables verifient ces criteres on considere la premiere variable 5 Cette variable axe des temps doit contenir l attribut units qui doit etre ecrit suivant la syntaxe: seconds since 0001 01 01 00:00:00 hours since 0001 01 01 00:00:00 days since 1979 01 01 00:59:59 months since 1979 01 01 00:59:59 years since 1979 01 01 00:59:59 je crois que c est tout GRID UTVWF to specify the type of grid Defaut is 1 based on the name of the file if the file ends by GRID _ TUVFW NC not case sensible or 2 T if case 1 is not found FUNCTION scanfile namefile GRID GRID _extra ex common res 1 filename fullname isafile filename namefile IODIRECTORY iodir _extra ex open file cdfid ncdf_open fullname What contains the file infile ncdf_inquire cdfid find vargrid IF keyword_set grid THEN vargrid strupcase grid ELSE BEGIN vargrid T default definition IF finite glamu 0 EQ 1 THEN BEGIN pattern GRID GRID_ GRID UPID_ 30ID_ gdtype T U V W F fnametest strupcase fullname FOR i 0 n_elements pattern 1 DO BEGIN FOR j 0 n_elements gdtype 1 DO BEGIN substr pattern i gdtype j pos strpos fnametest substr IF pos NE 1 THEN vargrid strmid fnametest pos strlen substr 1 1 ENDFOR ENDFOR ENDIF ENDELSE name of all dimensions namedim strarr infile ndims for dimiq 0 infile ndims 1 do begin ncdf_diminq cdfid dimiq tmpname value namedim dimiq strlowcase tmpname ENDFOR we are looking for a x dimension dimidx where namedim EQ x OR strmid namedim 0 3 EQ lon OR strmid namedim 0 3 EQ xi_ OR namedim EQ xt_i7_156 dimidx dimidx 0 if dimidx EQ 1 then begin print one of the dimensions must have the name: x or lon or xi_ or xt_i7_156 stop endif we are looking for a y dimension dimidy where namedim EQ y OR strmid namedim 0 3 EQ lat OR strmid namedim 4 EQ eta_ OR namedim EQ yt_j6_75 dimidy dimidy 0 if dimidy EQ 1 then begin print one of the dimensions must have the name: y or lat or eta_ or yt_j6_75 stop endif name of all variables we keep only the variables containing at least x y and time dimension if existing namevar strarr infile nvars for varid 0 infile nvars 1 do begin invar ncdf_varinq cdfid varid what contains the variable if where invar dim EQ dimidx 0 NE 1 AND where invar dim EQ dimidy 0 NE 1 AND where invar dim EQ infile recdim 0 NE 1 OR infile recdim EQ 1 THEN namevar varid invar name ENDFOR namevar namevar where namevar NE listgrid replicate vargrid n_elements namevar time axis date0fk date2jul 19000101 IF infile recdim EQ 1 THEN BEGIN jpt 1 time date0fk fakecal 1 ENDIF ELSE BEGIN ncdf_diminq cdfid infile recdim timedimname jpt we look for the variable containing the time axis we look for the first variable having for only dimension infile recdim varid 0 repeat BEGIN invar ncdf_varinq cdfid varid varid varid 1 endrep until n_elements invar dim EQ 1 AND invar dim 0 EQ infile recdim varid varid 1 CASE 1 OF varid EQ 1:BEGIN dummy report the file fullname has no time axis C we create a fake calendar fakecal 1 time date0fk lindgen jpt END invar natts EQ 0:BEGIN dummy report the variable invar name has no attribut C we create a fake calendar fakecal 1 time date0fk lindgen jpt END ELSE:BEGIN we want to know which attributes are attached to the time variable attnames strarr invar natts for attiq 0 invar natts 1 do attnames attiq ncdf_attname cdfid varid attiq if where attnames EQ units 0 EQ 1 then BEGIN dummy report Attribut units not found for the variable varid name C we create a fake calendar fakecal 1 time date0fk lindgen jpt ENDIF ELSE BEGIN on lit l axe des temps ncdf_varget cdfid varid time time double time ncdf_attget cdfid varid units value time_counter:units seconds since 0001 01 01 00:00:00 time_counter:units hours since 0001 01 01 00:00:00 time_counter:units days since 1979 01 01 00:00:00 time_counter:units months since 1979 01 01 00:00:00 time_counter:units years since 1979 01 01 00:00:00 value strtrim strcompress string value 2 mots str_sep value unite mots 0 debut str_sep mots 2 now we try to find the attribut called calendar the the attribute calendar exists If no we suppose that the calendar is gregorian calendar if where attnames EQ calendar 0 NE 1 then BEGIN ncdf_attget cdfid varid calendar value value string value CASE value OF noleap :key_caltype noleap 360d :key_caltype 360d greg :IF n_elements key_caltype EQ 0 THEN key_caltype greg ELSE:BEGIN notused report Unknown calendar: value we use greg calendar key_caltype greg END ENDCASE ENDIF ELSE BEGIN notused report Unknown calendar we use key_caltype calendar IF n_elements key_caltype EQ 0 THEN key_caltype greg ENDELSE ATTENTION il faut recuperer l attribut calendar et ajuster time en consequense on passe time en jour julien d idl unite strlowcase unite IF strpos unite s strlen unite 1 NE 1 THEN unite strmid unite 0 strlen unite 1 IF strpos unite julian_ NE 1 THEN unite strmid unite 7 case unite of second :time julday debut 1 debut 2 debut 0 time 86400 d hour :time julday debut 1 debut 2 debut 0 time 24 d day :time julday debut 1 debut 2 debut 0 time month :BEGIN if total fix time NE time NE 0 then we switch to days with 30d m time julday debut 1 debut 2 debut 0 round time 30 ELSE for t 0 n_elements time 1 DO time t julday debut 1 time t debut 2 debut 0 END year :BEGIN if total fix time NE time NE 0 then we switch to days with 365d y time julday debut 1 debut 2 debut 0 round time 365 ELSE for t 0 n_elements time 1 do time t julday debut 1 debut 2 debut 0 time t END ENDCASE high frequency calendar: more than one element per day IF max histogram long time time 0 GT 1 THEN fakecal 1 ELSE fakecal 0 date0fk date2jul 19000101 IF keyword_set fakecal THEN time date0fk lindgen jpt ELSE time long time ENDELSE END ENDCASE ENDELSE ncdf_close cdfid return filename:fullname time_counter:time listvar:namevar listgrid:strupcase listgrid caltype:key_caltype fakecal:date0fk fakecal end"); 363 a[361] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/selectfile.html", "selectfile.pro", "", " PRO selectfile_event event common widget_control event id get_uvalue eventuvalue default definition of messenger when selectfile_event is called directly without calling xmanager widget_control event handler get_uvalue messenger messenger 1 IF chkstru eventuvalue name EQ 0 THEN return case eventuvalue name of cancel button Global Cancel :BEGIN widget_control event handler get_uvalue messenger messenger 1 widget_control event handler destroy END data file informations datafilename :BEGIN widget_control event id get_value filename filename isafile filename filename 0 iodir iodir onlync title data file name if size filename type NE 7 then BEGIN widget_control event id set_value return ENDIF widget_control event id set_value filename END browse datafilename :BEGIN filename isafile iodir iodir onlync title data file name if size filename type NE 7 then return widget_control widget_info event handler find_by_uname datafilename set_value filename END switch automatic by and mesh definition buttons gridload :BEGIN IF event select EQ 1 THEN BEGIN widget_control widget_info event handler find_by_uname argtxt set_value widget_control widget_info event handler find_by_uname kwdtxt set_value widget_control widget_info event handler find_by_uname kwd base sensitive 1 CASE event value OF via initnetcdf :BEGIN widget_control widget_info event handler find_by_uname meshload set_value initncdf editable 0 widget_control widget_info event handler find_by_uname arg base sensitive 0 widget_control widget_info event handler find_by_uname kwdlab set_value initncdf keywords: END via perso :BEGIN widget_control widget_info event handler find_by_uname meshload set_value editable 1 widget_control widget_info event handler find_by_uname arg base sensitive 1 widget_control widget_info event handler find_by_uname kwdlab set_value keywords of IDL procedure: END ENDCASE ENDIF END name of the procedure or batch file meshload :BEGIN widget_control event id get_value filename filename find filename 0 onlypro firstfound 0 if filename EQ NOT FOUND then begin widget_control event id set_value return endif CASE protype filename OF this is a procedure proc :BEGIN widget_control widget_info event handler find_by_uname arg base sensitive 1 widget_control widget_info event handler find_by_uname kwd base sensitive 1 widget_control widget_info event handler find_by_uname kwdlab set_value file_basename filename pro keywords: END this is a function this case is not accepted func :BEGIN widget_control event id set_value return END this is an IDL batch file batch :BEGIN widget_control widget_info event handler find_by_uname arg base sensitive 0 widget_control widget_info event handler find_by_uname kwd base sensitive 0 widget_control widget_info event handler find_by_uname kwdlab set_value no keywords: END ENDCASE widget_control widget_info event handler find_by_uname argtxt set_value widget_control widget_info event handler find_by_uname kwdtxt set_value widget_control event id set_value file_basename filename pro END browse meshload :BEGIN filename isafile iodir homedir onlypro title to load the grid file if size filename type NE 7 then return meshload_id widget_info event handler find_by_uname meshload widget_control meshload_id set_value filename selectfile_event ID:meshload_id TOP:event top HANDLER:event handler END Lets Go button Lets Go :BEGIN widget_control widget_info event handler find_by_uname datafilename get_value datafilename datafilename datafilename 0 IF datafilename EQ THEN return datafilename isafile filename datafilename iodir iodir onlync title data file name if size datafilename type NE 7 then BEGIN widget_control widget_info event handler find_by_uname datafilename set_value return ENDIF widget_control widget_info event handler find_by_uname gridload get_value gridload widget_control widget_info event handler find_by_uname argtxt get_value argtxt argtxt strtrim argtxt 0 2 IF strpos argtxt EQ 0 THEN argtxt strmid argtxt 1 widget_control widget_info event handler find_by_uname kwdtxt get_value kwdtxt kwdtxt strtrim kwdtxt 0 2 IF strpos kwdtxt EQ 0 THEN kwdtxt strmid kwdtxt 1 CASE gridload 0 OF via perso :BEGIN meshload_id widget_info event handler find_by_uname meshload widget_control meshload_id get_value meshload meshload meshload 0 IF meshload EQ THEN return meshload find meshload 0 onlypro firstfound 0 if meshload EQ NOT FOUND then begin widget_control meshload_id set_value return endif END via initnetcdf :meshload datafilename ENDCASE IF strlen argtxt NE 0 THEN meshload meshload argtxt IF strlen kwdtxt NE 0 THEN meshload meshload kwdtxt widget_control event handler get_uvalue messenger messenger create_struct datafilename datafilename meshload meshload widget_control event handler destroy END endcase return end FUNCTION selectfile datafilename idlfile argspro _extra ex common pour recuperer les reponses possees lors de l utilisation de ce widget on cree un pointeur que l on place dans la uvalue Comme ca une fois que le widget est detruit dans la procedure event pro la variable surlaquelle pointait le pointeur contenue ds la uvalue du widget n est pas detruite est on peut recuperer le resultat messenger ptr_new allocate_heap base widget_base column title selectfile align_center uvalue messenger _EXTRA ex cancel button dummyid widget_button base value Cancel uvalue name: Global Cancel data file informations basea widget_base base row align_center dummyid widget_label basea value Data file name: database widget_text basea value uvalue name: datafilename uname datafilename xsize 45 EDITABLE dummyid widget_button basea value Browse uvalue name: browse datafilename switch automatic by and mesh definition buttons baseb widget_base base row align_center gdldid cw_bgroup baseb automatic grid construction with initncdf pro grid construction with other IDL batch or procedure exclusive set_value 0 uvalue name: gridload uname gridload button_uvalue via initnetcdf via perso name of the procedure or batch file basec widget_base base row align_center uname pro base dummyid widget_label basec value IDL batch file of procedure basemeshload widget_text basec value initncdf uvalue name: meshload uname meshload xsize 45 editable 0 dummyid widget_button basec value Browse uvalue name: browse meshload arguments informations based widget_base base row align_center uname arg base sensitive 0 dummyid widget_label based value procedure arguments agrbase widget_text based value uvalue name: argtxt uname argtxt xsize 45 EDITABLE keyword informations basee widget_base base row align_center uname kwd base dummyid widget_label basee uname kwdlab value keywords of initncdf: dummyid widget_text basee value uvalue name: kwdtxt uname kwdtxt xsize 45 EDITABLE Lets Go button basego widget_button base value Lets Go uvalue name: Lets Go IF n_elements datafilename NE 0 THEN BEGIN widget_control database set_value datafilename selectfile_event ID:database TOP:base HANDLER:base ENDIF IF n_elements idlfile NE 0 THEN BEGIN widget_control basemeshload set_value idlfile selectfile_event ID:basemeshload TOP:base HANDLER:base widget_control basemeshload get_value idlfile2 IF idlfile2 0 NE THEN widget_control gdldid set_value 1 ENDIF IF n_elements argspro NE 0 THEN widget_control argbase set_value argspro IF n_elements datafilename EQ 0 THEN BEGIN widget_control base realize xmanager selectfile base event_handler selectfile_event no_block 0 ENDIF ELSE selectfile_event ID:basego TOP:base HANDLER:base get back the information from selectfile_event res messenger ptr_free messenger if size res type NE 8 then return 1 loadgrid res meshload _extra ex ccreadparameters funclec_name: read_ncdf jpidta:jpidta jpjdta:jpjdta jpkdta:jpkdta ixmindta:ixmindta ixmaxdta:ixmaxdta iymindta:iymindta iymaxdta:iymaxdta izmindta:izmindta izmaxdta:izmaxdta res3 scanfile res datafilename iodir iodir _extra ex if size res3 type NE 8 then return 1 return fileparameters:res3 readparameters:ccreadparameters meshparameters:ccmeshparameters end"); 364 a[362] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/singleclickaction.html", "singleclickaction.pro", "", "PRO singleclickaction event cm_4mesh cm_4data return widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue actionid widget_info event top find_by_uname action type widget_info actionid combobox_gettext IF type NE plt THEN return on active la bonne fenetre widget_control event id get_value win wset win choix du type d action case uval press of 1:BEGIN coor convert_coord uval x 0 uval y 0 device to_data x coor 0 y coor 1 help x y oldgrid vargrid CASE strupcase vargrid OF T :vargrid F W :vargrid F U :vargrid V V :vargrid U F :vargrid T ENDCASE grille 1 glam gphi 1 nx ny nz firstx firsty firstz lastx lasty lastz vargrid oldgrid define the corner of the cells in the clockwise direction IF keyword_set key_periodic AND nx EQ jpi THEN BEGIN x1 glam 0:ny 2 y1 gphi 0:ny 2 x2 glam 1:ny 1 y2 gphi 1:ny 1 x3 shift glam 1:ny 1 1 0 y3 shift gphi 1:ny 1 1 0 x4 shift glam 0:ny 2 1 0 y4 shift gphi 0:ny 2 1 0 ENDIF ELSE BEGIN x1 glam 0:nx 2 0:ny 2 y1 gphi 0:nx 2 0:ny 2 x2 glam 0:nx 2 1:ny 1 y2 gphi 0:nx 2 1:ny 1 x3 glam 1:nx 1 1:ny 1 y3 gphi 1:nx 1 1:ny 1 x4 glam 1:nx 1 0:ny 2 y4 gphi 1:nx 1 0:ny 2 ENDELSE glam 1 free memory gphi 1 free memory What is the longitude WHILE x GT x range 1 DO x x 360 WHILE x LT x range 0 DO x x 360 IF x GT x range 1 THEN RETURN IF y GT y range 1 THEN RETURN IF y LT y range 0 THEN RETURN cell inquad x y x1 y1 x2 y2 x3 y3 x4 y4 onsphere key_onearth x1 1 free memory y1 1 free memory x2 1 free memory y2 1 free memory x3 1 free memory y3 1 free memory x4 1 free memory y4 1 free memory IF cell 0 EQ 1 OR n_elements cell GT 1 THEN RETURN yy cell 0 nx 1 key_periodic nx EQ jpi xx cell 0 MOD nx 1 key_periodic nx EQ jpi CASE strupcase vargrid OF T :BEGIN xx xx firstx 1 yy yy firsty 1 END W :BEGIN xx xx firstx 1 yy yy firsty 1 END U :BEGIN xx xx firstx yy yy firsty 1 END V :BEGIN xx xx firstx 1 yy yy firsty END F :BEGIN xx xx firstx yy yy firsty END ENDCASE bad where xx GE jpi IF bad 0 NE 1 THEN BEGIN xx bad xx bad jpi yy bad yy bad 1 ENDIF bad where yy GE jpj IF bad 0 NE 1 THEN stop print glamt xx yy gphit xx yy cmd buildcmd event top boxzoom boxzoom END ELSE: endcase RETURN end"); 365 a[363] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/tracecadre.html", "tracecadre.pro", "", "PRO tracecadre small out out erase erase fill fill determination de la colonne et de la ligne correspondant au small en entree numdessin small 2 1 numligne numdessin small 0 numcolonne numdessin numligne small 0 determination de poscadre largeurcolonne 1 small 0 largeurligne 1 small 1 cadre numcolonne largeurcolonne 1 numligne 1 largeurligne numcolonne 1 largeurcolonne 1 numligne largeurligne decale 0 001 cadre cadre decale decale decale decale reinitplt p position 0 0 1 1 IF keyword_set fill then begin polyfill cadre 0 cadre 2 cadre 2 cadre 0 cadre 0 cadre 1 cadre 1 cadre 3 cadre 3 cadre 1 color 255 normal ENDIF ELSE BEGIN plot cadre 0 cadre 2 cadre 2 cadre 0 cadre 0 cadre 1 cadre 1 cadre 3 cadre 3 cadre 1 xrange 0 1 yrange 0 1 linestyle 2 keyword_set out noerase normal thick 2 color 0 255 keyword_set erase ENDELSE return end"); 366 a[364] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/updatewidget.html", "updatewidget.pro", "", "PRO updatewidget base NOBOXZOOM noboxzoom NODATES nodates NOTYPE notype widget_control base get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 widget_control base update 0 date1 et date2 if keyword_set nodates then begin date1 0 date2 0 ENDIF ELSE BEGIN dates extractatt top_uvalue dates numdessinin date1 dates 0 date2 dates 1 ENDELSE domain boxzoom extractatt top_uvalue domaines numdessinin if total boxzoom EQ 0 then boxzoom 1 if keyword_set noboxzoom then boxzoom 0 varinfo: filename namevar varinfo extractatt top_uvalue varinfo numdessinin filename varinfo 0 nomvar varinfo 1 if filename NE OR nomvar NE THEN BEGIN changefile base filename fieldname nomvar BOXZOOM boxzoom DATE1 date1 DATE2 date2 ENDIF ELSE BEGIN if date1 NE 0 then begin date1id widget_info base find_by_uname calendar1 widget_control date1id set_value date1 endif if date2 NE 0 then begin date2id widget_info base find_by_uname calendar2 widget_control date2id set_value date2 endif if keyword_set boxzoom then BEGIN domainid widget_info base find_by_uname domain widget_control domainid set_value boxzoom endif ENDELSE exextra if n_elements extractatt top_uvalue exextra numdessinin NE 0 then begin exextra extractatt top_uvalue exextra numdessinin specifieid widget_info base find_by_uname specifie widget_control specifieid set_value exextra endif text command txtcmd extractatt top_uvalue txtcmd numdessinin if txtcmd NE then begin txtcmdid widget_info base find_by_uname txtcmd widget_control txtcmdid set_value txtcmd endif graphtype if NOT keyword_set notype then BEGIN graphtype extractatt top_uvalue types numdessinin if graphtype NE then begin actionid widget_info base find_by_uname action widget_control actionid get_value action_value widget_control actionid set_combobox_select where action_value EQ graphtype 0 endif endif widget_control base update 1 return end"); 367 a[365] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/xcreateanim.html", "xcreateanim.pro", "", "pro xcreateanim_event event common on recupere les aguments contenus ds le widget if tag_names event structure_name NE WIDGET_BUTTON then return widget_control event id get_uvalue uval if n_elements uval EQ 0 then return if uval EQ cancel then begin widget_control event top destroy return ENDIF on va ecrire l animation widget_control event top get_uvalue local_uvalue widget_control local_uvalue parent get_uvalue top_uvalue calendar extractatt top_uvalue fileparameters local_uvalue indexfile time_counter key_caltype extractatt top_uvalue fileparameters local_uvalue indexfile caltype fakecal extractatt top_uvalue fileparameters local_uvalue indexfile fakecal widget_control widget_info event top find_by_uname Filename get_value nomfic nomfic nomfic 0 widget_control widget_info event top find_by_uname directorie get_value animdir animdir animdir 0 widget_control widget_info event top find_by_uname debut get_value vdate1 index1 where calendar eq date2jul vdate1 index1 index1 0 if index1 EQ 1 then return widget_control widget_info event handler find_by_uname fin get_value vdate2 index2 where calendar eq date2jul vdate2 index2 index2 0 if index2 EQ 1 OR index2 LE index1 then return on detruit le widget avant de creer le fichier ps widget_control event top destroy creation de la routine qui nous serviera pour faire le dessin on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript DATE1IN date1in DATE2IN date2in creation du fichier recupere le nombre d octets surlequel on code la palette device get_visual_depth depth taille de l image en nombre de pixel: xsize d x_size ysize d y_size on verifie que le nom du fichier termine bien par gif if strpos nomfic gif EQ 1 then nomfic nomfic gif current_window d window window free pixmap xsize xsize ysize ysize indication du numero de l image que l on est en train de creer base widget_base sliderid widget_slider base minimum 1 maximum index2 index1 1 value 1 title image number: widget_control base realize commencement du fichier gif ecriture d une image vide IF keyword_set fakecal THEN date index1 ELSE date jul2date calendar index1 xxx2ps noerase date1in date date2in date image tvrd true depth GT 8 If an 8 bit image was read reduce the number of colors if depth le 8 then begin tvlct red green blue get reduce_colors image index red red index green green index blue blue index endif if depth gt 8 then Convert 24 bit image to 8 bit image color_quan image 1 red green blue colors 256 get_translation translation map_all write_gif animdir nomfic image red green blue multiple wdelete d window boucle de creation et d ecriture ds le fichier IF index2 GT index1 THEN BEGIN FOR ind index1 1 index2 do BEGIN widget_control sliderid set_value ind index1 1 on bouge le slider window free pixmap xsize xsize ysize ysize IF keyword_set fakecal THEN date ind ELSE date jul2date calendar ind xxx2ps noerase date1 date date2 date image tvrd true depth GT 8 if depth gt 8 then image color_quan image 1 aaa bbb ccc colors 256 translation translation write_gif animdir nomfic image red green blue multiple wdelete d window ENDFOR ENDIF on met une derniere image blanche window free pixmap xsize xsize ysize ysize reinitplt plot 0 0 nodata image tvrd true depth GT 8 if depth gt 8 then image color_quan image 1 aaa bbb ccc colors 256 translation translation write_gif animdir nomfic image red green blue multiple wdelete d window fermeture du fichier write_gif animdir nomfic close widget_control base destroy rebascule en mode normal thisOS strupcase strmid version os_family 0 3 wset current_window si on est sous x on essaie de lancer xanim if thisOS NE MAC AND thisOS NE WIN then begin spawn which xanim result if strpos result 0 xanim EQ strlen result 0 5 then spawn xanim animdir nomfic endif return end PRO xcreateanim parent common widget_control parent get_uvalue top_uvalue on va s assurer que toutes les procedures de sont pas pltt procedures extractatt top_uvalue nameprocedures if total procedures EQ pltt NE 0 then begin nothing report Certains des plots ont un axe se rapportant au temps C Animation impossible error return ENDIF on va s assurer que toutes les figures ont le meme calendrier filelist extractatt top_uvalue filelist filenames extractatt top_uvalue varinfo 0 filenames reform filenames filenames filenames uniq filenames sort filenames if strtrim filenames 0 1 EQ then filenames filenames 1:n_elements filenames 1 indexfile where filelist EQ filenames 0 0 calendar extractatt top_uvalue fileparameters indexfile time_counter key_caltype extractatt top_uvalue fileparameters indexfile caltype fakecal extractatt top_uvalue fileparameters indexfile fakecal if n_elements filenames GT 1 then begin for i 1 n_elements filenames 1 do begin indexfilebis where filelist EQ filenames i 0 calendarbis extractatt top_uvalue fileparameters indexfilebis time_counter if n_elements calendarbis NE n_elements calendar then begin nothing report Les diffrents plots n utilisent pas le meme calendrier C Animation impossible error return ENDIF if total calendar NE calendarbis NE 0 then begin nothing report Les diffrents plots n utilisent pas le meme calendrier C Animation impossible error return endif endfor endif c est possible de faire une animation base widget_base column title animation creation uvalue parent:parent indexfile:indexfile rien widget_label base value animation name rien widget_text base value anim_idl gif uname Filename editable rien widget_label base value animation directory if n_elements animdir EQ 0 then cd current animdir rien widget_text base value animdir uname directorie editable rien widget_label base value starting date rien cw_calendar base calendar calendar 0 FAKECAL fakecal uname debut uvalue name: calendar frame rien widget_label base value ending date rien cw_calendar base calendar calendar n_elements calendar 1 FAKECAL fakecal uname fin uvalue name: calendar frame rien widget_button base value OK uvalue ok rien widget_button base value Cancel uvalue cancel widget_control base realize xmanager xcreateanim base no_block return end"); 368 a[366] = new Array("./ToBeReviewed/WIDGET/AUTOUR_de_XXX/xxxmenubar_event.html", "xxxmenubar_event.pro", "", " PRO xxxmenubar_event event common case event value of Open :begin oldmeshparams ccmeshparameters newfile selectfile if size newfile type NE 8 then return widget_control event top hourglass widget_control event top update 0 widget_control event top get_uvalue top_uvalue on s occupe de filelist filelist extractatt top_uvalue filelist filelist filelist newfile fileparameters filename currentfile n_elements filelist 1 on update le widget filelistid widget_info event top find_by_uname filelist widget_control filelistid combobox_additem file_basename newfile fileparameters filename widget_control filelistid set_combobox_select currentfile on update les elements filelist et currentfile de la top_uvalue top_uvalue 1 findline top_uvalue filelist filelist oldfile top_uvalue 1 findline top_uvalue currentfile top_uvalue 1 findline top_uvalue currentfile currentfile on s occupe du nom de la variable vlstid widget_info event top find_by_uname varlist quel etait le champ selectionne on le reselectionne fieldname widget_info vlstid combobox_gettext index where newfile fileparameters listvar EQ fieldname widget_control vlstid set_value newfile fileparameters listvar widget_control vlstid set_combobox_select 0 index 0 on s occupe du calendrier key_caltype newfile fileparameters caltype date1id widget_info event top find_by_uname calendar1 widget_control date1id get_value date1 widget_control date1id destroy jdate1 jul2date date1 if where newfile fileparameters time_counter EQ jdate1 0 EQ 1 then jdate1 newfile fileparameters time_counter 0 date2id widget_info event top find_by_uname calendar2 widget_control date2id get_value date2 widget_control date2id destroy jdate2 jul2date date2 if where newfile fileparameters time_counter EQ jdate2 0 EQ 1 then jdate2 jdate1 basecal widget_info event top find_by_uname basecal fakecal newfile fileparameters fakecal rien cw_calendar basecal newfile fileparameters time_counter jdate1 uname calendar1 FAKECAL fakecal uvalue name: calendar1 frame rien cw_calendar basecal newfile fileparameters time_counter jdate2 uname calendar2 FAKECAL fakecal uvalue name: calendar2 frame on update les elements fileparameters readparameters et meshparameters de la top_uvalue newfileparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newfileparameters i extractatt top_uvalue fileparameters i newfileparameters currentfile newfile fileparameters ptr_free extractatt top_uvalue fileparameters top_uvalue 1 findline top_uvalue fileparameters newfileparameters newreadparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newreadparameters i extractatt top_uvalue readparameters i newreadparameters currentfile newfile readparameters ptr_free extractatt top_uvalue readparameters top_uvalue 1 findline top_uvalue readparameters newreadparameters newmeshparameters ptrarr currentfile 1 allocate_heap FOR i 0 currentfile 1 DO newmeshparameters i extractatt top_uvalue meshparameters i newmeshparameters currentfile newfile meshparameters ptr_free extractatt top_uvalue meshparameters top_uvalue 1 findline top_uvalue meshparameters newmeshparameters on actualise le widget if cmpgrid oldmeshparams then BEGIN domainid widget_info event top find_by_uname domain widget_control domainid set_value 1 endif widget_control event top update 1 end New xxx :BEGIN widget_control event top get_uvalue top_uvalue extra extractatt top_uvalue extra xxx CALLERWIDID event top _extra extra end Quit :begin widget_control event top get_uvalue top_uvalue ptr_free extractatt top_uvalue exextra ptr_free extractatt top_uvalue fileparameters ptr_free extractatt top_uvalue readparameters ptr_free extractatt top_uvalue meshparameters ptr_free top_uvalue widget_control event top destroy on ferme le widget end PostScript :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as postscript in demo mode return ENDIF widget_control event top get_uvalue top_uvalue on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand for i 0 n_elements globalcommand 1 do print globalcommand i on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape DATE1IN date1in DATE2IN date2in POSTSCRIPT END Animated gif :begin IF float strmid version release 0 3 GE 6 2 THEN xcreateanim event top end Gif :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as an image in demo mode return ENDIF widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 tracecadre smallin erase tracecadre smallout erase filename xquestion dans quelle fichier gif voulez vous sauver C l ecran de xxx xxx_image gif if rstrpos filename gif NE strlen filename 4 then filename filename gif filename isafile file filename io imagedir new saveimage filename quiet end IDL procedure :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save as a idl program file in demo mode return ENDIF on recupere le nom du fichier filename xquestion dans quelle procedure IDL voulez vous sauver C la realisation de ce graph xxx_figure pro on le complete par un pro if rstrpos filename pro NE strlen filename 4 then filename filename pro filename isafile file filename io homedir new widget_control event top get_uvalue top_uvalue portrait ou landscape options extractatt top_uvalue options optionsflag extractatt top_uvalue optionsflag portrait optionsflag where options EQ Portrait Landscape 0 0 on lit les commandes pour faire un plot globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme thisOS strupcase strmid version os_family 0 3 CASE thisOS of MAC :sep : WIN :sep ELSE:sep ENDCASE poslastsep rstrpos filename sep proname strmid filename poslastsep 1 strlen filename poslastsep 1 4 globalcommand pro proname NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape DATE1IN date1in DATE2IN date2in _extra ex globalcommand return end on les ecrit dans un programme putfile filename globalcommand END RESTORE kwd of xxx :BEGIN IF lmgr demo EQ 1 THEN BEGIN dummy report impossible to save the widget in demo mode return ENDIF on recupere le nom du fichier filename xquestion dans quel fichier bianire voulez vous sauver le widget xxx_widget dat on le complete par un dat if rstrpos filename dat NE strlen filename 4 then filename filename dat filename isafile file filename io homedir new widget_control event top get_uvalue uvalue widget_control extractatt uvalue graphid get_value win wshow win wset win image tvrd true save uvalue image filename filename END Print to prompt :BEGIN commande getfile myuniquetmpdir xxx_oneplot pro for i 0 n_elements commande 1 do print commande i end Portrait Landscape :begin widget_control event top get_uvalue top_uvalue options extractatt top_uvalue options index where options EQ Portrait Landscape index index 0 optionsflag extractatt top_uvalue optionsflag key_portrait 1 optionsflag index 0 top_uvalue 1 findline top_uvalue optionsflag index key_portrait fenetre separee ou fenetre collee au widget if widget_info event top find_by_uname graph EQ 0 then BEGIN on tue la fenetre graphid extractatt top_uvalue graphid widget_control widget_info graphid parent destroy on la recree basegraph widget_base title xxx window group_leader event top uvalue event top uname basegraph windsize givewindowsize graphid widget_draw basegraph uname graph uvalue name: graph press:0 click:0 x: 0 0 y: 0 0 button_events retain 2 xsize windsize 0 ysize windsize 1 widget_control basegraph realize xmanager xxx basegraph no_block on redessine ce qu il y avait dedans on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape KWDUSED noerase PORTRAIT portrait on reattribue l element graphid de la top_uvalue top_uvalue 1 findline top_uvalue graphid graphid ENDIF ELSE BEGIN extra extractatt top_uvalue extra xxx CALLERWIDID event top redraw _extra extra widget_control event top destroy on ferme le widget ENDELSE end Overlay :begin widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Overlay on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag end Vecteur :BEGIN widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Vecteur on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag end Longitude x index :BEGIN widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Longitude x index on change le flag sur Longitude x index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag maintenant on va changer les sliders definissant la boxzoom domainid widget_info event top find_by_uname domain boxzoom extractatt top_uvalue domaines numdessinin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar if flag EQ 0 then BEGIN longitudes on fait un domdef pour retrouver le lon1 lon2 correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid xindex yindex flags where options EQ Latitude y index numdessinin 0 widget_control domainid set_value lon1 lon2 boxzoom 2:3 ENDIF ELSE BEGIN xindex maintenant ion veut retrouver firstx lastx correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid yindex flags where options EQ Latitude y index numdessinin 0 grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz widget_control domainid set_value firstx lastx boxzoom 2:3 ENDELSE on met a jour la top_uvalue widget_control domainid get_value boxzoom top_uvalue 1 findline top_uvalue domaines numdessinin boxzoom end Latitude y index :begin widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag index where options EQ Latitude y index on change le flag sur Latitude y index flag 1 flags index numdessinin flag flag 0 on le reeatribue top_uvalue 1 findline top_uvalue optionsflag index numdessinin flag maintenant on va changer les sliders definissant la boxzoom domainid widget_info event top find_by_uname domain boxzoom extractatt top_uvalue domaines numdessinin on veut retrouver le type de grille qui est utilisee currentfile extractatt top_uvalue currentfile listgrid extractatt top_uvalue fileparameters currentfile listgrid listvar extractatt top_uvalue fileparameters currentfile listvar vlstid widget_info event top find_by_uname varlist namevar widget_info vlstid combobox_gettext indexvar where listvar EQ namevar vargrid strupcase listgrid indexvar if flag EQ 0 then BEGIN latitudes on fait un domdef pour retrouver le lat1 lat2 correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid yindex xindex flags where options EQ Longitude x index numdessinin 0 widget_control domainid set_value boxzoom 0:1 lat1 lat2 ENDIF ELSE BEGIN yindex maintenant ion veut retrouver firsty lasty correspondant a la boxzoom definie sur le widget domdef boxzoom gridtype vargrid xindex flags where options EQ Longitude x index numdessinin 0 grille 1 1 1 1 nx ny nz firstx firsty firstz lastx lasty lastz widget_control domainid set_value boxzoom 0:1 firsty lasty ENDELSE on met a jour la top_uvalue widget_control domainid get_value boxzoom top_uvalue 1 findline top_uvalue domaines numdessinin boxzoom END endcase return end"); 369 a[367] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_bgroup.html", "cw_bgroup.pro", "", " Id: cw_bgroup pro 69 2006 05 11 10:35:53Z smasson Copyright c 1992 2005 Research Systems Inc All rights reserved Unauthorized reproduction prohibited NAME: CW_BGROUP PURPOSE: CW_BGROUP is a compound widget that simplifies creating a base of buttons It handles the details of creating the proper base standard exclusive or non exclusive and filling in the desired buttons Events for the individual buttons are handled transparently and a CW_BGROUP event returned This event can return any one of the following: The Index of the button within the base The widget ID of the button The name of the button An arbitrary value taken from an array of User values CATEGORY: Compound widgets CALLING SEQUENCE: Widget CW_BGROUP Parent Names To get or set the value of a CW_BGROUP use the GET_VALUE and SET_VALUE keywords to WIDGET_CONTROL The value of a CW_BGROUP is: Type Value normal None exclusive Index of currently set button non exclusive Vector indicating the position of each button 1 set 0 unset INPUTS: Parent: The ID of the parent widget Names: A string array containing one string per button giving the name of each button KEYWORD PARAMETERS: BUTTON_UVALUE: An array of user values to be associated with each button and returned in the event structure COLUMN: Buttons will be arranged in the number of columns specified by this keyword EVENT_FUNCT: The name of an optional user supplied event function for buttons This function is called with the return value structure whenever a button is pressed and follows the conventions for user written event functions EXCLUSIVE: Buttons will be placed in an exclusive base with only one button allowed to be selected at a time FONT: The name of the font to be used for the button titles If this keyword is not specified the default font is used FRAME: Specifies the width of the frame to be drawn around the base IDS: A named variable into which the button IDs will be stored as a longword vector LABEL_LEFT: Creates a text label to the left of the buttons LABEL_TOP: Creates a text label above the buttons MAP: If set the base will be mapped when the widget is realized the default NONEXCLUSIVE: Buttons will be placed in an non exclusive base The buttons will be independent NO_RELEASE: If set button release events will not be returned RETURN_ID: If set the VALUE field of returned events will be the widget ID of the button RETURN_INDEX: If set the VALUE field of returned events will be the zero based index of the button within the base THIS IS THE DEFAULT RETURN_NAME: If set the VALUE field of returned events will be the name of the button within the base ROW: Buttons will be arranged in the number of rows specified by this keyword SCROLL: If set the base will include scroll bars to allow viewing a large base through a smaller viewport SET_VALUE: The initial value of the buttons This is equivalent to the later statement: WIDGET_CONTROL widget set_value value SPACE: The space in pixels to be left around the edges of a row or column major base This keyword is ignored if EXCLUSIVE or NONEXCLUSIVE are specified UVALUE: The user value to be associated with the widget UNAME: The user name to be associated with the widget XOFFSET: The X offset of the widget relative to its parent XPAD: The horizontal space in pixels between children of a row or column major base Ignored if EXCLUSIVE or NONEXCLUSIVE are specified XSIZE: The width of the base X_SCROLL_SIZE: The width of the viewport if SCROLL is specified YOFFSET: The Y offset of the widget relative to its parent YPAD: The vertical space in pixels between children of a row or column major base Ignored if EXCLUSIVE or NONEXCLUSIVE are specified YSIZE: The height of the base Y_SCROLL_SIZE: The height of the viewport if SCROLL is specified OUTPUTS: The ID of the created widget is returned SIDE EFFECTS: This widget generates event structures with the following definition: event ID:0L TOP:0L HANDLER:0L SELECT:0 VALUE:0 The SELECT field is passed through from the button event VALUE is either the INDEX ID NAME or BUTTON_UVALUE of the button depending on how the widget was created RESTRICTIONS: Only buttons with textual names are handled by this widget Bitmaps are not understood MODIFICATION HISTORY: 15 June 1992 AB 7 April 1993 AB Removed state caching 6 Oct 1994 KDB Font keyword is not applied to the label 10 FEB 1995 DJC fixed bad bug in event procedure getting id of stash widget 11 April 1995 AB Removed Motif special cases pro CW_BGROUP_SETV id value compile_opt hidden ON_ERROR 2 return to caller stash WIDGET_INFO id CHILD WIDGET_CONTROL stash GET_UVALUE state NO_COPY case state type of 0: message unable to set plain button group value 1: begin WIDGET_CONTROL SET_BUTTON 0 state ids state excl_pos state excl_pos value WIDGET_CONTROL SET_BUTTON state ids value end 2: begin n n_elements value 1 for i 0 n do begin state nonexcl_curpos i value i WIDGET_CONTROL state ids i SET_BUTTON value i endfor end endcase WIDGET_CONTROL stash SET_UVALUE state NO_COPY end function CW_BGROUP_GETV id value compile_opt hidden ON_ERROR 2 return to caller stash WIDGET_INFO id CHILD WIDGET_CONTROL stash GET_UVALUE state NO_COPY case state type of 0: message unable to get plain button group value 1: ret state excl_pos 1: ret state ret_arr state excl_pos 2: ret state nonexcl_curpos 2: BEGIN index where state nonexcl_curpos NE 0 if index 0 EQ 1 then begin if size state ret_arr type EQ 7 then ret ELSE ret 1 ENDIF ELSE ret state ret_arr index END endcase WIDGET_CONTROL stash SET_UVALUE state NO_COPY return ret end function CW_BGROUP_EVENT ev compile_opt hidden WIDGET_CONTROL ev handler GET_UVALUE stash WIDGET_CONTROL stash GET_UVALUE state NO_COPY WIDGET_CONTROL ev id get_uvalue uvalue ret 1 Assume we return a struct case state type of 0: 1: if ev select eq 1 then begin state excl_pos uvalue ENDIF else begin if state no_release ne 0 then ret 0 ENDELSE 2: begin Keep track of the current state state nonexcl_curpos uvalue ev select if state no_release ne 0 and ev select eq 0 then ret 0 end endcase if ret then begin Return a struct ret ID:state base TOP:ev top HANDLER:0L SELECT:ev select VALUE:state ret_arr uvalue efun state efun WIDGET_CONTROL stash SET_UVALUE state NO_COPY if efun ne then return CALL_FUNCTION efun ret else return ret endif else begin Trash the event WIDGET_CONTROL stash SET_UVALUE state NO_COPY return 0 endelse end function CW_BGROUP parent names BUTTON_UVALUE button_uvalue COLUMN column EVENT_FUNCT efun EXCLUSIVE excl FONT font FRAME frame IDS ids LABEL_TOP label_top LABEL_LEFT label_left MAP map NONEXCLUSIVE nonexcl NO_RELEASE no_release RETURN_ID return_id RETURN_INDEX return_index RETURN_NAME return_name ROW row SCROLL scroll SET_VALUE sval SPACE space TAB_MODE tab_mode UVALUE uvalue XOFFSET xoffset XPAD xpad XSIZE xsize X_SCROLL_SIZE x_scroll_size YOFFSET yoffset YPAD ypad YSIZE ysize Y_SCROLL_SIZE y_scroll_size UNAME uname IF N_PARAMS ne 2 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller Set default values for the keywords version WIDGET_INFO version if version toolkit eq OLIT then def_space_pad 4 else def_space_pad 3 IF N_ELEMENTS column eq 0 then column 0 IF N_ELEMENTS excl eq 0 then excl 0 IF N_ELEMENTS frame eq 0 then frame 0 IF N_ELEMENTS map eq 0 then map 1 IF N_ELEMENTS nonexcl eq 0 then nonexcl 0 IF N_ELEMENTS no_release eq 0 then no_release 0 IF N_ELEMENTS row eq 0 then row 0 IF N_ELEMENTS scroll eq 0 then scroll 0 IF N_ELEMENTS space eq 0 then space def_space_pad IF N_ELEMENTS uname eq 0 then uname CW_BGROUP_UNAME IF N_ELEMENTS uvalue eq 0 then uvalue 0 IF N_ELEMENTS xoffset eq 0 then xoffset 0 IF N_ELEMENTS xpad eq 0 then xpad def_space_pad IF N_ELEMENTS xsize eq 0 then xsize 0 IF N_ELEMENTS x_scroll_size eq 0 then x_scroll_size 0 IF N_ELEMENTS yoffset eq 0 then yoffset 0 IF N_ELEMENTS ypad eq 0 then ypad def_space_pad IF N_ELEMENTS ysize eq 0 then ysize 0 IF N_ELEMENTS y_scroll_size eq 0 then y_scroll_size 0 top_base 0L if n_elements label_top ne 0 then begin next_base WIDGET_BASE parent XOFFSET xoffset YOFFSET yoffset COLUMN if keyword_set font then junk WIDGET_LABEL next_base value label_top font font else junk WIDGET_LABEL next_base value label_top top_base next_base endif else next_base parent if n_elements label_left ne 0 then begin next_base WIDGET_BASE next_base XOFFSET xoffset YOFFSET yoffset ROW if keyword_set font then junk WIDGET_LABEL next_base value label_left font font else junk WIDGET_LABEL next_base value label_left if top_base eq 0L then top_base next_base endif We need some kind of outer base to hold the users UVALUE if top_base eq 0L then begin top_base WIDGET_BASE parent XOFFSET xoffset YOFFSET yoffset next_base top_base endif If top_base EQ next_base THEN next_base WIDGET_BASE top_base Xpad 1 Ypad 1 Space 1 Set top level base attributes WIDGET_CONTROL top_base MAP map FUNC_GET_VALUE CW_BGROUP_GETV PRO_SET_VALUE CW_BGROUP_SETV SET_UVALUE uvalue SET_UNAME uname Tabbing if n_elements tab_mode ne 0 then begin WIDGET_CONTROL top_base TAB_MODE tab_mode WIDGET_CONTROL next_base TAB_MODE tab_mode end The actual button holding base base WIDGET_BASE next_base COLUMN column EXCLUSIVE excl FRAME frame NONEXCLUSIVE nonexcl ROW row SCROLL scroll SPACE space XPAD xpad XSIZE xsize X_SCROLL_SIZE x_scroll_size YPAD ypad YSIZE ysize Y_SCROLL_SIZE y_scroll_size EVENT_FUNC CW_BGROUP_EVENT UVALUE WIDGET_INFO top_base child n n_elements names ids lonarr n for i 0 n 1 do begin if n_elements font eq 0 then begin ids i WIDGET_BUTTON base value names i UVALUE i UNAME uname _BUTTON STRTRIM i 2 endif else begin ids i WIDGET_BUTTON base value names i FONT font UVALUE i UNAME uname _BUTTON STRTRIM i 2 endelse endfor Keep the state info in the real inner base UVALUE Pick an event value type: 0 Return ID 1 Return INDEX 2 Return NAME ret_type 1 if KEYWORD_SET RETURN_ID then ret_type 0 if KEYWORD_SET RETURN_NAME then ret_type 2 if KEYWORD_SET BUTTON_UVALUE then ret_type 3 case ret_type of 0: ret_arr ids 1: ret_arr indgen n 2: ret_arr names 3: ret_arr button_uvalue endcase type 0 if excl ne 0 then type 1 if nonexcl ne 0 then type 2 if n_elements efun le 0 then efun state type:type 0 Standard 1 Exclusive 2 Non exclusive base: top_base cw_bgroup base ret_arr:ret_arr Vector of event values efun : efun Name of event fcn nonexcl_curpos:intarr n If non exclus tracks state excl_pos:0 If exclusive current button ids:ids Ids of buttons no_release:no_release WIDGET_CONTROL WIDGET_INFO top_base CHILD SET_UVALUE state NO_COPY if n_elements sval ne 0 then CW_BGROUP_SETV top_base sval return top_base END"); 370 a[368] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_calendar.html", "cw_calendar.pro", "", " IDL testwid julday 1 1 1980 lindgen 100 5 PRO testwid_event event ComboboxId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy set :BEGIN widget_control event id get_value value widget_control ComboboxId set_value value END get :BEGIN widget_control ComboboxId get_value value help value struct END ELSE: endcase return end PRO testwid calendar date0 _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_calendar base calendar date0 _extra ex uname c est lui uvalue c est lui print cw_calendar ID nothing nothing widget_label base value end of the test nothing widget_text base value string calendar 0 uvalue set editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return END PRO cw_calendar_set_value id value compile_opt strictarr strictarrsubs cm_4cal get back the calendar and its related informations winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid key_caltype infowid caltype high freqeuncy calendar IF keyword_set infowid fakecal THEN BEGIN value2 date2jul long value infowid fakecal IF value2 LT n_elements infowid calendar AND value2 GE 0 THEN BEGIN stepid widget_info id find_by_uname step widget_control stepid set_value combobox_select:value2 infowid date jul2date value2 infowid fakecal widget_control winfo_id set_uvalue infowid ENDIF ENDIF ELSE BEGIN value long value 0 define year month day year value 10000l month value MOD 10000L 100L day value MOD 100L make sure the values correspond to real dates if year EQ 0 then year 1 if month EQ 0 then month 6 if day EQ 0 then day 15 check that the date exists in the calendar if where infowid calendar EQ julday month day year 0 EQ 1 then return update the value of infocal infowid date value widget_control winfo_id set_uvalue infowid update the combobox if needed possiblecase day month year for name 2 0 1 do BEGIN call set_cal_combobox with out 2 to specify that the call is coming from cw_calendar_set_value if widget_info id find_by_uname possiblecase name NE 0 then set_cal_combobox handler:id out:2 possiblecase name value ENDFOR ENDELSE return end FUNCTION cw_calendar_get_value id compile_opt strictarr strictarrsubs winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid return infowid date END FUNCTION get_cal_value id winfoid compile_opt strictarr strictarrsubs winfo_id widget_info id find_by_uname infocal widget_control winfo_id get_uvalue infowid oldate infowid date day wid_id widget_info id find_by_uname day if wid_id NE 0 then BEGIN widget_control wid_id get_value wid_value date long wid_value combobox_gettext ENDIF ELSE date oldate MOD 100L month wid_id widget_info id find_by_uname month if wid_id NE 0 then BEGIN widget_control wid_id get_value wid_value allmonths string format C CMoA 31 indgen 12 month where allmonths EQ wid_value combobox_gettext 0 1 date date 100L long month ENDIF ELSE date date oldate MOD 10000L 100L 100L year wid_id widget_info id find_by_uname year widget_control wid_id get_value wid_value date date 10000L long wid_value combobox_gettext IF arg_present winfoid NE 0 THEN BEGIN winfoid winfo_id infowid date date return infowid ENDIF ELSE return date end redefine the value and index position of the combobox PRO set_cal_combobox event casename date0 compile_opt strictarr strictarrsubs casename: Which widget shall we move: day month or year wid_id widget_info event handler find_by_uname casename we get back the calendar winfo_id widget_info event handler find_by_uname infocal widget_control winfo_id get_uvalue infowid caldat infowid calendar monthcal daycal yearcal and the current date IF n_elements date0 EQ 0 then date0 get_cal_value event handler year0 date0 10000L month0 date0 MOD 10000L 100L day0 date0 MOD 100L index of days months years according to date0 case casename of day :BEGIN list of days corresponding to month0 and year0 index where monthcal EQ month0 AND yearcal EQ year0 current daycal index END month :BEGIN list of months corresponding to year0 index where yearcal EQ year0 current monthcal index keep only the uniq values indexbis uniq current index index indexbis current current indexbis END year :BEGIN keep only the uniq years index uniq yearcal current yearcal index END ENDCASE we update the uvalue of the widget widget_control wid_id set_uvalue name:casename for event out 0 we store the previous position of the combobox to use it as the default position IF event out EQ 0 THEN widget_control wid_id get_value oldselect we redefine the new list if casename EQ month then begin widget_control wid_id set_value string format C CMoA 31 current 1 ENDIF ELSE BEGIN widget_control wid_id set_value strtrim current 1 ENDELSE specify the index position within the new list of values widget_control wid_id get_value combobox CASE event out OF 1: we put to the biggest position 1:selected combobox combobox_number 1 0: same as the previous position is the best choice 0:selected oldselect combobox_index combobox combobox_number 1 1: we put to the smallest position 1:selected 0 2: a new date has been specified 2:BEGIN case casename of day :selected where current EQ day0 0 month :selected where current EQ month0 0 year :selected where current EQ year0 0 ENDCASE END ENDCASE widget_control wid_id set_value combobox_select:selected update the date infowid date get_cal_value event handler widget_control winfo_id set_uvalue infowid return end move cyclicly the calendar to the value 0 if event out 1 or combobox_number 1 if event out 1 PRO move event casename compile_opt strictarr strictarrsubs possiblecase day month year impossiblecase id widget_info event handler find_by_uname casename widget_control id get_value wvalue we try to move but we are already at the beginning end of the combobox wvalue combobox_index EQ wvalue combobox_number 1 and event out EQ 1 wvalue combobox_index EQ 0 and event out EQ 1 move is not called when out eq 0 whichcase where possiblecase EQ casename 0 if wvalue combobox_index EQ wvalue combobox_number 1 event out EQ 1 THEN BEGIN if widget_info event handler find_by_uname possiblecase whichcase 1 EQ 0 then begin it is impossible to move the next combobox widget_control id get_value widvalue we set to widvalue combobox_number 1 when event out EQ 1 and to 0 when event out EQ 1 selected widvalue combobox_number 1 event out EQ 1 widget_control id set_value combobox_select:selected we call move for the next combobox ENDIF ELSE move event possiblecase whichcase 1 it is possible to move from 1 ENDIF ELSE widget_control id set_value combobox_select:wvalue combobox_index event out set_cal_combobox event possiblecase whichcase 1 return end FUNCTION cw_calendar_event event cm_4cal compile_opt strictarr strictarrsubs winfo_id widget_info event handler find_by_uname infocal widget_control winfo_id get_uvalue infowid key_caltype infowid caltype widget_control event id get_uvalue uval high frequency calendar IF uval name EQ step THEN BEGIN infowid date jul2date event index infowid fakecal ENDIF ELSE BEGIN possiblecase day month year impossiblecase whichcase where possiblecase EQ uval name 0 if event out NE 0 then BEGIN we use the button and we want to go out of the combobox: to index 1 event out 1 or to index combobox_number event out 1 we try to move the combobox just right with name: possiblecase whichcase 1 if widget_info event handler find_by_uname possiblecase whichcase 1 EQ 0 then BEGIN this widget do not exist we set cyclicly the current widget to the value 0 if event out 1 or combobox_number 1 if event out 1 widget_control event id get_value widvalue selected widvalue combobox_number 1 event out EQ 1 widget_control event id set_value combobox_select:selected ENDIF ELSE move event possiblecase whichcase 1 ENDIF if we changed month year we need to update the day and month list if uval name NE day then begin event out 0 for name whichcase 1 0 1 do BEGIN if widget_info event handler find_by_uname possiblecase name NE 0 then set_cal_combobox event possiblecase name endfor ENDIF we update the date infowid get_cal_value event handler winfo_id ENDELSE widget_control winfo_id set_uvalue infowid return CW_CALENDAR ID:event handler TOP:event top HANDLER:0L VALUE:infowid date FAKECAL: infowid fakecal end FUNCTION cw_calendar parent calendar jdate0 CALTYPE CALTYPE FAKECAL fakecal UVALUE uvalue UNAME uname _extra ex cm_4cal compile_opt strictarr strictarrsubs if keyword_set caltype then key_caltype caltype months days years found in the calendar caldat calendar monthcal daycal yearcal hourcal mincal scdcal starting date if n_elements jdate0 EQ 0 then jdate0 calendar 0 if where calendar EQ jdate0 0 EQ 1 then jdate0 calendar 0 caldat jdate0 month0 day0 year0 test the type of calendar if n_elements calendar GT 1 then BEGIN each day have the same value if n_elements uniq daycal sort daycal EQ 1 then monthly 1 each month and each day have the same value if keyword_set monthly AND n_elements uniq monthcal sort monthcal EQ 1 then yearly 1 endif if NOT keyword_set uvalue then uvalue dummy: if NOT keyword_set uname then uname base0 widget_base parent ROW EVENT_FUNC cw_calendar_event FUNC_GET_VALUE cw_calendar_get_value PRO_SET_VALUE cw_calendar_set_value UVALUE uvalue UNAME uname space 0 _extra ex if n_elements fakecal eq 0 then fakecal 0 base widget_base base0 space 0 uname infocal uvalue calendar:calendar date:jul2date jdate0 fakecal:fakecal caltype: key_caltype IF keyword_set fakecal THEN BEGIN cmbbid cw_combobox_pm base UVALUE name: step UNAME step value strtrim indgen n_elements calendar 1 widget_control cmbbid set_value combobox_select: where calendar EQ jdate0 0 ENDIF ELSE BEGIN vallen widget_info base string_size m day if NOT keyword_set monthly then begin dayindex where monthcal EQ month0 AND yearcal EQ year0 currentday daycal dayindex currentday strtrim currentday 1 cmbbid cw_combobox_pm base UVALUE name: day UNAME day value currentday widget_control cmbbid set_value combobox_select: where long currentday EQ day0 0 endif month if NOT keyword_set yearly then BEGIN monthindex where yearcal EQ year0 currentmonth long monthcal monthindex we suppress the repeted months monthindexbis uniq currentmonth sort currentmonth monthindex monthindex monthindexbis currentmonth currentmonth monthindexbis xoff 34 2 vallen 0 1 keyword_set monthly cmbbid cw_combobox_pm base UVALUE name: month UNAME month value string format C CMoA 31 currentmonth 1 xoffset xoff widget_control cmbbid set_value combobox_select: where long currentmonth EQ month0 0 endif year yearindex uniq yearcal sort yearcal currentyear strtrim yearcal yearindex 1 xoff 34 2 vallen 0 1 keyword_set monthly 33 3 vallen 0 1 keyword_set yearly cmbbid cw_combobox_pm base UVALUE name: year UNAME year value currentyear xoffset xoff widget_control cmbbid set_value combobox_select: where long currentyear EQ year0 0 ENDELSE return base end"); 371 a[369] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_combobox_pm.html", "cw_combobox_pm.pro", "", " NAME: cw_combobox_pm PURPOSE: widget equivalent a WIDGET_COMBOBOX sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_combobox_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_COMBOBOX OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by Combobox Widgets Pressing the mouse button while the mouse cursor is over an element of a combobox widget causes the widget to change the label on the combobox button and to generate an event The appearance of any previously selected element is restored to normal at the same time The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_COMBOBOX_PM ID:0L TOP:0L HANDLER:0L INDEX:0L OUT:0 The first three fields are the standard fields found in every widget event INDEX returns the index of the selected item This can be used to index the array of names originally used to set the widget s value OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que l index est deja aux max rq: ds ce cas l index reste au max 1: si on appuie sur alors que l index est deja aux min rq: ds ce cas l index reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 3 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_COMBOBOX: COMBOBOX_NUMBER: the number of elements currently contained in the specified combobox widget COMBOBOX_SELECT: the zero based number of the currently selected element i e the currently displayed element in the specified combobox widget DYNAMIC_RESIZE: a True value 1 if the widget specified by Widget_ID is a button combobox or label widget that has had its DYNAMIC_RESIZE attribute set Otherwise False 0 is returned 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la combobox comme on peut le faire pour WIDGET_COMBOBOX Impose peut etre: a The contents of the list widget string or string array b une structure qui peut avoir comme elements de 1 a 3 : DYNAMIC_RESIZE:Set this keyword to activate if set to 1 or deactivate if set to 0 dynamic resizing of the specified CW_COMBOBOX_PM widget see the documentation for the DYNAMIC_RESIZE keyword to WIDGET_COMBOBOX procedure for more information about dynamic widget resizing COMBOBOX_SELECT:Set this keyword to return the zero based number of the currently selected element i e the currently displayed element in the specified combobox widget VALUE: The contents of the list widget string or string array RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 6 9 1999 testwid value strtrim indgen 10 2 PRO testwid_event event help event STRUCT ComboboxId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy dynamic_resize :BEGIN widget_control event id get_value value widget_control ComboboxId set_value dynamic_resize:value END combobox_select :BEGIN widget_control event id get_value value widget_control ComboboxId set_value combobox_select:value END value :BEGIN widget_control event id get_value value widget_control ComboboxId set_value value END get :BEGIN widget_control ComboboxId get_value value help value struct END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_combobox_pm base _extra ex uname c est lui uvalue c est lui print cw_combobox_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue dynamic_resize editable nothing widget_text base value 10 uvalue combobox_select editable nothing widget_text base value 5 uvalue value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end PRO cw_combobox_pm_set_value id value ComboboxId widget_info id find_by_uname Combobox if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of dynamic_resize :widget_control ComboboxId dynamic_resize value dynamic_resize for compatibility droplist_select :widget_control ComboboxId set_combobox_select value droplist_select combobox_select :widget_control ComboboxId set_combobox_select value combobox_select value :widget_control ComboboxId set_value value value ELSE:ras report wrong tag name in argument value of cw_combobox_pm_set_value endcase endfor ENDIF ELSE widget_control ComboboxId set_value value return end FUNCTION cw_combobox_pm_get_value id ComboboxId widget_info id find_by_uname Combobox widget_control ComboboxId get_value cmbbval cmbbtxt widget_info ComboboxId combobox_gettext cmbbnumb widget_info ComboboxId combobox_number index where cmbbval EQ cmbbtxt 0 return combobox_number:cmbbnumb combobox_gettext:cmbbtxt combobox_index:index combobox_value:cmbbval dynamic_resize:widget_info ComboboxId dynamic_resize end FUNCTION cw_combobox_pm_event event widget_control event id get_uvalue uval if uval EQ Combobox then return CW_COMBOBOX_PM ID:event handler TOP:event top HANDLER:0L INDEX:event index STR:event str OUT:0 ComboboxId widget_info event handler find_by_uname Combobox widget_control ComboboxId get_value cmbbval cmbbtxt widget_info ComboboxId combobox_gettext cmbbnumb widget_info ComboboxId combobox_number index where cmbbval EQ cmbbtxt 0 out 0 case uval OF plus :BEGIN if index LT cmbbnumb 1 then BEGIN index index 1 widget_control ComboboxId set_combobox_select index ENDIF ELSE out 1 END minus :BEGIN if index GT 0 then BEGIN index index 1 widget_control ComboboxId set_combobox_select index ENDIF ELSE out 1 END endcase return CW_COMBOBOX_PM ID:event handler TOP:event top HANDLER:0L INDEX:index STR:cmbbtxt OUT:out end FUNCTION cw_combobox_pm parent VALUE value UVALUE uvalue UNAME uname ROW row COLUMN column _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller cheking for row and column keywords row keyword_set row 1 keyword_set column column keyword_set column 1 keyword_set row keyword_set column EQ row if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 0 EVENT_FUNC cw_combobox_pm_event FUNC_GET_VALUE cw_combobox_pm_get_value PRO_SET_VALUE cw_combobox_pm_set_value UVALUE uvalue UNAME uname _extra ex vallen widget_info base string_size m vallen 35 vallen 0 1 max strlen value if keyword_set row THEN BEGIN nothing widget_button base value uvalue minus xoffset 0 yoffset 5 xsize 15 ysize 15 nothing widget_combobox base VALUE value UVALUE Combobox UNAME Combobox xoffset 13 yoffset 0 xsize vallen nothing widget_button base value uvalue plus xoffset vallen 11 yoffset 5 xsize 15 ysize 15 ENDIF ELSE BEGIN nothing widget_combobox base VALUE value UVALUE Combobox UNAME Combobox xoffset 0 yoffset 0 xsize vallen nothing widget_button base value uvalue minus xoffset vallen 2 15 yoffset 24 xsize 15 ysize 15 nothing widget_button base value uvalue plus xoffset vallen 2 yoffset 24 xsize 15 ysize 15 ENDELSE widget_control base realize return base end"); 372 a[370] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_domain.html", "cw_domain.pro", "", " IDL testwid PRO testwid_event event help event struct Id widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy set :BEGIN widget_control event id get_value value value value 0 nothing execute boxzoom value widget_control Id set_value boxzoom END get :BEGIN widget_control Id get_value value print value END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_domain base _extra ex uname c est lui uvalue c est lui print cw_domain ID nothing nothing widget_label base value end of the test nothing widget_text base value 40 100 10 10 uvalue set editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end pro cw_domain_set_value id value cm_4mesh topid findtopid id widget_control topid get_uvalue top_uvalue make sure that we have the good grid stored in the cm_4mesh common parameters currentfile extractatt top_uvalue currentfile currentgrid extractatt top_uvalue meshparameters currentfile change changegrid currentgrid quel est le type de boxzoom currentplot extractatt top_uvalue smallin 2 1 options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flags flags currentplot IF flags where options EQ Longitude x index 0 EQ 0 THEN xtype geographic ELSE xtype index IF flags where options EQ Latitude y index 0 EQ 0 THEN ytype geographic ELSE ytype index comment completer la boxzoom IF xtype EQ geographic then begin lonn1 lon1 lonn2 lon2 xtitle lon ENDIF ELSE BEGIN lonn1 firstxt lonn2 lastxt xtitle x ind ENDELSE IF ytype EQ geographic then begin latt1 lat1 latt2 lat2 ytitle lat ENDIF ELSE BEGIN latt1 firstyt latt2 lastyt ytitle y ind ENDELSE vertf1 floor min gdepw 0 gdept 0 vertf2 ceil max gdepw 0 gdept 0 Case N_Elements Value OF 0:boxzoom lonn1 lonn2 latt1 latt2 vertf1 vertf2 1:BEGIN if value EQ 1 then boxzoom lonn1 lonn2 latt1 latt2 vertf1 vertf2 ELSE boxzoom lonn1 lonn2 latt1 latt2 0 value 0 END 2:boxzoom lonn1 lonn2 latt1 latt2 value 0 value 1 4:boxzoom Value 5:boxzoom Value 0:3 0 Value 4 6:boxzoom Value Else:BEGIN rien report Wrong Definition of Boxzoom END ENDCASE boxzoom 0 floor boxzoom 0 boxzoom 1 ceil boxzoom 1 boxzoom 2 floor boxzoom 2 boxzoom 3 ceil boxzoom 3 if n_elements boxzoom GE 5 then begin boxzoom 4 floor boxzoom 4 boxzoom 5 ceil boxzoom 5 endif widget_control widget_info id find_by_uname lon1 get_uvalue uvalue strict uvalue strict les longitudes min et max possible if xtype EQ geographic then BEGIN min floor min glamt glamf max max max ceil max ENDIF ELSE BEGIN min 0 max jpi 1 ENDELSE les id des widgets lon1id widget_info id find_by_uname lon1 lon2id widget_info id find_by_uname lon2 doit on changer de type d axe x: longitude index lonbase widget_info id find_by_uname lonbase widget_control lonbase get_uvalue lonbase_uvalue if lonbase_uvalue name NE xtype then BEGIN widget_control lonbase update 0 on casse tout widget_control lon1id destroy widget_control lon2id destroy on reconstruit lon1id cw_slider_pm lonbase value min boxzoom 0 boxzoom 0 keyword_set strict boxzoom 1 boxzoom 0 keyword_set strict widget_control lonbase set_uvalue name:xtype widget_control lonbase update 1 ENDIF ELSE BEGIN la nouvelle valeur qu ils vont avoir cursorvalue1 min boxzoom 0 boxzoom 0 strict boxzoom 1 boxzoom 2 boxzoom 2 keyword_set strict boxzoom 3 boxzoom 2 keyword_set strict widget_control latbase set_uvalue name:ytype widget_control latbase update 1 ENDIF ELSE BEGIN cursorvalue1 min boxzoom 2 boxzoom 2 strict boxzoom 3 indice2 1 if indice1 EQ indice2 then BEGIN if where gdep1 GE boxzoom 4 AND gdep2 LE boxzoom 5 0 EQ 1 then begin indice1 0 indice1 dthlv1_uval grid_t EQ 1 indice2 indice1 endif boxzoom 4 gdep1 indice1 boxzoom 5 boxzoom 4 1 endif maintenant que les values et les indexes sont definis proprement on peut les appliquer widget_control dthlv1id set_value combobox_select:indice1 widget_control dthlv2id set_value combobox_select:indice2 controler les min et les max des sliders if indice1 EQ 0 then min1 0 ELSE min1 gdep2 indice1 1 max1 min1 1 gdep1 indice2 widget_control depth1id set_value slider_min:min1 slider_max:max1 value:boxzoom 4 min2 gdep2 indice1 if indice2 EQ jpk 1 then BEGIN max2 max gdept gdepw max2 strtrim string max2 format e8 0 1 max2 float 1 strmid max2 1 float max2 ENDIF ELSE max2 gdep1 indice2 1 widget_control depth2id set_value slider_min:min2 slider_max:max2 value:boxzoom 5 return end FUNCTION cw_domain_get_value id box lonarr 6 possiblecase lon1 lon2 lat1 lat2 depth1 depth2 for i 0 5 do begin widget_control widget_info id find_by_uname possiblecase i get_value value box i value value endfor return box end FUNCTION cw_domain_event event common help struct event if where tag_names event EQ OUT 0 NE 1 then if event out NE 0 then return 1 widget_control event id get_uvalue uval case uval name of lon1 :widget_control widget_info event handler find_by_uname lon2 set_value slider_min:event value uval strict lon2 :widget_control widget_info event handler find_by_uname lon1 set_value slider_max:event value uval strict lat1 :widget_control widget_info event handler find_by_uname lat2 set_value slider_min:event value uval strict lat2 :widget_control widget_info event handler find_by_uname lat1 set_value slider_max:event value uval strict unzoom :BEGIN id widget_info event handler find_by_uname lon1 widget_control id get_value value widget_control id set_value slider_min:value slider_min_max 0 widget_control id set_value value slider_min_max 0 id widget_info event handler find_by_uname lat1 widget_control id get_value value widget_control id set_value slider_min:value slider_min_max 0 widget_control id set_value value slider_min_max 0 id widget_info event handler find_by_uname lon2 widget_control id get_value value widget_control id set_value slider_max:value slider_min_max 1 widget_control id set_value value slider_min_max 1 id widget_info event handler find_by_uname lat2 widget_control id get_value value widget_control id set_value slider_max:value slider_min_max 1 widget_control id set_value value slider_min_max 1 END dthlv1 :BEGIN ids depth1id widget_info event handler find_by_uname depth1 depth2id widget_info event handler find_by_uname depth2 dthlv2id widget_info event handler find_by_uname dthlv2 faut il changer dthlv2 widget_control event id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value widget_control dthlv2id get_value dthlv2_value gdep2 fix dthlv2_value combobox_value if dthlv2_value combobox_index LT event index then BEGIN on redefinie la valeur de dthlv2id widget_control dthlv2id set_value combobox_select:event index donc on redefinit la valeur et le max du slider 2 if event index EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 event index 1 1 widget_control depth2id set_value slider_max:max value:gdep2 event index du coup on redefinie donc le max du slider 1 widget_control depth1id set_value slider_max:gdep1 event index END on redefinie la valeur et le min du slider depth 1 if event index EQ 0 then min 0 ELSE min gdep1 event index 1 1 widget_control depth1id set_value slider_min:min value:gdep1 event index du coup on change aussi la valeur du min du slider depth 2 widget_control depth2id set_value slider_min:gdep1 event index 1 END dthlv2 :BEGIN ids depth1id widget_info event handler find_by_uname depth1 depth2id widget_info event handler find_by_uname depth2 dthlv1id widget_info event handler find_by_uname dthlv1 faut il changer dthlv1 widget_control dthlv1id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value widget_control event id get_value dthlv2_value gdep2 fix dthlv2_value combobox_value if dthlv1_value combobox_index GT event index then BEGIN on redefinie la valeur de dthlv1id widget_control dthlv1id set_value combobox_select:event index donc on redefinit la valeur et le min du slider 1 if event index EQ 0 then min 0 ELSE min gdep2 event index 1 widget_control depth1id set_value slider_min:min value:gdep1 event index du coup on redefinie donc le min du slider 2 widget_control depth2id set_value slider_min:gdep2 event index END on redefinie la valeur et le max du slider depth 2 if event index EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 event index 1 1 widget_control depth2id set_value slider_max:max value:gdep2 event index du coup on change aussi la valeur du max du slider depth 1 widget_control depth1id set_value slider_max:gdep2 event index 1 END depth1 :BEGIN ids depth2id widget_info event handler find_by_uname depth2 dthlv1id widget_info event handler find_by_uname dthlv1 doit on changer dthlv1 widget_control dthlv1id get_value dthlv1_value gdep1 fix dthlv1_value combobox_value rien where gdep1 LT event value indice indice indice indice 1 if indice NE dthlv2_value combobox_index then begin on change le max de depth1 widget_control depth1id set_value slider_max:gdep2 indice 1 on redefinie la valeur de dthlv2id widget_control dthlv2id set_value combobox_select:indice donc on redefinit le max du slider 2 if indice EQ jpk 1 then BEGIN max max gdept gdepw max strtrim string max format e8 0 1 max float 1 strmid max 1 float max ENDIF ELSE max gdep2 indice 1 1 widget_control event id set_value slider_max:max endif END ELSE: ENDCASE slidesliceid widget_info event top find_by_uname slide_slice if slidesliceid NE 0 then widget_control slidesliceid set_value 1 return ID:event handler TOP:event top HANDLER:0L BOX:cw_domain_get_value event handler end FUNCTION cw_domain parent BOXZOOM boxzoom STRICT strict UVALUE uvalue UNAME uname UNZOOM unzoom _extra ex cm_4mesh cm_4data def de la boxzoom Case N_Elements Boxzoom OF 0:boxzoom lon1 lon2 lat1 lat2 min gdepw 0 gdept 0 max gdepw 0 gdept 0 1:boxzoom lon1 lon2 lat1 lat2 0 boxzoom 0 2:boxzoom lon1 lon2 lat1 lat2 boxzoom 0 boxzoom 1 4:boxzoom Boxzoom vert1 vert2 5:boxzoom Boxzoom 0:3 0 Boxzoom 4 6: Else: return report Mauvaise Definition de Boxzoom ENDCASE IF total Boxzoom EQ 0 THEN boxzoom lon1 lon2 lat1 lat2 min gdepw 0 gdept 0 max gdepw 0 gdept 0 boxzoom 0 floor boxzoom 0 boxzoom 1 ceil boxzoom 1 boxzoom 2 floor boxzoom 2 boxzoom 3 ceil boxzoom 3 boxzoom 4 floor boxzoom 4 boxzoom 5 ceil boxzoom 5 if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent row 2 space 0 EVENT_FUNC cw_domain_event FUNC_GET_VALUE cw_domain_get_value PRO_SET_VALUE cw_domain_set_value UVALUE uvalue UNAME uname _extra ex baseh widget_base base column 1 keyword_set unzoom space 0 baseh1 widget_base baseh row 2 space 0 longitude min floor min glamt glamf max max max ceil max IF max min EQ 361 AND keyword_set key_periodic THEN max max 1 lonbase widget_base baseh1 column 2 space 0 uname lonbase uvalue name: geographic lon1id cw_slider_pm lonbase value min boxzoom 0 boxzoom 0 keyword_set strict boxzoom 1 boxzoom 0 keyword_set strict latitude min floor min gphit gphif max max max ceil max latbase widget_base baseh1 column 2 space 0 uname latbase uvalue name: geographic lat1id cw_slider_pm latbase value min boxzoom 2 boxzoom 2 keyword_set strict boxzoom 3 boxzoom 2 keyword_set strict unzoom if keyword_set unzoom then rien widget_button baseh value unzoom uvalue name: unzoom xsize 60 ysize 110 depth basez widget_base base column 3 space 0 base_align_center basezdrp widget_base basez row 2 space 0 if strupcase vargrid EQ W then gdep gdepw ELSE gdep gdept gdep1 floor gdep gdep2 ceil gdep same where gdep2 gdep1 EQ 0 if same 0 NE 1 then gdep2 same gdep2 same 1 sgdep1 strtrim gdep1 1 sgdep2 strtrim gdep2 1 dephtid cw_combobox_pm basezdrp value sgdep1 uvalue name: dthlv1 grid_t:strupcase vargrid NE W uname dthlv1 rien where gdep1 LT boxzoom 4 indice1 indice1 indice1 indice2 1 widget_control dephtid set_value combobox_select:indice2 basedepthslid widget_base base column 2 space 0 strminlen max strlen strtrim round gdept gdepw 1 if indice1 EQ 0 then min1 0 ELSE min1 gdep2 indice1 1 max1 min1 1 gdep1 indice2 rien cw_slider_pm basez value min1 boxzoom 4 boxzoom 4 boxzoom 5 max2 uvalue name: depth2 minimum min2 maximum max2 uname depth2 title z2 strminlen strminlen return base end"); 373 a[371] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_droplist_pm.html", "cw_droplist_pm.pro", "", " NAME: cw_droplist_pm PURPOSE: widget equivalent a WIDGET_DROPLIST sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_droplist_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_DROPLIST OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by Droplist Widgets Pressing the mouse button while the mouse cursor is over an element of a droplist widget causes the widget to change the label on the droplist button and to generate an event The appearance of any previously selected element is restored to normal at the same time The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_DROPLIST_PM ID:0L TOP:0L HANDLER:0L INDEX:0L OUT:0 The first three fields are the standard fields found in every widget event INDEX returns the index of the selected item This can be used to index the array of names originally used to set the widget s value OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que l index est deja aux max rq: ds ce cas l index reste au max 1: si on appuie sur alors que l index est deja aux min rq: ds ce cas l index reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 3 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_DROPLIST: DROPLIST_NUMBER: the number of elements currently contained in the specified droplist widget DROPLIST_SELECT: the zero based number of the currently selected element i e the currently displayed element in the specified droplist widget DYNAMIC_RESIZE: a True value 1 if the widget specified by Widget_ID is a button droplist or label widget that has had its DYNAMIC_RESIZE attribute set Otherwise False 0 is returned 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la droplist comme on peut le faire pour WIDGET_DROPLIST Impose peut etre: a The contents of the list widget string or string array b une structure qui peut avoir comme elements de 1 a 3 : DYNAMIC_RESIZE:Set this keyword to activate if set to 1 or deactivate if set to 0 dynamic resizing of the specified CW_DROPLIST_PM widget see the documentation for the DYNAMIC_RESIZE keyword to WIDGET_DROPLIST procedure for more information about dynamic widget resizing DROPLIST_SELECT:Set this keyword to return the zero based number of the currently selected element i e the currently displayed element in the specified droplist widget VALUE: The contents of the list widget string or string array RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 6 9 1999 PRO testwid_event event help event STRUCT DroplistId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy dynamic_resize :BEGIN widget_control event id get_value value widget_control DroplistId set_value dynamic_resize:value END droplist_select :BEGIN widget_control event id get_value value widget_control DroplistId set_value droplist_select:value END value :BEGIN widget_control event id get_value value widget_control DroplistId set_value value END get :BEGIN widget_control DroplistId get_value value help value struct END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_droplist_pm base _extra ex uname c est lui uvalue c est lui print cw_droplist_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue dynamic_resize editable nothing widget_text base value 10 uvalue droplist_select editable nothing widget_text base value 5 uvalue value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end PRO cw_droplist_pm_set_value id value DroplistId widget_info id find_by_uname Droplist if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of dynamic_resize :widget_control DroplistId dynamic_resize value dynamic_resize droplist_select :widget_control DroplistId set_droplist_select value droplist_select value :widget_control DroplistId set_value value value ELSE:ras report mauvais nom de l argument de la structure ds cw_droplist_pm_set_value endcase endfor ENDIF ELSE widget_control DroplistId set_value value return end FUNCTION cw_droplist_pm_get_value id DroplistId widget_info id find_by_uname Droplist return droplist_number:widget_info DroplistId droplist_number droplist_select:widget_info DroplistId droplist_select dynamic_resize:widget_info DroplistId dynamic_resize end FUNCTION cw_droplist_pm_event event widget_control event id get_uvalue uval if uval EQ Droplist then return CW_DROPLIST_PM ID:event handler TOP:event top HANDLER:0L INDEX:event index OUT:0 DroplistId widget_info event handler find_by_uname Droplist index widget_info DroplistId droplist_select case uval OF plus :BEGIN indexmax widget_info DroplistId droplist_number 1 if index NE indexmax then widget_control DroplistId set_droplist_select index 1 return CW_DROPLIST_PM ID:event handler TOP:event top HANDLER:0L INDEX: index 1 index 1 OUT: long index EQ 0 END endcase end FUNCTION cw_droplist_pm parent UVALUE uvalue UNAME uname ROW row COLUMN column _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller cheking for row and column keywords row keyword_set row 1 keyword_set column column keyword_set column 1 keyword_set row keyword_set column EQ row if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 1 xpad 1 ypad 1 ROW row COLUMN column EVENT_FUNC cw_droplist_pm_event FUNC_GET_VALUE cw_droplist_pm_get_value PRO_SET_VALUE cw_droplist_pm_set_value UVALUE uvalue UNAME uname _extra ex if keyword_set row THEN nothing widget_button base value uvalue minus nothing widget_droplist base UVALUE Droplist UNAME Droplist _extra ex if keyword_set column then begin base1 widget_base base row align_center space 1 xpad 1 ypad 1 nothing widget_button base1 value uvalue minus xsize 20 ysize 20 nothing widget_button base1 value uvalue plus xsize 20 ysize 20 ENDIF ELSE nothing widget_button base value uvalue plus widget_control base realize return base end"); 374 a[372] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_pagelayout.html", "cw_pagelayout.pro", "", " FUNCTION cw_pagelayout_event event widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout if uval name EQ undo then begin return ID:event handler TOP:event top HANDLER:0L ENDIF ELSE BEGIN common si on ne change pas le nombre de colonnes on sort if uval name EQ column then if event index 1 EQ smallin 0 THEN return ID:event handler TOP:event top HANDLER:0L si on ne change pas le nombre de lignes on sort if uval name EQ row then if event index 1 EQ smallin 1 THEN return ID:event handler TOP:event top HANDLER:0L on efface la page graphid widget_info event top find_by_uname graph graphid extractatt top_uvalue graphid widget_control graphid get_value win wset win erase 255 case uval name of clear : column :BEGIN smallin event index 1 smallin 1 1 smallout event index 1 smallout 1 1 END row :BEGIN smallin smallin 0 event index 1 1 smallout smallout 0 event index 1 1 END endcase nbredessin smallin 0 smallin 1 on remet tout a 0 en ce qui concerne les postscripts createhistory event top smallin options extractatt top_uvalue options flags extractatt top_uvalue optionsflag flag flags numdessinin update and reset all values of the top_uvalue top_uvalue 1 findline top_uvalue smallin smallin top_uvalue 1 findline top_uvalue smallout smallout top_uvalue 1 findline top_uvalue penvs replicate p nbredessin top_uvalue 1 findline top_uvalue xenvs replicate x nbredessin top_uvalue 1 findline top_uvalue yenvs replicate y nbredessin top_uvalue 1 findline top_uvalue nameprocedures strarr nbredessin top_uvalue 1 findline top_uvalue types strarr nbredessin top_uvalue 1 findline top_uvalue varinfo strarr 2 nbredessin top_uvalue 1 findline top_uvalue domaines fltarr 6 nbredessin top_uvalue 1 findline top_uvalue dates lonarr 2 nbredessin top_uvalue 1 findline top_uvalue txtcmd strarr nbredessin top_uvalue 1 findline top_uvalue optionsflag flag replicate 1 nbredessin ptr_free extractatt top_uvalue exextra top_uvalue 1 findline top_uvalue exextra ptrarr nbredessin allocate_heap top_uvalue 1 findline top_uvalue ENDELSE return ID:event handler TOP:event top HANDLER:0L end FUNCTION cw_pagelayout parent small UVALUE uvalue UNAME uname UNZOOM unzoom COLUMN column ROW row _extra ex row keyword_set row 1 keyword_set column if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent EVENT_FUNC cw_pagelayout_event FUNC_GET_VALUE cw_pagelayout_get_value PRO_SET_VALUE cw_pagelayout_set_value UVALUE uvalue UNAME uname space 0 _extra ex IF n_elements small eq 0 then small 1 1 1 dummy widget_label base value cln yoffset 3 id widget_combobox base value strtrim indgen 9 1 1 uvalue name: column uname column xoffset 20 xsize 40 widget_control id set_combobox_select small 0 1 IF keyword_set row THEN BEGIN xoff 60 yoff 0 ENDIF ELSE BEGIN xoff 0 yoff 20 ENDELSE dummy widget_label base value row xoffset xoff yoffset yoff 3 id widget_combobox base value strtrim indgen 9 1 1 uvalue name: row uname row xoffset xoff 20 xsize 40 yoffset yoff widget_control id set_combobox_select small 1 1 return base end "); 375 a[373] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_slide_slice.html", "cw_slide_slice.pro", "", "pro cw_slide_slice_set_value id value common topid findtopid id domainid widget_info topid find_by_uname domain widget_control domainid get_value boxzoom if boxzoom 1 boxzoom 0 LT boxzoom 3 boxzoom 2 then type y ELSE type x thickid widget_info topid find_by_uname thickness widget_control thickid get_uvalue thicknessuval widget_control thickid get_value thickness thickness thicknessuval choix thickness droplist_select sliderid widget_info topid find_by_uname slider if type EQ y then BEGIN mini floor min glamt glamf max maxi maxi ceil maxi thickness widget_control sliderid set_value slider_min:mini slider_max:maxi value:boxzoom 0 maxi value mini boxzoom 0 maxi value mini boxzoom 2 maxi column uname slider uvalue name: slider ENDELSE index where thicknessval EQ thickness index index 0 if index EQ 1 then BEGIN index 20 thicknessval 20 strtrim thickness 1 widget_control droplistid set_value thicknessval widget_control droplistid set_uvalue name: thickness choix:thicknessval endif widget_control droplistid set_value droplist_select:index if type EQ xt then begin mini floor min glamt glamf max maxi maxi ceil maxi ENDIF ELSE BEGIN mini floor min gphit gphif max maxi maxi ceil maxi ENDELSE return base end"); 376 a[374] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_slider_pm.html", "cw_slider_pm.pro", "", " NAME: cw_slider_pm PURPOSE: widget equivalent a WIDGET_SLIDER sauf qu en plus on dispose de 2 bouttons et pour deplacer le widget de 1 CATEGORY: compound widget aide a l ecriture des widgets CALLING SEQUENCE: id cw_slider_pm parent INPUTS: Parent: The widget ID of the parent widget KEYWORD PARAMETERS:tous ceux de WIDGET_SLIDER OUTPUTS: The returned value of this function is the widget ID of the newly created animation widget COMMON BLOCKS: none SIDE EFFECTS: Widget Events Returned by the CW_SLIDER_PM Widget Slider widgets generate events when the mouse is used to change their value The event structure returned by the WIDGET_EVENT function is defined by the following statement: CW_SLIDER_PM ID:0L TOP:0L HANDLER:0L VALUE:0L DRAG:0 OUT:0 ID is the widget ID of the button generating the event TOP is the widget ID of the top level widget containing ID HANDLER contains the widget ID of the widget associated with the handler routine VALUE returns the new value of the slider DRAG returns integer 1 if the slider event was generated as part of a drag operation or zero if the event was generated when the user had finished positioning the slider Note that the slider widget only generates events during the drag operation if the DRAG keyword is set and if the application is running under Motif When the DRAG keyword is set the DRAG field can be used to avoid computationally expensive operations until the user releases the slider OUT:c est un entier qui peut prendre 3 valeurs: 1 : si on appuie sur alors que le slider est deja aux max rq: ds ce cas le slider reste au max 1: si on appuie sur alors que le slider est deja aux min rq: ds ce cas le slider reste au min 0 : ds les autres cas Keywords to WIDGET_CONTROL A number of keywords to the WIDGET_CONTROL procedure affect the behavior of cw_slider_pm widget: GET_VALUE and SET_VALUE 1 GET_VALUE widget_control wid_id get_value resultat retourne ds la variable resultat une structure de 2 elements dont les noms sont inspires des mots cles que l on peut passer a widget_control qd on utilise WIDGET_SLIDER: VALUE:the value setting of the widget SLIDER_MIN_MAX: a 2 elements array: The minimum and the maximum value of the range encompassed by the slider 2 SET_VALUE widget_control wid_id set_value impose permet de modifier l etat de la slider bar comme on peut le faire pour WIDGET_SLIDER Impose peut etre: a un entier: donne la nouvelle position of the slider b une structure qui peut avoir comme elements de 1 a 3 : VALUE:un entier qui donne la nouvelle position of the slider SLIDER_MIN:Set to a new minimum value for the specified slider widget SLIDER_MAX:Set to a new minimum value for the specified slider widget RESTRICTIONS: EXAMPLE: cf utiliser le programme founit i dessous: testwid et la procedure associee testwid_event MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 5 9 1999 PRO testwid_event event help event STRUCT SliderBarId widget_info event top find_by_uname c est lui widget_control event id get_uvalue uval if n_elements uval EQ 0 then return case uval of done :widget_control event top destroy slider_min :BEGIN widget_control event id get_value value widget_control SliderBarId set_value slider_min:value END slider_max :BEGIN widget_control event id get_value value widget_control SliderBarId set_value slider_max:value END slider_value :BEGIN widget_control event id get_value value widget_control SliderBarId set_value value END get :BEGIN widget_control SliderBarId get_value value help value struct print value slider_min_max END ELSE: endcase return end PRO testwid _extra ex base widget_base COLUMN print base base nothing widget_label base value beginning of the test nothing cw_slider_pm base _extra ex uname c est lui uvalue c est lui print cw_slider_pm ID nothing nothing widget_label base value end of the test nothing widget_text base value 0 uvalue slider_min editable nothing widget_text base value 10 uvalue slider_max editable nothing widget_text base value 5 uvalue slider_value editable nothing widget_button base value get uvalue get nothing widget_button base value done uvalue done widget_control base REALIZE xmanager testwid base return end FUNCTION decvalue value a float value 0 return strtrim string floor a 0 1 indgen 10 format f15 1 2 end FUNCTION decind value a float value 0 return round 10 a floor a computation accuracy end PRO cw_slider_pm_set_value id value sbid widget_info id find_by_uname SliderBar dcid widget_info id find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX if size value type eq 8 then BEGIN this is a structure tagnames tag_names value for tag 0 n_tags value 1 do begin case strtrim strlowcase tagnames tag 2 of slider_min :BEGIN IF float value slider_min 0 LT minmax 1 THEN BEGIN minmax 0 value slider_min 0 widget_control sbid set_slider_min floor float value slider_min 0 valuedc float widget_info dcid combobox_gettext IF valuedc LT value slider_min THEN BEGIN widget_control sbid set_value floor float value slider_min 0 widget_control dcid set_value decvalue value slider_min widget_control dcid set_combobox_select decind value slider_min ENDIF ENDIF end slider_max :BEGIN IF float value slider_max 0 GT minmax 0 THEN BEGIN minmax 1 value slider_max 0 widget_control sbid set_slider_max ceil float value slider_max 0 valuedc float widget_info dcid combobox_gettext IF valuedc GT value slider_max THEN BEGIN widget_control sbid set_value ceil float value slider_max 0 widget_control dcid set_value decvalue value slider_max widget_control dcid set_combobox_select decind value slider_max ENDIF ENDIF end value :IF float value value 0 GE minmax 0 AND float value value 0 LE minmax 1 THEN value2 float value value 0 ELSE:ras report wrong tag name in argument value of cw_slider_pm_set_value endcase endfor ENDIF ELSE BEGIN IF float value 0 GE minmax 0 AND float value 0 LE minmax 1 THEN value2 float value 0 ENDELSE IF n_elements value2 NE 0 THEN BEGIN widget_control sbid set_value fix value2 widget_control dcid set_value decvalue value2 widget_control dcid set_combobox_select decind value2 ENDIF return end FUNCTION cw_slider_pm_get_value id sbid widget_info id find_by_uname SliderBar dcid widget_info id find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX value float widget_info dcid combobox_gettext return value:value slider_min_max:minmax end FUNCTION cw_slider_pm_event event widget_control event id get_uvalue uval sbid widget_info event handler find_by_uname SliderBar dcid widget_info event handler find_by_uname decimal minmax widget_info sbid SLIDER_MIN_MAX IF uval EQ decimal THEN value float event str ELSE value float widget_info dcid combobox_gettext out 0 defaut case case uval OF plus : if value 1 LE minmax 1 then value2 value 1 ELSE out 1 minus :if value 1 GE minmax 0 then value2 value 1 ELSE out 1 SliderBar :if event value value floor value LE minmax 1 THEN value2 event value value floor value decimal :BEGIN CASE 1 OF value GT minmax 1 : value2 minmax 1 value LT minmax 0 : value2 minmax 0 ELSE: ENDCASE END ELSE: ENDCASE IF n_elements value2 NE 0 THEN BEGIN value value2 widget_control sbid set_value floor value widget_control dcid set_value decvalue value widget_control dcid set_combobox_select decind value ENDIF return CW_SLIDER_PM ID:event handler TOP:event top HANDLER:0L VALUE:value OUT:OUT end FUNCTION cw_slider_pm parent MAXIMUM maximum MINIMUM minimum STRMINLEN strminlen VALUE value UVALUE uvalue UNAME uname title title _extra ex IF N_PARAMS NE 1 THEN MESSAGE Incorrect number of arguments ON_ERROR 2 return to caller if n_elements minimum NE 0 then minimum floor minimum ELSE minimum 0 if n_elements maximum NE 0 then maximum ceil maximum ELSE maximum 100 if NOT keyword_set title then title cheking exclusive keywords column keyword_set column 1 keyword_set row keyword_set vertical xsize lenstr max strlen strtrim minimum maximum 1 if keyword_set strminlen then lenstr strminlen lenstr xsize 35 mlen lenstr 1 3 lenstr lt 4 xsize 35 mlen lenstr 2 dummyid widget_combobox base value decvalue minimum UVALUE decimal UNAME decimal xoffset xoff yoffset 2 xsize xsize dummyid widget_slider base MAXIMUM maximum MINIMUM minimum UVALUE SliderBar UNAME SliderBar suppress_value drag yoffset 30 xsize xoff xsize if keyword_set value then cw_slider_pm_set_value base value return base end"); 377 a[375] = new Array("./ToBeReviewed/WIDGET/COMPOUND_WIDGET/cw_specifie.html", "cw_specifie.pro", "", " PRO cw_specifie_set_value id value cm_general if size value type NE 8 then return widget_control widget_info id find_by_uname min set_value strtrim value min 2 widget_control widget_info id find_by_uname max set_value strtrim value max 2 widget_control widget_info id find_by_uname int set_value strtrim value inter 2 widget_control widget_info id find_by_uname palnum set_value strtrim value lct 2 autres extractstru value min max inter lct nothing xindex yindex if size autres type EQ 8 then BEGIN autresid widget_info id find_by_uname autres widget_control widget_info id find_by_uname autres get_value autresautres autresautres autresautres 0 if strtrim autresautres 2 NE then begin autresautres createfunc get_extra autresautres filename myuniquetmpdir for_createfunc pro autres mixstru autres autresautres endif autres strkeywd autres widget_control widget_info id find_by_uname autres set_value autres endif return end FUNCTION cw_specifie_get_value id cm_general widget_control widget_info id find_by_uname min get_value min min float min 0 widget_control widget_info id find_by_uname max get_value max max float max 0 widget_control widget_info id find_by_uname int get_value int int float int 0 widget_control widget_info id find_by_uname palnum get_value palnum palnum long palnum 0 widget_control widget_info id find_by_uname autres get_value autres autres autres 0 exextra min:min max:max inter:int lct:palnum if strtrim autres 2 NE then exextra createfunc get_extra autres _extra exextra kwdlist exextra exextra exextra exextra filename myuniquetmpdir for_createfunc pro return exextra end FUNCTION cw_specifie_event event on recuper les ID des differents widgets widget_control event id get_uvalue uval widget_control event top get_uvalue top_uvalue smallin extractatt top_uvalue smallin numdessinin smallin 2 1 smallout extractatt top_uvalue smallout numdessinout smallout 2 1 case uval of default :BEGIN on trouve le nom de la variable: vlstid widget_info event top find_by_uname varlist fieldname widget_info vlstid combobox_gettext exextra definedefaultextra fieldname widget_control widget_info event handler find_by_uname min set_value strtrim exextra min 1 widget_control widget_info event handler find_by_uname max set_value strtrim exextra max 1 widget_control widget_info event handler find_by_uname int set_value strtrim exextra inter 1 widget_control widget_info event handler find_by_uname palnum set_value strtrim exextra lct 1 widget_control widget_info event handler find_by_uname autres set_value END palcol :BEGIN ind fix strmid event value 0 strpos event value widget_control widget_info event handler find_by_uname palnum set_value strtrim ind 1 END ELSE: endcase return ID:event handler TOP:event top HANDLER:0L OK:uval EQ ok end FUNCTION cw_specifie parent ROW row COLUMN column UVALUE uvalue UNAME uname FRAME frame FORXXX forxxx _extra ex cheking exclusive keywords column keyword_set column 1 keyword_set row row keyword_set row 1 keyword_set column keyword_set row EQ column if NOT keyword_set uvalue then uvalue if NOT keyword_set uname then uname base widget_base parent space 0 frame EVENT_FUNC cw_specifie_event FUNC_GET_VALUE cw_specifie_get_value PRO_SET_VALUE cw_specifie_set_value UVALUE uvalue UNAME uname _extra ex base1 base1 widget_base base rien widget_label base1 value Min xoffset 85 yoffset 15 rien widget_label base1 value Max xoffset 145 yoffset 15 rien widget_label base1 value Int xoffset 210 yoffset 15 lct get_name nomcouleur nbrligne 30 nbrlist n_elements nomcouleur nbrligne nomcouleur strtrim sindgen n_elements nomcouleur 1 nomcouleur nomcouleur 0 nomcouleur nomcouleur 1 Color nomcouleur if nbrlist GT 1 then for i 1 nbrlist do nomcouleur nomcouleur 0:nbrligne i 1 i 1 nomcouleur nbrligne i i:n_elements nomcouleur 1 rien cw_pdmenu base1 nomcouleur RETURN_NAME uvalue palcol uname palcol xoffset 250 yoffset 0 base2 base2 widget_base base column 4 keyword_set forxxx yoffset 30 if keyword_set forxxx then rien widget_button base2 value Default uvalue default frame tooltip see find definedefaultextra 0 rien widget_text base2 value editable xsize 7 uname min uvalue min rien widget_text base2 value editable xsize 7 uname max uvalue max rien widget_text base2 value editable xsize 7 uname int uvalue int if keyword_set forxxx then colvalue ELSE colvalue 39 rien widget_text base2 value colvalue editable xsize 2 uname palnum uvalue palnum widget text contennant les autres mots cles passe ds top_uvalue exextra en reste t il si oui il faut les mettres sous forme de string rien widget_text base value editable uname autres uvalue autres xsize 54 ysize 3 yoffset 65 wrap no_newline if keyword_set forxxx then cw_specifie_set_value base definedefaultextra rien_du_tout return base end "); 378 a[376] = new Array("./ToBeReviewed/WIDGET/findtopid.html", "findtopid.pro", "", " NAME: findtopid PURPOSE: retrouve a partir d un Id de widget l Id du widget qui est the top level base i e it has no parent CATEGORY: aide pour les widgets CALLING SEQUENCE: res findtopid Widget_ID INPUTS: Widget_ID: this argument should be the widget ID of the widget for which information is desired KEYWORD PARAMETERS: OUTPUTS: l Id du widget qui est the top level base COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 22 9 1999 FUNCTION findtopid identite id long identite exist widget_info id managed if exist EQ 0 then return 1 topid id topid2 id while topid2 NE 0 do begin topid topid2 topid2 widget_info topid2 parent endwhile return long topid end"); 379 a[377] = new Array("./ToBeReviewed/WIDGET/slec.html", "slec.pro", "", "FUNCTION slec name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex include common cm_4data IF NOT keyword_set key_forgetold THEN BEGIN updatenew updatekwd ENDIF case n_params of 1:tab nlec name PARENT parent BOXZOOM boxzoom _EXTRA ex 2:tab nlec name debut PARENT parent BOXZOOM boxzoom _EXTRA ex 3:tab nlec name debut fin PARENT parent BOXZOOM boxzoom _EXTRA ex 4:tab nlec name debut fin nomexp PARENT parent BOXZOOM boxzoom _EXTRA ex endcase return tab:tab grille:vargrid unite:varunit experience:varexp nom:varname end"); 380 a[378] = new Array("./ToBeReviewed/WIDGET/xnotice.html", "xnotice.pro", "", " NAME:xnotice PURPOSE:cree un widget avec du texte au milieu de la fenetre CATEGORY:information CALLING SEQUENCE:widgetid xnotice text INPUTS:text: un string ou un vecteur de string Si c est un scalaire on cherche le separateur de ligne C pour creer un texte a plusieurs lignes KEYWORD PARAMETERS:chkwidget: oblige a verifier qu il y a des widgets actif pour creer un widget sinon imprime au prompt OUTPUTS:lidentite du widget cree COMMON BLOCKS SIDE EFFECTS:ne fait pas appelle a xmanager ne cree aucun event il faut detruire ce widget a la main: widget_control widgetid destroy RESTRICTIONS: EXAMPLE: IDL id xnotice ca marche C ou pas IDL widget_control id destroy MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 2000 3 17 FUNCTION xnotice text CHKWIDGET chkwidget on separe le text en differentes lignes separees par C si ce n est pas deja fait if n_elements text EQ 1 then text str_sep text C trim if keyword_set chkwidget then makewid widget_info managed 0 ELSE makewid 1 if makewid EQ 0 then BEGIN for i 0 n_elements text 1 do print text i noticebase 0 endif noticebase widget_base column title information align_center screensize get_screen_size widget_control noticebase tlb_set_xoffset screensize 0 2 2 tlb_set_yoffset screensize 1 2 2 nothing widget_label noticebase value for i 0 n_elements text 1 do nothing widget_label noticebase value text i nothing widget_label noticebase value widget_control noticebase realize return noticebase end"); 381 a[379] = new Array("./ToBeReviewed/WIDGET/xquestion.html", "xquestion.pro", "", " NAME:xquestion PURPOSE: a small widget who ask a question and give an answer WARNING: For a binary question with yes no answer use DIALOG_MESSAGE CATEGORY: widget CALLING SEQUENCE: answer xquestion question proposedanswer INPUTS: question: a scalar string or a array of string If this argument is set to : an array of strings: each array element is displayed as a separate line of text a scalar string: we are looking for the separate line character C proposedanswer: a string proposing a answer KEYWORD PARAMETERS: those from WIDGET_BASE and WIDGET_TEXT CHKWIDGET: active this keyword if you whant that xquestion check if managed widget are present If not xquestion do not open a widget but print the question in the IDL window OUTPUTS: answer: a string COMMON BLOCKS: none we use a false widget SIDE EFFECTS: The function does not return to its caller until the user press Enter key in the widget RESTRICTIONS: EXAMPLE: IDL help xquestion Postscript name STRING toto ps MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr 13 10 1999 pro xquestion_event event we get the answer widget_control widget_info event top find_by_uname text get_value answer answer answer 0 now we give the answer to xquestion pro by using the pointer uvalue widget_control event top get_uvalue ptranswer ptranswer answer we destroy the widget widget_control event top destroy return end FUNCTION xquestion question proposedanswer CHKWIDGET chkwidget _extra ex is separate line a scalar we must cut it into pieces if n_elements question EQ 1 then question str_sep question C trim is a widget necessary if keyword_set chkwidget then BEGIN if widget_info managed 0 EQ 0 then BEGIN if n_elements proposedanswer EQ 0 then BEGIN proposedanswer answer complete ENDIF ELSE BEGIN answer proposedanswer complete default answer is proposedanswer ENDELSE if n_elements question GT 1 THEN for i 0 n_elements question 2 do print question i read question n_elements question 1 complete answer if keyword_set answer EQ 0 then answer proposedanswer return answer endif endif definition of the widget BaseId widget_base column title Question _extra ex screensize get_screen_size widget_control BaseId tlb_set_xoffset screensize 0 2 2 tlb_set_yoffset screensize 1 2 2 for i 0 n_elements question 1 DO trash widget_label BaseId value question i align_left if n_elements proposedanswer EQ 0 then answer ELSE answer proposedanswer trash widget_text BaseId value answer editable _extra ex uname text trash widget_button BaseId value ok ptranswer ptr_new allocate_heap widget_control BaseId set_uvalue ptranswer we realize the widget and wait for an answer widget_control BaseId realize xmanager xquestion BaseId we get the answer answer ptranswer we freeing the pointer ptr_free ptranswer return answer end"); 382 a[380] = new Array("./ToBeReviewed/WIDGET/xx.html", "xx.pro", "", " PRO xx JOUR jour MESHFILENAME meshfilename LISTVAR listvar LISTGRID listgrid FUNCLEC_NAME funclec_name CALENDAR calendar _extra ex common partie a changer nom de la fonction de lecture: if NOT keyword_set funclec_name then funclec_name slec varexp INF liste des variables if NOT keyword_set listvar then listvar tn sn un vn taux tauy hdep20 hdep28 hdep15 hturb hpycn htoth emp qn qs smltot11 smltot12 smltot13 smltot14 smltot15 smltot16 tmltot11 tmltot12 tmltot13 tmltot14 tmltot15 tmltot16 liste des grilles auxquelles elles se rapportent les variables if NOT keyword_set listgrid then BEGIN listgrid replicate T n_elements listvar listgrid 2 4 U listgrid 3 5 V ENDIF calendrier a utiliser en jours juliens d IDL if NOT keyword_set calendar then BEGIN if keyword_set jour then calendar calendriertotem julian_day ELSE calendar calendriertotem julian_day mensuel ENDIF nom du fichier se rapportant au masque if NOT keyword_set meshfilename then meshfilename usr1 com smasson IDL INIT inittotem pro meshparameters whichgrid meshfilename parameteres specifiant comment doit etre lu le champ readparameters funclec_name: funclec_name jpidta: jpidta jpjdta: jpjdta jpkdta: jpkdta ixmindta: ixmindta ixmaxdta: ixmaxdta iymindta: iymindta iymaxdta: iymaxdta izmindta: izmindta izmaxdta: izmaxdta fin de la partie a changer fileparameters filename: many time_counter: calendar listvar: listvar listgrid: strupcase listgrid multistructure fileparameters: temporary fileparameters readparameters: temporary readparameters meshparameters: temporary meshparameters xxx multistructure temporary multistructure _extra ex return end"); 383 a[381] = new Array("./ToBeReviewed/WIDGET/xxx.html", "xxx.pro", "", " NAME:xxx PURPOSE:un maximum de possibilites avec un minimum de clics CATEGORY:super widget CALLING SEQUENCE:xxx INPUTS:none KEYWORD PARAMETERS: SEPARATE: pour separer la partie boutons de la partie dessin en 2 fenetres Utile pour les petits ecrans mais attention peut saturer la memoire video de certains Tx un peu vetustes RESTORE toto dat ou toto dat est un fichier cree lors d une precedente utilisation de xxx grace a la commande Widget du menu save as OUTPUTS: COMMON BLOCKS:common pro SIDE EFFECTS: RESTRICTIONS: EXAMPLE: MODIFICATION HISTORY:Sebastien Masson smasson lodyc jussieu fr PRO xxx_event event common widget_info event top find_by_uname quel est le type d evenement if event id EQ 622 then help event struct widget_control event id get_uvalue uval if tag_names event structure_name 0 EQ WIDGET_TRACKING then uval name: ActiverFenetre if keyword_set uval EQ 0 then return help event struct help uval struct case sur le type d evenement widget_control event top get_uvalue top_uvalue si on a active le mot cles separate a l appelle de xxx if size top_uvalue type EQ 3 then begin event top top_uvalue widget_control event top get_uvalue top_uvalue endif on tue le petit widget cree par notice pro si il existe noticebase extractatt top_uvalue noticebase if noticebase NE 0 then BEGIN widget_control noticebase destroy top_uvalue 1 findline top_uvalue noticebase 0l endif options extractatt top_uvalue options case uval name OF menubar :xxxmenubar_event event ok :nouveaudessin 1 specifie : action : calendar1 :BEGIN date2id widget_info event top find_by_uname calendar2 widget_control date2id get_value date2 if event value GT date2 then widget_control date2id set_value event value END calendar2 :BEGIN date1id widget_info event top find_by_uname calendar1 widget_control date1id get_value date1 if event value LT date1 then widget_control date1id set_value event value END domain : varlist :BEGIN currentfile extractatt top_uvalue currentfile listvar extractatt top_uvalue fileparameters currentfile listvar name listvar event index changefield event top name END txtcmd : filelist :BEGIN changefile event top event index END ActiverFenetre :BEGIN if event enter EQ 1 AND d name NE PS then BEGIN graphid widget_info event top find_by_uname graph graphid extractatt top_uvalue graphid widget_control graphid get_value win wset win widget_control event top get_uvalue top_uvalue numdessinin extractatt top_uvalue smallin 2 1 p extractatt top_uvalue penvs numdessinin x extractatt top_uvalue xenvs numdessinin y extractatt top_uvalue yenvs numdessinin endif END graph :BEGIN quelclick identifyclick event case quelclick type of inutile :return long :longclickaction event single :singleclickaction event double :doubleclickaction event endcase END endcase if keyword_set nouveaudessin then letsdraw event top return end PRO xxx datafilename idlfile argspro CALLERWIDID CallerWidId REDRAW redraw SEPARATE separate UVALUE uvalue RESTORE restore _EXTRA ex all_cm reinitialize the p x y z variables reinitplt we get back the uvalue of the widget that called xxx to create a new widget if keyword_set restore then BEGIN restore isafile filename restore iodir homedir _extra ex if size restore type NE 7 then restore 0 ELSE BEGIN restore isafile file restore iodir homedir _extra ex newgrid extractatt uvalue meshparameters 0 change changegrid newgrid ENDELSE endif if n_elements CallerWidId NE 0 THEN widget_control CallerWidId get_uvalue uvalue ELSE CallerWidId 0 liste des fichiers que l on veut regarder if keyword_set uvalue then BEGIN currentfile extractatt uvalue currentfile filelist extractatt uvalue filelist fileparameters extractatt uvalue fileparameters readparameters extractatt uvalue readparameters meshparameters extractatt uvalue meshparameters ENDIF ELSE BEGIN newfile selectfile datafilename idlfile argspro _extra ex if size newfile type NE 8 then return fileparameters ptrarr 1 allocate_heap fileparameters 0 newfile fileparameters readparameters ptrarr 1 allocate_heap readparameters 0 newfile readparameters meshparameters ptrarr 1 allocate_heap meshparameters 0 newfile meshparameters currentfile 0 filelist newfile fileparameters filename ENDELSE if keyword_set uvalue THEN BEGIN smallin extractatt uvalue smallin smallout extractatt uvalue smallout ENDIF ELSE BEGIN smallin 1 1 1 smallout 1 1 1 ENDELSE nbredessin smallin 0 smallin 1 numdessinin smallin 2 1 warning flg definition must be consistent with cw_pdmenu argument see also flag definition in cw_pagelayout if keyword_set uvalue then BEGIN flag extractatt uvalue optionsflag key_portrait flag 0 numdessinin ENDIF ELSE flag key_portrait 0 0 0 0 replicate 1 nbredessin We start the widget definition widget and screen size scrsize get_screen_size 0 95 windsize givewindowsize xxxsize windsize 0 1 keyword_set separate 350 windsize 1 The top base IF xxxsize 0 LE scrsize 0 AND xxxsize 1 LE scrsize 1 THEN BEGIN base widget_base title xxx GROUP_LEADER group tracking_events uname base space 0 ENDIF ELSE BEGIN base widget_base title xxx GROUP_LEADER group tracking_events uname base space 0 xsize xxxsize 0 ysize xxxsize 1 x_scroll_size xxxsize 0 selectact ENDIF ELSE selectfile 0 menu options xoff xoff 110 if keyword_set uvalue then begin options extractatt uvalue options ENDIF ELSE options Portrait Landscape Overlay Vecteur Longitude x index Latitude y index desc 1 File 0 Open 0 New xxx 2 Quit 1 Save as 0 PostScript 0 Animated gif 0 Gif 0 IDL procedure 0 RESTORE kwd of xxx 2 Print to prompt 1 Flag options descsuite options if n_elements descsuite GE 2 then descsuite 0:n_elements descsuite 2 0 descsuite 0:n_elements descsuite 2 descsuite n_elements descsuite 1 2 descsuite n_elements descsuite 1 desc desc descsuite menu cw_pdmenu base desc RETURN_NAME uname menubar uvalue name: menubar xoffset xoff yoffset yoff Ok button yoff yoff 37 xoff 5 boutton OK baseok widget_button base value OK uvalue name: ok uname ok button frame xoffset xoff yoffset yoff Page Layout page layout xoff xoff 65 dummyid cw_pagelayout base smallin row frame xoffset xoff yoffset yoff List of Variables xoff xoff 140 currentlistvar fileparameters currentfile listvar vlstid widget_combobox base value currentlistvar uvalue name: varlist uname varlist xoffset xoff yoffset yoff 1 if keyword_set uvalue then BEGIN selectvar extractatt uvalue varinfo 1 numdessinin selectvar where currentlistvar EQ selectvar 0 widget_control vlstid set_combobox_select 0 selectvar ENDIF ELSE selectvar 0 List of files yoff yoff 35 flstid widget_combobox base value file_basename filelist uname filelist xsize 345 yoffset yoff uvalue name: filelist if keyword_set uvalue then BEGIN selectfile extractatt uvalue varinfo 0 numdessinin selectfile where file_basename filelist EQ selectfile 0 widget_control flstid set_combobox_select 0 selectfile ENDIF ELSE selectfile 0 Text for computation yoff yoff 32 computation done on the files if keyword_set uvalue then txtvalue extractatt uvalue txtcmd numdessinin ELSE txtvalue varexp dummyid widget_text base value txtvalue uvalue name: txtcmd uname txtcmd editable yoffset yoff xsize 54 frame Calendar yoff yoff 40 currentcalendar fileparameters currentfile time_counter key_caltype fileparameters currentfile caltype fakecal fileparameters currentfile fakecal if keyword_set uvalue then begin dates extractatt uvalue dates numdessinin date1 date2jul dates 0 date2 date2jul dates 1 ENDIF basecalid widget_base base column 2 space 0 yoffset yoff uname basecal dummyid cw_calendar basecalid currentcalendar date1 FAKECAL fakecal uname calendar1 uvalue name: calendar1 frame dummyid cw_calendar basecalid currentcalendar date2 FAKECAL fakecal uname calendar2 uvalue name: calendar2 frame Domain yoff yoff 60 vargrid strupcase fileparameters currentfile listgrid selectvar IF vargrid EQ W then zgrid W ELSE zgrid T if keyword_set uvalue then boxzoom extractatt uvalue domaines numdessinin dummyid cw_domain base uname domain uvalue name: domain unzoom frame boxzoom boxzoom yoffset yoff xoffset 15 Plots specifications yoff yoff 230 speid cw_specifie base uname specifie uvalue name: specifie frame column forxxx yoffset yoff if keyword_set uvalue then BEGIN exextra extractatt uvalue exextra numdessinin IF n_elements exextra NE 0 THEN widget_control speid set_value exextra ENDIF drawing part if keyword_set separate then basegraph widget_base title xxx window group_leader base uvalue base ELSE basegraph base graphid widget_draw basegraph uname graph button_events retain 2 uvalue name: graph press:0 click:0 x: 0 0 y: 0 0 xoffset 350 1 keyword_set separate xsize windsize 0 ysize windsize 1 tooltip toto realize the widget widget_control base realize if keyword_set separate then begin widget_control basegraph realize xmanager xxx basegraph no_block endif if keyword_set uvalue then BEGIN on recopie le pointeur uvalue dans top_uvalue Attention il faut completement redefinir top_uvalue a partir des variables pointees par uvalue Sinon si on fait simplement top_uvalue uvalue qd on detruit par uvalue et les variables surlesquelles il pointe on detruit aussi les variables sur lesquelles pointent top_uvalue case 1 of keyword_set redraw :BEGIN top_uvalue uvalue widget_control base set_uvalue top_uvalue we find homedir homedir isadirectory io homedir title Bad definition of homedir on recupere la liste des instructions globalcommand extractatt top_uvalue globalcommand on complete par le premiere et les dernieres lignes du programme createpro globalcommand filename myuniquetmpdir xxx2ps pro KWDLIST NOERASE noerase POSTSCRIPT postscript PORTRAIT portrait LANDSCAPE landscape noerase END keyword_set restore :begin top_uvalue uvalue widget_control base set_uvalue top_uvalue widget_control graphid get_value win wshow win wset win tv image true etat des widgets updatewidget base menage END ELSE:BEGIN top_uvalue ptrarr 2 29 allocate_heap FOR i 0 28 do top_uvalue 0 i uvalue 0 i FOR i 0 14 do top_uvalue 1 i uvalue 1 i FOR i 18 27 do top_uvalue 1 i uvalue 1 i numfile n_elements extractatt uvalue filelist top_uvalue 1 15 ptrarr numfile allocate_heap top_uvalue 1 16 ptrarr numfile allocate_heap top_uvalue 1 17 ptrarr numfile allocate_heap for i 0 numfile 1 do begin top_uvalue 1 15 i uvalue 1 15 i top_uvalue 1 16 i uvalue 1 16 i top_uvalue 1 17 i uvalue 1 17 i endfor top_uvalue 1 28 ptrarr nbredessin allocate_heap for i 0 nbredessin 1 do top_uvalue 1 28 i uvalue 1 28 i widget_control base set_uvalue top_uvalue copie l ecran du widget de uvalue dans celui de top_uvalue if keyword_set CallerWidId then begin widget_control extractatt uvalue graphid get_value win wshow win wset win image tvrd true widget_control graphid get_value win wshow win wset win tv image true ENDIF END endcase top_uvalue 1 findline top_uvalue graphid graphid ENDIF ELSE BEGIN sinon on va definit tous les elements que l on acroche au widget grace a la top_uvalue qui est un tableau de pointeurs a 2 colonnes: les noms et des variables on initialie tous ces elements variables concernant le widget ds sa generalite if NOT keyword_set ex then ex nothing:0 variables se rapportant aux differents fichiers que l on peut lire variables specifiques a chaque dessin creation du pointeur que l on va attache au widget top_uvalue ptrarr 2 29 allocate_heap variables se rapportant au widget en general top_uvalue 0 0 options top_uvalue 1 0 options top_uvalue 0 1 smallin top_uvalue 1 1 smallin top_uvalue 0 2 smallout top_uvalue 1 2 smallout top_uvalue 0 3 graphid top_uvalue 1 3 graphid top_uvalue 0 4 alreadyvector top_uvalue 1 4 1 top_uvalue 0 5 alreadyover top_uvalue 1 5 1 top_uvalue 0 6 alreadyread top_uvalue 1 6 1 top_uvalue 0 7 currentreadcmd top_uvalue 1 7 top_uvalue 0 8 globalcommand top_uvalue 1 8 top_uvalue 0 9 globaloldcommand top_uvalue 1 9 top_uvalue 0 10 no more used top_uvalue 1 10 9999 top_uvalue 0 11 noticebase top_uvalue 1 11 0l top_uvalue 0 12 extra top_uvalue 1 12 ex variables se rapportant aux differents fichiers que l on peut lire top_uvalue 0 13 currentfile top_uvalue 1 13 currentfile top_uvalue 0 14 filelist top_uvalue 1 14 filelist top_uvalue 0 15 fileparameters top_uvalue 1 15 fileparameters top_uvalue 0 16 readparameters top_uvalue 1 16 readparameters top_uvalue 0 17 meshparameters top_uvalue 1 17 meshparameters variables se rapportant aux differents dessins que l on peut faire top_uvalue 0 18 penvs top_uvalue 1 18 replicate p nbredessin top_uvalue 0 19 xenvs top_uvalue 1 19 replicate x nbredessin top_uvalue 0 20 yenvs top_uvalue 1 20 replicate y nbredessin top_uvalue 0 21 nameprocedures top_uvalue 1 21 strarr nbredessin top_uvalue 0 22 types top_uvalue 1 22 strarr nbredessin top_uvalue 0 23 varinfo top_uvalue 1 23 strarr 2 nbredessin top_uvalue 0 24 domaines top_uvalue 1 24 fltarr 6 nbredessin top_uvalue 0 25 dates top_uvalue 1 25 lonarr 2 nbredessin top_uvalue 0 26 txtcmd top_uvalue 1 26 strarr nbredessin top_uvalue 0 27 optionsflag top_uvalue 1 27 flag top_uvalue 0 28 exextra top_uvalue 1 28 ptrarr nbredessin allocate_heap widget_control base set_uvalue top_uvalue createhistory base smallin ENDELSE xmanager xxx base no_block return end"); 384 a[382] = new Array("./Utilities/createfunc.html", "createfunc.pro", "", " file_comments write an idl function compile it and execute it usefull to avoid the use of execute param command in required a scalar string defining the result to be byven back by the function see examples keyword FILENAMEIN in name of the funccedure to be created for_createfunc pro by default keyword KWDLIST in a vector string to specify a list of keywords that must be included in the function definition Warning: the string must start with a for example: KWDLIST TOTO toto keyword _EXTRA used to pass your keywords to the created function SIDE EFFECTS: ends the function name with pro if needed restrictions arguments can be given only through keywords examples IDL print createfunc 3 2 filename test IDL print createfunc 3 two filename test kwdlist two two two 2 history Sebastien Masson smasson lodyc jussieu fr May 2005 FUNCTION createfunc command FILENAMEIN filenamein KWDLIST kwdlist _extra ex compile_opt idl2 hidden strictarrsubs IF n_elements command NE 1 THEN stop define filename if needed if NOT keyword_set filenamein then filename for_createfunc pro ELSE filename filenamein get the name of the function not the name of the file containing the function shortfilename file_basename filename pro check if the directory exists dirname isadirectory file_dirname filename title Redefine shortfilename pro directory IF size dirname type NE 7 THEN return 1 filename dirname shortfilename pro create the file if NOT keyword_set kwdlist then kwdlist kwdlist kwdlist _extra ex IF strmid kwdlist 0 1 NE THEN kwdlist kwdlist putfile filename function shortfilename kwdlist compile_opt idl2 hidden strictarrsubs res command return res end go in dirname directory cd dirname current old_dir compile it resolve_routine shortfilename is_function cd old_dir execute it res call_function shortfilename _extra ex return res end"); 385 a[383] = new Array("./Utilities/createpro.html", "createpro.pro", "", " file_comments write an idl procedure compile it and execute it param command in required a string array defining the procedure to be created each element will be a line of the created procedure keyword FILENAMEIN name of the procedure to be created for_createpro pro by default keyword KWDLIST a vector string to specify a list of keywords that must be included in the procedure definition Warning: the string must start with a for example: KWDLIST TOTO toto keyword _EXTRA used to pass your keywords to the created procedure SIDE EFFECTS: ends the procedure name with pro if needed restrictions is not working with functions use createfunc instead arguments can be given only through keywords examples IDL createpro print OK filename test IDL createpro if keyword_set ok then print OK else print No IDL filename test kwdlist ok ok IDL createpro if keyword_set ok then print OK else print No IDL filename test kwdlist ok ok ok history Sebastien Masson smasson lodyc jussieu fr cleaning new keywords: October 2005 Feb 2006: supress keyword kwdused and use call_procedure instead of execute PRO createpro command FILENAMEIN filenamein KWDLIST kwdlist KWDUSED kwdused _extra ex compile_opt idl2 hidden strictarrsubs IF keyword_set kwdused THEN BEGIN dummy report keyword KWDUSED has been suppressed please pass directly your keywords through _extra see exaemples in createpro header return ENDIF define filename if needed if NOT keyword_set filenamein then filename for_createpro pro ELSE filename filenamein get the name of the procedure not the name of the file containing the procedure shortfilename file_basename filename pro check if the directory exists dirname isadirectory file_dirname filename title Redefine shortfilename pro directory IF size dirname type NE 7 THEN return filename dirname shortfilename pro create the file if NOT keyword_set kwdlist then kwdlist kwdlist kwdlist _extra ex kwdlist strtrim kwdlist 2 IF strmid kwdlist 0 1 NE THEN kwdlist kwdlist for i 0 n_elements command 1 do print command i putfile filename pro shortfilename kwdlist compile_opt idl2 hidden strictarrsubs command return end go in dirname directory cd dirname current old_dir compile it resolve_routine shortfilename cd old_dir execute it call_procedure shortfilename _extra ex return end"); 386 a[384] = new Array("./Utilities/def_myuniquetmpdir.html", "def_myuniquetmpdir.pro", "", " file_comments if needed define and create myuniquetmpdir common variable from cm_general and add it to path categories utilities examples IDL def_myuniquetmpdir uses cm_general history Sebastien Masson smasson lodyc jussieu fr June 2005 PRO def_myuniquetmpdir cm_general IF n_elements myuniquetmpdir EQ 0 THEN BEGIN define a new and unique directory in getenv IDL_TMPDIR by using systime 1 look for the login if we use unix system IF d name EQ X THEN spawn whoami login noshell ELSE login idl myuniquetmpdir file_search getenv IDL_TMPDIR mark_directory myuniquetmpdir myuniquetmpdir 0 login 0 strtrim long systime 1 1 create it file_mkdir myuniquetmpdir add it to path path path : expand_path myuniquetmpdir ENDIF return end"); 387 a[385] = new Array("./Utilities/demomode_compatibility.html", "demomode_compatibility.pro", "", " categories utilities uses cm_general PRO demomode_compatibility cm_general 1 remove all cm_demomode_used pro found in path to_rm find cm_demomode_used IF to_rm 0 NE NOT FOUND THEN file_delete to_rm 2 copy oldcm_full _empty to myuniquetmpdir oldcm_used pro select which file should be copied to oldcm_used pro IF lmgr demo EQ 1 THEN BEGIN democm find cm_demomode file_copy democm myuniquetmpdir cm_demomode_used pro overwrite ENDIF ELSE BEGIN create an empty file close the journal if already open IF journal NE 0 THEN journal open a new one journal myuniquetmpdir cm_demomode_used pro close it it will be empty journal ENDELSE return END"); 388 a[386] = new Array("./Utilities/find.html", "find.pro", "", " file_comments based on file_search but it is possible to speficy a set of possibles names and a different set of possibles directories names By defaut look for files included in path categories find a file param filein in required A scalar or array variable of string type containing file names to match Input names specifications may contain wildcard characters enabling them to match multiple files see file_search for more informations By defaut and if necessary find is looking for filename and also for filename completed with pro keyword FIRSTFOUND activate this keyword to stop looking for the file as soon as we found one keyword IODIRECTORY A scalar or array variable of string type containing directories names where we are looking for the file by defaut we use path Different directories can be separated by path_sep search_path : on unix type machine as it is done to define path Note that if filename s dirname is different from this keyword is not taken into account keyword LOOKALLDIR activate to look for the file with a recursive search in iodir homedir path the DATA:TestsData directory if it exists keyword NOPRO activate to avoid the automatic search of filename completed with pro keyword ONLYPRO force to look only at file ending with pro keyword ONLYNC force to look only at file ending with nc keyword RECURSIVE performs recursive searching of directory hierarchies In a recursive search find looks recursively for any and all subdirectories in the file hierarchy rooted at the IODIRECTORY argument keyword REPERTOIRE obsolete keep for compatibility use directory keyword keyword UNIQUE activate to make sure that each element of the output vector is unique file_comments all file_search keywords can be used returns A scalar or array variable of string type containing the name with the full path of the matching files If no files exist with names matching the input arguments find returns the scalar string : NOT FOUND examples IDL print find loadct usr local rsi idl_6 0 lib utilities xloadct pro usr local rsi idl_6 0 lib loadct pro IDL print find loadct iodir dir recursive usr local rsi idl_6 0 lib loadct pro usr local rsi idl_6 0 lib utilities xloadct pro IDL print find loadct pro usr local rsi idl_6 0 lib utilities xloadct pro usr local rsi idl_6 0 lib loadct pro IDL print find loadct nopro NOT FOUND IDL print find loadct iodir usr local rsi idl_6 0 lib usr local rsi idl_6 0 lib loadct pro IDL print find loadct iodir usr local rsi idl_6 0 lib test_write NOT FOUND IDL print find loadct iodir usr local rsi idl_6 0 lib recursive usr local rsi idl_6 0 lib loadct pro usr local rsi idl_6 0 lib utilities xloadct pro IDL print find mesh iodirectory iodir path Users sebastie DATA ORCA2 meshmaskORCA2closea nc Users sebastie IDL meshmaskclosesea pro Users sebastie IDL meshmaskclosesea pro Users sebastie SAXO_RD Obsolete meshlec pro usr local rsi idl_6 0 lib mesh_obj pro history Sebastien Masson smasson lodyc jussieu fr 28 4 1999 6 7 1999: compatibilite mac et windows June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION find filein IODIRECTORY iodirectory RECURSIVE recursive REPERTOIRE repertoire NOPRO nopro ONLYPRO onlypro ONLYNC onlync UNIQUE unique FIRSTFOUND firstfound LOOKALLDIR LOOKALLDIR _extra ex define where we look for the file CASE 1 OF keyword_set lookalldir :BEGIN cm_general dirnames iodir homedir path tstdtadir file_dirname find find onlypro mark_directory tstdtadir file_search tstdtadir DATA TestsData 0 IF tstdtadir NE THEN dirnames tstdtadir dirnames END keyword_set iodirectory : dirnames iodirectory keyword_set repertoire : dirnames repertoire ELSE: dirnames path ENDCASE tmp dirnames dirnames dummy FOR i 0 n_elements tmp 1 DO dirnames dirnames strsplit tmp i path_sep search_path extract dirnames dirnames 1: fileout dummy FOR i 0 n_elements filein 1 DO BEGIN dir file_dirname filein i base file_basename filein i try to complete the file name with pro or nc if needed CASE 1 OF keyword_set onlypro :BEGIN promiss strpos base pro reverse_search promiss promiss strlen base 4 bad where promiss NE 0 OR strlen base LE 4 cnt IF cnt NE 0 THEN base bad base bad pro end keyword_set onlync :BEGIN ncmiss strpos base nc reverse_search ncmiss ncmiss strlen base 3 bad where ncmiss NE 0 OR strlen base LE 3 cnt IF cnt NE 0 THEN base bad base bad nc END ELSE:if strmid base 0 1 reverse_offset NE AND NOT keyword_set nopro THEN base base pro ENDCASE use dirnames only if dir eq IF dir EQ THEN BEGIN if keyword_set recursive THEN found file_search dirnames base _extra ex ELSE found file_search dirnames base _extra ex ENDIF ELSE found file_search dir base _extra ex IF found 0 NE THEN BEGIN IF keyword_set firstfound THEN BEGIN IF keyword_set unique THEN return found uniq found sort found ELSE return found ENDIF fileout fileout found ENDIF ENDFOR IF n_elements fileout EQ 1 THEN fileout NOT FOUND ELSE fileout fileout 1: IF n_elements fileout GT 1 THEN BEGIN IF keyword_set unique THEN fileout fileout uniq fileout sort fileout ENDIF ELSE fileout fileout 0 RETURN fileout END"); 389 a[387] = new Array("./Utilities/isadirectory.html", "isadirectory.pro", "", " file_comments check if a directory exists and make sure that it ends with the directory separator mark categories io param directoryin in optional a proposed directory If neither dirname input parameter of IODIRECTORY keyword are defined the ask the user to choose a directory keyword IODIRECTORY a proposed directory keyword TITLE the title of the window file_comments all dialog_pickfile keywords like filter can be used returns the directory name examples IDL print dir usr local rsi idl_6 0 IDL print isadirectory dir usr local rsi idl_6 0 IDL print isadirectory dir notgood history Sebastien Masson smasson lodyc jussieu fr June 28 2000 June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION isadirectory directoryin TITLE title IODIRECTORY iodirectory _extra ex CASE 1 OF size directoryin type 0 EQ 7:directory directoryin keyword_set iodirectory :directory iodirectory ELSE:directory directory that is not existing ENDCASE testfile file_test directory directory if directory doesn t exist we ask the user to provide a directory name IF total testfile NE n_elements directory THEN BEGIN IF NOT keyword_set title THEN title choose a directory FOR i 0 n_elements directory 1 DO BEGIN IF testfile i EQ 0 THEN BEGIN directory i dialog_pickfile directory title title must_exist _extra ex if directory i EQ THEN RETURN report check find directory canceled ENDIF ENDFOR ENDIF directory file_search directory mark_directory IF n_elements directory EQ 1 THEN RETURN directory 0 ELSE RETURN directory END"); 390 a[388] = new Array("./Utilities/isafile.html", "isafile.pro", "", " file_comments same as find pro except that as long as the file is NOT FOUND isafile calls dialog_pickfile to ask the user to select a file categories io param filein in optional a proposed name If neither filein input parameter of filename keyword are defined the ask the user to choose a file keyword FILENAME a proposed filename keyword IODIRECTORY a directory where we look for the file this keyword is taken into account only if the dirmame of filein or filename is keyword NEW to specify that filename is a new file and that we should check only its path keyword ONLYPRO force to look only at file ending with pro keyword ONLYNC force to look only at file ending with nc keyword RECURSIVE performs recursive searching of directory hierarchies In a recursive search find looks recursively for any and all subdirectories in the file hierarchy rooted at the IODIRECTORY argument file_comments all find file_search and dialog_pickfile keywords like title can be used returns the filename with its path examples IDL print isafile Users sebastie SAXO_RD Commons cm_4mesh pro Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir Users sebastie SAXO_RD Commons Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir path Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir Users sebastie SAXO_RD recursive Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile cm_4mesh pro iodir getenv HOME recursive Users sebastie SAXO_RD Commons cm_4mesh pro IDL print isafile fake_file pro history Sebastien Masson smasson lodyc jussieu fr 11 2 2000 June 2005: Sebastien Masson: cleaning use for file_ functions FUNCTION isafile filein FILENAME filename IODIRECTORY iodirectory NEW new RECURSIVE RECURSIVE ONLYPRO onlypro ONLYNC onlync _extra ex CASE 1 OF size filein type 0 EQ 7:fileout filein keyword_set filename :fileout filename ELSE:fileout file that is not existing ENDCASE if size fileout type NE 7 THEN return 1 CASE 1 OF keyword_set onlypro : filter pro keyword_set onlync : filter nc else: filter ENDCASE basename file_basename fileout dirname file_dirname fileout should we redefine dirname if keyword_set iodirectory AND dirname EQ then dirname iodirectory if keyword_set new then return dirname path_sep basename fileout find basename iodirectory dirname recursive recursive unique firstfound ONLYPRO onlypro ONLYNC onlync _extra ex WHILE fileout 0 EQ NOT FOUND DO BEGIN fileout dialog_pickfile path dirname 0 filter filter _extra ex if fileout EQ THEN RETURN report check find file canceled check again everything basename file_basename fileout dirname file_dirname fileout check if the name of the dirname is ok dirname isadirectory dirname title choose a directory for the file basename if we cancel the check IF size dirname type NE 7 THEN return report check find file canceled fileout find basename iodirectory dirname recursive recursive unique firstfound ONLYPRO onlypro ONLYNC onlync _extra ex ENDWHILE RETURN fileout END"); 391 a[389] = new Array("./Utilities/protype.html", "protype.pro", "", " file_comments test is a pro file corresponds to an IDL procedure function or batch file categories utilities param file in A scalar of string type the name of the pro file to be tested if necessary the input name is completed with pro and its path found in path returns A scalar of string type: proc func or batch examples IDL print protype protype func IDL print protype protype pro func IDL print protype init batch IDL print protype plt proc history Sebastien Masson smasson lodyc jussieu fr Feb 2006 FUNCTION protype file filepro find file 0 onlypro firstfound 0 if filepro EQ NOT FOUND then return 1 name file_basename filepro pro allines getfile filepro CASE 1 OF this is a procedure max stregex allines pro name fold_case boolean :RETURN proc this is a function max stregex allines function name fold_case boolean :RETURN func this is an IDL batch file ELSE:RETURN batch ENDCASE RETURN 1 END"); 392 a[390] = new Array("./buildinit.html", "buildinit.pro", "", " NAME: PURPOSE: CATEGORY: CALLING SEQUENCE: INPUTS: OPTIONAL INPUTS: KEYWORD PARAMETERS: OUTPUTS: OPTIONAL OUTPUTS: COMMON BLOCKS: SIDE EFFECTS: RESTRICTIONS: PROCEDURE: EXAMPLE: MODIFICATION HISTORY: slightly mofified version of cw_field FUNCTION CW_FIELD2 Parent COLUMN Column ROW Row EVENT_FUNC efun FLOATING Float INTEGER Int LONG Long STRING String FONT LabelFont FRAME Frame TITLE Title UVALUE UValue VALUE TextValueIn RETURN_EVENTS ReturnEvents ALL_EVENTS AllUpdates FIELDFONT FieldFont NOEDIT NoEdit TEXT_FRAME Text_Frame XSIZE XSize YSIZE YSize UNAME uname FLOOR vmin CEILING vmax resolve_routine cw_field compile_full_file is_function Examine our keyword list and set default values for keywords that are not explicitly set Column KEYWORD_SET Column Row 1 Column AllEvents 1 KEYWORD_SET NoEdit Enum Update None All CRonly Update 0 IF KEYWORD_SET AllUpdates THEN Update 1 IF KEYWORD_SET ReturnEvents THEN Update 2 IF N_ELEMENTS efun LE 0 THEN efun IF N_ELEMENTS Title EQ 0 THEN Title Input Field: TextValue N_ELEMENTS TextValueIn gt 0 TextValueIn : Convert non string values to strings if SIZE TextValue TNAME ne STRING then TextValue STRTRIM TextValue 2 IF N_ELEMENTS YSize EQ 0 THEN YSize 1 IF N_ELEMENTS uname EQ 0 THEN uname CW_FIELD_UNAME Type 0 string is default IF KEYWORD_SET Float THEN Type 1 IF KEYWORD_SET Int THEN Type 2 IF KEYWORD_SET Long THEN Type 3 Don t allow multiline non string widgets if Type ne 0 then YSize 1 YSize YSize 1 Build Widget Base WIDGET_BASE Parent ROW Row COLUMN Column UVALUE UValue EVENT_FUNC CW_FIELD_EVENT PRO_SET_VALUE CW_FIELD_SET FUNC_GET_VALUE CW_FIELD_GET FRAME Frame UNAME uname FOR i 0 n_elements title 1 DO Label WIDGET_LABEL Base VALUE Title i FONT LabelFont UNAME uname _LABEL align_left Text WIDGET_TEXT Base VALUE TextValue XSIZE XSize YSIZE YSize FONT FieldFont ALL_EVENTS AllEvents EDITABLE AllEvents AND TYPE EQ 0 FRAME Text_Frame UNAME uname _TEXT NO_ECHO AllEvents AND TYPE NE 0 Save our internal state in the first child widget State efun: efun TextId:Text Title:Title Update:Update Type:Type WIDGET_CONTROL WIDGET_INFO Base CHILD SET_UVALUE State NO_COPY RETURN Base END PRO printerdef_event event get back the ids of the cw_field widgets widget_control event id get_uvalue cwids IF size cwids n_dimensions EQ 1 THEN cwids reform cwids 3 1 help cwids dims size cwids dimensions help dims print dims results strarr dims FOR i 0 dims 1 1 DO BEGIN widget_control cwids 0 i get_value res results 0 i res widget_control cwids 1 i get_value res results 1 i res widget_control cwids 2 i get_value res results 2 i res ENDFOR nothing where results EQ count IF count NE 0 THEN BEGIN nothing dialog_message Some of the text box are still empty dialog_parent event top information return ENDIF now we give the result to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptresult ptresult temporary results we destroy the widget widget_control event top destroy RETURN END PRO papsize_event event get back the ids of the cw_field widgets widget_control event id get_uvalue uvalue IF uvalue 0 NE ok THEN return idist widget_info event top find_by_uname list id widget_info idist list_select widget_control idist get_uvalue selected selected selected id selected strsplit selected extract now we give the result to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptresult ptresult float selected 3 float selected 4 we destroy the widget widget_control event top destroy RETURN END PRO xask_event event now we give the answer to buildinit pro by using the pointer uvalue widget_control event top get_uvalue ptranswer ptranswer event value we destroy the widget widget_control event top destroy RETURN END FUNCTION xask _extra ex base widget_base field cw_field2 base frame return_events column _extra ex ptranswer ptr_new allocate_heap we realize the widget and wait for an answer widget_control base realize set_uvalue ptranswer xmanager xask base we get the answer answer ptranswer we freeing the pointer ptr_free ptranswer RETURN answer END FUNCTION getdir title title nomark nomark nowrite nowrite REPEAT BEGIN dir dialog_pickfile directory must_exist title title make sure dir is ok check read write access and directory separator mark dir file_search dir test_directory test_read test_write 1 keyword_set nowrite mark_directory 1 keyword_set nomark dir dir 0 ENDREP UNTIL dir NE RETURN dir END PRO buildinit IF fix strmid version release 0 1 LT 6 THEN BEGIN print print ERROR print print This version of SAXO needs at least IDL version 6 0 print print ERROR print return ENDIF IF lmgr demo EQ 1 THEN BEGIN print impossible to use buildinit in demo mode return ENDIF init This is the initialisation file it defines the path and the defaut values of some of the common variables this is supposed to speed up IDL a fltarr 1000 1000 100 a 0 path definition define myIDL directory myIDL getdir title Select the home directory my IDL nomark define SAXO directory saxodir getdir title Select SAXO directory nomark nowrite define the path init init path expand_path myIDL : expand_path saxodir : expand_path dir should we keep the compatibility with the old version yes dialog_message shall we keep the compatibility with the old version question default_no yes strlowcase yes init init compatibility with the old version keep_compatibility strtrim fix yes EQ yes 2 define all the commons init init define all the commons all_cm define default directories init init define default directories homedir isadirectory myIDL title Select the default HOME directory iodir getdir title Select the default IO directory init init iodir isadirectory iodir title Select the default IO directory psdir getdir title Select the default postscripts directory init init psdir isadirectory psdir title Select the default postscripts directory imagedir getdir title Select the default images directory init init imagedir isadirectory imagedir title Select the default images directory animdir getdir title Select the default animations directory init init animdir isadirectory animdir title Select the default animations directory number of printer ptnumb xask title Number of accessible printers value 0 long define all the printer parameters init init define printer parameters IF ptnumb NE 0 THEN BEGIN base widget_base column frame cwids lonarr 3 ptnumb FOR i 0 ptnumb 1 DO BEGIN subbase widget_base base row cwids 0 i cw_field subbase string Title printer_human_names strtrim i 2 cwids 1 i cw_field subbase string Title printer_machine_names strtrim i 2 cwids 2 i cw_field subbase string value lpr P Title printer_machine_names strtrim i 2 ENDFOR trash widget_button base value ok uvalue cwids ptresult ptr_new allocate_heap we realize the widget and wait for an answer widget_control base realize set_uvalue ptresult xmanager printerdef base init init printer_human_names strarr strtrim ptnumb 2 printer_machine_names strarr strtrim ptnumb 2 print_command strarr strtrim ptnumb 2 FOR i 0 ptnumb 1 DO BEGIN init init printer_human_names strtrim i 2 ptresult 0 i printer_machine_names strtrim i 2 ptresult 1 i print_command strtrim i 2 ptresult 2 i ENDFOR we freeing the pointer ptr_free ptresult ENDIF ELSE BEGIN init init printer_human_names printer_machine_names print_command ENDELSE Colors init init colors device decomposed 0 device retain 2 default color tables loadct get_names names ntables 40 title Choose the default color table the following lines come from loadct procedure nlines ntables 2 3 of lines to print nend nlines nlines 3 ntables for i 0 nend 1 do Print each line title title string format i2 a17 3x i2 a17 3x i2 a17 i names i i nlines names i nlines i 2 nlines xask title title value 39 long xask title title value 0 long 2 init init archive_ps strtrim archive_ps 2 end of the part that should be modified by the users if needed keep compatibility with the old version updateold filename xask title name of the init file written in homedir: myIDL value init pro string journal myIDL filename FOR i 0 n_elements init 1 DO journal init i journal RETURN END"); 394 393 395 394
Note: See TracChangeset
for help on using the changeset viewer.