; ;.............A bunch of basic/useful procedures.......................... ;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ;========================================================================= ;..Define procedures for setting up a basic map backgrounds... ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;...This would be handy, but doesn't work!!............ ;...."mapid" has to be defined *coming in* to a procedure....... ;++++++++ ;procedure map0(wid,mapid) ; begin ; mapid = create "Map0" mapPlotClass wid ; end create ; end ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;...NOTE ! : the basic map INSTANTIATION must be done outside of a procedure! ;++++++++ procedure map1 (wid,mapid) begin setvalues mapid "mpFillOn" : "false" "mpAreaMaskingOn" : "false" "vpYF" : 0.9 "vpHeightF" : 0.8 "vpXF" : 0.1 "vpWidthF" : 0.8 end setvalues ; end create end ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;++++++++ procedure map2 (wid,mapid) begin setvalues mapid "mpFillOn" : "true" "mpFillDrawOrder" : "draw" "mpAreaMaskingOn" : "false" "vpYF" : 0.9 "vpHeightF" : 0.8 "vpXF" : 0.1 "vpWidthF" : 0.8 end setvalues ; end create end ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;++++++++ procedure map3 (wid,mapid) local mask_specs begin mask_specs = "oceans" setvalues mapid "mpFillOn" : "true" "mpFillDrawOrder" : "postdraw" "mpAreaMaskingOn" : "true" "mpMaskAreaSpecifiers" : mask_specs "vpYF" : 0.9 "vpHeightF" : 0.8 "vpXF" : 0.1 "vpWidthF" : 0.8 end setvalues ; end create end ;-------------------------------------------------------------------- ;...Set up "mpFillColors" for land, water........ ;++++++++ procedure mapfill (mapid) begin setvalues mapid "mpFillOn" : "true" "mpOceanFillColor" : 2 "mpLandFillColor" : 3 "mpInlandWaterFillColor" : 4 end setvalues end ;==================================================================== ;...RESET THE LIMITS OF A MAP..... ;++++++++ procedure set_mplims(mapid, lat1,lat2, lon1,lon2) ;..set the map limits to the limits of the data extracted... begin setvalues mapid "mpLimitMode" : "latlon" "mpMinLatF" : lat1 "mpMaxLatF" : lat2 "mpMinLonF" : lon1 "mpMaxLonF" : lon2 "vpYF" : 0.9 "vpHeightF" : 0.8 "vpXF" : 0.1 "vpWidthF" : 0.8 end setvalues ; ...Set up "mpFillColors" for land, water........ mapfill (mapid) end ;==================================================================== ;...RE-START A MAPID.....>> NO LONGER NEEDED SINCE FOUND "NhlRemoveOverlay" ;++++++++ ;procedure restart_mapid(mapid,wid) ;begin ;; delete (mapid) ; ! ILLEGAL !!! ; mapid = create "Map0" mapPlotClass wid ; "vpYF" : 0.9 ; "vpHeightF" : 0.8 ; "vpXF" : 0.1 ; "vpWidthF" : 0.8 ; end create ;end ;========================================================================= ;========================================================================= ;========================================================================= ;.......SIMPLE MIN/MAX FINCTIONS..... ;----------------------- ;++++++++ function amin(a,b) local tmp begin tmp=1. if (a.gt.b) then tmp=b else tmp=a end if return(tmp) end ;----------------------- ;++++++++ function amax(a,b) local tmp begin tmp=1. if (a.gt.b) then tmp=a else tmp=b end if return(tmp) end ;----------------------- ;++++++++ ;procedure getfield(fileid,fvarnam,nvarnam) ;begin ; nvarnam = fileid->fvarnam ;end ;========================================================================= ;========================================================================= ;========================================================================= ;...adjust colormap to have 10 elements at start for ocean, land, etc. ;....(see "mpFillColors").... ;++++++++ procedure adjust_colormap(wid) local cmap1,cmap2,lencmap,tmp1,i,j,fillindices begin getvalues wid "wkColorMapLen" : lencmap end getvalues lennewcmap=lencmap+8 cmap1=new((/lencmap,3/), float) cmap2=new((/lennewcmap,3/), float) cmap2(0:1,:)=cmap1(0:1,:) do i=2,lencmap-1 cmap2(i+8,:)=cmap1(i,:) end do cmap2(2,:)=(/.80,.90,.91/) ; ocean cmap2(3,:)=(/.90,.80,.75/) ; land cmap2(4,:)=(/.80,.85,.93/) ; inland water cmap2(5,:)=(/.90,.90,.90/) ; cmap2(6,:)=(/.80,.80,.80/) cmap2(6,:)=(/.70,.70,.70/) cmap2(7,:)=(/.60,.60,.60/) cmap2(8,:)=(/.50,.50,.50/) cmap2(9,:)=(/.40,.40,.40/) setvalues wid "wkColorMap" : cmap2 end setvalues end ; clear(wid) ; draw(mapid) ;-------------------------------------------------------------------- ;.......SELECT COLORS FROM COLORMAP FOR CONTOUR FILL..... ;...Note: skip first 10 element (fg,bg,ocean,land,water,reserved)... ;++++++++ procedure set_cnfill(wid, cnid) local nclev,lencmap,tmp1,i,j,fillindices begin getvalues wid "wkColorMapLen" : lencmap end getvalues getvalues cnid "cnLevelCount" : nclev end getvalues fillindices = new (nclev+1, integer) lencmapm=lencmap-10 tmp1=new(1,float) j=new(1,integer) do i=1,nclev+1 tmp1=i frac=tmp1/(nclev+1) j=floattoint(floor(frac*lencmapm)) if (j.gt.lencmap) then j=j-lencmap end if fillindices(i-1) = j+9 end do setvalues cnid "cnFillOn" : "true" "cnFillColors" : fillindices "cnLineColors" : fillindices end setvalues end ;--------------------------------------------------------------------- ;....FORCE BLACK LETTERS ON WHITE BKGRD......... ;++++++++ procedure black_on_white (wid) begin setvalues wid "wkBackgroundColor" : (/1.0, 1.0, 1.0/) "wkForegroundColor" : (/ 0., 0., 0./) end setvalues end ;--------------------------------------------------------------------- ;....FORCE WHITE LETTERS ON BLACK BKGRD......... ;++++++++ procedure white_on_black (wid) begin setvalues wid "wkBackgroundColor" : (/ 0., 0., 0./) "wkForegroundColor" : (/1.0, 1.0, 1.0/) end setvalues end ;========================================================================= ;========================================================================= ;========================================================================= ;....Set a bunch of contour label specs.... ;++++++++ procedure cnlabels(cnid) begin setvalues cnid ; "cnLineLabelBackgroundColor" : 0 ; (background) ; "cnHighLabelBackgroundColor" : 0 ; appears to control Low labels, too "cnLineLabelBackgroundColor" : -1 "cnHighLabelBackgroundColor" : -1 ; appears to control Low labels, too "cnLineLabelFont" : 21 "cnHighLabelFont" : 21 "cnLowLabelFont" : 21 "cnLineLabelPerimSpaceF" : .1 "cnHighLabelPerimSpaceF" : .1 "cnLowLabelPerimSpaceF" : .1 "cnLineLabelFontHeightF" : .013 "cnHighLabelFontHeightF" : .016 ; appears to control Low labels, too "cnLowLabelFontHeightF" : .016 "cnLineLabelAngleF" : 0 end setvalues end ;--------------------------------------------------------------------- ;....CONTOUR A DATA ARRAY.... ;+++++++++ procedure contour(appid,wid,cnid,dataid, ARRAY[*][*],lat1,lat2,lon1,lon2) begin ; delete (dataid) ; dataid = create "data_1" scalarFieldClass appid setvalues dataid "sfDataArray" : ARRAY "sfXCStartV" : lon1 "sfXCEndV" : lon2 "sfYCStartV" : lat1 "sfYCEndV" : lat2 end setvalues ; end create setvalues cnid "cnScalarFieldData" : dataid "cnLabelDrawOrder" : "postdraw" ;puts labels on last "cnLineLabelFont" : 21 end setvalues ; ...Set a bunch of contour label specs.... cnlabels(cnid) ; ...Pick colorfill colors from the wid colormap... set_cnfill(wid, cnid) end ;==================================================================== ;==================================================================== ;==================================================================== ; Define a procedure for creating a 64-element colormap.... ;++++++++ procedure gen_colormap_64(cmap) begin ;This procedure explicitly sets the red, green, and blue ;intensities for each element in a 64-element colormap array. ; Create a 64x3 array for the colormap (the first dimension is arbitrary). ; The second dimension represents each component of an RGB triple. ; cmap = new ((/64,3/), float) ; Set the color map cmap( 63,:) = (/1.00,.000,.000/) cmap( 62,:) = (/1.00,.000,.000/) cmap( 61,:) = (/.990,.000,.000/) cmap( 60,:) = (/.950,.010,.000/) cmap( 59,:) = (/.900,.030,.000/) cmap( 58,:) = (/.870,.050,.000/) cmap( 57,:) = (/.830,.070,.000/) cmap( 56,:) = (/.800,.090,.000/) cmap( 55,:) = (/.750,.090,.000/) cmap( 54,:) = (/.700,.090,.000/) cmap( 53,:) = (/.700,.100,.000/) cmap( 52,:) = (/.700,.120,.000/) cmap( 51,:) = (/.700,.130,.000/) cmap( 50,:) = (/.700,.180,.000/) cmap( 49,:) = (/.700,.240,.000/) cmap( 48,:) = (/.700,.260,.000/) cmap( 47,:) = (/.700,.270,.000/) cmap( 46,:) = (/.700,.285,.000/) cmap( 45,:) = (/.690,.300,.000/) cmap( 44,:) = (/.680,.330,.000/) cmap( 43,:) = (/.675,.375,.000/) cmap( 42,:) = (/.570,.420,.000/) cmap( 41,:) = (/.565,.485,.000/) cmap( 40,:) = (/.560,.530,.000/) cmap( 39,:) = (/.555,.545,.000/) cmap( 38,:) = (/.550,.550,.000/) cmap( 37,:) = (/.160,.565,.000/) cmap( 36,:) = (/.130,.570,.000/) cmap( 35,:) = (/.100,.575,.000/) cmap( 34,:) = (/.060,.680,.000/) cmap( 33,:) = (/.030,.685,.000/) cmap( 32,:) = (/.000,.690,.000/) cmap( 31,:) = (/.000,.725,.000/) cmap( 30,:) = (/.000,.700,.100/) cmap( 29,:) = (/.000,.650,.200/) cmap( 28,:) = (/.000,.600,.300/) cmap( 27,:) = (/.000,.550,.400/) cmap( 26,:) = (/.000,.500,.500/) cmap( 25,:) = (/.000,.450,.600/) cmap( 24,:) = (/.000,.400,.700/) cmap( 23,:) = (/.000,.350,.700/) cmap( 22,:) = (/.000,.300,.700/) cmap( 21,:) = (/.000,.250,.700/) cmap( 20,:) = (/.000,.200,.700/) cmap( 19,:) = (/.000,.150,.700/) cmap( 18,:) = (/.000,.100,.700/) cmap( 17,:) = (/.000,.050,.700/) cmap( 16,:) = (/.000,.000,.700/) cmap( 15,:) = (/.050,.050,.700/) cmap( 14,:) = (/.100,.100,.700/) cmap( 13,:) = (/.150,.150,.700/) cmap( 12,:) = (/.200,.200,.700/) cmap( 11,:) = (/.250,.250,.700/) cmap( 10,:) = (/.300,.300,.700/) cmap( 9,:) = (/.350,.350,.700/) cmap( 8,:) = (/.420,.400,.700/) cmap( 7,:) = (/.450,.450,.700/) cmap( 6,:) = (/.560,.500,.700/) cmap( 5,:) = (/.550,.550,.700/) cmap( 4,:) = (/.610,.600,.700/) cmap( 3,:) = (/.650,.650,.700/) cmap( 2,:) = (/.700,.700,.700/) ; Entry 1 is the foreground color. ; The continental outlines in the map object use this color ; as a default. cmap( 1,:) = (/.999,.999,.999/) ;JPS: this doesn't work! ; Entry 0 is the background color. cmap( 0,:) = (/.000,.000,.000/) end