;********************************************************************* PRO readmesh, filename, filetype, _extra = ex ; case filetype of 'OPA C-Grid.Binary IEEE: Meshmask':BEGIN meshlec, filename, /pasblabla, _extra = ex END 'OPA C-Grid.Net Cdf: Meshmask':BEGIN ncdf_meshlec, filename, _extra = ex END 'Regular 2D.Binary IEEE: mask': 'Regular 2D.Net Cdf: mask': 'Regular 3D.Binary IEEE: mask+vertical axis': 'Regular 3D.Net Cdf: mask+vertical axis': 'Gaussian 2D.T30 truncature.Binary IEEE: mask': 'Gaussian 2D.T30 truncature.Net Cdf: mask': 'Gaussian 2D.T42 truncature.Binary IEEE: mask': 'Gaussian 2D.T42 truncature.Net Cdf: mask': 'Gaussian 3D.T30 truncature.Binary IEEE: mask': 'Gaussian 3D.T30 truncature.Net Cdf: mask': 'Gaussian 3D.T42 truncature.Binary IEEE: mask': 'Gaussian 3D.T42 truncature.Net Cdf: mask': ELSE : ENDCASE ; return end ;********************************************************************* FUNCTION getgridparameter, top @common widget_control, widget_info(top, find_by_uname = 'xmesh'), get_value = answer jpiglo = long(answer[0]) jpi = long(answer[1]) ixminmesh = long(answer[2]) ixmaxmesh = long(answer[3]) widget_control, widget_info(top, find_by_uname = 'ymesh'), get_value = answer jpjglo = long(answer[0]) jpj = long(answer[1]) iyminmesh = long(answer[2]) iymaxmesh = long(answer[3]) widget_control, widget_info(top, find_by_uname = 'zmesh'), get_value = answer jpkglo = long(answer[0]) jpk = long(answer[1]) izminmesh = long(answer[2]) izmaxmesh = long(answer[3]) widget_control, widget_info(top, find_by_uname = 'key_shift') $ , get_value = answer key_shift = long(answer[0]) widget_control, widget_info(top, find_by_uname = 'key_periodique') $ , get_value = answer key_periodique = long(answer[0]) widget_control, widget_info(top, find_by_uname = 'triangulation') $ , get_value = answer triangulation = answer[0] EQ 'y' widget_control, widget_info(top, find_by_uname = 'Glam Boundary') $ , get_value = answer rien = execute('boundary = float('+answer[0]+')') res = {jpiglo:jpiglo, jpjglo:jpjglo, jpkglo:jpkglo, jpi:jpi, jpj:jpj, jpk:jpk $ , ixminmesh:ixminmesh, ixmaxmesh:ixmaxmesh $ , iyminmesh:iyminmesh, iymaxmesh:iymaxmesh $ , izminmesh:izminmesh, izmaxmesh:izmaxmesh $ , key_shift:key_shift, key_periodique:key_periodique $ , triangulation:triangulation, boundary:boundary} return, res end ;********************************************************************* pro showgridparameter, basetop, EDITABLE = editable, _EXTRA = ex ; @common ;------------------------------------------------------------ ; widget_control, basetop, update = 0 base=widget_base(basetop, /COLUMN, /align_center, _EXTRA = ex) nothing = cw_fourparameter(base, jpiglo, jpi, ixminmesh, ixmaxmesh, 'x', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'xmesh') nothing = cw_fourparameter(base, jpjglo, jpj, iyminmesh, iymaxmesh, 'y', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'ymesh') nothing = cw_fourparameter(base, jpkglo, jpk, izminmesh, izmaxmesh, 'z', 'mesh', EDITABLE = editable, CLEAR = editable, uname = 'zmesh') nothing = widget_label(base, value = 'autres parametres ...') basea=widget_base(base, /row, /align_center) nothing = widget_label(basea, value = 'key_shift') if NOT keyword_set(key_shift) then key_shift = 0 nothing = widget_text(basea, value = strtrim(key_shift*(1-keyword_set(editable)),1), uname = 'key_shift', xsize = 4, EDITABLE = editable) nothing = widget_label(basea, value = 'key_periodique') if NOT keyword_set(key_periodique) then key_periodique = 0 nothing = widget_text(basea, value = strtrim(key_periodique*(1-keyword_set(editable)),1), uname = 'key_periodique', xsize = 4, EDITABLE = editable) baseb=widget_base(base, /row, /align_center) nothing = widget_label(baseb, value = 'use a triangulation (y/n) ?') nothing = widget_text(baseb, value = 'y', uname = 'triangulation', xsize = 4, EDITABLE = editable) if NOT keyword_set(editable) then begin ming = min(glamt, max = maxg) value = tostr([floor(ming), ceil(maxg)]) ENDIF ELSE value = tostr([0, 0]) nothing = widget_label(baseb, value = 'Glam Boundary') nothing = widget_text(baseb, value = value, uname = 'Glam Boundary', xsize = 10, EDITABLE = editable) nothing = widget_button(base, value = 'Ok, Get the Mesh parameters!', uvalue = {name:'ok finish'}) widget_control, basetop, update = 1 ; return END ;********************************************************************* FUNCTION give_file_type_choice, type = type if keyword_set(type) then begin case type of 'nc':desc = [ '1\File or Grid type: ' , $ '0\OPA C-Grid.Net Cdf: Meshmask' , $ '0\Regular 2D.Net Cdf: mask' , $ '0\Regular 3D.Net Cdf: mask+vertical axis' , $ '1\Gaussian 2D' , $ '0\T30 truncature.Net Cdf: mask' , $ '2\T42 truncature.Net Cdf: mask' , $ '1\Gaussian 3D' , $ '0\T30 truncature.Net Cdf: mask+vertical axis' , $ '2\T42 truncature.Net Cdf: mask+vertical axis' , $ '2\No file' ] endcase ENDIF ELSE BEGIN desc = [ '1\File or Grid type: ' , $ '0\OPA C-Grid.Binary IEEE: Meshmask' , $ '0\Regular 2D.Binary IEEE: mask' , $ '0\Regular 3D.Binary IEEE: mask+vertical axis' , $ '1\Gaussian 2D' , $ '0\T30 truncature.Binary IEEE: mask' , $ '2\T42 truncature.Binary IEEE: mask' , $ '1\Gaussian 3D' , $ '0\T30 truncature.Binary IEEE: mask+vertical axis' , $ '2\T42 truncature.Binary IEEE: mask+vertical axis' , $ '2\No file' ] ; desc = [ '1\File or Grid type: ' , $ ; '1\OPA C-Grid' , $ ; '0\Binary IEEE: Meshmask' , $ ; '2\Net Cdf: Meshmask' , $ ; '1\Regular 2D' , $ ; '0\Binary IEEE: mask' , $ ; '2\Net Cdf: mask' , $ ; '1\Regular 3D' , $ ; '0\Binary IEEE: mask+vertical axis' , $ ; '2\Net Cdf: mask+vertical axis' , $ ; '1\Gaussian 2D' , $ ; '1\T30 truncature' , $ ; '0\Binary IEEE: mask' , $ ; '2\Net Cdf: mask' , $ ; '1\T42 truncature' , $ ; '0\Binary IEEE: mask' , $ ; '2\Net Cdf: mask' , $ ; '2\' , $ ; '1\Gaussian 3D' , $ ; '1\T30 truncature' , $ ; '0\Binary IEEE: mask+vertical axis' , $ ; '2\Net Cdf: mask+vertical axis' , $ ; '1\T42 truncature' , $ ; '0\Binary IEEE: mask+vertical axis' , $ ; '2\Net Cdf: mask+vertical axis' , $ ; '2\' , $ ; '2\No file' ] ENDELSE return, desc end ;********************************************************************* PRO whichgrid_event, event @common widget_control, event.id, get_uvalue = eventuvalue IF chkstru(eventuvalue,'name') EQ 0 THEN return case eventuvalue.name OF 'Cancel':BEGIN widget_control, event.handler, get_uvalue = messenger *messenger = -1 widget_control,event.handler,/destroy END 'filename':BEGIN ; on detruit, si il existe deja, ce que l''on va ajouter au widget typebaseid = widget_info(event.handler, find_by_uname = 'typebase') if typebaseid NE 0 then widget_control,typebaseid,/destroy showgridparameterid = widget_info(event.handler, find_by_uname = 'showgridparameter') if showgridparameterid NE 0 then widget_control,showgridparameterid,/destroy ; widget_control, event.id, get_value = filename filename = filename[0] filename = isafile(filename = filename) if size(filename, /type) NE 7 then return if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin createpro, '@'+strmid(filename, 0, strlen(filename)-4) $ , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $ +'for_createpro.pro' showgridparameter, event.handler, group_leader = event.handler,/frame, uname = 'showgridparameter' ENDIF ELSE BEGIN basetype=widget_base(event.handler, /row, /align_center, group_leader = event.handler, uname = 'typebase') type = '' if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc' nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'}) nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'}) ENDELSE END 'browse filename':BEGIN ; on detruit, si il existe deja, ce que l''on va ajouter au widget typebaseid = widget_info(event.handler, find_by_uname = 'typebase') if typebaseid NE 0 then widget_control,typebaseid,/destroy showgridparameterid = widget_info(event.handler, find_by_uname = 'showgridparameter') if showgridparameterid NE 0 then widget_control,showgridparameterid,/destroy ; filename = isafile() if size(filename, /type) NE 7 then return widget_control, widget_info(event.handler, find_by_uname = 'Filename'), set_value = filename if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin createpro, '@'+strmid(filename, 0, strlen(filename)-4) $ , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $ +'for_createpro.pro' showgridparameter, event.handler, group_leader = event.handler,/frame, uname = 'showgridparameter' ENDIF ELSE BEGIN basetype=widget_base(event.handler, /row, /align_center, group_leader = event.handler, uname = 'typebase') type = '' if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc' nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'}) nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'}) ENDELSE END 'file type choice':BEGIN widget_control, widget_info(event.handler,find_by_uname='Filename'), get_value = filename filename = filename[0] filetype = event.value filetype = strmid(filetype, strpos(filetype, '.')+1) widget_control, widget_info(event.handler, find_by_uname = 'file type'), set_value = filetype case filetype of 'OPA C-Grid.Binary IEEE: Meshmask':BEGIN meshlec, filename, /pasblabla, /getdimensions showgridparameter, event.handler, /editable, group_leader = event.handler,/frame, uname = 'showgridparameter' END 'OPA C-Grid.Net Cdf: Meshmask':BEGIN ncdf_meshlec, filename, /getdimensions showgridparameter, event.handler, /editable, group_leader = event.handler,/frame, uname = 'showgridparameter' END 'Regular 2D.Binary IEEE: mask': 'Regular 2D.Net Cdf: mask': 'Regular 3D.Binary IEEE: mask+vertical axis': 'Regular 3D.Net Cdf: mask+vertical axis': 'Gaussian 2D.T30 truncature.Binary IEEE: mask': 'Gaussian 2D.T30 truncature.Net Cdf: mask': 'Gaussian 2D.T42 truncature.Binary IEEE: mask': 'Gaussian 2D.T42 truncature.Net Cdf: mask': 'Gaussian 3D.T30 truncature.Binary IEEE: mask': 'Gaussian 3D.T30 truncature.Net Cdf: mask': 'Gaussian 3D.T42 truncature.Binary IEEE: mask': 'Gaussian 3D.T42 truncature.Net Cdf: mask': ELSE : endcase END 'file type':BEGIN help, event, /struct END 'ok finish':BEGIN widget_control, widget_info(event.handler,find_by_uname='Filename'),get_value=filename filename = filename[0] typeid = widget_info(event.handler,find_by_uname='file type') if typeid NE 0 then begin widget_control, typeid, get_value=filetype filetype = filetype[0] ENDIF ELSE filetype = 'batch file' widget_control, event.handler, get_uvalue = messenger *messenger = create_struct('filename', filename, 'filetype', filetype, getgridparameter(event.handler)) ; readmesh, filename, filetype[0], glamboundary = (*messenger).boundary ; widget_control,event.handler,/destroy END ELSE: endcase return END ;********************************************************************* FUNCTION whichgrid, name, IODIRECTORY = iodirectory, PARENT = parent, _EXTRA = ex @common ; ; if n_elements(name) NE 0 then begin filename = isafile(filename = name) if size(filename, /type) NE 7 then return, -1 ENDIF ELSE filaname = 'no file' ; ; pour recuperer les reponses possees lors de l''utilisation de ce ; widget on cree un pointeur que l''on place dans la uvalue. Comme ca ; une fois que le widget est detruit dans la procedure ...event.pro, ; la variable surlaquelle pointait le pointeur (contenue ds la uvalue ; du widget) n''est pas detruite est on peut recuperer le resultat! ; messenger = ptr_new(/allocate_heap) ; if keyword_set(parent) then BEGIN base=widget_base(parent, /COLUMN, title = 'whichgrid', /align_center, uvalue = messenger, _EXTRA = ex) ENDIF ELSE BEGIN base=widget_base(/COLUMN, title = 'whichgrid', /align_center, uvalue = messenger, _EXTRA = ex) nothing = widget_button(base, value = 'Cancel', uvalue = {name:'Cancel'}) ENDELSE ; basemane=widget_base(base, /row, /align_center) nothing = widget_label(basemane, value = 'Mesh Filename or IDL batch file') nothing = widget_text(basemane, value = filename, uname = 'Filename', uvalue = {name:'filename'}, /editable) nothing = widget_button(basemane, value = 'Browse', uvalue = {name:'browse filename'}) ; if filename NE 'no file' then begin if rstrpos(filename, '.pro') EQ strlen(filename)-4 then begin createpro, '@'+strmid(filename, 0, strlen(filename)-4) $ , filename = isadirectory(io = homedir, title = 'Bad definition of Homedir') $ +'for_createpro.pro' showgridparameter, base, group_leader = base,/frame, uname = 'showgridparameter' ENDIF ELSE BEGIN basetype=widget_base(base, /row, /align_center, group_leader = base, uname = 'typebase') type = '' if rstrpos(filename, '.nc') EQ strlen(filename)-3 then type = 'nc' nothing = cw_pdmenu(basetype, give_file_type_choice(type = type), /return_full_name, uname = 'file type choice', uvalue = {name:'file type choice'}) nothing = widget_text(basetype, value = '', uname = 'file type', uvalue = {name:'file type'}) ENDELSE endif ; widget_control,base,/realize xmanager,'whichgrid', base,event_handler = 'whichgrid_event', no_block = 0 res = *messenger ptr_free, messenger return, res end