",{"class":"quizMarker"});oi.append(i),v.setSize(i.width()),v.setColor(i.css("color")),i.remove(),ai.show()}Mi=!0,_(),wn.hide(),$t()&&C.setOnBugCallback(function(e){1===e&&cn("#videoWrapper","For the best experience, avoid tapping the video while inputting text.",!0)}),en()}function $t(){return i.isIPad()&&8>i.getIOSMajorVersion()&&Xi&&(Bi||g()&&s.quizEnabled()&&h.quizContainsTextInputQuestions())}function en(){Wi=!1,Fi=!1,l.isPlaylist()&&(l.onFirstMedia()?(Mn.removeClass("previous_button_normal"),Mn.addClass("previous_button_disabled")):(Mn.addClass("previous_button_normal"),Mn.removeClass("previous_button_disabled")),l.onLastMedia()?(Ln.removeClass("next_button_normal"),Ln.addClass("next_button_disabled")):(Ln.addClass("next_button_normal"),Ln.removeClass("next_button_disabled")),d.isEnabled()&&(d.clearPercentWatched(),wi=0),Cn.src=l.getCurrentMedia().mediaSrc),i.isIPad()||i.isAndroid()?Cn.play():(Cn.load(),Cn.play()),d.isEnabled()&&d.setVideoLoadStartTime((new Date).getTime()),u.getTrackEvents()&&Yi&&(Yi=!1,u.getAltEventCategoryAsFilename()?n("Video_Started",Zi):n("Video_Started",""+l.getCurrentMedia().mediaSrc),n("Video_Percent_Viewed","Viewed: 0 Percent"))}function tn(e){switch(e.type){case"COMPLETE":case"REVIEW":if(Wn&&Qi?$(!0):_t(!0),E(),Pt(),L(),"REVIEW"===e.type&&u.getEnforceLinearAssessment()){var t=s.findPrevMarkerTimeForMarker(Ti);Ti=-1,st(t/1e3),Cn.play()}else Cn.play();break;case"BEGIN":case"SKIP":s.setViewContainer("#videoWrapper"),yn.unbind("click",an),bn?Hi&&s.getQuizReady()&&(B(),Cn.play(),Mi=!0,_()):Xt(),s.startTrackingProgress();break;case"ERROR":bn||Xt(),cn("#videoWrapper",r.getString("txtErrorMessage"),!0);break;case"STATUS":Wt(e.message);break;case"SUBMITTED":Jt()}}function nn(n,a){oi=t(n),pn=n,gn=pn.replace(/^[#]/,""),Bi=a,$i=i.requiresManualPreload()&&Xi,oi.html(ia),wn=t("#controls"),Nn=wn.find(".controls_left"),xn=wn.find(".controls_right"),Rn=t("#rewind"),Pn=t("#play"),Mn=t("#previous"),Ln=t("#next"),$n=t("#volume"),Bn=t("#closedCaptionButton"),Dn=t("#tocButton"),On=t("#settingsButton"),_n=t("#fullscreen_enter_button"),ei=t("#volume_slider_vertical"),ti=t("#volume_slider_horizontal"),ni=t("#volume_slider_container"),Qn=t("#progress"),Vn=t("#progress_box"),Gn=t("#load_progress"),Fn=t("#play_progress"),qn=t("#progress_scrubbar_track"),Un=t("#current_time_display"),Hn=t("#duration_display"),zn=t("#scrubbar_scrubber"),Wn=t("#videoSidebar"),Jn=t("#tableOfContentsList"),Kn=t("#searchBox"),kn=t("#clearSearchButton"),Zn=t("#caption"),Xn=t("#caption > p"),ii=t("#hotspots"),ai=t("#markers"),Tn=t("#videoWrapper"),En=t("#videoDiv"),yn=t("#videoClickToPlayLink"),In=t("#videoClickToReplayLink"),ri=t("#youtubePointerEventWorkaround"),si=t(document),$i&&yn.addClass("noClickToPlayEvents"),oi.css("background-color",u.getBackgroundColor()),u.getPosterImageSrc()&&w(u.getPosterImageSrc()),oi.fadeIn(li),In.fadeIn(li),In.hide(),(i.isIPad()||i.isAndroid())&&($n.hide(),_n.hide(),$n.remove()),Bi&&Dn.removeClass(Ki),f.hasCaptionItems()&&("under"===f.getCaptionPosition()?u.setAutoHideControls(!1):Bn.removeClass(Ki)),l.isPlaylist()?(Mn.removeClass(Ki),Ln.removeClass(Ki)):(Mn.addClass(Ki),Ln.addClass(Ki)),_(),t(e).resize(function(){Mi=!0,_()
+}),Kn.focus(function(){Vi=!0,Kn.val()==na.getString("search")&&Kn.val(""),y(),Dt()}),Kn.blur(function(){Vi=!1,""===Kn.val().replace(/ /g,"")&&Kn.val(na.getString("search")),E(),Bt()})}function an(e){e.preventDefault(),hn&&hn(),g()&&s.quizEnabled()?Kt():Xt()}function rn(){TSC.playerView.displayMessagePanel("#tsc_overlay",TSC.localizationStrings.getString("txtQuizErrorMessage"),!1)}function on(){t("#alertDialog").hide()}function sn(){Kn.val(na.getString("search"));var e=i.isIPad()&&!i.isNuevoApp();if((e||i.isAndroid()||g()&&s.quizEnabled())&&!u.getMobileWebViewCanAutoPlay()&&u.setAutoPlayMedia(!1),u.getAutoPlayMedia()===!0&&void 0===u.getJumpToTime()?(hn&&hn(),setTimeout(Xt,80)):yn.bind("click",an),g()&&s.quizEnabled()){s.setViewContainer(pn);var t;t=u.getFathomId()?p:m,s.setQuestionGrader(t),s.setQuestionData(h),s.setViewControlBarOffset(wn.height()),s.addEventListener("COMPLETE",tn),s.addEventListener("REVIEW",tn),s.addEventListener("BEGIN",tn),s.addEventListener("SKIP",tn),s.addEventListener("ERROR",tn),s.addEventListener("STATUS",tn),s.addEventListener("SUBMITTED",tn),s.addEventListener("SHOW_LOADING_MESSAGE",zt),s.addEventListener("HIDE_LOADING_MESSAGE",Jt),s.addEventListener("SHOW_SUBMISSION_RETRY_MESSAGE",rn),s.addEventListener("HIDE_SUBMISSION_RETRY_MESSAGE",on),void 0!==u.getJumpToTime()&&setTimeout(Kt,80)}else void 0!==u.getJumpToTime()&&setTimeout(Xt,80);(u.getTrackEvents()||u.getReportScormComplete()||g()&&s.quizEnabled())&&(d.setEnabled(!0),f.xmpAvailable()&&d.initPercentWatched(f.getMediaDuration())),ci=!0,u.getDebugUIMode()&&An&&An.call(this)}function un(){ii.removeClass(Ki),ii.find("map").empty(),t.each(f.getHotspotItemArray(),function(e,n){var i;if(l.isPlaylist()&&(i=l.getCurrentMedia().mediaSrc),void 0===n.file||n.file===i){n.viewpoints=[];for(var e=0;n.points.length>e;e+=2){var a={xorig:Math.round(n.points[e]),yorig:Math.round(n.points[e+1]),xscale:Math.round(n.points[e])/di,yscale:Math.round(n.points[e+1])/fi};n.viewpoints.push(a)}n.pointsToCoords=function(){for(var e=[],t=0;this.viewpoints.length>t;t++)e.push(this.viewpoints[t].xorig>=0?Math.round(this.viewpoints[t].xscale*ii.width()):0),e.push(this.viewpoints[t].yorig>=0?Math.round(this.viewpoints[t].yscale*ii.height()):0);return e.join(",")},n.jqel=t("
",{shape:"poly",coords:n.pointsToCoords(),hotspot_index:n.index,alt:"Hotspot",href:"#"})}})}function cn(e,n,i){n="
"+n+"",i&&(n+="
"+na.getString("clickToClose")+"
"),ci?(t("#alertDialog").html(n),t("#alertDialog").fadeIn(li)):(t(e).css("background-color",u.getBackgroundColor()),t(e).css("height","100%"),t(e).html('
'+n+"
"),t(e).fadeIn(li),t("#alertDialog").show()),i&&t("#alertDialog").bind("click",function(){on(),t("#alertDialog").unbind("click")})}function ln(){var e="#000";u.getPosterImageSrc()&&(e+=" url("+u.getPosterImageSrc()+") center no-repeat"),t(".appplayer").css({background:e,position:"relative","background-size":"cover",height:"100%","z-index":"1"})}function dn(e){var n,a=t(e);if(TSC.mediaPlayer.isNuevoAppCapableAndAvailable()&&(f.hasAdvancedFeatures()||u.getFathomId())){n=u.getUseSlimAppSplashScreen()?o.ios_app_slim_splash_template({openWithSmartPlayer:na.getString("openWithSmartPlayer")}):o.ios_app_splash_template({playWithSmartPlayer:na.getString("playWithSmartPlayer"),playVideoOnly:na.getString("playVideoOnly")}),a.after(n),ln();var r=t(".appplayer");r.show(),a.hide(),u.getUseSlimAppSplashScreen()?t(".openVideoSmartPlayerContainer").click(function(){TSC.mediaPlayer.redirectToiPhoneApp()}):(t(".externalLargePlayBtn").click(function(){r.hide(),a.show(),TSC.mediaPlayer.redirectToiPhoneApp()}),t(".appNativePlayBtn").click(function(){r.hide(),a.show(),bn=t("video"),Cn.play()}),t(".appstoreBtn").click(function(){TSC.mediaPlayer.redirectToiPhoneAppDownload()}))}else if(i.isIPhoneOrIPod()){n=o.ios_app_default_template(),a.after(n);var s=t(".externalDefaultPlaybackContainer");u.getPosterImageSrc()&&(I(s,u.getPosterImageSrc()),s.addClass("fullSizePosterImgContainer")),s.show(),a.hide(),s.click(function(e){e.preventDefault(),a.show(),bn=t("video"),Cn.play(),setTimeout(function(){a.hide()},1e3)})}}function fn(e){if(isNaN(e)){var t=0,n=0,i=0,a=e.toLowerCase(),r=RegExp("(\\d+[h])","g"),o=RegExp("(\\d+[m])","g"),s=RegExp("(\\d+[s])","g"),u=RegExp("\\d+","g"),c=a.match(r),l=a.match(o),d=a.match(s),f=a.match(u);return d||l||c?(c&&(t=60*60*Number(c[0].split("h").join(""))),l&&(n=60*Number(l[0].split("m").join(""))),d&&(i=Number(d[0].split("s").join(""))),Number(t+n+i)):f?i=Number(f[0]):0}return 0>e&&(e=0),e}var pn,gn,hn,mn,vn,An,Sn,bn,Cn,Tn,En,yn,In,wn,Nn,xn,Rn,Pn,Mn,Ln,kn,_n,On,Dn,Bn,Qn,Vn,qn,Gn,Fn,Un,Hn,zn,Wn,Jn,Yn,jn,Kn,Zn,Xn,$n,ei,ti,ni,ii,ai,ri,oi,si,ui,ci=!1,li=300,di=-1,fi=-1,pi=0,gi=0,hi=-1,mi=1,vi=-1,Ai=250,Si=1,bi=-1,Ci=5e3,Ti=-1,Ei=-1,yi=0,Ii=0,wi=0,Ni=10,xi=!1,Ri=!1,Pi=!1,Mi=!1,Li=!1,ki=!1,_i=!1,Oi=!1,Di=!1,Bi=!1,Qi=!1,Vi=!1,qi=!1,Gi=!1,Fi=!1,Ui=!1,Hi=!1,zi=!1,Wi=!1,Ji=!1,Yi=!0,ji="click",Ki="hide",Zi="HTML5-Video",Xi=!1,$i=!1,ea=32,ta=a,na=r,ia=o.html5_player_template({msgSearch:na.getString("search"),msgSearchIsDisabledInFS:na.getString("searchDisabledFullScreen"),accessBtnClearSearch:na.getString("accessBtnClearSearch"),accessBtnRewind:na.getString("accessBtnRewind"),accessBtnPlay:na.getString("accessBtnPlay"),accessBtnPrevious:na.getString("accessBtnPrevious"),accessBtnNext:na.getString("accessBtnNext"),accessBtnVolume:na.getString("accessBtnVolume"),accessBtnClosedCaption:na.getString("accessBtnClosedCaption"),accessBtnTableOfContents:na.getString("accessBtnTableOfContents"),accessBtnSettings:na.getString("accessBtnSettings"),accessBtnFullScreen:na.getString("accessBtnFullScreen")});return{initHtml5View:function(e,t){nn(e,t),sn()},initSimpleHtml5View:function(n){if(l.isPlaylist()){for(var a=t(e).innerWidth()-20,r=l.getMediaList(),o=r.length,s="
",u="style='width: "+a+"px; height: 75px;'",c=0;o>c;c++)s+="- "+Ht([r[c]],!0,!0)+"
";s+="
",t(n).html(s),t(n).css("background-color","#ffffff"),t("body").css("overflow","auto"),t(n).css("overflow","auto"),t(n+" ol").css("list-style","none"),t(n+" ol").css("margin","10px"),t(n+" ol").css("padding","0")}else t(n).html(Ht(l.getCurrentMedia(),!i.isIPhoneOrIPod(),!0));dn(n)},initYouTubeView:function(e,n,i){Xi=!0,nn(e,n);var a=t(e);S.init(i,"videoDiv",sn,jt,Zt,a.attr("width"),a.attr("height"))},jsSeekTime:function(e){if(ci)if(bn)Cn.duration&&Cn.duration>e&&(Ji?It(e):(!g()||g()&&!s.viewOpen())&&st(e,!0));else{var t={};t.t=e,u.setURLParams(t),g()&&s.quizEnabled()?s.viewOpen()||setTimeout(Kt,80):setTimeout(Xt,80)}},jsPlay:function(){ci&&(bn?Ji?It(0):Cn.play():g()&&s.quizEnabled()?s.viewOpen()||setTimeout(Kt,80):setTimeout(Xt,80))},displayMessagePanel:function(e,t,n){void 0===n&&(n=!0),cn(e,t,n)},addEventListener:function(e,t){switch(e){case"VIDEO_START_INITIATED":hn=t;break;case"VIDEO_START":mn=t;break;case"CAPTION_CHANGE":vn=t;break;case"READY":An=t;break;case"VIDEO_PLAY":Sn=t}},removeEventListener:function(e){switch(e){case"VIDEO_START_INITIATED":hn=void 0;break;case"VIDEO_START":mn=void 0;break;case"CAPTION_CHANGE":vn=void 0;break;case"READY":An=void 0;break;case"VIDEO_PLAY":Sn=void 0}}}}()}(this,jQuery,TSC.externalMessageController,TSC.deviceInfo,TSC.ioOverlayView,TSC.localizationStrings,TSC.templates,TSC.quizController,TSC.playerConfiguration,TSC.playerSettingsView,TSC.mediaList,TSC.videoAnalytics,TSC.xmp,TSC.fathomGrader,TSC.fathomService,TSC.quizModel,TSC.xmpGrader,TSC.quizMarker,TSC.iFrameBridge,TSC.youTube,TSC.searchTool,TSC.iOSTextInputFix),function(e,t,n,i,a){"use strict";e.TSC=e.TSC||{},e.TSC.imageView=function(){function e(e){l.css("background-image","url("+e+")"),o("Imaged_Loaded",e)}function r(e){s=e,u=t(s),u.html(f),u.fadeIn(d),u.css("background-color",a.getBackgroundColor()),c=t("#image"),l=t("#imageDiv")}function o(e,t,n){a.getCustomEventTracking()&&a.getCustomEventCallback()&&(a.getAltEventCategoryAsFilename()?a.getCustomEventCallback().call(this,{category:a.getMediaFileName(),action:e,label:t,value:n}):a.getCustomEventCallback().call(this,{category:p,action:e,label:t,value:n})),a.getGoogleAnalyticsID()&&_gaq.push(["_trackEvent",p,e,t])}var s,u,c,l,d=300,f=i.image_view_template(),p="Loaded Content";return{initView:function(t){r(t);var i=n.getCurrentMedia()[0].mediaSrc;e(i)}}}()}(this,jQuery,TSC.mediaList,TSC.templates,TSC.playerConfiguration);var _gaq=_gaq||[];(function(e,t,n,i,a,r,o,s,u,c,l,d,f,p,g,h,m,v,A,S,b){e.TSC=e.TSC||{},e.TSC.mediaPlayer=function(){"use strict";function C(){c.getMediaType()!==u.WEBM&&n.hasFlashPlayerVersion(s.getMinFlashPlayerVersion())?m.render(F):v.displayMessagePanel(F,c.getErrorMessage())}function T(){a.isLocal()?v.displayMessagePanel(F,g.getLocalErrorMessage()):v.displayMessagePanel(F,g.get404ErrorMessage())}function E(){_gaq.push(["_setAccount",s.getGoogleAnalyticsID()]),s.getGAPageViewTracking()&&_gaq.push(["_trackPageview",s.getMediaFileName()]),function(){var e=document.createElement("script");e.type="text/javascript",e.async=!0,e.src=("https:"==document.location.protocol?"https://ssl":"http://www")+".google-analytics.com/ga.js";var t=document.getElementsByTagName("script")[0];t.parentNode.insertBefore(e,t)}()}function y(){if(a.isNuevoApp()){var e=document.querySelector("meta[name=viewport]");e&&e.setAttribute("content","width=device-width; initial-scale=1.0; maximum-scale=1.0; user-scalable=0;")}}function I(){N()}function w(){a.lookAtDevice(),y(),r.strip(),!a.isNuevoApp()&&s.getPreRollSrc()?S.createView(s.getPreRollSrc(),I):V()||N()}function N(){c.addEventListener("READY",M),c.addEventListener("ERROR",C),c.init(s.getMediaSources())}function x(){if(a.isNuevoApp()&&g.xmpAvailable()){var e=document.location,t=g.getTocTitle(),n=g.getMediaDuration();document.location="nuevo://info?url="+e+"?title="+t+"?duration="+n}}function R(){v.removeEventListener("VIDEO_START_INITIATED",R),S&&S.viewExists()&&S.destroyView()}function P(){Y||(v.removeEventListener("VIDEO_START"),t(document).trigger("techsmith.cloud.videofirstclickplay"),Y=!0)}function M(){c.removeEventListener("READY",M),c.removeEventListener("ERROR",C);var e=d.getPlayerType();switch(e){case l.YOUTUBE:A.addApi(),L();break;case l.HTML5_VIDEO:L();break;case l.FLASH_VIDEO:m.render(F);break;case l.IMAGE:k(),b.initView(F);break;case l.NOT_SUPPORTED:c.getMediaType()===u.WEBM?v.displayMessagePanel(F,i.getString("noWebMSupport")):v.displayMessagePanel(F,i.getString("videoNotSupportedUseFlash"))}}function L(){s.getGoogleAnalyticsID()&&E(),O()}function k(){s.getGoogleAnalyticsID()&&E()}function _(e){s.getFathomId()?(h.addEventListener("GET_COMPLETE",function(){B(),"function"==typeof e&&e()}),h.addEventListener("ERROR",function(){B(),T()}),h.getFathom(s.getFathomId())):B()}function O(){s.getXMPSrc()?(g.addEventListener("READY",_),g.addEventListener("ERROR",function(){"string"==typeof TSC.embedded_config_xml?g.parseXMP(TSC.embedded_config_xml):(_(),T())}),g.loadXMP(s.getXMPSrc())):_()}function D(t){e.top!==e&&o.postMessage("CAPTION-CHANGED","*",t)}function B(){var t=!1,n=!1;if(g.xmpAvailable()&&(g.removeEventListener("READY",B),g.removeEventListener("ERROR",T)),a.isIPhoneOrIPod()&&!a.isNuevoApp())v.initSimpleHtml5View(F);else{if(g.xmpAvailable()&&((g.hasTocItems()||(g.hasCaptionItems()||g.hasScreenTextItems()||g.hasSpeechTextItems())&&s.getIsSearchable())&&(t=!0),g.hasCaptionItems()&&e.top!==e&&o.postMessage("HAS-CAPTIONS","*"),x()),p&&p.getQuizID()&&(a.isLocal()&&p.getReportMethod()!==f.NONE?(n=!0,p.setReportMethod(f.NONE)):p.getUseScorm()&&0===p.getTotalNumberOfGradedQuestionSets()&&s.setReportScormComplete(!0)),v.addEventListener("VIDEO_START_INITIATED",R),v.addEventListener("VIDEO_START",P),v.addEventListener("CAPTION_CHANGE",D),d.getPlayerType()===TSC.playerType.YOUTUBE){var r;r=c.isPlaylist()?c.getCurrentMedia().mediaSrc:c.getCurrentMedia()[0].mediaSrc,v.initYouTubeView(F,t,r)}else v.initHtml5View(F,t);n&&v.displayMessagePanel(F,i.getString("xmpSecurity"))}}function Q(e){var t=document.createElement("script");t.setAttribute("type","text/javascript"),t.setAttribute("src",e),t.async=!0,t.onload=function(){N()},t.onerror=function(){N()},t!==void 0&&document.getElementsByTagName("head")[0].appendChild(t)}function V(){return G()?(Q(H+z),!0):!1}function q(){return"true"===W}function G(){return a.isIPhoneOrIPod()&&a.isRetinaDisplay()&&!a.isNuevoApp()?!0:!1}var F,U="3.19.2",H="http://www.techsmith.com/redirect.asp?",z="target=nuevoappdata&product=camtasia&lang=enu&ver=1.0.0&os=mac",W="false",J="",Y=!1;return{init:function(e){F=e,w()},getVersion:function(){return U},keyValueDataCallback:function(e){W=e.isAppReady,J=e.appDownloadURL},isNuevoAppCapableAndAvailable:function(){return G()&&q()},redirectToiPhoneAppDownload:function(){G()&&e.open(J,"_parent")},jsSeekTime:function(e){d.getPlayerType()===l.FLASH_VIDEO?m.jsSeekTime(e):v.jsSeekTime(e)},jsPlay:function(){d.getPlayerType()===l.FLASH_VIDEO?m.jsPlay():v.jsPlay()},jsDebugUI:function(e){return d.getPlayerType()!==l.FLASH_VIDEO?"HTML5_VIDEO player does not support this method.":(s.setDebugUIMode(e),v.jsDebugUI(e),void 0)},redirectToiPhoneApp:function(){if(G()&&q()){var t=document.location+"",n=s.getPosterImageSrc(),i=(new Date).getTime();setTimeout(function(){var t=(new Date).getTime();1e3>t-i&&e.open(J,"_parent")},300);var a="nuevo://import?url=";a+=-1!==t.indexOf("?")?t+"&posterImage="+n:t+"?posterImage="+n,a+=s.getAdditionalAppQueryString(),e.open(a,"_parent")}},addEventListener:function(e,t){v.addEventListener(e,t)},removeEventListener:function(e){v.removeEventListener(e)}}}()})(this,jQuery,swfobject,TSC.localizationStrings,TSC.deviceInfo,TSC.queryParamsStripper,TSC.iFrameBridge,TSC.playerConfiguration,TSC.mediaType,TSC.mediaList,TSC.playerType,TSC.mediaPlayerController,TSC.reportType,TSC.quizModel,TSC.xmp,TSC.fathomService,TSC.flashView,TSC.playerView,TSC.youTube,TSC.preRollController,TSC.imageView);
\ No newline at end of file
diff --git a/junctions/skins/overlay/spritesheet.min.css b/junctions/skins/overlay/spritesheet.min.css
new file mode 100644
index 0000000..936b7b9
--- /dev/null
+++ b/junctions/skins/overlay/spritesheet.min.css
@@ -0,0 +1 @@
+.spritesheet{display:inline-block;overflow:hidden;background-repeat:no-repeat;background-image:url(spritesheet.png)}.sprite_repeat{background-repeat:repeat-x!important}.rewind_button_normal{width:43px;height:43px;background-position:-192px -226px}.rewind_button_over{width:43px;height:43px;background-position:-240px -226px}.rewind_button_down{width:43px;height:43px;background-position:-144px -288px}.rewind_button_disabled{width:43px;height:43px;background-position:-192px -226px}.play_button_normal{width:43px;height:43px;background-position:-144px -0px}.play_button_over{width:43px;height:43px;background-position:-144px -48px}.play_button_down{width:43px;height:43px;background-position:-96px -288px}.play_button_disabled{width:43px;height:43px;background-position:-144px -0px}.pause_button_normal{width:43px;height:43px;background-position:-96px -192px}.pause_button_over{width:43px;height:43px;background-position:-96px -240px}.pause_button_down{width:43px;height:43px;background-position:-96px -144px}.pause_button_disabled{width:43px;height:43px;background-position:-96px -192px}.previous_button_normal{width:43px;height:43px;background-position:-144px -192px}.previous_button_over{width:43px;height:43px;background-position:-144px -240px}.previous_button_down{width:43px;height:43px;background-position:-144px -144px}.previous_button_disabled{width:43px;height:43px;background-position:-144px -96px}.next_button_normal{width:43px;height:43px;background-position:-96px -48px}.next_button_over{width:43px;height:43px;background-position:-96px -96px}.next_button_down{width:43px;height:43px;background-position:-96px -0px}.next_button_disabled{width:43px;height:43px;background-position:-48px -288px}.settings_button_normal{width:43px;height:43px;background-position:-380px -0px}.settings_button_over{width:43px;height:43px;background-position:-428px -0px}.settings_button_down{width:43px;height:43px;background-position:-332px -0px}.settings_button_disabled{width:43px;height:43px;background-position:-380px -0px}.settings_off_button_normal{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_over{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_down{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_disabled{width:43px;height:43px;background-position:-476px -0px}.closed_caption_button_normal{width:43px;height:43px;background-position:-0px -48px}.closed_caption_button_over{width:43px;height:43px;background-position:-0px -96px}.closed_caption_button_down{width:43px;height:43px;background-position:-0px -0px}.closed_caption_button_disabled{width:43px;height:43px;background-position:-0px -48px}.closed_caption_off_button_normal{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_over{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_down{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_disabled{width:43px;height:43px;background-position:-0px -144px}.toc_button_normal{width:43px;height:43px;background-position:-353px -48px}.toc_button_over{width:43px;height:43px;background-position:-401px -48px}.toc_button_down{width:43px;height:43px;background-position:-305px -48px}.toc_button_disabled{width:43px;height:43px;background-position:-353px -48px}.toc_off_button_normal{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_over{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_down{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_disabled{width:43px;height:43px;background-position:-449px -48px}.fullscreen_enter_button_normal{width:43px;height:43px;background-position:-48px -48px}.fullscreen_enter_button_over{width:43px;height:43px;background-position:-48px -96px}.fullscreen_enter_button_down{width:43px;height:43px;background-position:-48px -0px}.fullscreen_enter_button_disabled{width:43px;height:43px;background-position:-48px -48px}.fullscreen_leave_button_normal{width:43px;height:43px;background-position:-48px -192px}.fullscreen_leave_button_over{width:43px;height:43px;background-position:-48px -240px}.fullscreen_leave_button_down{width:43px;height:43px;background-position:-48px -144px}.fullscreen_leave_button_disabled{width:43px;height:43px;background-position:-48px -192px}.fullframe_enter_button_normal{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_over{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_down{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_disabled{width:43px;height:43px;background-position:-0px -240px}.fullframe_leave_button_normal{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_over{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_down{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_disabled{width:43px;height:43px;background-position:-0px -288px}.play_button_overlay_normal{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_over{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_down{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_disabled{width:108px;height:108px;background-position:-192px -0px}.replay_button_overlay_normal{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_over{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_down{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_disabled{width:108px;height:108px;background-position:-192px -113px}.scroll_down_arrow_normal{width:16px;height:16px;background-position:-14px -213px}.scroll_down_arrow_over{width:16px;height:16px;background-position:-192px -274px}.scroll_down_arrow_down{width:16px;height:16px;background-position:-14px -213px}.scroll_down_arrow_disabled{width:16px;height:16px;background-position:-14px -213px}.scroll_up_arrow_normal{width:16px;height:16px;background-position:-232px -313px}.scroll_up_arrow_over{width:16px;height:16px;background-position:-253px -292px}.scroll_up_arrow_down{width:16px;height:16px;background-position:-232px -292px}.scroll_up_arrow_disabled{width:16px;height:16px;background-position:-232px -313px}.scroll_thumb_bottom_normal{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_over{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_down{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_disabled{width:14px;height:50px;background-position:-192px -295px}.scroll_track_normal{width:15px;height:13px;background-position:-232px -274px}.scroll_track_over{width:16px;height:4px;background-position:-69px -336px}.scroll_track_down{width:16px;height:4px;background-position:-48px -336px}.scroll_track_disabled{width:15px;height:13px;background-position:-232px -274px}.scrubbar_scrubber_normal{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_over{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_down{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_disabled{width:10px;height:43px;background-position:-305px -0px}.unmute_button_normal{width:43px;height:43px;background-position:-545px -48px}.unmute_button_over{width:43px;height:43px;background-position:-305px -96px}.unmute_button_down{width:43px;height:43px;background-position:-497px -48px}.unmute_button_disabled{width:43px;height:43px;background-position:-545px -48px}.volume_button_normal{width:43px;height:43px;background-position:-353px -192px}.volume_button_over{width:43px;height:43px;background-position:-353px -240px}.volume_button_down{width:43px;height:43px;background-position:-305px -144px}.volume_button_disabled{width:43px;height:43px;background-position:-353px -192px}.volume_button_low_normal{width:43px;height:43px;background-position:-401px -96px}.volume_button_low_over{width:43px;height:43px;background-position:-449px -96px}.volume_button_low_down{width:43px;height:43px;background-position:-353px -96px}.volume_button_low_disabled{width:43px;height:43px;background-position:-401px -96px}.volume_button_med_normal{width:43px;height:43px;background-position:-545px -96px}.volume_button_med_over{width:43px;height:43px;background-position:-353px -144px}.volume_button_med_down{width:43px;height:43px;background-position:-497px -96px}.volume_button_med_disabled{width:43px;height:43px;background-position:-545px -96px}.volume_button_high_normal{width:43px;height:43px;background-position:-305px -240px}.volume_button_high_over{width:43px;height:43px;background-position:-305px -288px}.volume_button_high_down{width:43px;height:43px;background-position:-305px -192px}.volume_button_high_disabled{width:43px;height:43px;background-position:-305px -240px}.volumebar_slider_normal{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_over{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_down{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_disabled{width:13px;height:9px;background-position:-96px -336px}.scrubbar_loaded_track_end{width:2px;height:43px;background-position:-288px -226px}.scrubbar_track_left{width:1px;height:43px;background-position:-295px -226px}.scrubbar_track_right{width:1px;height:43px;background-position:-320px -0px}.scrubbar_track{width:2px;height:43px;background-position:-0px -479px}.scrubbar_loaded_track{width:2px;height:43px;background-position:-0px -393px}.scrubbar_played_track{width:2px;height:43px;background-position:-0px -436px}.seperator{width:1px;height:43px;background-position:-326px -0px}.volumebar_track{width:5px;height:2px;background-position:-35px -192px}.volumebar_track_end{width:5px;height:2px;background-position:-35px -199px}.volumebar_backdrop{width:31px;height:97px;background-position:-401px -144px}.control_backdrop_left{width:2px;height:43px;background-position:-0px -192px}.control_backdrop_right{width:2px;height:43px;background-position:-7px -192px}.toc_title_backdrop{width:8px;height:18px;background-position:-0px -522px}.control_backdrop{width:2px;height:43px;background-position:-0px -350px}
\ No newline at end of file
diff --git a/junctions/skins/overlay/spritesheet.png b/junctions/skins/overlay/spritesheet.png
new file mode 100644
index 0000000..fa3a68a
Binary files /dev/null and b/junctions/skins/overlay/spritesheet.png differ
diff --git a/junctions/skins/overlay/techsmith-smart-player.min.css b/junctions/skins/overlay/techsmith-smart-player.min.css
new file mode 100644
index 0000000..49f76f3
--- /dev/null
+++ b/junctions/skins/overlay/techsmith-smart-player.min.css
@@ -0,0 +1 @@
+html{color:#000}body,div,dl,dt,dd,ul,ol,li,h1,h2,h3,h4,h5,h6,pre,code,form,fieldset,legend,input,textarea,p,blockquote,th,td{margin:0;padding:0}table{border-collapse:collapse;border-spacing:0}fieldset,img{border:0}address,caption,cite,code,dfn,em,strong,th,var{font-style:normal;font-weight:400}li{list-style:none}caption,th{text-align:left}h1,h2,h3,h4,h5,h6{font-size:100%;font-weight:400}q:before,q:after{content:''}abbr,acronym{border:0;font-variant:normal}sup{vertical-align:text-top}sub{vertical-align:text-bottom}input,textarea,select{font-family:inherit;font-size:inherit;font-weight:inherit}input,textarea,select{*font-size:100%}legend{color:#000}body{font:13px/1.231 arial,helvetica,clean,sans-serif;*font-size:small;*font:x-small}table{font-size:inherit;font:100%}pre,code,kbd,samp,tt{font-family:monospace;*font-size:108%;line-height:100%}h1{font-size:138.5%}h2{font-size:123.1%}h3{font-size:108%}h1,h2,h3{margin:1em 0}h1,h2,h3,h4,h5,h6,strong{font-weight:700}abbr,acronym{border-bottom:1px dotted #000;cursor:help}em{font-style:italic}blockquote,ul,ol,dl{margin:1em}ol,ul,dl{margin-left:2em}ol li{list-style:decimal outside}ul li{list-style:disc outside}dl dd{margin-left:1em}th,td{border:0;padding:.5em}th{font-weight:700;text-align:center}caption{margin-bottom:.5em;text-align:center}p,fieldset,table,pre{margin:0}input[type=text],input[type=password],textarea{width:12.25em;*width:11.9em}html,body{height:100%}html,body,form,fieldset,p,div,h1,h2,h3,h4,h5,h6{-webkit-text-size-adjust:none}body{margin:0;padding:0;overflow:hidden;background-color:#000}object:focus{outline:0}#tscVideoContent{width:100%;height:100%;padding:0;margin:0;overflow:hidden}#tscVideoContent video{width:100%;height:100%}#videoWrapper{width:100%;height:100%}#videoDiv{width:100%;height:100%}#hotspotContainer,#hotspotContainerDebug{position:absolute}#alertDialog{display:none;position:absolute;text-align:center;z-index:12;padding:15px;color:#434343;font-size:20px;top:30px;left:25%;right:25%;background-color:#fff;border:1px solid #bcbcbc}#alertDialog span{display:block;max-height:200px;overflow-y:auto}#alertDialog h4{font-size:16px;padding:5px 0;border-radius:20px;margin-top:14px;text-align:center;margin-left:auto;margin-right:auto;max-width:200px;color:#434343;background-color:#fff;border:1px solid #bcbcbc}.alertDialogClose{display:block;float:right}#tsc_io_container{position:absolute;z-index:12;width:100%;height:100%;top:45%;padding:0;margin:0;text-align:center;color:#fff}#tsc_io_message{margin-left:auto;margin-right:auto;padding:8px;background-color:rgba(0,0,0,.8);border-top-right-radius:12px;border-top-left-radius:12px;border-bottom-right-radius:12px;border-bottom-left-radius:12px;-moz-border-radius:12px;-webkit-border-radius:12px;max-width:300px}#tsc_io_message span{display:block}#tsc_io_container img{border:0;margin:10px 10px 0}.centeredImage{vertical-align:middle;text-align:center}#screenText{display:none}#speechText{display:none}#hotspots{position:absolute;width:100%;height:100%;top:0;left:0}#hotspots.hide{display:none}#hotspots area:focus,#hotspots area:active{outline:0}.hotspots_mapimg{position:absolute;width:100%;height:100%}#youtubePointerEventWorkaround{position:absolute;width:100%;height:100%;top:0}#youtubePointerEventWorkaround.hide{display:none}#caption{position:absolute;left:20px;right:20px}#caption p{display:inline-block;background-color:#000;font-family:Arial,Helvetica,sans-serif;color:#FFF;line-height:1.2}#caption.hide{display:none}#caption.caption_under_video{position:relative;bottom:0;left:0;right:0}.captionVAlignTop{top:20px}.captionVAlignBottom{bottom:54px}.captionHAlignLeft{text-align:left}.captionHAlignCenter{text-align:center}.captionHAlignRight{text-align:right}#videoClickToPlayLink,#videoClickToReplayLink{position:absolute;top:0;left:0;display:block;width:100%;height:100%;background-position:center center;background-repeat:no-repeat;background-size:100%;cursor:pointer}.noClickToPlayEvents{pointer-events:none}#videoClickToPlay,#videoClickToReplay{position:absolute;top:50%;left:50%}#markers{width:100%;height:100%}.foundSearchText{color:#40C6E2}.appplayer{position:relative;border-radius:5px;background-size:cover;z-index:1}.posterFade{background:rgba(0,0,0,.6);border-radius:5px;height:100%}.appplayer .content{text-align:center;z-index:2}.appplayer h2{color:#fff;font-weight:700;margin:50px 0 10px;text-shadow:0 0 2px #000;filter:dropshadow(color=#000000,offx=0,offy=0);z-index:2}.externalDefaultPlaybackContainer{position:relative;background-size:cover;z-index:1;background-color:#000;width:100%;height:100%}.externalLargePlayBtn{display:block;width:73px;height:73px;background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAJIAAACSCAYAAACue5OOAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAA2ZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNS1jMDE0IDc5LjE1MTQ4MSwgMjAxMy8wMy8xMy0xMjowOToxNSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wTU09Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9tbS8iIHhtbG5zOnN0UmVmPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvc1R5cGUvUmVzb3VyY2VSZWYjIiB4bWxuczp4bXA9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC8iIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDowMTgwMTE3NDA3MjA2ODExOTEwOUU0OEZENkUxNjA2MCIgeG1wTU06RG9jdW1lbnRJRD0ieG1wLmRpZDpBNkIwOTY0OUYyMjkxMUUyQUU1QUQ4MDY4QjcxREZCQSIgeG1wTU06SW5zdGFuY2VJRD0ieG1wLmlpZDpBNkIwOTY0OEYyMjkxMUUyQUU1QUQ4MDY4QjcxREZCQSIgeG1wOkNyZWF0b3JUb29sPSJBZG9iZSBQaG90b3Nob3AgQ1M1IE1hY2ludG9zaCI+IDx4bXBNTTpEZXJpdmVkRnJvbSBzdFJlZjppbnN0YW5jZUlEPSJ4bXAuaWlkOkYyNjVEOEM5OEZCOTExRTE5RDM1REJEMUIxMjY5QThEIiBzdFJlZjpkb2N1bWVudElEPSJ4bXAuZGlkOkYyNjVEOENBOEZCOTExRTE5RDM1REJEMUIxMjY5QThEIi8+IDwvcmRmOkRlc2NyaXB0aW9uPiA8L3JkZjpSREY+IDwveDp4bXBtZXRhPiA8P3hwYWNrZXQgZW5kPSJyIj8+P8m+9gAAKdlJREFUeNrsXQd4U2X3z96jSdqmu5SN7D0EBEQ+RBBUVFBBPgT1UxBRUBQ/54cDFFniABEZggKCgiAIMmVVKLJn90ibvXfyf0962//NJb1J25Qmbc7z3OcmN+vmvr973jN+57zU0ZPmUGISUGhoa0c4dhNtzqb4Z3euW1SvzzOaKUgy0ZaObVloa402JnacF+J32NGWizYP2q6hrQBtRWgrxo43K2nqQAKt0gXbOqMtFW1tw/TdbLR1wB53DPB6Lgaq89h2oalqs4BAqq+Ka2wZM3luS7QbjLbe2EZrpFNpiW2Dcceyse0Yus7XYxop8sADGuFetI1AW1IEn2oVuF9A56xG+31oO4BAdS4GpMYDjwztHkbb2LqAJzMtiZ2WnMhOTU7gZKbKuZI4EVMsEjCrXpfGiVgCPtfv+lisNpdKo3dUPTeaLC61RucoKq2wliiU9uIypT2vsNQW4inA+U+EDf2XCrTfhbafEagU0TgeVKLXFulTG7roPdDuKcKUQSo9OrcT3NW2Bb9lZipfniBlZ6TKeQ15jsVlFZZypdaeW1BiuXw9z5xz8brJ7fZ4Q/z4KbRtRONwPAakhgHQQLSbihnOQbXNoL5d4zq1byVq1zpDyKDTqY157l4kV28WGC9ezTUez76gu5lfHIrWuoIB6vcYkMIDoJFoNwVz0WuUZHk86/5h/WQD+3SVJcji2JF80fUGk/PQiRzVH4dPqwuKFfYgb4ewwlq0/YbGxhMDUt0ANB2L7QQUIZ9HHzaol+Seft2kbVqmC6PRtsgtLDX/dfq8Zu+hUxoEMBfJW0vR9i0an19iQArdfZ+LeTcBpW3LdO7jY4cnde/cNo7JYNAoTUBcbrf3n0s3dVt2HlBcupZnIXnrJbQtiLTwQcQACQEIDOBpmCfDDPSeju2yeBPGDk/u1qltHKUJCwKSYfOOP0rPXbphruEtMMVtRdtKNF6mGJD+H0QQA5pdkxvfq2t74WMP3pvUoU0LEaUZya38EtOWnX+W/ZV93lDDWyAWtRSN2e5mDSQEIAHavYO2oYFeb90ijfP85HEZ7Vpnht3+cTpdaKCKPMhF9xSVKLwFxWXe/MLSamO2XKn2qtRaP5ddKhFTk+UJ1R5gRmoSNT0tiZaZlkxtnZVOy0hLpvG4nLBfp/yiMvMX320rRJ6fhSRk8DYaO3WzAxICEbjxHwbSQnwehzbl8QdShg/unRgu1/1WXpHnxN/nPWf+uey+dPWWB4AS7DN0Ot1Jo9PcvrnE46G7XW5msM/EyyTUju1a0Xp06UDr16szvX2brLDYcBBCOPjXWeXqjb+WGs0Wdw3a6S00ftnNBkgIRE+i3YxAthACj2TS+JFpEFmuz2/o9Ebv/sMn3afOXnT/fe6SR6PV44HjZbKYdgYDNoYTbQ4Wi40e0110OsMVyve73W66y+ViOp0OttPpZLnhscvJdjmdbK+XUg3+OJGQ2qNrB1qfHp3owwf3oyfES+p1YxhNFueGbXtLdh84rq7BdlqFeXeeJgskBCCwcd5H28BAcaBZ0x7LRAZ1ne0gu91BOXzijHvX3iOuw8f/rr5rqVSKh8XmWNhstoXL5ZnR3taQF9XhsLOtFqvAbrfx7A471+vx0qteG9CnG/2B+wbRhw3qw6jPNHgjt8i4dPVPBTXEobIx7aRuckBCIIKA4pJAU9mgvl3FM6aOb4EubJ1yfxcu3/Bs3bnfdeDIKbfRZPZpHqRdHFwe38DlcM0cLtfSmIaozWbj2qwWvsVqEbmcLl+wlM1mUYbf048xfsxwBkyDdbpxHE7PV+u25+8/kq2tYap7BY3npSYDJASibmi3GG1+2obJYFCfnTQ2deTQfvK6fO/Z81c8K9f85MjOuehT4zQazcXj8w0CvkDPamCtU3dt5WCbTUax2WIWe9we343T5a62tKlPjmMOHdibXpfvPHj8rHLld9uKbXYHcTqDG2guGtNTUQ8kLEf2CaWSCOY3lc2bOally4wUfq0v3LFs96r1PzsvXb3pu3DI3rEJhSI1ny8wUqlULyVKxGw2CY0GgwyBiwvP27bKpE176mHGv4YNqLVmhkTxx8vX5waY6oBM915D5+waFEgIRGPQ7r8UArmsf89OopeffTyrtlMZaKCFy9c6rlzP9QGIxWJZReI4FY/HM1GiWGxWK0+n1yY47A4fKyErI5U2Z8bTzIF9u9dKQwWZ6haisf0p6oCEQDQZ7V4iHkfTmPS5yeNa1MatV1SovYtWrHWAF+YDEJtliRNLlI1t+zSELaXX6+LtNpvAZzv260F/beYUJsSnahMmWLdlT9HWXQeVAV5eg8Z3ZUOcO71t1wF+B554aEQ4QDQF7WYSj08YOzzxmSfGZCJbJmQQbfp5j+uVtxbZr93M90JcRyqTlUmlsgoGk9nk+M8MBsMlEAgMTBbL5nDYuPmFpbSffzvgotPolE4dWqO/HxxPaGqnduvYRszlsCnAgyK83H3T9j9YaIxPRzyQsKz9POLxF//9SNrDo4ak1EYLvfj6R/atv/7hcrldXoFQqElISCxBrrud0sSFyWQ6BEKRDtSL1WrhnjxzwXv0ZI67b68udLFQENJN2KFNCyGyQ5mncy4b0NfgX+qGwKRB43w5nOcc1sw5AhGwFt/xQyqdRn1j5uQWtfHMjp3KcT/+zFzbuQtXPcgOssiTUvJACyFN5qE0EwGnIU4iVSUlp+axORwT2IWPTZ1j3fvncVeo3zF0QI+E/86emgXeMeGl17AbPvI0EkbAXwomjN8Zv/Bk5t19usSH8h2Q/1qxepNzweJVDuTKeoUikRppoVKk092UZirw32G6A/MHeXm8Pw6d9Ki1em/fHp3pDEZwWzxFHs9tnZXOOXrqnA6nmQBYg5BmOo/GuzRiNBIu2Ojn4v/n6YdSB/btGhKIlCqtd9rs92xrftgB+S1XQmJikUQiVVJi4hNxXJw6ITGpAOzELb/sc018bp6tqLQ8pFBHzy7tJLOmP55OnEHRtghTAI0PJCztAcFGCf74+NFDE0bdOyCk6o7C4jLPpBfm+6YyZAOZk5NT8iCVEYOPv3A4HGtySkoe2hshCT0ZXbNL126FNN3DNDd14uhkwmHwDhdjFTmNByR0AvD5/4EGJbr4Tz82KiOU74ALMek/8+1l5UovXyDQypOSC0NNnDZHodHo7kR5UjGa9lWQiJ42613b3+cuhTT1P3T/PSlwgxMOyzDNxGxMjQScaj8jq2+PjkKIE4Xy4RPZ/7j/PfNtm85g9IpEIqVMFq+IQSU0gWk/TiJRWKw2yvNz/mffd+hESGCa/Oj96ff0705kmAKl59VGARJCMHCqn8Efg4LDV56b0DKUYCP88ZlvfGy3I6NaIpGUgYcSg0ftRCQSa6UyWYnL5fLOfWexfceeg0E1OcSZZj7zaBaQBgkvjUdjOvSOAgmzi97Df57DZtHmv/x0y1DSHqfOXHC/+b9ldrgAsvj4EqFIrIvBom4iEAgN8QmJRQgfnvcWfuUIJTzAZjFpb7w0uRVU4RBe+m9d7aW6aiTInyXiD8ycOj4daaSgFaxgE4EmQq6+VyZLKIZEawwO9RNwTOITEoq9Xo9n/ofLHaHYTInxEs7s5yYQS71EmM3b8EDCiPp+KnDYwJ5xg/t3D+rmg7s64/WPYDqjoPm9nMfnm2IwCB+YZPEJvmnu5fmLHKF4c727dZCMHTmYOG690RiPbVAgYVOan1EmT5Ayn5s0LjOUONEzL71jA08DDGuY38N5IZ1OB8toNMTBvrmCicfjmyRSWSmQ++CGDSXONGn8yHQocSccnlXbKa62GukF4pQG9NhgdpHH46G8/v4SOxDuwcUPt2GtUipTykpLW2k1mmRFWVlLjUad2JxtJqFQqIYbFpLdoP2D2Uuzn53QIsAUN7tBgIQQCp3OHsYfA4ps5w6txME+u3zVJueZfy57gP4Rbhcf2QU0i8UsBurqI6OHM7xeL9VkNMoQsLIMBr2kWYYGpLIKDodjun6rwLPoi+8dwd7fqkWqAGJ/hMMjMWZr2DXSa/j3QyLw3xNGp4cSK/KlPWg0F2Tvw33RqtJHLCaT+vbc51g/fPMxB6iraIrj6LTapPJyRYbNauU3NzAh47u0Kp0Siif31CP/Sgvgxb2GBZ3DAyTMwPZD57Qnx6QE6/oBVJA3FyyHO8IrlcWX3YmINdSUrf9yAWfhO7NZ8gQZ1W6z8SsqyjOUyopUt9vVbJqvQgQcjG8qleJ9d+GXDkhDkb0fmoxNnzQ2lXAYZqFx4dRI0/FPwDgbMaRvUFrIWx+usMNcDVn8O02HBd7zjvVLuM8+PZ4J057VYhGh6a4lsqMSmguYIDcnEsUpIfo974NlDrBVyWQI8rzbt84khnCmhKKVaCFoI3D1/XoTIS8tPVj0evf+Yy6o7gBedWNl8aFu7MWpjzN/3bCMO2LoADpUyyLPLl5RVtrCaDSKmwOYgDUAiXAolNi4dTcpqxSi3s9PfohorkAe9YFwaKQp+CfIuOYHM7ANRrP3k6VrnL4pTSpr9PxZUqKMuujd2ezvlr/P6dC2JQ2qNrQadUpFuSIdTX3cpg4mZFYoYIpbueZHJ4RhghneUJxRW61EC6KN+lIIPaQnjB0elBqycs1mJyRikauvi6T6MihE3LzqE857815gQSm1zWYTIGO8BYQPkLaiNVUgYdRdNUxxn3+9ISjX/fGxw4l0E4gTDq2PRvJLykKDqy53tSbtTQQu54879rnodJoTTWkVkXhhx90/lLF78xecKRMfZDCZDAqEDyBcoNNp45sqmOLiJCqoPv5t3xEX5DqDaSVo4EpmJ4cMJCyG0MNPG427LznYCX/w6Tc+o04cJ4lojjWfz6XOfn4Sa/u6JVwo+0EeHcug1ycoFGUZULjY1ICEccDL4fFHS751BjO8J4y7TSu1xopda62RxuOfZGWkcHp1bU+qjQDp5y9f9xnYEGGNhgucniKnrvjkDfZXn77FbpWVTnPY7Xy1SpVWUV6eBs0gmhKYIIUChQR5hSUeqFYmey80NYMOeYTDj9UKSFgbPr858bExw+Rg1ZP9OJRRY55C1HGt+/fuSt+65lPO3BlTWEIBH9lPViGkW9QqJbozvdSmAiY0xfnG5qu1W4LaSo+OuZdoD/erKQdXk0aCAGT13QgRz749O0rJfvTcxWsecPfB1YxWvjWaiilPPfqAz36a+PBIBjw3m81xpSWlLfV6nawpAAla+nC4XCPYskeOnyHVSj06t42Ll8YxCXgZWRsgjcI/+dfQvtJg3WO//n6rD+FCkVgT7RdbJORT5816hvXj6oWc3t070VwuJ0uv0yWWKxQZFosl6tMtYrFYjZ9ByOJKo+7tT7yBQgMSUl2gznrijw29u2d8ME/t+OlzbuRm2qK9oYOfl9oqk7Z6yTucJQteY6chW8put/FVyooMZUV5KnRpi16txLFCAh3s2WAkuCEDehDHvgPWwjqoRhqFPw5GdrC1O3bs/tOXQ4Oy6qboOkPfop/XLubOevZJJkTLrVarSFFWmhXNdBWhUOQbq1/2HCIFEuRTIQhNODw6FCD5ldre0787KRUDqmN/23fUTaVR3dHiqdXtLmZRoBnWrk0ruA+OHAJ0FVo001WA4gyFqHsPHndBoJJUK92OgRHBgATTml9erX/PTqQXCer0IYqNXEtDNDW5qqvIJGLqB2+82CToKnweXw/Etz+PniZlZfTq1oGIgSSsurpGIPkFnKCrWkpSPGkuCpKzlQjnGyjNSPB0FWiJ7E9XcdOjAkgCgR72O38/TDq9QYdhyGqQYYUUSHf37hw0OQvdY4FAxeE0raZXoQrQVXZuXBaVdBVoCc1kMuyncy66gTtG9t5+PTuJQwUSPO7mH0doRwokYD+CauTyeM26pAhPVxl+Tz+6x+NmVNFVTCZjRC97AZ1/IV1y8NjpIDGl27DQEU1v7EBAgjmvOlEHfY1atUglnfMPnzjjS9jwmjmQqg2HRBn1s/df9aOraNTq1Eimq1SN3Yns86RAykxP4kMRLO4QBCo7BgKS38qMrTJTOWTVIYDiv07muKEZOsQlYjDC3b0YXeW/rz7rT1dRKZMjja4C0xswNU6eOe8mqzgBImOn9i2JiqVbICD58Y663NVaQHYCEIQEbw2ByNIcvLW6yPgH7/Onq5jNcZFIV4FVEQBEF67cINVKd7XNIgKpUyAgtcO/o01WOum09s+l675pjc3hxPoYkcZrKukqW9Z8ysHTVcoVZZmRQlfhsNk+RynnwjVSbkmbrDQiJtoSgQTzXRb+HWkpiaRzes75qz70xqa10AR6Z1fRVeCx3W7nRQpdhc3h+sYQ+piTvS89Vc4NEE8S4IGUScGtVASGdrD4EVZb7mVH6FINkSpAV9kSiK6iVskbi67CYrHs0M3k6o08UiDJJGI2LIFGONyaCKT/v3vSU9hkVSIQUi8uLfcymAxHzD6qvYC9hKerwDGzySRtTLoKk8n0lY4FKw5AJg9RwbTEA8mvMC5ZLiNVtcCwA68NfjwGi7pLFV0FNFRj01WgSTzsb+YVkmqllKQEYoOuJDyQkvyBFE8KpIKiyqpNJiMGpHAInq4CS53i6SqwuOAdARKD4fP9C0sUpBopMV5CpM+k4IHk10w0QRZHyrVRlKsq10Rrgss4NKYAXeWX9UuIdJU70l2FwWD6gFSqqCDVSPLbgeSnkSQEo4oUSMVY3x0GnREDUrg9KBxd5YERgxkQwKyiq0D/pwYDErNyLItLK0g1kuT2JWIleCD55YMEfC5p9rpCpfH9GJ0Ra2PcUAJ0lQ/nz/Sjq0D/p4aiq1Q1+FBpdKRAQl4bnQxIEv83c0m7dugNJi8WJnDHhrxhpYqusgCBCk9XgergcNJVqpbp0OvJ06ZCAY+IDRGUc1cBSUDQSKRAgtQI1JJD65TYUN8ZGY2mOTxdBasODitdBXpY6Y0mco0UOP/KoxFBhFnwpIExX3KPSvXEhvfOShVdZdvaxQS6SllmOOgqEBM0W6ykQKIzAsYXebTAriD5CnMQkKRSYoHIxhKoDq6iq0DowOGw84CuoqyoSK0vkIL1nKyhLM03tbHr+qOxIW1cAboK1N5V0VWsVouoPnYTmCuwD9YXAFJoRHwBkGJTVBSL2+3xUZ4dTqc3XDc4jUYL9pu3/QYYTnWKBUH32NgwNq5AI4jFX66H/pC+geXxePr6dIDxeil1HVMnI5BGgmW/ORw2nczoM1ksMSA1kkCuc8Hi1Q7otQDP2Wy2RSgSw7L19eKGgXIAj5AUMS6XpyYg3Vb94QJ9SSLwY16PlxYb0jsrMIVBNzxoZAZ2DKQ1+AK+TiyOU4fj+6FnOZ9Hvviy0xkQSPaqmADUpFW7j2aLzS2T1FxAAoZdIaWMitxPeiyW1PACoNny6x8uaHwPy0P44jl8vk4WD83vw+f0eDzeoKt4AzYCOfJVQNL7A8lKmvqIl8VRMaMrBqQGFij5WvTF905YehSeczhcY5wkTgmk/fAa7ZXenlhMzv4NgA3tznWLPHiNVC0ms5UUHDIpBiSXiwGNLmPDHX6BBWkWr1zn+PNoZb0Zi802CwRCHbbidvi9P4yukhgvra1GMlR5bSB+c6xaqycFR4o8gVppeDmZHAo3NuphFLPZ6v1m/Vbnxq27XdCgg06nu3wLAcVJGnSFTZerclWEtOREUttXrdERsaHFA8mvF7ZSrSMFUmpyIhX7cVZs6MMnsJQo2EEqtRZz5/l6qVRaTqM3vPkA7EzYJ8njSTWSUnObkinFA8lvsZmSMiUpoT8zPdmHWlcUN5uKJIG2iR8vXeO4cj0Xs4M4JuSJqdicO1ehU9U4rEV6CimQFBVqom2mwAOp1A9i5SpSjQTlNBD9RD/OicGg7gKNG5at+sEJva99dhCLZeULhFqhUKi/0+ficDp8Y9m6ZQbp1FaiUBKBVIIHUgH+lcIShR0CTzX1jYQ4UmZaMi2vsIQJQaxY3q12AonRtZt/dX67cbsTHkM0ms8XaCXSxmtw73K62FKJmAqEuprjTF5vbkEJUUsW4IGUT6lMlTAxt95bVq62kbX8u6t9KwCSB5ojcLjNs6VNXQTWTvv8qw3OsnKl7+bj8ngGWCGBwWg82jIUaEIHOiDRkb1Phewj5LURA5LX8UCCF/MouBLc4tIKKxmQenRuT0MqmWKzx4AUikCvhAWfr3acu3AVS2twzCKxWMWNgGtns9l84wxsAtJprayCqI1Kd65bZMEDCeQaHkhXbxWYBvTuXGOxXpeObX0/6rDbecTwQUz8QineL1Zvdm7btd9nB0HnX1jsJ9yLQ9dvqrX7YjjdOrcjpaBcu1VI7Fh8reoBHkgX0Dam+snlW6RtjltnpdMgVaI3GnkxOymQF+Si/Lhjr+uLbzc7fERAdH14fL5WJosvjzibzWYVgN0bbGq7eDWXiIkLgYB0Dv+Om/nFNnQBXDX1SAKv7e5+3eloevNarRY+rHMRg0+lEOkdaPoyxEkkSiaTFXFZADStcSHH1q9nFzpZ5h+cr6s3C4hT2/lqPOAOgsHtF36/cqOAtKTgnv49fZ+3Wq2CGHwq6R0zXv/I/vL8hXYAEdA7ZPHxxQmJ8pJIBFHl2Fl8Yze4fw/Saa2wuNxiszvwhjaEAa4E0kgeDGED/1+V3TL27NKuxvbIA/t296HYhp1McxVIayxf/UM1vYNOZzgEQkHY6B0NDCQhzC5DB/UhBdLZC9eIsa0ryNC2B9JIIMfwT/7KvkAaGIMmUsMG9qG73R6mzWrlNTcAAWi2/vqHa9SEF22bfv7dByKgdySnpORFA4jA7Yf40d19utHJ4kcgJ89c1JNhhUH2Ylm5ylFcVmFJS06sESRj7x/C2HPgmNtkNombUxgA1vD4cMm3OHoHx4TsoIpw0zsaUkwmk68E/EE0hmTv0+gMjuu5RdbaAAnyJjcpuO7/J/6+qH10zLAagdS3Z2c6VICqNToRuiPLI3nVyHAI0DuWfLXBsf/wSRy9Q6CLtuUzwNO2mM0iaPaFbF16EG1EXGNGgaa1m37OV4DP7cY/+fPYGdJ4B8yvo0cMovvW5jA13SXQwYWHzPxDk1+2AohoNLpLKBKpkpKSC6NxDRboX4lufMaIIf3pwXjaR06e05JhpCYg/U7BFQSgqc2eX1RGSiofN2oYo1JVGiVNEURA7xjz5EvW1Rt+dkJ8COgdyA7KlUikymj9Tyaj0beQ40MPDCOd1pRqnf3StTyiyfJbUCAhlQWJw2z8sf1H/yYlVQEbADq2guGG1GWT8eCgT+YTz71he+fjlQ7gCEEH30S5vCA+IaGUTo9eirHNZuVBM/lundvTOt/VhjQIuf9INvFmuYQwUhCKRroNcfuPnNZAiRLZD056bLQP2QaDPuqXPAd6x5sLljueeHae7dLVmx4mi2WVSGWlcnlSYVNYc8Wg1/tSX0+OH0XaDc7ldnt/P3RSHUwbkQHpAAVXpgQZ31O3G1y3Gd3QxweQbrFEZ1wJKB1rNu7w2UHAEQLHQSAUqpOTU/IbgyPUMP/RxoWVCGAWGT64L6mRnXPhuk6jNeDJ/qBM/ggZSFig6QD+2PY9R8qBj0L2wzOmTfAhXK/XJkTbBd536IR77KSXrUu/2egEwxroHUnJKblSqayC0oREp60cmxeeeZwZrDT7171HiXnBYwgbAZ0vMkNrOwWXxIXc24Urt/Rd7modR6aVoDtrds5FDrSpEwpFuki/sEDvWLh8La5qlWNG3pi6vlWrEel5IvvVbrfzYcGdYNroRm6R8dylG8RrsLVG772mFxDyIF1yHn9s22+HgmauX5s5hQVI1+u0iVBAGbF2gtHsfX/R145Hp86xAYigajVOIimXJyUVNkUQQS9KrVbtaxw6b9ZUVjBttH3PYeJY5yJMHK81kDBZj39y9sI105Ub+aQxE+jXM2XCg0zIKGu1kTfFgfu+YctvvrQGcISA3sEXCDQpqSm5oiaw1HxNgm7seEhlwXq83Tq1Ix13CPccPfUP0SbcTPaZYEA6TCHwuddv/b002ElPn/wIU54go5pNpjgw7iLlYkLV6sNTXrEuWrHWAaXPULWalJycW8kRarp8KqgQMZmMUuCPzZ0xJWjf7s079hPHGOzEnXUGEpTiot3X+GPITjKfv3yT1PaBbiWvvjAZTpiqUauTGrsFThW94/k5//OjdyTK5cWRSu8Ip6hVymRoWTNz+kQmrDZA9t5b+SWmv7LPE2ed1QgLzvpoJF8YiVKZf6uWbzb8UgwxBrIPwVqv9wzoRYeSJa1Wk9gYFxDoHZ9/td7x8NOv2I6ePOsGeodILFbKk5ILYLlySjMQWBvO4XDwIDTz8Oh7SaPY4JV/tW57EeFwaTBtFBKQMK20An+soFhh33foVFDD+/15L/ha+kI4/k5GvPH0jrWbfvWjdzR06XMkCTBXDXp9PExpn7zzMjuYgX305Dn11ZsFxIDrymDaKFSNBGACysAp/LENW/cq9AYT6Q/EiYXURe/O9v0BjUaVcifW1YA1xyCt8cFn3zigjTPQO+TypHxZfEJZU2cm4AW6i6jVKlgahPrBGy+yUpISSKc0oFV/9+Nuom10HY3976H8Xm2aZS2l4JK5RrPFvWbzrsJgH4ISl5nTJvq8OKWyPDXc9hIV+zboofjq25/Z/z3zbRuUPkPVqlQmK0mUJxXdydLnSBGVsiLV4/YwIHU1eEDPoGGYDdv2Fqs0OqJiWBjq74UMJITM68SA1J/HzujOnL8WtKxmysQHmQP6dKM7HU6uRqOWhxdINA9k4yG9UU3vEIpUSckp+dFI7wiHaDXqRAg8gl0069kng/ZnuHazwLhz3zFiTu13NObnwg4kTFZgrmC1LPv2p0KTmbwxF0xtH731EisjLRlCAhJkAIZ1cTvIxqempV8HT8xH75BGL72jvmIw6CVGo1EGtuniD+awYZFBMrHZ7O7Pvt6cT/ya2mijWgMJq6r8EH8Mknor127LD/ZZsJdWLprPAcMPGYCJRqMhrCQ4oHWAJxbN9I76e6kmoU6rlQNRbdlHr7MT4iVBzYhvN+0qLLu9achCNNaGBgMSzvD2cwchCoqmuaDJTehYvxT9QfijsNJPOJY9iAlmLFvMAo1alYo0EPXTd19hByt2BDmdc1nz+8GTxGj+sVAN7HoBCZPPKIRWOCvWbC3OLSwNmqOC8Pzyj+aByqWiuTylKdNz76QmUquUqchepH7y9svsUIzrUoXKuvjrTUSCGthJ79XlHOoEJIRYqKp9G+/FOV0u74dLv78VzF4CAZYALLuJPCuIfKfo9TppDA51E6NBH6dWqVIZDAbt4//OYt0bJKtfZRd9uOz7WwE6i7xXE02koTQSBbPoV+KPlSs1TnSCN2to6u0nUFz5zeK3fTaTXqeTh9ubaw6i02ritVptMjIVqKDlIZsQ7DOQkVj89eZcCCoTXtpIlt1vMCBhYFqLdgfxxyAXt3TVT3nBSHBV09yaZe+xIcEL0W+VsiIltjRFaKJWq5IMBkMC3IjfLnmX079315AoO1+v25F/4sxFoiENHP2l9TmfcHTvhznVb649fCJHt2rjrwWhfLhVVjpt3coFHAgNWCwWcbmiLPNOrSwdjeJ2uxjoGmVAGAVW5F77xQfsYAT+Ktm0/Y/iAMY11DK+iaXCGg9ImL30MgVrk1t9fN8x9Zadf5aE8h1JiTLqxq8+4kDQEjjfZWUlWU2pGiVcArmzsrLSLAg2QgXI2hUfcIB7Hcpndx84rvhh+z5iftQ3dnW1i8KtkQBMkDH+D3Zi1bJuyx7F/iPZIXGegd7w5aL57BnTJjKpFCpdpVKmg90Um+oqRavVJCgrKjIg7TFl4oOM1Z+/w4EbMJTPnjxzUf3l99uJNzXYSC8RK2YbFUgYmOCE5lIIy3YtXf1TUahgApk+6WHmqs/fZlexBhRlpS2g2UFzBZDT4WDBNTAaDL4s/hcL32TPfn4SK1jEujoodOof1ccr1hPNDJjG3sDo1JSIAhIGJjDa3qQQlu4CMIU6zYH06taRvu27zzhQdAl8JkVZWRbckc1JO8F/BS6RQlGaBdN9z6530X78dhEHvN1QvwPZQ+WffLGhIMBCfR+gsToSzvOlt+06wO/AEw+NqNcXos/nI6MO5tyB+OP/XL5psljtzu6d2oqhT2Cw7+Fw2NRR9w1ipKcmUbNzLnmNRhMPGZhiWAk6mjp+1EUgwIg82DSr1SricTnUV1+czHrrleksAZ8X8o20cdveou82/1YW4KUVCEQ/hfucww4k7DsuIzABHfdu/PFrNwsspeUqa+/uHeLoNFpIFwWKCYDZZzSaoYSaChfXYjULoJ0wk8l0NiUAQSm1SqlMQVO6DGg3I4YOoC/98HVO/15dQtZCECf6ev0vBdv3HA5E4AOS2ncNce7U0ZPmEKensH35mMlzx6LdfOIU2qNzO8Gc/zzRUijg1crNJ9agAecIWgxHe/9K8Mb0el28w+7wtQ/q2L41bQ7SQsHaFRMFyGnLVm/JC8C5BvkMje2mhvoPDQokDEz3ot37FMJq3vHSOOa8GU9ltWudKaztd8LaHavX/+wEHjY8ZzAZdoFAqIUlqKJl/TioM0NTmAhpH0nVUhzg0j//9HhmqMFFvECe8+Pl63MDZPLhpluAxvWXhvw/DQ4kDEw90O5TCm5xwSqZOnF08riRg5NDsZuIcvVGnmcVAlRV0ytYbhxKjPh8gZ7Hj0wtBVl6s9ksslktQq+3UlODUzENeavB6s3IYkSrN+4shXwn8efQNq8+qY+IAhIGpnS0W4K2TOJrfXt0FM6a9lhWbae6KoFyox27/3Tt2nfUXbVEFRjlPB7PwOFyzdBBpLH42uB9ge2DbDs+ApEY4kBwHFz5B0YMokPBYvs2WXUCEExlK9ZszQ9QzAgC7IxXwhUnihggYWDiYeGBkcTXpBIR46VnHssg66IbWtwkx717/zE30lIuoN9WCYvNsrDZHAuHAxvX0pAN5sHmgWUZHHY71165MoJP20LsB0q0xiLwDOzXnR6sqoNMoA/D8jVbA5HSQMC1fxvLOlCaHJAIRvhrRLsJpH/PTqLpT43NSJDF1SsICTVtf2Wf85w+e9ENFbbFpeV+wKEz6E4GneFgMJkOFpNpg0JJKtJaDAbdRaczSKkwUKEB+UBYlRoChg5k48Bzt8vFIi6GCAnpXt070qEnOdg+wQoUgwk0Bl2zaVcR5DMDvOzE3PuNd1rzNgqQMDC1RLtFgaY6JoNBnfToyKTR992dVNNSX7UVaJ4FnWiPncxx38ov8oIHGFJ8hE53gj5xu9whTbuQhG7VIp0KLns/tAUrA6qNWw+1hBAbIjROx09lr6Pxu9IYU3ijAQk31UFaZUyg19OSE9nPTRqb1q1T27iG+H2wrYqKFd4SRYX3Vn6xR63RecuVmmrNpTcYvVWaDDLtUlwvauR1UhMTpNTMtGRqWoqclpGaRAUQNcR5QuOOL7/fXpRXWFrTyp5A5XnvTk5lEQUkHKAGYrZTwNLubh3b8J965F+pdQkVRLOAS79+y56Sv/+5WlN5OWQQPkZjdqCxzzUigITTTjPQNp5SQw4QApmPPDBETtbsqykI1Jlt2XWw7NTZS2T9CaAA47PG1EIRCSQcoFpjhniPmt6TlZHCeWjUPYn9e3SUcjhselMADzR7zc65rPll71FlgPp7vFyiVJYLXYqk8484IOEANRjtpqOtQ03v4bBZtIF9u4qH3d1T1rlDq6isRgH759DxHM3hE2e1Acj4eIF40Bo0Pvsi8X9ELJBwgIKs8jS0dSF7H8ShRg7pJ7u7Txcp2RKqkSBQCvRX9nnN7gMn1AHq7W/DGgagg5H8nyIeSDhAwVT3PNmUh/OomD26tBP07NxO3K51hkAmETcqMQ5iPzfzik3Z567ocy5eN0K1TQgfA9LZ6juR3mhWQMIBCqa6iWgbgraQNE+yPJ7Vq2t7YftWGYIWGSm8eKmYVdPKmPUVqBmrUOvshcUKy/W8InN2zhUjLMMRqqlEqWy3uBWNw9lomqKjDkgELw/sKIhB9a3t58UiASMtOYHVtlUGL0Uez+Eho53L5dDlCdJq7cXncehV2gy0Cr74E9boMJstbpvd4S5WKG1I41hLFEo7ocF5qAKggY76ByLFC2s2QCKASoYBClh5baMlTESp7KL/C7b+S1TLbUBqAgKg6om2Xmjrh7aUCDkvBaZ5jmP7iAJPfRUIg9L0BBoh7MM2kCTMQO+JaavMUG2r+oSFMI0DLjuUtkNRRCmlCQuD0vQFNMFuiv9idUBVAX5UawxY8BjfXJ4MbFUgwQMX6vrysONF2LFmJdQQSvRjEpOg8n8CDAAbSuWl7er+TQAAAABJRU5ErkJggg==) no-repeat;background-size:contain;cursor:pointer;z-index:2}.centerAbsoluteElement{position:absolute;top:50%;left:50%;-webkit-transform:translate(-50%,-50%);transform:translate(-50%,-50%)}.openVideoSmartPlayerContainer{display:-webkit-box;display:-webkit-flexbox;display:-webkit-flex;display:flex;-webkit-box-align:center;-webkit-flex-align:center;-webkit-align-items:center;align-items:center;height:100%;width:100%;z-index:9;-webkit-box-sizing:border-box;box-sizing:border-box}.openVideoSmartPlayerButton{text-align:center;display:block;border-radius:12px;padding:20px 10px 20px 60px;background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAFAAAABQCAYAAACOEfKtAAAACXBIWXMAAAsTAAALEwEAmpwYAABA0GlUWHRYTUw6Y29tLmFkb2JlLnhtcAAAAAAAPD94cGFja2V0IGJlZ2luPSLvu78iIGlkPSJXNU0wTXBDZWhpSHpyZVN6TlRjemtjOWQiPz4KPHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0iQWRvYmUgWE1QIENvcmUgNS41LWMwMTQgNzkuMTUxNDgxLCAyMDEzLzAzLzEzLTEyOjA5OjE1ICAgICAgICAiPgogICA8cmRmOlJERiB4bWxuczpyZGY9Imh0dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogICAgICA8cmRmOkRlc2NyaXB0aW9uIHJkZjphYm91dD0iIgogICAgICAgICAgICB4bWxuczp4bXA9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC8iCiAgICAgICAgICAgIHhtbG5zOmRjPSJodHRwOi8vcHVybC5vcmcvZGMvZWxlbWVudHMvMS4xLyIKICAgICAgICAgICAgeG1sbnM6eG1wTU09Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9tbS8iCiAgICAgICAgICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvc1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICAgICAgICAgIHhtbG5zOnN0UmVmPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvc1R5cGUvUmVzb3VyY2VSZWYjIgogICAgICAgICAgICB4bWxuczpwaG90b3Nob3A9Imh0dHA6Ly9ucy5hZG9iZS5jb20vcGhvdG9zaG9wLzEuMC8iCiAgICAgICAgICAgIHhtbG5zOnRpZmY9Imh0dHA6Ly9ucy5hZG9iZS5jb20vdGlmZi8xLjAvIgogICAgICAgICAgICB4bWxuczpleGlmPSJodHRwOi8vbnMuYWRvYmUuY29tL2V4aWYvMS4wLyI+CiAgICAgICAgIDx4bXA6Q3JlYXRvclRvb2w+QWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpPC94bXA6Q3JlYXRvclRvb2w+CiAgICAgICAgIDx4bXA6Q3JlYXRlRGF0ZT4yMDEyLTA1LTA1VDEzOjI5OjA3LTA0OjAwPC94bXA6Q3JlYXRlRGF0ZT4KICAgICAgICAgPHhtcDpNZXRhZGF0YURhdGU+MjAxMy0wNy0zMVQxNjozNzowMS0wNDowMDwveG1wOk1ldGFkYXRhRGF0ZT4KICAgICAgICAgPHhtcDpNb2RpZnlEYXRlPjIwMTMtMDctMzFUMTY6Mzc6MDEtMDQ6MDA8L3htcDpNb2RpZnlEYXRlPgogICAgICAgICA8ZGM6Zm9ybWF0PmltYWdlL3BuZzwvZGM6Zm9ybWF0PgogICAgICAgICA8eG1wTU06SW5zdGFuY2VJRD54bXAuaWlkOjc5ZGYxOGEyLTMzNjktNDdlOS05OGE0LWI1MzdmMjFmYjIwZDwveG1wTU06SW5zdGFuY2VJRD4KICAgICAgICAgPHhtcE1NOkRvY3VtZW50SUQ+eG1wLmRpZDpGODdGMTE3NDA3MjA2ODExOEMxNEY2OTRGNzQyMTc5NjwveG1wTU06RG9jdW1lbnRJRD4KICAgICAgICAgPHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD54bXAuZGlkOkY4N0YxMTc0MDcyMDY4MTE4QzE0RjY5NEY3NDIxNzk2PC94bXBNTTpPcmlnaW5hbERvY3VtZW50SUQ+CiAgICAgICAgIDx4bXBNTTpIaXN0b3J5PgogICAgICAgICAgICA8cmRmOlNlcT4KICAgICAgICAgICAgICAgPHJkZjpsaSByZGY6cGFyc2VUeXBlPSJSZXNvdXJjZSI+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDphY3Rpb24+Y3JlYXRlZDwvc3RFdnQ6YWN0aW9uPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6aW5zdGFuY2VJRD54bXAuaWlkOkY4N0YxMTc0MDcyMDY4MTE4QzE0RjY5NEY3NDIxNzk2PC9zdEV2dDppbnN0YW5jZUlEPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6d2hlbj4yMDEyLTA1LTA1VDEzOjI5OjA3LTA0OjAwPC9zdEV2dDp3aGVuPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6c29mdHdhcmVBZ2VudD5BZG9iZSBQaG90b3Nob3AgQ1M1IE1hY2ludG9zaDwvc3RFdnQ6c29mdHdhcmVBZ2VudD4KICAgICAgICAgICAgICAgPC9yZGY6bGk+CiAgICAgICAgICAgICAgIDxyZGY6bGkgcmRmOnBhcnNlVHlwZT0iUmVzb3VyY2UiPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6YWN0aW9uPnNhdmVkPC9zdEV2dDphY3Rpb24+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDppbnN0YW5jZUlEPnhtcC5paWQ6Rjk3RjExNzQwNzIwNjgxMThDMTRGNjk0Rjc0MjE3OTY8L3N0RXZ0Omluc3RhbmNlSUQ+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDp3aGVuPjIwMTItMDUtMDVUMTM6MzA6MDktMDQ6MDA8L3N0RXZ0OndoZW4+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDpzb2Z0d2FyZUFnZW50PkFkb2JlIFBob3Rvc2hvcCBDUzUgTWFjaW50b3NoPC9zdEV2dDpzb2Z0d2FyZUFnZW50PgogICAgICAgICAgICAgICAgICA8c3RFdnQ6Y2hhbmdlZD4vPC9zdEV2dDpjaGFuZ2VkPgogICAgICAgICAgICAgICA8L3JkZjpsaT4KICAgICAgICAgICAgICAgPHJkZjpsaSByZGY6cGFyc2VUeXBlPSJSZXNvdXJjZSI+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDphY3Rpb24+c2F2ZWQ8L3N0RXZ0OmFjdGlvbj4KICAgICAgICAgICAgICAgICAgPHN0RXZ0Omluc3RhbmNlSUQ+eG1wLmlpZDplNDk4NzlmNC1mNDg1LTQxYTktODczOS03YjRjZDM0NTIyMWY8L3N0RXZ0Omluc3RhbmNlSUQ+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDp3aGVuPjIwMTMtMDctMzFUMTY6Mzc6MDEtMDQ6MDA8L3N0RXZ0OndoZW4+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDpzb2Z0d2FyZUFnZW50PkFkb2JlIFBob3Rvc2hvcCBDQyAoTWFjaW50b3NoKTwvc3RFdnQ6c29mdHdhcmVBZ2VudD4KICAgICAgICAgICAgICAgICAgPHN0RXZ0OmNoYW5nZWQ+Lzwvc3RFdnQ6Y2hhbmdlZD4KICAgICAgICAgICAgICAgPC9yZGY6bGk+CiAgICAgICAgICAgICAgIDxyZGY6bGkgcmRmOnBhcnNlVHlwZT0iUmVzb3VyY2UiPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6YWN0aW9uPmNvbnZlcnRlZDwvc3RFdnQ6YWN0aW9uPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6cGFyYW1ldGVycz5mcm9tIGFwcGxpY2F0aW9uL3ZuZC5hZG9iZS5waG90b3Nob3AgdG8gaW1hZ2UvcG5nPC9zdEV2dDpwYXJhbWV0ZXJzPgogICAgICAgICAgICAgICA8L3JkZjpsaT4KICAgICAgICAgICAgICAgPHJkZjpsaSByZGY6cGFyc2VUeXBlPSJSZXNvdXJjZSI+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDphY3Rpb24+ZGVyaXZlZDwvc3RFdnQ6YWN0aW9uPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6cGFyYW1ldGVycz5jb252ZXJ0ZWQgZnJvbSBhcHBsaWNhdGlvbi92bmQuYWRvYmUucGhvdG9zaG9wIHRvIGltYWdlL3BuZzwvc3RFdnQ6cGFyYW1ldGVycz4KICAgICAgICAgICAgICAgPC9yZGY6bGk+CiAgICAgICAgICAgICAgIDxyZGY6bGkgcmRmOnBhcnNlVHlwZT0iUmVzb3VyY2UiPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6YWN0aW9uPnNhdmVkPC9zdEV2dDphY3Rpb24+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDppbnN0YW5jZUlEPnhtcC5paWQ6NzlkZjE4YTItMzM2OS00N2U5LTk4YTQtYjUzN2YyMWZiMjBkPC9zdEV2dDppbnN0YW5jZUlEPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6d2hlbj4yMDEzLTA3LTMxVDE2OjM3OjAxLTA0OjAwPC9zdEV2dDp3aGVuPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6c29mdHdhcmVBZ2VudD5BZG9iZSBQaG90b3Nob3AgQ0MgKE1hY2ludG9zaCk8L3N0RXZ0OnNvZnR3YXJlQWdlbnQ+CiAgICAgICAgICAgICAgICAgIDxzdEV2dDpjaGFuZ2VkPi88L3N0RXZ0OmNoYW5nZWQ+CiAgICAgICAgICAgICAgIDwvcmRmOmxpPgogICAgICAgICAgICA8L3JkZjpTZXE+CiAgICAgICAgIDwveG1wTU06SGlzdG9yeT4KICAgICAgICAgPHhtcE1NOkRlcml2ZWRGcm9tIHJkZjpwYXJzZVR5cGU9IlJlc291cmNlIj4KICAgICAgICAgICAgPHN0UmVmOmluc3RhbmNlSUQ+eG1wLmlpZDplNDk4NzlmNC1mNDg1LTQxYTktODczOS03YjRjZDM0NTIyMWY8L3N0UmVmOmluc3RhbmNlSUQ+CiAgICAgICAgICAgIDxzdFJlZjpkb2N1bWVudElEPnhtcC5kaWQ6Rjg3RjExNzQwNzIwNjgxMThDMTRGNjk0Rjc0MjE3OTY8L3N0UmVmOmRvY3VtZW50SUQ+CiAgICAgICAgICAgIDxzdFJlZjpvcmlnaW5hbERvY3VtZW50SUQ+eG1wLmRpZDpGODdGMTE3NDA3MjA2ODExOEMxNEY2OTRGNzQyMTc5Njwvc3RSZWY6b3JpZ2luYWxEb2N1bWVudElEPgogICAgICAgICA8L3htcE1NOkRlcml2ZWRGcm9tPgogICAgICAgICA8cGhvdG9zaG9wOkNvbG9yTW9kZT4zPC9waG90b3Nob3A6Q29sb3JNb2RlPgogICAgICAgICA8dGlmZjpPcmllbnRhdGlvbj4xPC90aWZmOk9yaWVudGF0aW9uPgogICAgICAgICA8dGlmZjpYUmVzb2x1dGlvbj43MjAwMDAvMTAwMDA8L3RpZmY6WFJlc29sdXRpb24+CiAgICAgICAgIDx0aWZmOllSZXNvbHV0aW9uPjcyMDAwMC8xMDAwMDwvdGlmZjpZUmVzb2x1dGlvbj4KICAgICAgICAgPHRpZmY6UmVzb2x1dGlvblVuaXQ+MjwvdGlmZjpSZXNvbHV0aW9uVW5pdD4KICAgICAgICAgPGV4aWY6Q29sb3JTcGFjZT42NTUzNTwvZXhpZjpDb2xvclNwYWNlPgogICAgICAgICA8ZXhpZjpQaXhlbFhEaW1lbnNpb24+ODA8L2V4aWY6UGl4ZWxYRGltZW5zaW9uPgogICAgICAgICA8ZXhpZjpQaXhlbFlEaW1lbnNpb24+ODA8L2V4aWY6UGl4ZWxZRGltZW5zaW9uPgogICAgICA8L3JkZjpEZXNjcmlwdGlvbj4KICAgPC9yZGY6UkRGPgo8L3g6eG1wbWV0YT4KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAKPD94cGFja2V0IGVuZD0idyI/PhmqurQAAAAgY0hSTQAAeiUAAICDAAD5/wAAgOkAAHUwAADqYAAAOpgAABdvkl/FRgAABqRJREFUeNrsnWtsFFUUx38z5R2kpYIERIwBH+gHhaACYsQQkqpEaE2MmhAJJn7QGJ9Ro3zR+IgJEFDxg4pRSQQjCgiCgiAKyEMEHxQKJUZABCxC2zQCW3avH+6ZpMDO3NnZ6e7OzP6TTZvO9M7Mv+fec87/nLm1lFL4wA3AZOB24GqgL9CdeOEMcBLYC2wBvgI2Ap4EWR4E2sBU4AXgKpKJfcBrwAIgkwuBVwIfA6MpA2CrGFOjHwInAF8Afcq8nYNWoA5Y60XgLcA6oFuZr6xIiYFtzEbgEGA70L/MkyeagFHAQcdROF8Xlcnzhf7Apw53DoFTgTE+BzglZE8HRsiAVkQ/lwAjgYeAzyWU8YPRwhkopSylVIMyo10pNVMpVa2UIqafAUqpeUqptA8+GpRSlqWUGgdsMDDeIoH09wmZpncAi4FehvNutYFJhpPOAlMSRB7AKqAWSBvOm2T7WPtmAusT6CxWA+8YzhljKaX+Bga6nNAGXAY0J9Tj9pNwpafL8aM2UO0xwJcByOsqF44DjgPLPY73tQ2qypoAF+0lOePTMcloVnsc624bfnlHwItWydq5E6iJOIGeHJgIPJznxa8Vj7ZKvo8iDuVDYFjOo0ascaZYZ5TQnA+B6RBvpJusi43AI0CXiBB4Nh8COys0mAdsA8ZH3cPYRbz2COA7tHg7rExgcNQCvwGvAL3LBAZDT+BFdBFnegndV2QIdDAQmA9sIiIFrVL9S48GfgQ+QZcaEkVgBjgWwjgWcD9QL9O7Z1IIbAfeAxai5f980VscTIMQaiVhCqfFIcwBvsHQHuETQ2RKr5MQKBFrYArdZzIb+CWkMcejy6/zcdcxY+dE2oBlaIX3r5DuezqwmyLLZoX2wk3Ah+hmnbYQxqsSgaJeAvJEhDFp4A/gTWAFLl1POWKYpIQFl82KGQe2Az8Ds0RYCAM1wK8iVvSLO4EO/hPLeRv4M4TxuqDlsj0UQDazlHeLapCYqxJdlN4cYHrawGB0G1llSM/oOJqv8xhDFZrAZuA08Jmsd0Gs6Dp00T8sC1oCPAvsjwqBDo6im5FaAozVAxiH7lsMKy59SzKb5qgQ6GCHTKP2gOHKnejW4zBwBJghIVUmKgQ6QsNy8ZS5pneWZB51wMUhEbkTeApz60rJEOigBd2keCTA+BXoVy0mh5SBKFlinke6TnMhsFhhTCXwcEB1JS2edTa6ppJ3JAJcA1wexTjwnzyUmjPAD0JkfcAxjqG7U0dh7pEsqSnsZCJvEE7t2QIGoPsYB3SCN1alSOBCtGYYJiqAoUKkm4K9DHgmx3iw5NbAYwbybHRdJNf7c4TcuVnWx93o1t0pAYPpkrLAuYZzxgIT0SWBxQGzGYCLZKwFwLsY2jSiMoW3iXjglX08d97PDktamEs2kwF+Eks8HUKo45pzFhJpzE2bd2f52aXAE0L+Gh+WtB9di2nq7AcqNIFLDQ/fHxjucfwmCTmWAruyWMYJdEdpQ6EeqJAEnpCH9sJ9PmPXOvRLfwvFIaXQr2FsIdyWvJIKpBcZjg/Hu+HdLZtREtNtKjR5hbTAesN6VCFWlQs2AI+LIFA0FMICFd6vCoCu9fr9Yx4EHgBuKzZ5hbLAlXi/BdkbLZqacAq9f8EswmkZiQSBrejKmxfqfFiwSW6KLYGLDGrLYOAKj+PbgcfEu5YkOnMNbMRbMLWAe12OHUHLTDeXMnmdbYFLDMdHSK7aESl0q8brhNP6EVkC1xoW+q5c+J5yPmXHWBGYQbfneqGmg1CxS9a59UQQndWh6lUqrEJv9HAceFSmciTJK4aY4IQtc4CXiMGL3CYCK0LOL0/K9N0dF45MBFYB/4ZwEyfQOt6eCBpZVT4EDsqTwNOikmwhWEtHKWBIPgReD/weUEDYgZbT24g2Rpq8sFeiPzHABc8C76MVmKiTB7qS54Yzpm1PWiRfjQMRQTAQ3TXr1oNz1CbLrowdUAk8SXLxMt4NTPtsH8n6DODGBJJXK4KGFzbbmNXibugdbccmiLx70FKcqS6+Itft715VSvWJ8fZ3Q5VSHyilMj742OtsfwfwILrd1Q9a0A06a9Cv6h+SDCNq6IGuAg5ClxQmoNuI/eoD04CPHAJtIvSWeAlgqyxpmfImtLmjSZzqAc4z14OilKTKHLkiJRwd6JiJdMRGWQday1xdgFbgLjrsIY3LgrkW3cCztczZOWveKODbbLlwNjTKIjmN8Ntwo4R9wsFYt4zNCvjvMKqJ33bxKbRu6fw7jJXo/htPgv4fAACYxQCp1KuJAAAAAElFTkSuQmCC) no-repeat;background-size:40px auto;background-position:10px center;background-color:#42474C;border:1px solid rgba(255,255,255,.2);color:#fff;font-size:16px;max-width:360px;margin:auto;-webkit-box-shadow:0 2px 6px 2px rgba(0,0,0,.2);box-shadow:0 2px 6px 2px rgba(0,0,0,.2);text-shadow:1px 1px 0 rgba(0,0,0,.8);cursor:pointer;webkit-user-select:none;-webkit-box-sizing:border-box;box-sizing:border-box}.appstoreBtn{display:block;width:91px;height:30px;background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAALYAAAA8CAYAAADL20C6AAAACXBIWXMAAAsTAAALEwEAmpwYAAA5mWlUWHRYTUw6Y29tLmFkb2JlLnhtcAAAAAAAPD94cGFja2V0IGJlZ2luPSLvu78iIGlkPSJXNU0wTXBDZWhpSHpyZVN6TlRjemtjOWQiPz4KPHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0iQWRvYmUgWE1QIENvcmUgNS41LWMwMTQgNzkuMTUxNDgxLCAyMDEzLzAzLzEzLTEyOjA5OjE1ICAgICAgICAiPgogICA8cmRmOlJERiB4bWxuczpyZGY9Imh0dHA6Ly93d3cudzMub3JnLzE5OTkvMDIvMjItcmRmLXN5bnRheC1ucyMiPgogICAgICA8cmRmOkRlc2NyaXB0aW9uIHJkZjphYm91dD0iIgogICAgICAgICAgICB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIKICAgICAgICAgICAgeG1sbnM6c3RSZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiCiAgICAgICAgICAgIHhtbG5zOnN0RXZ0PSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvc1R5cGUvUmVzb3VyY2VFdmVudCMiCiAgICAgICAgICAgIHhtbG5zOnhtcD0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wLyIKICAgICAgICAgICAgeG1sbnM6ZGM9Imh0dHA6Ly9wdXJsLm9yZy9kYy9lbGVtZW50cy8xLjEvIgogICAgICAgICAgICB4bWxuczpwaG90b3Nob3A9Imh0dHA6Ly9ucy5hZG9iZS5jb20vcGhvdG9zaG9wLzEuMC8iCiAgICAgICAgICAgIHhtbG5zOnRpZmY9Imh0dHA6Ly9ucy5hZG9iZS5jb20vdGlmZi8xLjAvIgogICAgICAgICAgICB4bWxuczpleGlmPSJodHRwOi8vbnMuYWRvYmUuY29tL2V4aWYvMS4wLyI+CiAgICAgICAgIDx4bXBNTTpPcmlnaW5hbERvY3VtZW50SUQ+eG1wLmRpZDowMTgwMTE3NDA3MjA2ODExOTEwOUU0OEZENkUxNjA2MDwveG1wTU06T3JpZ2luYWxEb2N1bWVudElEPgogICAgICAgICA8eG1wTU06RG9jdW1lbnRJRD54bXAuZGlkOkYyNjVEOENFOEZCOTExRTE5RDM1REJEMUIxMjY5QThEPC94bXBNTTpEb2N1bWVudElEPgogICAgICAgICA8eG1wTU06SW5zdGFuY2VJRD54bXAuaWlkOmUwMzFhMTNmLTFlNjctNDAwMy1hMTJmLWUwNWM2ZmM0YTA1NDwveG1wTU06SW5zdGFuY2VJRD4KICAgICAgICAgPHhtcE1NOkRlcml2ZWRGcm9tIHJkZjpwYXJzZVR5cGU9IlJlc291cmNlIj4KICAgICAgICAgICAgPHN0UmVmOmluc3RhbmNlSUQ+eG1wLmlpZDowMTgwMTE3NDA3MjA2ODExOTEwOUU0OEZENkUxNjA2MDwvc3RSZWY6aW5zdGFuY2VJRD4KICAgICAgICAgICAgPHN0UmVmOmRvY3VtZW50SUQ+eG1wLmRpZDowMTgwMTE3NDA3MjA2ODExOTEwOUU0OEZENkUxNjA2MDwvc3RSZWY6ZG9jdW1lbnRJRD4KICAgICAgICAgPC94bXBNTTpEZXJpdmVkRnJvbT4KICAgICAgICAgPHhtcE1NOkhpc3Rvcnk+CiAgICAgICAgICAgIDxyZGY6U2VxPgogICAgICAgICAgICAgICA8cmRmOmxpIHJkZjpwYXJzZVR5cGU9IlJlc291cmNlIj4KICAgICAgICAgICAgICAgICAgPHN0RXZ0OmFjdGlvbj5zYXZlZDwvc3RFdnQ6YWN0aW9uPgogICAgICAgICAgICAgICAgICA8c3RFdnQ6aW5zdGFuY2VJRD54bXAuaWlkOmUwMzFhMTNmLTFlNjctNDAwMy1hMTJmLWUwNWM2ZmM0YTA1NDwvc3RFdnQ6aW5zdGFuY2VJRD4KICAgICAgICAgICAgICAgICAgPHN0RXZ0OndoZW4+MjAxMy0wNy0zMVQxMzoxOTo0MC0wNDowMDwvc3RFdnQ6d2hlbj4KICAgICAgICAgICAgICAgICAgPHN0RXZ0OnNvZnR3YXJlQWdlbnQ+QWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpPC9zdEV2dDpzb2Z0d2FyZUFnZW50PgogICAgICAgICAgICAgICAgICA8c3RFdnQ6Y2hhbmdlZD4vPC9zdEV2dDpjaGFuZ2VkPgogICAgICAgICAgICAgICA8L3JkZjpsaT4KICAgICAgICAgICAgPC9yZGY6U2VxPgogICAgICAgICA8L3htcE1NOkhpc3Rvcnk+CiAgICAgICAgIDx4bXA6Q3JlYXRvclRvb2w+QWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpPC94bXA6Q3JlYXRvclRvb2w+CiAgICAgICAgIDx4bXA6Q3JlYXRlRGF0ZT4yMDEzLTA3LTMxVDEyOjQ4OjAxLTA0OjAwPC94bXA6Q3JlYXRlRGF0ZT4KICAgICAgICAgPHhtcDpNb2RpZnlEYXRlPjIwMTMtMDctMzFUMTM6MTk6NDAtMDQ6MDA8L3htcDpNb2RpZnlEYXRlPgogICAgICAgICA8eG1wOk1ldGFkYXRhRGF0ZT4yMDEzLTA3LTMxVDEzOjE5OjQwLTA0OjAwPC94bXA6TWV0YWRhdGFEYXRlPgogICAgICAgICA8ZGM6Zm9ybWF0PmltYWdlL3BuZzwvZGM6Zm9ybWF0PgogICAgICAgICA8cGhvdG9zaG9wOkNvbG9yTW9kZT4zPC9waG90b3Nob3A6Q29sb3JNb2RlPgogICAgICAgICA8dGlmZjpPcmllbnRhdGlvbj4xPC90aWZmOk9yaWVudGF0aW9uPgogICAgICAgICA8dGlmZjpYUmVzb2x1dGlvbj43MjAwMDAvMTAwMDA8L3RpZmY6WFJlc29sdXRpb24+CiAgICAgICAgIDx0aWZmOllSZXNvbHV0aW9uPjcyMDAwMC8xMDAwMDwvdGlmZjpZUmVzb2x1dGlvbj4KICAgICAgICAgPHRpZmY6UmVzb2x1dGlvblVuaXQ+MjwvdGlmZjpSZXNvbHV0aW9uVW5pdD4KICAgICAgICAgPGV4aWY6Q29sb3JTcGFjZT42NTUzNTwvZXhpZjpDb2xvclNwYWNlPgogICAgICAgICA8ZXhpZjpQaXhlbFhEaW1lbnNpb24+MTgyPC9leGlmOlBpeGVsWERpbWVuc2lvbj4KICAgICAgICAgPGV4aWY6UGl4ZWxZRGltZW5zaW9uPjYwPC9leGlmOlBpeGVsWURpbWVuc2lvbj4KICAgICAgPC9yZGY6RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1ldGE+CiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgCjw/eHBhY2tldCBlbmQ9InciPz6H5nxsAAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1MAAA6mAAADqYAAAXb5JfxUYAABqgSURBVHja7F15VFRH1v/1wiayBxUBRVAQUVARZVRAEyOKGjeiccE9JzouRyRDosccz0x0TGJi1BkT3FAU3KIGlYgiQlxGZWQRUAkwKARwASHQLE2v9/vDefX1o7vZNI6a/p3zDs17t+q9uu9W1a17694nmDZtGgoKCvDo0SOo1epZNTU104jIG8BbMMCAVx8KgUCQbW5ufs7MzGxnRUWFEgDEQqEQQqEQEolku0KhWGXgkwGvG4hobH19/VipVBrs4uIyr7i4+KmoW7duKCws3FRfX/+xgUUGvOYC3kelUnlev379qMjIyKhvWVnZAQBGBtYY8LpDLpd7yOXyQpFUKl2nUCgCDCwx4E1BQ0ODibCxsdHTwAoD3iQolUonIQClgRUGvGEQCw08MOBNXEcaBNuAN3PIft4KzM3NYWVlBaGwY31EJpOhsrLytWSetbU1unbtisrKSlRXV7e5nKWlJRwcHPD06VNUVVW1SvfkyRPU1NS8ljx66623YGdnh9LSUjQ2Nr7Ue58FQO09bGxs6Ouvv6bi4mKSSCQdOurq6qiqqorOnDlDgYGB1JHnAEAzZ86kyMhIGjduXIfraO3w9/enlJQUCg0NZeeWLVtGMpmM1q5d2666wsLCSCaT0YYNG1qkW7BgAclkMlq6dOnv1q7f+9i4cSPJZDJ69913X+Z9czs0YhsbG+Po0aMYO3bsC+lZkyZNQmBgIEaNGoXbt2+3q6yzszMOHToEIyMjFBYWwtPTEyqV6oX3fi8vL4wePRpZWVk4ceLEs+lOLIaxsTGMjNrnAuDKGRsbt4lOLBa/8iNzly5d4OfnhytXrqCuro4nK8bGxhCJRC/1eYQdfckvSqg5WFlZ4S9/+Uu7y02ePBlGRkY4d+4cevbsCWdn59+FUdHR0ejfvz8iIyP/f4VCBABQq9XtW9m0sRxHx/19lfHPf/4TCQkJWgLMtbG9PPqf6Nh9+/ZtlSY3Nxc//vgjAEClUsHb2xvTp09vtde3F0FBQSgoKMDu3bsREhKCadOmYevWrQAAkUiEOXPmQKVSIS4ujpXp1q0bpk2bhszMTNy8eRPGxsYYNmwYJk2aBFtbW2RmZuLw4cM8vbZr164YMmQI1Go18vLyWpzNRo4cifHjx8Pa2hoZGRk4fPgwJBKJFq1cLseAAQOwePFiNDU1ITY2Fnfu3Gm1zTY2NggLC4OPjw/u3r2Lffv2oba2ttVyPXr0wKxZs9C7d2/k5OTg2LFjqKioYNd9fHwwfPhwHDlyBP3798fUqVNRWVmJqKgovTq+WCzGrFmz4OPjAyLCihUrUFJSgsOHD/NmToVCgeDgYISEhCA/Px/R0dFoamri1eXj44N58+bB0tISZ8+exZkzZ16ujj179mxqDYWFhXTw4EE6ePAgxcTEUGpqaqtlLly40K7nsLa2ppqaGjpx4gRZWVlRY2MjZWZmsusCgYASExOJiMjX15ed/+KLL4iIaNGiRQSAAgICqL6+nrKzsykjI4OIiHJycsjBwYGVeeedd4iIKCIigp1bsWIFERGtX7+enRs4cCDV1NTQ7du3KTMzk4iIMjIyqHPnzjzdmeNRZWUlVVVVERFRY2MjhYSEMLrFixcTEdHy5cvZOS8vLyouLqaqqiq6dOkSNTU1UUFBATk6OrbIqxkzZlBtbS01NDTQnTt3iIiovLychg8fzmjCw8OJiCg1NZVqa2tJKpUyXtjY2Ois18zMjAoKCkitVhMRkUKhoMLCQjIxMSEAtHnzZiIiys7OpqqqKlIoFEREFB8fTwKBgNUTGRlJUqmUsrKy6MaNG0REtHv37g7r2B0S7FmzZtHvgfYK9vz584mIKCwsjADQ/v37SalUUteuXRnNvHnziIhoy5Yt7Fxubi5VVlaSlZUVASBzc3NydnZm1z/66CMiIvroo4/YuVGjRhER0cqVK1sUbGNjY+rSpQv7/89//jMREc2bN09LsIuKisjHx4fMzMwoICCApFIpPX78mOzs7PQK9qVLlyg/P5/Mzc0JAPXr14+IiLZv366XT2+99RbV19dTUVEROTk5EQB6++23iYiotLSU8WHRokVMCPv06UM2Nja0detWIiKaM2eOzroFAgFZW1tTcnIyKZVK8vLyImtraya0nGAfO3aMunfvTl26dKH4+HgiIho2bBgBIA8PD1KpVPTtt9+yej/++GMiIurXr9/LWzxyOHfuHEpKSjps6uP0R1NTU8ydO7fd9cyYMQNSqRS5ubno3r07kpOTsWDBAoSEhGD//v0AgNOnT6OyshKBgYEAACcnJ/Tt2xebN29m03dDQwOampqwcOFC+Pv7w8XFhZmq2gu5XA6JRIIlS5ZgyJAh8PDwAAD069dPi/bkyZPIzs4GAFy9ehWXLl3ChAkTMHjwYFy8eFGL3tHREUFBQThx4gRGjRoFExMTiMViSKVSTJw4EWvWrNG5cB47dizMzc2xdetWlJWVAQBSUlJw4sQJhIaGwtXVFVlZWUwPPnnyJAoLC9naIjw8HAMHDuSpc5rvr6amBnK5HADw9OlTntoiEAgAAHv37sXDhw8BAHFxcZg8eTK8vLyQlpaGsLAwCIVCVFdXY/LkyRAIBExNCQoKwr17916uHfvLL7/ElStXnl/RF4sRGhrartW/mZkZfHx8YGZmhlu3bvE6xeLFixETEwO1Wo3a2lrs3bsXn3zyCdOtxWIxjh8/zugHDx6MmJgYuLu7Iz4+Hk+ePOG9lPbgT3/6Ew4cOABnZ2ckJCTg6dOnTN9vjuZ23f/85z8AAAsLC5119+zZEyKRCO+99x4mT57Mq6eqqgpCoVCnYHNrIk6wOOTk5CA0NBTW1tZanbP579YsOByv9L1DTV4qlUpenW5ubgCATz75hPFJrVajurq6w4vO5xLsTp06vZAVrL4X2RLeeecdODo64siRIzh37hyEQiEEAgE2bNgAf39/9OrVC0VFRQCA8+fPY+3atfjwww8xYcIE3Lt3D/n5+YzhmzZtgqenJ3x9fZGdnY0ePXogLCys3YItEAiwbds2uLq6YtiwYcjMzMSwYcMQGhqqk765sDs5OQGA3oUgNxJ+++232LRpE0xNTdniXK1WQ6FQ6CzHddTmAuzu7q7zfprt5gaM1iwzAoEAAoGACW1Lgs395urkFtYzZ87EtWvXGF+USqXWAvN3Nfe9CggLCwMA7Ny5E7GxsTh48CBiYmIQFRUFkUiEoUOHMtq0tDTcvXsXq1evxtChQ/H1118zIRAKhejfvz+qq6uZWvDBBx90yEQlEong6OiI3377jdU1evRoLcHgXmxISAi6devGLAJjxoxBcXExMjIydNZfUFCAe/fuYe7cuXB1dUV1dTWqq6tRW1vLsx3rUhlVKhWWL1/OhHvYsGGYMWMGysrK2ADwPFAqlRAKhXB1dW132WPHjgEAZs+eDalUytoll8t5s8cbL9hmZmYIDg7G48ePkZ6ezrv2008/AQCWL1/Oer5MJsP+/ftha2sLgUCAS5cuMXqVSoVTp07B3t4ely9fxokTJ7Bq1SqtmYSbYjWnZO63iYkJe7kpKSmwt7dHamoqTp06hYiICK3R0tLSEgBgamqKO3fuICUlBbdv34a5uTmWLFnCRmaufu6vUqnE2rVrYW9vj9zcXCQlJeHChQsoKyvDyJEj9fLrwYMH2Lx5M3x9fZGeno7jx4/j8uXLUCgUWLx4MRuxm7dHc8TmZgd9uHHjBgAgMTERe/bsYZ2XK6eponAOLe5+KSkp2LNnD2bPno2ioiKcOXMGN27cQEZGBszNzTskIyIAswG4t6fQgAEDMH36dMTFxTG98HkFNTw8HA8fPkRMTEyr9F27dkWXLl2wa9cuLU9lfX09OnXqhMrKSly9ehUymYwtakxNTXH06FEkJibyynDrBC8vL1RWVmLBggVobGxEVlYW7t69y16MqakpLl68iOLiYiYASqUSFy9eZIutxMREmJiYoE+fPnjy5AmWLVsGpVKJjIwMZGZmMsGWSqVYunQpamtrMWTIEKSlpWHhwoW4du0aey4TExOo1WokJSWxe+bn5+PkyZNQKpXo3bs3hEIhEhMTcf78+RZH7dTUVKSlpcHNzQ0uLi44f/48lixZgps3b/I6KhHh4sWL7L2KRCJYWloiJSWF8UKfYBMROnfujOLiYpw/f569W4lEgvPnz7M9QZwn8sKFC/j111+f2ZzPnkV6ejrs7e3h5OSEiooKxMTEICMjoyN6dsVzmfte1N4MGxsbqquro9TU1Nd2T4TheKWOXMO2VQPeSBgE2wCDYBtgwOsC8ZvWoICAAAQGBkKtVkMgEEAikeD777//Xbayvmw4OjoiODgYQ4YMgaenJ8zNzSGTyVBSUoLs7GxkZmbi+vXrkEqlBsl+kxaPIpGI0tPTtfagBAUFvfYLog8//JAePXrU6n6b4OBgw+LxTVs8Ojg46NyToc/z97pg5cqV2L17N3PmcObLsrIyXlhdY2Oj3m2v7u7ubN+KQcd+zTBy5EiYmZkBeLYfnLN/anohXzd4enpi27Zt7P/8/HxMnToVffv2haenJzw8PDBkyBBs374dUVFRKC8v55VfsGAB0tLSkJOTg/DwcIMq8jqqIhcuXGBT8uzZs6m8vJztEfbx8Xktp9X169ezNkkkEvLw8GhXeU3V7B//+IdBFXnd4O7ujlGjRgEAmpqakJyczDx9YrEYM2fOfC3bNWLECPb7ypUrbPNWW6EZudPRfRcGq8j/EIMHD2Z7D3JyclBRUYG8vDxMnDgRwLNNP/rg4eGBFStWAHi2E27jxo0AgOnTp2P8+PFwdnaGWCxGTU0N/v3vf2Pnzp2or6/n1eHk5ITIyEgIBAI8fPgQmzdvBgBMmTIFkyZNgpOTE6vj1q1b+P7779sUzqW5b8PW1rZNvLCwsMBnn30GU1NTnl49ZswYbN++ne3E+/HHH5GSkqI1QMyZMweenp6ws7NjneP+/fs4fPiwzg1agwYNwqJFiwAAN2/eRFxcHOzs7BAZGQlvb280NjZi0aJFvPaKxWLMnz8fo0aNgqOjI0xNTSGRSFBYWIjY2FikpaUZVBEAFBcXx6bcyMhIAkDjx49n5+rr66lXr146y44ZM4bRVVdXk52dHUVHR+u1PGRnZ7PoD2iEhHF48uQJ2dra0t69e/XWkZOT06aUE1u2bGFlVCoVixZq6XBwcGhTxNJnn33GK7du3Tr67bff9NJLpVLasWMHC/vijunTpzOaQ4cOUY8ePSg7O5uda2ho4EUVubu705UrV1q8T/Nnw8sMDXtVBNvBwYFqamqIiKipqYnc3d158Xgc1q1bp7P88OHDGU1VVRUlJSWx/4uKiignJ4dkMhmP+ffv36eePXuyOjw9PUkulzPBPnPmDK+O7OxsrTpKSkqod+/eLbbN19eXV6apqYnWr1/PQrx0Hfb29iwukosx5ASmqqqKHStWrNCKA+VQXFxMP/zwA/3www9UWlrKu7Z//37e/caOHcuuxcTE0L59+7SemRPsnj17sphLIqLc3FzauXMnbdu2jZKTk3nlZs+e/ccW7ClTpjBm5OXlkVgsZteioqLYtczMTBIKhVrl/fz8tEaN4uJimjVrFnXq1IlEIhF5e3vTsWPHeDQHDhzgjUJNTU286w8fPqSwsDAyMzMjoVBIXl5edPToUR5NcnJyq+37/PPPtZ7v8ePH9Pnnn5Ofn58WvVAoJBsbG7K1taV//etfrMyePXvI1taWHaamplr8IyKKjY0lW1tbVl+XLl3o7NmzPJrw8HB2ffTo0bzZSqlUkkwmowMHDtDatWtp9erV1LlzZxIIBHTy5ElGe/r0abKwsOA9u2YHq6ioIEtLyz+uYO/YsYMxY9u2bbxrc+bM4VkVunfv3uqoKJfL9Tp1rl69yugUCgX179+fAFCfPn14gi2TyWjs2LGtWm/kcjn17du31Tb+/e9/1+o4RERKpZK+++47vVHqP//8M6PVFfArEono7t27jObWrVtkZGSkRWdqakr5+fm8WYijCwwM5D2TTCajDz74QKsOzQ7w4MEDMjMz06IxMjLiPc/kyZP/mFYRGxsbzJgxA8CzjfhcEC+H06dPswBWCwsLTJkyRauO5uFMR44cweXLl3Xeb926dcw9LxaLWa4UtVrNi5I5fPgwkpKSdNaxefNmZmM3MjJqkwNp3bp1GDlyJBISEnixkiKRCMuWLcOtW7d4FhQOusK8mi+cuRAxAPjqq690hpg1NTXh4MGD7H9XV1cEBOj+XkBMTAyOHj2qdX7cuHHs96lTp3S6/hUKBQ4dOsT+14zt/EM5aCZMmICuXbsCAMrLy1FeXg4LCwt2qNVqFlXDOSyav2Ai4gllQkKC3vulpaWhtLSU/d+rVy+ddJob+Jvj6tWrLDABAPz9/dvU1vT0dEyaNAmDBw/G9u3beYEFDg4OSEpKwqBBg9rFv8DAQBbdolAokJOTo5f29OnTvD03QUFBOun0BXj7+Piw387OzlizZg0iIiJ4x5o1a+Dr68vreH9Ic5/mKOXg4ICsrCwtGs4byZkFe/fujYKCgjbZfnWNKJrpBfSFLnGRO7qgUqnw66+/spfGhYq1Ffn5+Vi9ejV27NiBTZs2sRjNTp064dNPP22Xzb5Pnz48N33zSHZNlJeXo6qqimXs0pdOjouK4QmaWMwbBN5//328//77rT5fe3nzRgi2iYkJC5YFnoUccZHe+iASieDn59eiYLeU34SI2hSq1FqE+4vYbXj//n3Mnz8fTk5OLOZxwoQJcHJyYupXa9CMZVQqlXoj3bln1lTb9PFJV6S6kZERL15UKpVCoVDorIObPQUCAW92/MMI9tixY9mop1QqsW/fPkgkEh6ziAgCgQBhYWFspJk/f77O5C8cWhJckUjEG6UbGho69OyayXja4qjRB7lcji+++IKpT+bm5nBxcWmzYGvm57a2toadnZ3WfhMOdnZ2PCfR48eP29yp5XI5T6f+29/+hpiYmFazsHY0p/ZzCXZHcz7oeviOZBTlpmDg2aanpUuXtiiQq1evZnpljx49dE6ZwLN9z/rg6OjIu65PCDp37qy3DhcXF3h6/v83rbhUDR1F86Tzmh1TU8h08ZjbdsAtrt3c3PS2afTo0bwRvqV1hK7RPj8/n7XbyckJjx49ejVd6oMGDWpRuLn8ziqVCnK5XK/wWlhYQCwWt0u4xWIx/Pz82P/6cnFwSE1NZYJtYmICX19fvYK9ZMkSxMbG6txbER4ezoRWrVbj7NmzOusIDQ1FVFSUzql96dKlbNRXqVSIj49/rpeo2cFramp4eUI079+9e3etsteuXUNdXR1LNTF37ly9i78FCxaw30+ePNFyx7eGW7duMavUhAkTsGHDhha/6PC8+N2SUkqlUrp9+7aW5+pFJKUcMWIEy/BJRDR16tQ2eyeJiI4cOcKueXt78+oiIvrrX/+q5cwZN24cNTY2MpqEhAR2zc3NjWUn5bBlyxYSiUS8OoKDg6m2tpbRpKen87KONj/mzp1LGzduJE9PTzI2NuZds7KyYokkOURHR/NoDh48yPOqurq6at0jNjaWV4cut31kZCSPZufOnexaczv2iBEjdLbF3d2d1/aff/5Z7zYHExMTXoZavCrZViUSCY0YMYJl40xISHihgr1r1y6ea5rLPtrSERMTw8rU1dUxl7guwSYiunLlCkVERNCqVatYhlDN8ppeP12CTUR0/fp1ioiIoJUrV9KpU6d492loaKCAgAC9zysQCOjy5cvMkfPLL7/Q2bNn6cCBA3Tq1CkqLi7m3auiokIrO+nChQu13Pj79u2jmJgYcnNzYy54zcFHpVJRdHQ0jRs3jiZOnMjzFnJOHE2PYFsFGwAtX75cS04OHTpES5cupVmzZtGqVavou+++o7y8PPrqq69ermC3JT/2rl27eGVCQkJaLZOUlNSm+wuFQsrLy2Pl4uPj21Tu3Xff5d1v8eLFWoKtUqkoLi6OVCqV3udsamqiGTNm8OrWFGy1Wk3Jycm8fRq66tBMLazrcHFx0dpfog9lZWU0cOBAnTPV06dPdZbRzI09YMAArY6iC1lZWdSjRw/ePYKCgng0I0eObLFdERERbWpTYWGhzi0Qv5vnsS2WABsbm3bbI9uqY3t4eMDa2prleLtw4UKbymVnZ6O4uJiV69+/v05TX1RUFCZNmqQzp11iYiKGDx/Oy9aqyyqwZ88ejB8/nueI4dqYlJSEgIAAnidPFx4/fozg4GAcPXpU71fJfvnlF3z66afw9fXV+f2eR48e4e2339baBqpSqXgLy9zcXAwfPhzbt2/XqfcWFxfj448/xujRo7XWJgqFgvG0urq6RZMhAHzzzTcYMWIEjh8/rvNLCXV1dbh69Sq+/PLLDmW8BQDBf0fsie0p5OjoiKKiIt5eYV3mnVWrVuHIkSPw8PDA7t27MXDgwBbrXbduHdvH3Jrt1dzcnHWEmpqaNqfBsrKy4qWqrampgbe3N27fvs1LFpmYmAhra2v4+fnBxsYGCoUCJSUlPCuCJtzc3HDnzh1mNVi4cCEOHDgAS0tLDB06FLa2tlAqlXjw4IFOJ1Jr6NatGzw8PGBhYQEjIyPI5XI8evQId+/ebdEZpLnY9vf3h729PWQyGUpLS5GXl6fT5ty9e3d4e3vD0tISarUalZWVyMzM1JtCTSwW8wYuiUSiN+uqLllyd3dH586doVKpIJFIUFJS0mH79X9xp0OqCP4bNa1LL22Ourq6Nk078fHxOjfFvIyjuY49fvz4dtfRXMdeuHChIVr8fxga1mFz3549e3D//n289957evNbCwQCGBkZQaVS6fW0cQkbo6OjW53CDDDgpdixL126xEvJa4ABrwoMKc50eOg6umDRdOV3tA4DDIL9QsF97qL5Ftb2QKlUsjpe9gc7DdBWRf7wQ0thYSEGDx7Morc78umK0tJS+Pv7s2/h6HPXG/CSJmChUPiTWq0OMfDCgDdIrbwpNDMzSzSwwoA3Sg0Ri/OEAwYMOGBsbPzAwA4D3hA09u3b9xtht27d6h0cHNYAkBh4YsDrDjs7u805OTl3xUqlEp06dYo3NTV9XyaTfU5EvQ3sMeA1RIWJicm3T58+3Q0A/zcAL59CfMvOIQsAAAAASUVORK5CYII=) no-repeat;background-size:contain;margin:auto;z-index:2}.appNativePlayBtn{position:absolute;left:25%;bottom:8px;display:block;width:50%;height:30px;background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAQIAAABMCAYAAACGarn4AAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAA2ZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNS1jMDE0IDc5LjE1MTQ4MSwgMjAxMy8wMy8xMy0xMjowOToxNSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wTU09Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9tbS8iIHhtbG5zOnN0UmVmPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvc1R5cGUvUmVzb3VyY2VSZWYjIiB4bWxuczp4bXA9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC8iIHhtcE1NOk9yaWdpbmFsRG9jdW1lbnRJRD0ieG1wLmRpZDowMTgwMTE3NDA3MjA2ODExOTEwOUU0OEZENkUxNjA2MCIgeG1wTU06RG9jdW1lbnRJRD0ieG1wLmRpZDpBNkIwOTY0NUYyMjkxMUUyQUU1QUQ4MDY4QjcxREZCQSIgeG1wTU06SW5zdGFuY2VJRD0ieG1wLmlpZDpBNkIwOTY0NEYyMjkxMUUyQUU1QUQ4MDY4QjcxREZCQSIgeG1wOkNyZWF0b3JUb29sPSJBZG9iZSBQaG90b3Nob3AgQ1M1IE1hY2ludG9zaCI+IDx4bXBNTTpEZXJpdmVkRnJvbSBzdFJlZjppbnN0YW5jZUlEPSJ4bXAuaWlkOkNDREM1RjY4OEZCQzExRTE5NzFGRkY4Q0IzQjJGQkM3IiBzdFJlZjpkb2N1bWVudElEPSJ4bXAuZGlkOkNDREM1RjY5OEZCQzExRTE5NzFGRkY4Q0IzQjJGQkM3Ii8+IDwvcmRmOkRlc2NyaXB0aW9uPiA8L3JkZjpSREY+IDwveDp4bXBtZXRhPiA8P3hwYWNrZXQgZW5kPSJyIj8+3m+BHwAACIJJREFUeNrsnV1MW/cZxl9/gD/B2MZ82CSh1F6JQmkaRZoCFRWJoOku1qhDWRppbFdjqiq10S52k4hwuaoMaVWm5W4Xa3oTTdEupkrJNK0XkSJFVSLlCwFRvhgLBvNlKAkE+j5nIdtS23F8TGzI85P+gnCO7RMdPc//ed//8TmWo0ePilnsdrscP348qr+26/ihDoeO13RYhRCST1Z0DOp4oOOCjn+srq4Om9awmRc7HA45duzYB/prVzQabWxpaaloamoqLykpsdbV1bksCs8bIflDRb967969HUtLSytXrlx59/z585+ozG7optO66csXagQ2m036+vp+BANoUw4ePBipqKhwzs/PC8bCwoJcvXpVHj16hAPn2SMkD2BeVe1ZdKJ1u1wuaW1t9XZ2doanp6cbTp8+vVO3dzw2hL8993s/b2mgByG9vb0fVlVV/erIkSMNoVDIowcic3NzhvAJIS8OTMplZWWiE7HE4/H5gYGBm+Pj439UM/jDuiWCxybw6+bm5l/29PQ0LC8v20dHR0VjCs8IIQUAky8mYiRxNQOP6nP7yZMnP9Z04FIz6M/2fbJu5sF59EN6mpqaYAIxjf/2yclJmgAhRQB0CD1Cl9AndKpm0JN3I+jr69tfXV39UXd3d4N+mGV2dlZWVlZ4BggpEqBH6BL6hE6hVzWD/XkrDbA6oHQdPny4XpOBfWZmJmMTUGsUGRsbe9I4ZGogxBwoy91ut5SXl4sKXCorKyXVohx0iX6dz+ezQ68DAwNd+uev8mIEWCLcvXt3e11dnTeZTKZNAhMTE3L9+nWBUTzucIrVajX+E4QQc7M9dDU1NSW3bt2C0KWxsVFCoVDKfaFT6BW6VS1+8KylRXs2ToQ00N7eHl5eXk47u9+8eVOuXbtmXFwUDAbF6/WK0+k0Xg9D4CUFhOQGZnk0BR8+fCiLi4uGyFECXLhwwTCDaDSasmcAvUK3Fy9eRCowZwS9vb27YrFYkzqQEzE/FSMjI3Ljxg3Dpaqqqoz4gnICpoBEgEEIMZcIMCBumAHifzwel8HBQcMoVKPfew30Ct1CvzoR79L9vjFTGrToG5Xjl1TXCaAcwMGgZqmpqTHWNGEAawlgzc0IIeaAppCwoS+k7bXEPTQ0ZFxH8HSZAN1hO/Sr+7Ton0wZQbMK3JOqOYi/4SAg/traWvF4PMbsz9UEQtYX6AzlN3SHkgFleVtb2/dKcGgU+oWOTZUGyiuBQMCVStxIA4goDQ0Ngkse06UGQsj6AN2Fw2GjPMdqHVYUni4poF/o2KwReEtLS22pBI4rmuBKOBiWAIQUzgzQl8MFRU8bATQJ/ULHZo2gRGOIJVVpgA9GWYA4QhMgpHC9A+gwkUikLN+hX+jYrBE8ecOnQVdSYwdNgJACg1W6VKt62X771272AJgGCCmOVGBGh6aNYG1tkxBSOMze98O0EcAEePMRQjY2NAJCiHkj4O3ICKERGImA3yUghEZAIyCERkAjIIQ9AvYICKERwAj4bUNCWBrw7kOE0AhoBIQUA2Z6dXkpDWgEhLzkRsD+ACHFgZm7hXPVgBBCIyCE5Kk0oBEQstGNIBsRZ9iHiYCQIiJHLTIREELMG8H9+/d5qzJCigA8ZaxgRoALimgEhGxs+LVBQgiNgBBCIyCE0AgIIcCezcIfFwcJ2RjkqlUmAkKI+SsLCSHFFAly0yoTASGERkAIoREQQoSrBoRsKnLVKpuFhGwqJ2CzkBCSIzQCQgh7BIRsqsogVyNgj4CQzeQE7BEQQnLElBHYrFY+5YiQYhCyatFuz/2GY/Zsbjyabh+3x2M8XQW3KyOEFA7o0Ov15nwjYVOJIBAIiMvl4lkgpMB4dFKurq7OPVHAPzINybBt69at4vf7eRYIKTA+n0/C4XBGHWdOBIgSmcZ/aoOUo6ysTF6przd+EkIKA/RXrzoMYFLOpOP1Kg2Sc3OyZ88eCYVCbBoSUiCgv9bWVpmdnTVRGqhbpBtrpNuOpxyhR7Bv3z6pq6ujGRDygtmyZYu0t7eLx+1+8tSxTFpOR8b1ht9++qnb4XBkTA3T09PStGOH8WHnzp2TeDwu8/PzPEOErCNoDiIJwASaX39dRkdHM+7vdDptOlF7VafJlEbwDLcI+crLS9dSQTpwEDiY2poa+efXX8vt27cNg4AhcGmRkPyA6wRgABUVFbJt2zZ5u63NeMzZ3bt3M+oTSb28rKxkcXExiIr+uROBsj0cibhLS0vlwYMHaXfCQeBgAsGg/Ly7W4aHh2V4ZET+PTYmC99+yzNISB5waxleU1sr0VdflWg0KuOavu/cufPM10G/0LHuv13/efu5EoHNZsOPt34Qi/ngROomz/zAyYkJmUokjOsL9u7da9Qt9pISnkFC8sDy0pLMLyzIjKbtwcFBoyeQbZKAji9duvSW/vOrlPuke4DpZ/39uyorK99rbGz0Iw1k+6BT7IcnJGMQQgoP9AsdaxnxnpYJf9HJ/5usjOD3n3/u0B9d+995J2K1Wi0L6kKr/AYiIRsS6Nfv91s6Ozoif/7iiy41g6uq5/+r9e3L/2MEaCqcOHECD1n/RUdHx89eUxeZmpqSJTb8CNnQzM7NCfQMXZ89e3Zatf4nNYPx/xqB1h0AX1pQEzio9cRvDhw4ULvzjTdqYAK4aIgQsrFJqs5xlc/bbW0Rn8/3yZkzZ36qZvCZmsGXRgjQgU5iWEdnLBb78aFDh+rVDJxo/GH5jyUBIZsDJH4sPwYrK9FoXDx16tStoaGhv+qmv1ti0ei1UCjk2Pnmm/5IJFKRmJy0JBIJrv8TsknBKgJW9gLB4Oq/RkenL1++PGX5XX//ajKZFIh/ZmbGWCZkCiBk86cDp9NpfGvRr6Zg+cn771P1hLzsKWHpcbOQEPIyGwF7AYS89HwnwABntQlsNjK2TgAAAABJRU5ErkJggg==) center no-repeat;background-size:129px 38px;color:#fff;cursor:pointer;text-shadow:0 -1px 0 #000;filter:dropshadow(color=#000000,offx=0,offy=-1);font-size:.8em;font-weight:700;text-align:center;margin:0 auto;padding-top:8px;z-index:4}.appNativePlayBtnText{font-size:.9em;font-weight:700;text-align:center;padding-top:2px}.topBrdr,.btmBrdr{height:8px;width:100%}.topBrdr{border-radius:5px 5px 0 0;border-top:1px solid #ccc}.btmBrdr{position:absolute;bottom:0;left:0;z-index:3;border-radius:0 0 5px 5px;border-top:1px solid #888;border-bottom:1px solid #000}.topBrdrInner,.btmBrdrInner{width:100%;height:7px}.topBrdrInner{padding-bottom:1px;border-radius:4px 4px 0 0;background:-webkit-linear-gradient(top,rgba(116,115,115,1) 0,rgba(54,54,54,1) 100%);background:linear-gradient(top,rgba(116,115,115,1) 0,rgba(54,54,54,1) 100%)}.btmBrdrInner{position:absolute;bottom:0;left:0;z-index:3;padding-top:1px;border-radius:0 0 4px 4px;background:-webkit-linear-gradient(top,#474747 0,#333 100%);background:linear-gradient(top,#474747 0,#333 100%)}.fullSizePosterImgContainer{display:display;background-size:contain!important;background-position:center!important;background-repeat:no-repeat!important;width:100%;height:100%;background-color:#000!important}.sr-only{position:absolute;width:1px;height:1px;padding:0;margin:-1px;overflow:hidden;clip:rect(0,0,0,0);border:0}@media (max-width:320px){.openVideoSmartPlayerButton{width:260px;font-size:14px;background-position:15px center}}#controls{position:absolute;bottom:0;left:0;width:100%;overflow:visible;font-family:Helvetica,Arial,sans-serif;z-index:3}.hide #controls{display:none}#controls .controls_left{float:left;margin-right:-15px}#controls .controls_right{float:right;margin-left:-15px}#controls .control_button{display:block;float:left;padding:0;border-style:none;background-color:transparent;cursor:pointer}#controls .control_button:focus{outline:0}#controls .hide{display:none}#controls.caption_under_video{position:relative;bottom:0;left:0;right:0}#progress{overflow:hidden}#progress_box{overflow:hidden;padding:0 15px}#progress_scrubbar_track_left{float:left}#progress_scrubbar_track_right{float:right}#progress_scrubbar_track{position:relative;display:block;width:auto;cursor:pointer;touch-action:none}#progress_scrubbar_track .scrubbar_track,#progress_scrubbar_track .scrubbar_loaded_track,#progress_scrubbar_track .scrubbar_played_track{position:absolute;left:0}#progress_scrubbar_track .scrubbar_track{width:100%}#play_progress{overflow:visible}#scrubbar_scrubber{position:absolute;top:0;right:0}#progress .seperator{float:right}#play_time{float:right;margin:0 15px 0 -15px;cursor:default}#markers{position:absolute;top:0;display:none}.volume_wrapper{position:relative;float:left;z-index:1}#volume_slider_container{position:absolute;bottom:100%;transition:height .1s}#volume_slider_container.hide{display:block;height:0}#volume_slider_vertical{position:relative;cursor:pointer}#volume_slider_vertical .ui-slider-range{position:absolute;bottom:0;left:0;width:100%}#volume_slider_vertical .ui-slider-handle{position:absolute;display:block}#playerSettingsContainer{position:absolute;bottom:100%;right:0;padding:10px}#videoSidebar{position:absolute;top:0;left:0;display:none;width:252px;border-color:#4c4c4c;border-width:1px;border-style:none solid;color:#fff;background:#000;background:rgba(0,0,0,.85)}#videoSidebar.right{left:auto;right:0}#videoSidebarHead{position:relative;overflow:hidden;z-index:1}#videoSidebarHead .video_title{font-size:inherit;font-weight:inherit;padding:6px 2px 4px}#searchArea{border:1px solid #ccc;border-radius:12px;margin:0 2px 4px;padding:2px 2px 2px 22px;background:#fff url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAAyNpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNS1jMDE0IDc5LjE1MTQ4MSwgMjAxMy8wMy8xMy0xMjowOToxNSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RSZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpDcmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpIiB4bXBNTTpJbnN0YW5jZUlEPSJ4bXAuaWlkOjk4NzYzMUY5RjIyOTExRTJBRTVBRDgwNjhCNzFERkJBIiB4bXBNTTpEb2N1bWVudElEPSJ4bXAuZGlkOjk4NzYzMUZBRjIyOTExRTJBRTVBRDgwNjhCNzFERkJBIj4gPHhtcE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6OTg3NjMxRjdGMjI5MTFFMkFFNUFEODA2OEI3MURGQkEiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6OTg3NjMxRjhGMjI5MTFFMkFFNUFEODA2OEI3MURGQkEiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz7QRiLXAAABCElEQVR42mL8//8/AyWABV3Ax8fHHkgVAbExVOgsEPdt2bLlIDYDGJFdANRcDaRacFhWCTSkA12QCc3mRiD+BcQ1QCwDxTVQsRagGht8XgDZzAzSgGZTK1DjXyDdDlXjgNUFQKALpedicT5MzACnF4gEzPgMuAylk7FoTIDSF/CFASiw9oICEuhnUKAtg4pHQf3+F6oGuwug8VwPxGxA3AvEz6G4Fyr2AYgf4U0HSNFZipaQngJxGhDfAcUC0LKnOA3ABoCG8gOph0DMDw0rkCHviI4FoOKPQGo6UnRvBxrKRmo0ToSmSBAwA2JXkgwAuuIF1BAGaFgcB7NAYUAK9vb2VkfmAwQYAOM2gBsK50UUAAAAAElFTkSuQmCC) scroll no-repeat 3px center;overflow:hidden}.search_disabled #searchArea{display:none}#searchBox{display:block;float:left;width:190px;height:22px;padding:0;border-style:none;font-size:18px}#clearSearchButton{display:block;float:right;width:28px;height:22px;padding:0;border-style:none;background:#fff url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA8AAAAPCAYAAAA71pVKAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAAyNpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNS1jMDE0IDc5LjE1MTQ4MSwgMjAxMy8wMy8xMy0xMjowOToxNSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RSZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpDcmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpIiB4bXBNTTpJbnN0YW5jZUlEPSJ4bXAuaWlkOjk4NzYzMUZERjIyOTExRTJBRTVBRDgwNjhCNzFERkJBIiB4bXBNTTpEb2N1bWVudElEPSJ4bXAuZGlkOjk4NzYzMUZFRjIyOTExRTJBRTVBRDgwNjhCNzFERkJBIj4gPHhtcE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6OTg3NjMxRkJGMjI5MTFFMkFFNUFEODA2OEI3MURGQkEiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6OTg3NjMxRkNGMjI5MTFFMkFFNUFEODA2OEI3MURGQkEiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz4kxTDvAAABTElEQVR42pySu0oDURCG3dVgERUT06cxWAgK1jaWkW2EoKQIqIURL2gjioWpDDZaiWJSWPoC2wYURS1ErcQLvoKCrcj6DczK5BAEXfh2dmf+/1zmHC+Korb/Ph3yCsOwm7AJA7AWBMGrK0TTSdgC0VbQvPtaq8AGTEAdYdYxJgm7sA7LsC/52DxktGNwgCGlxh7CNixAu2oGrXkJrs0A4zITxmFiFVbA09ozzMuHFzcMYT/hGEZV9AVvkDHGJ5hlv5dNZh0gRzjUpftOz+5gEeNVnPDco2KAEcIZdJn0J+QxNqzWd4wZ3X+ixbFOUU/bhN1zL+EIJn+5FyfSLFbw8TOzzlh3jLdQhnuTK+o9SNtl70HBiC6gxAw1Pd9HU5MJdqy5zxSlWdMYH+RHuzsHL0aTs+ZVOIWGnmPT3eb/nDADN6optzyqvzzfAgwAgaBscFQiLx4AAAAASUVORK5CYII=) scroll no-repeat center}#fsSearchAlert{display:none;margin:5px 0;padding:10px;color:#fff;font-size:12px;background-color:#ba8a29;background-image:-webkit-gradient(linear,0 0,0 100%,from(#ba8a29),to(#a8502f));background-image:-webkit-linear-gradient(top,#ba8a29,#a8502f);background-image:-moz-linear-gradient(top,#ba8a29,#a8502f);background-image:-ms-linear-gradient(top,#ba8a29,#a8502f);background-image:-o-linear-gradient(top,#ba8a29,#a8502f);border:1px solid maroon;-moz-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 5px rgba(0,0,0,.5);text-shadow:1px 1px 0 rgba(0,0,0,.5)}.search_disabled #fsSearchAlert{display:block}#pipimage{background-repeat:no-repeat;background-size:contain;border:1px solid #FFF;margin-top:10px;margin-bottom:10px}#videoSidebarContentWrapper{position:absolute;top:58px;right:0;bottom:0;left:0;overflow:auto}#searchList,#tableOfContentsList{margin:0}#searchList li,#tableOfContentsList li{list-style:none;cursor:pointer}#searchList li:hover,#tableOfContentsList li:hover{background-color:#333;color:#fff}#searchList li.noThumbImage,#tableOfContentsList li.noThumbImage{padding:10px 6px 10px 8px}#searchList li.hasThumbImage,#tableOfContentsList li.hasThumbImage{padding:4px 10px}#searchList .tocItemLabel,#tableOfContentsList .tocItemLabel{position:relative;margin-left:5px}#tsc_quiz_container{font-family:Arial,Helvetica,sans-serif;font-size:14px;z-index:10;padding:20px;position:absolute;background-color:#FFF;line-height:1.3em}#tsc_quiz_container h2{font-family:Actor,Arial,Helvetica,sans-serif;font-size:32px;letter-spacing:0;line-height:1em;padding:0;margin:0;margin-bottom:12px;min-height:46px;width:480px;color:#000ad2;word-wrap:break-word;text-shadow:-1px 1px 1px rgba(0,0,0,.4)}#tsc_quiz_container label{margin:3px 0;padding:4px 4px 6px 10px;word-wrap:break-word}.active_quiz_item:hover{background-color:#cdd4fb;border-top-left-radius:12px;border-top-right-radius:12px;border-bottom-left-radius:12px;border-bottom-right-radius:12px}.active_quiz_item:active{background-color:#dadff0;border-top-left-radius:12px;border-top-right-radius:12px;border-bottom-left-radius:12px;border-bottom-right-radius:12px}.picked_quiz_item{background-color:#dadff0;border-top-left-radius:12px;border-top-right-radius:12px;border-bottom-left-radius:12px;border-bottom-right-radius:12px}.quiz_question{margin:0 0 8px;padding:0;word-wrap:break-word}.quiz_question span{font-family:Actor,Arial,Helvetica,sans-serif;font-size:22px;color:#666}#tsc_quiz_container input[type=radio]{margin-right:10px}#tsc_quiz_controls{margin-top:10px}#tsc_text_input{width:300px;margin-left:22px;margin-bottom:14px}#tsc_textarea_input{width:460px;margin-left:22px;margin-bottom:10px;font-family:Actor,sans-serif;font-size:16px;font-weight:400}#tsc_question_set_result_info{display:none;margin:-10px 0 15px 4px;padding:0;width:490px;font-size:12px;color:#666;text-shadow:-1px 0 0 rgba(0,0,0,.4)}.tsc_multiple_choice{display:block}.image_feedback{margin-left:-3px;margin-right:10px;margin-bottom:-4px}.image_fitb_feedback{margin-left:0;margin-right:-20px;margin-bottom:-4px}.feedback_placeholder{display:none}.feedback_placeholder_show{display:block}button{cursor:pointer;padding:5px 10px}#tsc_previous_button{display:none}#tsc_next_button{display:none}#tsc_submit_button{float:right;display:none}#tsc_continue_button{float:right;display:none}#tsc_quiz_setup_container{font-family:Arial,Helvetica,sans-serif;font-size:18px;z-index:10;position:absolute;text-align:center;background-color:#FFF}#tsc_quiz_setup_container label{display:none;margin-left:4px}#tsc_quiz_question_count{padding:8px;text-align:center;line-height:1.6em;width:69px;height:70px;background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAFcAAABVCAYAAAA8AHhnAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJbWFnZVJlYWR5ccllPAAAAyNpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdpbj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNS1jMDE0IDc5LjE1MTQ4MSwgMjAxMy8wMy8xMy0xMjowOToxNSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlwdGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RSZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpDcmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIChNYWNpbnRvc2gpIiB4bXBNTTpJbnN0YW5jZUlEPSJ4bXAuaWlkOjM3NjI1MjRGRjIzMDExRTJBRTVBRDgwNjhCNzFERkJBIiB4bXBNTTpEb2N1bWVudElEPSJ4bXAuZGlkOjM3NjI1MjUwRjIzMDExRTJBRTVBRDgwNjhCNzFERkJBIj4gPHhtcE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6QTZCMDk2NEVGMjI5MTFFMkFFNUFEODA2OEI3MURGQkEiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6Mzc2MjUyNEVGMjMwMTFFMkFFNUFEODA2OEI3MURGQkEiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz6Y6n/8AAAY50lEQVR42uxdS6xl11Gt2m67TT7g2ChG6oATBghHzJIJEhJREgYMgAgpYWAk8AB7EomOGICFRJpZLIQUPlMIgzBxBukJA0bYYoDCR3wkkEEQGhEQODGyEyfpfq/fLu45Z1fVWrXP63sbyRIDv5b9Xt++95yz965dtWrVqv3UzOStrzfnq701BW/el+69+NxnPvonj7/nnR8S6WLLWw7Wrarrmy+3cxv/13Fhfve2Qw6vat5a1Q6vj/et37afl7cu9xMdL4/d5Z+1fvh708P3w2uLefT1U+s9zQel27WW6/T1+cfjxDW3ceUMjH+07bN5PR/R+Ltt9xbLi+n4sXd78XC/v7n+szc/tbxvmtznnv+xHz07O3vxe9/3qPzCJ35H3vbgtbdM8ISvr7/xinz5K1+Sl/7y9+Q7rj70yDMff+H1K/VN/eL8xtnZ3XWllon90r9/al2txQLcgpbvbbGIw3vauj75s6+0pS2M/+Nn2/o+v+5mFZuHWq8zrM2thS3LyLJUfH8p3pCe2S15e6+MZ96s3cZzNWnxM+7DNsaW49e0Yvj+cHtM3v/9vyQv/dXvy7Of+MLrz1jxuc89/5GfOzvrH7o4y9v03teLYuBr6ttP14fuy/70rTP+DR8xH3WbuHQeAsODn8aExITFoA7XHpPUxhTlFIOTG9vdr7F6gHH1BpPq/75cq0uPpwg3cPhAt3QX23sV77jd9nCD2xevytWH3i7g93hyz8/v3jg/v5A7Z+cxL4rOTtItbRMwbjombHu9x8DAu8b1lod1q04nCn51+0tO9XKt5laVi9dhUcQnzz+nMnbHdgufFPb/uPRGTxs7Afy+xNNZ7DBc1PjZdtDCrzz/4U8fLPa952cXcve857gjkI0V9UkfWzMezGqM1PizDXhzB2hkbfy0vt50TI6M4KlpeYfd08a7l8XDXaQULMc0jtXT4brGkm3/qRtDLGXeB54aX8/383j9dRWh99Dk/vJnPvJdZ3curt85+NplYpcJxodfJ+IwAb2suIS1KdxI12i+bDNEDBFpwR/38M9pBT4wtzBzJKGwW1TCv1cXtDyGDYtLn9jjeR0gILbpMQ6Ju2uMPN0UGs82nhyLiU3wa51cu3tx/e7ZxSNLIDu/c1fOaHJ1fbQMPnCBZesdXl98rq/y6n9Vh6XVDbdNSotAA9czXP0xMWhhEKA8IOKC4OKFNZsPUuN6e3BSKcBJ7rZwNfkZpbkw2J+zi2m/+hsffuL8vN84G+5gsdrVck2Kgy+g2DKAbdtPtqCgWjdQbkv3l5ZhKAInBJnJgsMq93x0uhHRdC0y7hWuRuDf0OXY5rJwqyPiab4gYFxC7+nrH9tJHdrtb/c1iJ0Nl3DnfJnkC5pJXxffPhF20QcP2NJgFXNAfQsoY1LbBjkAvrHfq4nJCpN8hyhYcQRRsC3L79vEt52UyWIrx25UDX/h1/QgGAbUe6AldHjzE29fV37z1158+vD96Yp3P/qTT1q6BYsszSP4YaT5QGNM/sgeqW1g0u0afZ1WczRgRgPCgQlgUR5UG25HAKnwgEzZM7qldbMCoCyepwm4mzGp5j5e0+eaupH1YUaWY1cjQ7wnt1DQV1iKr5rAintA04EGNouQKbUM4H+AVoyHOTWlUOULpOhTNVBFl/SJjkFbQL5t02LyI+R20mBiEXVzb27RBuu/zaIBBhowTxX8v51A3Cj63Iyh+YAmMjnxtIIE3RhtjaCUJkwNs7OxlZUidk72AtgRt6opJSmxTpTFcaw3+ONJkluUWrozdd4AEyFVQEkSU1wA1BHLLVtNyycVYMrehw1ib2RnAhZo4TEDkEeQsLT0gHSWkK+vC9RLkEnrigxs+Fu6t6ML04B1yyX6MIAOC9QN0IKx/+5xUyO8b6dQjr0zo6WAeTlhNdramLm49bhFGFiVaqLKLf00urZfZ/GD6/ubxsBXKKdKabgSfh0TB5neuiDxbBuzpWVU206orlACa3u8kNbyWX2MNrvTK5f7XCW34A6xF3yJwWNx6gpBYdlyCj7apIJ/A25CJ1ewvJ7Eif9E8W/C0jVdbSPidRVIWAb62BmLKVIUiY2dtlytF+jGe+34y32uWURozkDYa9URLamqjpfaCFyUIkLm5NmclHDQAdemZVp1VgHkOeVUAlsSkwikmWKCXpMK+Lzq9JoNN2aDd8Zk5eRKRFhurJ7S9nc2SUby4L6pAVxZLcZ6TtjwtU7v+fubInUo60Ti0iX4356rgZPd/KDuvk/gvh4Ee7F1A0Sy+eY68eknHKvL7Hl3ce7lPhcImslpBzPWKQ0VAPXJ7bbAvhKM1sCqlkC1s+db309pqycNMIF+2yacn25B02NFi4nbyCN2d45vnSjwXeq8hgfazSBEjLCsR1EltvNknIsRc7JswLiR4atyIBgPtgJvzPW7RboaVo1oAwaXQbUxBII0ONguQ/+Y3LGOoOrcs3Mfq88PC1RCFhSYR1Bv2sDFjDi0Ipf78bklgVDl7KO6C3OwTsS6AjGNXCgHjdVVtFYQiPL2XQdng2/NgWn8XaCqgGk5uAwzyiZ7uDF3wkZZYsQIr8Eppg4JHddg23Qmbo4FNKZflJmxAb3cDbRB4MTnxuuYUWGkj+s5zlTg+sti+rVVM2jJDnlDIUgHeQ87rQ37D5/qHMIaRxpRp1EM3UtZEUUNZCMQc07K0DxoiUlEyA2AJzOL1YGaGvdh1W34aC0RW2BKnGv1bZjJhJAFu8V0oAWDsgTmbasKI4FkE/8au0XZ8a1c1+AxPEBHpmn1WRTI/BNwrpkCmPfMh7Gis1SOR2txRwSCFrqU4bvwSQhCWW57iSxOqELQR+rrvtbRyeYTC1mOBVblHNPHl2SNUGF0L/syzxpVSh7KU3AUioW/C8y6+UeTZJEUoqzGtssyEaXE4fd6kC4Kqa4PqIeD2RbGo7XDNM7vx2BaEzQt5AiYDx5PqxZGM4QHVNk1KvyoyE5KL5VrOwUtEEGjSroNYpccKRQsTMx9cuuZsa3T1TDy7GJp8VK79HA5mBILMFMetTGSI9414brgYvkNaoSiwyPbYNhMp0LBChBtphdjvE2Pu4WqpvFU0XGvp6060l4v26TFyeQrIz8fda0cLPC7gK+d+vMyEpXeoaTvxIvslOhlNwPb9phJJyoz44ent1zzS/8sVNS3S1K0o9wCY72xLVd30EPGowRNlLaLlXqwqXAV2anGwq75RKvplLevA+xQRRiRPqDYqLE1S3ZYBqFtRZyCkK0Lp7IbB9E3vmT4Wb1EBdYwxpzqFhgXgOplcHVYYq/FSNHK/dvm14wrWR4YqaAYyQFbH5ZlGAGA0sdAwxAIJsl0kXxuFLS0KKK2yUprtRlRC5WnTgtoSf2ldQhkMzmIeT2H1fY+qVPEU9OAUZ04WUwyUDfQRKDEoqRvwExfJyGKAviX3UJiLpCWEJnEVYeaWnIcSrHl5IAmopMUqZadk4xmH9scJaD/Ik5Ax1azuZyOCycKVojsVNmYyomDQu0sSHVB/RnMgqIaB7NDLxV2wO68i/cKqycRN7NbABraNMQWXD2AG5lxljdy8qyTSQwYEwaSXTB4SLSr7KPpWQ3YNddIYGk+ZyRS707CQS6tZ1Zq07PHZFLyZqfhXF9xClCQtTQMZEAbRhEPy9Zu7TaKiu7rht9ecHQTncgb4oN9SENliRkTGoGrJA2SD9QchG/XRqlsg6Dss40Ck1rRCq7ErbvqFu4JwCwnBOsYVjyN7l16R5yGEtPEk6xM7DjhMg9II8nwZEZmnw0VBL+Ap7KY+6+Vk4FInD4ViCtIiK/EPwRPtmrwvacENKT91ocAzYFeIgCNYOK6Mp0FajE5Y7AGNbo+qhhWVI9GFd1ULbIr2iq5aiVa4A5chSWMKtZ/H1UTSp7Ga14/27QTWtgQeOZCG9w7iTCO/Op8glrkVZwcahIdS5Aw4CN0k9gbWP82UZt6EdPTrICAdEOlEDkuMOmZgpealkIJXEClE5ztQC35rFWszXPQNPOKTiwT49yToJivitNxqAREWRNWFmIpemcUMR7ErUODIXOsmQGnhxIxGbUqGW2glMH4IIVEN8jmmjbe8kOvoFRlsVTsYOV6jNn/k4JyeGeeEtAKCnR1C1mISnCjngiEIK4I6lZgHimuUcBEuaaYJ6Z9JimgzI1be7s3pKSQ3ATdaL2gl3xOn9xg1ChI5cK3OqF2iUTpOBRL/+Or3sDi9uVBQjV8LAxbQB4jvjf8uxqoDCVJbeV7IXxSgIYGm9PZtxbyqk2dvuztBgVNDcFIC4SAApuJEyvVly3IFTdmJ8mZUnKZ0ROIcFJcQymbygBQenaMaADEDbahcfbT4WcVlOEraR4M9FAWOnKuBjcvsnajBhQBTsKoZwOeF9yDgRpo6t3YIW/umUTURALxX49qADr9hnWFzKYasF1NS/Ca2SyM6F6aF8M8fssOV51XSWhrmutZVieiHNe/745bRwg3wLqVYETj0/vTLVgEIkXWSNPX9rJy7v9SDLdNSs/6DUY54m2ttAnIXiYkQi1SWvSjOhbXSmWDjANbqeBuCul5KDkDUQOmBwG27yqKGTCl7ViZB31pq+sDjBjpaasm1DM4s1Rhlwhf2zXINxdxfJaCip4r6nx9SnSchkTFPCIcowSlsIDghsLPt1mNg0KRo7oFK5oF30I+gbpDSUb1QLhnoBP5kmLqmufVcjqK6IIc32s2sbE9jWnQFrWyziny0ItJ+OWEdw0WpEoA3ByQnNcdozxaWjdD5ofBtV4K3Hq4kG5c6xLZb0sSZX2iGCpdBATVkGpidDaZOii9VGOlipIVE4NSuEW67j4U631cp1bBXC164mwW8V85xi0oJaEZ4XUqZGqAfyt4WIFrRXjXnVaxwh2osw8a+NMVk8G8tgalodHYJ42qvgJSpHXCOu8WE7kkELXQPCB92acuiERIkSC1UwJamxs7UAjnLsNL2gJkehWSGCl3XGvbR4lSpxpG9E1AIpGLkQr3bCDMrb9+tIMv12TAwu9OxVMjVBLX2csVuMsgRCwZP/T0JIIIZknSGWtsvRSi8VGwYBklFWPSnfXTBlKlBp/LllGkjVrKVlIbplwTsYFxO+kR0s8377oMfW7CPSZ/oG84YFhxHSfV0MAt5Iqze3CziG4Y9KNel9JG/kqIQOE8vraDUsFxJwOKhhLJ/msj2X/yGoq8DlyjQ62sTfLZ7LysPRac3gNWsJO4hWwciX4ExIENe84s0kqmHjNLc+sW1Ulm7PWoyIK6Eeu2blmVibok7FpqXIbA3owtjETTBgFUKA3W0oeWwRcxdQ9tWxXTHBXieetQwf2j84ab7DA7snKNBsyUEV2X5xj49pemxJ4hqBforQi4ZynlvIxUUWNtVxY+lbiOKJpi4dOqgmcshc6NNydxC8s8bOmlEHNvZsQj+JbqRdiG6WtiyrRWpxYpkRgLpih4G80lqKxpUPBETa3j0mC3LCGcgfVV0YgUJOOFTVGdFJ8KE+7Nh9S6dZrlJgnchFs8Jz+6W6lT6gdDRbpfsYF+QDBginH5Bgftg2yNqw2BVBKYa+QrJRhBaR5bCrWUzp3zbaWeGPw0iLdN7sMtYDBINTb3SVgoBBtFauduBcmOzZmSgC150hb8KpZReiFVKh+Ik48pcrbKKnVq4qkg2GXpz4/FSRs1Oq/TSUEGrJ2Yi5ZH5Uye8gm0OzUnxsn3CRX0kPxAgVp3TV9PQqjviNqq0keLu+kQxNgN8Rk0uAguPsG44G1Ucd7O9mImEsYtsniaE2au5DxPg2Kc0vUodXRR+JhSH1nmRRh48pyaUW2lFk/l1DRUiSmyU6oYoLVCsbIUDslTKeNy3N5E4IBEKlNapRpcVbVbpNrtfrgF5DZ5MKStCLxrO/JRaPAzFiIj+Zwsf5ubpw2aPYJ3qJQJa7WmU0e6TYT+1CgDyoiGzw0cRPDXKlNDCiouTxaFRD1MuYJQ83NsqRITIEwcy2a200u7k5FQSCbCnSRDDfFn1h8aSZ/YXXjwa8LEDy7snoJ8rwSJxDkGyNba/cmZ6pFXFUAayZL6pj6PGylVKlAH5ocHITTy4EKNeuO6HSOyCRUvO2q6qnQJcSr1n+W5DLUlS8qic41EofoMlWivdMiJ5y1UtkeKXBJbOzsexQcPXKlG3L69MGQ+0U1zsgPotxYKcw+q1KoEtCQhGoF6m2GzCbJ6Qm0FqEWWyWmw4qZ7nUL3O5HvqXLEso2OznKceF+tVrUDZO2uKPeq1Ez1We8Tg5bUoVAGp1VLBtysWzJX8LL4ibEDxdgNjhxgVY5RF73tiJ2zc76dbrm2s/pxQeA4FQgSb6RWsq4MqR38sJaEA5MIg9w9oqfx7tiyZOVWJZWdLgXWkNWGIzMRPMUEfTy2pKayh9m7VTiDlmunlHnA/yUQV2oi4zM8spmaq6J8XIu7ADzRCI+uivK2GXAJNjXxOdGO7U84+V6KF+PTQghJDCbPn9OAxROo6iqoIk2FjypsjcrtJ6oc8+ZOnnjPwBZkOpTUkynKc3C4pchQbWhGpzjhUYLoXjqofaSUzbHp2isRrDXrgGFTFAhVMAjKykR9aBganDxrkTxha1c9luY0lSOCIUvCWgDnBbkHvCfxCkXKFy5FlWtz2CsMCIU4jVJiZ98+JKC9U2RvkA5LQQWeDnBjTYn44cPrDpadv9t99EQIsD6Nz4RpcBanedZVmj3wXgosVsfFgBOQUNIv1PXO02oA2aZMb/jpRhUudhtcVs8g2ZNxhp3TQeXOmnJn+mIH2dzn044qSEWgJUq4WcQtoXGdjJtHYLuMSUe41IuUyYoATuIsXSntp7ojgDM+T7fI/lmcl80rHphbnA5hE8uRXfMGlWPQQuh9ldaFfB+Fg70zwXY0B5gkpJqFb9mgKQUDYBIu5RwG4YSgSrQ6ZWczf6uAVgPDQxGgg16sasA61fzwhKl9lHK55WotgwuctGQhXyIfBNu/YelbuQeBFDbxHhtwKiWg4nU5LQQ3tmgpT+wmCpmRAqasjsG69cI3SGlWlF3tgmjKwWkXnawVQ1EESuFHCdo50FaCl+xIPlF5vsnc20QlRofjdBhG4kxEA1oOlsB6GlKBPWpc9egslopKERVKOd4AszeXZQm4xn5fPRFUi+9T1C9xe5Il4QMtE9qhbOLBI46OlUb6LykMFzYUSimbq85n11IFVuGwovHHzOLnNVhXAaDqLsfsyYyhRnd46eyRuI/Sep56K5QBGUj4W5El+cOFf1W2KFRwt9FHTNFdpDBcCodc9KkoEZ0/qkUlOc42g8NY8/iqHpwtm4bQmbl4nk42+s2yfRWWyB6V7eMZjL2wTcm3wqQYdyfi2bXRZQaHSmgpvbXS4Fql1d1SBd5AzxYCOeOUINTlU3DLIw5alMiNCpRSMrEK+3IB7JImlXu3Sr3MVKHyaUikjCn+VlC7WmkUmZwHHmPivjV/H4ZOHG8eFg/vK8dNoAKn3reBUJsYPM3uTz+LgdLZ1goZv1s7e/kUKHb7jW+/Kg/YO/lwCCjLOK/aiQ1TQg0oIUb5Ep6FgAxUB0tU0DQQcV8O09CKWIQ5xXoeAj2L8rk6KPZbA7DA2WmWXMdU57v7nfL1b76y/HT7FK3YrW/c/k+50q9B+7ztiIZtOrO7C0tPWa3DSkQ/W4aqvpD5BNMEBUmFY7KiqqET6M4CqM2ZU9KZeXZatsS2oBERnonMB1f47nrkHT8gr/zPvy4XuHV0cg9b4uZ/vfr38mB/X3QJeiHQBR0hc2paSOj6W0502thZgcjD3PD4KFS91OARZSbjk+h2D5eT+bjuHufzSB69HecxSNEU61SJpu6e8fa3yZPrr485POvNo5P78INXbv73a//wmp59z2GCr9F5jAGhtQyWThqdj4J1rEv9CsqCvCDTW6OT8ki5qDqd3CzldH6SgHKzev7mEuwM6iK9gMr5oAz8RSMa4r4Hzt8j737kB+VfvvLnrz189cHjk/vsz3zh9X7+rRt/9+UX5B3nPy6tP4YdUADwbZIw1aP/s3zTs/I7HQHgE6HRSdngCG6B6IyKlyrbDBFeQzWQpdTee339eSx9SMPwBO4kAKFlY0uky3e+W37o2jPyx3/2W3J++40bz378hdflkgLn9PXZz//U56499sGff/L7fkIurv6T3Lnyj3KhX4vDgkLeack04UrjLxSykmIanLafgjmDxUsSW/A8HeWAqYWXQDU5ya2aTm3wWpSZ+etjSnpe3ebFu+VdD31Arj36w/Knf/05efnWS39w/akvPj2r8o98/fYffuzTV6+868YTj/+IPP7o++XtDz/GmPf/wffJbfwf/37K92XivvGtr8mt//gL+dt//iN545tfvfGLT9389f2WhxO+fvfzP/3EXbHrh43wscMN3kulDUVpjU76hyUlbG1LDdX3n0nIpLajUnQ6PgCtZt0YjQ9q31yEIu7nXTBS77V/oqMI2k/W16xa+e5b39vjcNBQdDX0des/3Dr8/+YDqp/95FNf/LfdfpK3fgflm/f1vwIMALZ/b7YQN5ZZAAAAAElFTkSuQmCC) no-repeat;position:absolute;top:-13px;right:18px}.tsc_quiz_question_count_current{margin-top:14px;margin-left:8px;display:block;font-size:32px;font-family:Quicksand,Arial,Helvetica,sans-serif;text-shadow:-1px 1px 1px rgba(0,0,0,.4);font-weight:800;color:#000}.tsc_quiz_question_count_total{display:block;margin-top:2px;margin-left:8px;font-size:14px}#tsc_answers{max-height:200px;overflow:auto;-webkit-overflow-scrolling:touch}@media screen and (min-height:401px){#tsc_quiz_container{padding:20px;left:0;bottom:0;width:580px;border:1px solid #CCC;border-top-right-radius:22px;border-top-left-radius:22px;border-bottom-right-radius:22px;border-bottom-left-radius:22px;-moz-border-radius:22px;-webkit-border-radius:22px;-moz-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 5px rgba(0,0,0,.5)}#tsc_quiz_setup_container{width:560px;left:50%;top:15px;margin-left:-280px;border:1px solid #CCC;border-top-right-radius:22px;border-top-left-radius:22px;border-bottom-right-radius:22px;border-bottom-left-radius:22px;-moz-border-radius:22px;-webkit-border-radius:22px;-moz-box-shadow:0 0 10px rgba(0,0,0,.5);-webkit-box-shadow:0 0 10px rgba(0,0,0,.5)}.inputBlock{margin-top:12px;text-align:left;width:404px;margin-left:auto;margin-right:auto}.inputContainer{text-align:center;margin-bottom:20px}#tsc_quiz_setup_container h2{color:#000ad2;text-align:left;font-size:1.2em;margin:20px 30px;text-shadow:1px 1px 1px rgba(0,0,0,.3)}#tsc_quiz_setup_container p{margin:20px 0}#tsc_quiz_setup_container input{font-size:1.1em;color:#325ea3;width:400px}#tsc_quiz_setup_container button{padding:10px 15px;font-size:1.4em}#tsc_quiz_setup_container a{margin-top:10px;padding:6px 10px;font-size:.75em;text-decoration:none;color:#fff;background-color:#333;-moz-border-radius:6px;-webkit-border-radius:6px;-moz-box-shadow:0 0 1px rgba(0,0,0,.5);-webkit-box-shadow:0 0 1px rgba(0,0,0,.5)}}@media screen and (max-height:400px){#tsc_quiz_container{padding:0;width:100%;height:100%;left:0!important;bottom:0!important;top:0!important;max-height:400px!important;border-top-right-radius:0;border-top-left-radius:0;border-bottom-right-radius:0;border-bottom-left-radius:0;-moz-border-radius:0;-webkit-border-radius:0}#tsc_quiz_container h2{margin:8px 4px 12px 8px;min-height:46px;font-size:28px;width:82%}.quiz_question{margin:8px}#tsc_textarea_input{width:90%}#tsc_question_set_result_info{width:80%;margin-left:10px}#tsc_answers{margin:10px}button{cursor:pointer;padding:10px 15px;font-size:18px}#tsc_previous_button{margin-left:10px;display:none}#tsc_next_button{display:none}#tsc_submit_button{float:right;margin-right:10px;display:none}#tsc_continue_button{float:right;margin-right:10px;display:none}#tsc_quiz_controls{width:100%;position:absolute;bottom:0;padding:10px 0;background-color:#fff}#tsc_quiz_setup_container{width:100%;height:100%;left:0;top:0}.inputBlock{margin-top:12px;text-align:left;width:404px;margin-left:auto;margin-right:auto}.inputContainer{text-align:center;margin-bottom:10px}#tsc_quiz_setup_container h2{color:#000ad2;font-size:1.1em;margin:15px 10px;text-shadow:1px 1px 1px rgba(0,0,0,.3)}#tsc_quiz_setup_container p{margin:20px 0}#tsc_quiz_setup_container input{font-size:1.1em;color:#325ea3;width:400px}#tsc_quiz_setup_container button{padding:10px 15px;font-size:1.4em}#tsc_quiz_setup_container a{margin-top:10px;padding:6px 10px;font-size:1.4em;text-decoration:none;color:#fff;background-color:#333;-moz-border-radius:6px;-webkit-border-radius:6px;-moz-box-shadow:0 0 1px rgba(0,0,0,.5);-webkit-box-shadow:0 0 1px rgba(0,0,0,.5)}#tsc_quiz_question_count{top:-13px;right:-5px}}#tsc_confirmation_container{font-family:Arial,Helvetica,sans-serif;font-size:18px;z-index:10;padding:6px;position:absolute;left:0;bottom:0;width:200px;background-color:#FFF;border:1px solid #CCC;line-height:1.3em;border-top-right-radius:22px;border-top-left-radius:22px;border-bottom-right-radius:22px;border-bottom-left-radius:22px;-moz-border-radius:22px;-webkit-border-radius:22px;-moz-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 5px rgba(0,0,0,.5)}#tsc_review_confirmation_container{font-family:Arial,Helvetica,sans-serif;font-size:18px;z-index:10;padding:6px;position:absolute;left:0;bottom:0;width:200px;background-color:#FFF;border:1px solid #CCC;line-height:1.3em;border-top-right-radius:22px;border-top-left-radius:22px;border-bottom-right-radius:22px;border-bottom-left-radius:22px;-moz-border-radius:22px;-webkit-border-radius:22px;-moz-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 5px rgba(0,0,0,.5)}#tsc_overlay{position:absolute;z-index:9;top:0;left:0;background-color:#000;width:100%;height:100%;padding:0;margin:0;opacity:.7}.largeButton{cursor:pointer;text-align:center;color:#fff;padding:15px;margin:5px;font-size:18px;-moz-border-radius:12px;-webkit-border-radius:12px;-moz-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 5px rgba(0,0,0,.5);-webkit-box-shadow:0 0 0 1px #666,0 0 0 2px #999,0 0 0 3px #666,1 1 1 6px #666;background:#45484d;background:-moz-linear-gradient(top,rgba(69,72,77,1) 0,rgba(0,0,0,1) 100%);background:-webkit-gradient(linear,left top,left bottom,color-stop(0%,rgba(69,72,77,1)),color-stop(100%,rgba(0,0,0,1)));background:-webkit-linear-gradient(top,rgba(69,72,77,1) 0,rgba(0,0,0,1) 100%);background:-o-linear-gradient(top,rgba(69,72,77,1) 0,rgba(0,0,0,1) 100%);background:-ms-linear-gradient(top,rgba(69,72,77,1) 0,rgba(0,0,0,1) 100%);filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#45484d', endColorstr='#000000', GradientType=0);text-shadow:1px 1px 1px rgba(0,0,0,.8)}.blueButton{background:#84c4e2;background:url(data:image/svg+xml;base64,PD94bWwgdmVyc2lvbj0iMS4wIiA/Pgo8c3ZnIHhtbG5zPSJodHRwOi8vd3d3LnczLm9yZy8yMDAwL3N2ZyIgd2lkdGg9IjEwMCUiIGhlaWdodD0iMTAwJSIgdmlld0JveD0iMCAwIDEgMSIgcHJlc2VydmVBc3BlY3RSYXRpbz0ibm9uZSI+CiAgPGxpbmVhckdyYWRpZW50IGlkPSJncmFkLXVjZ2ctZ2VuZXJhdGVkIiBncmFkaWVudFVuaXRzPSJ1c2VyU3BhY2VPblVzZSIgeDE9IjAlIiB5MT0iMCUiIHgyPSIwJSIgeTI9IjEwMCUiPgogICAgPHN0b3Agb2Zmc2V0PSIwJSIgc3RvcC1jb2xvcj0iIzg0YzRlMiIgc3RvcC1vcGFjaXR5PSIxIi8+CiAgICA8c3RvcCBvZmZzZXQ9IjM2JSIgc3RvcC1jb2xvcj0iIzM2OWFkNiIgc3RvcC1vcGFjaXR5PSIxIi8+CiAgICA8c3RvcCBvZmZzZXQ9IjYxJSIgc3RvcC1jb2xvcj0iIzM3ODZjOSIgc3RvcC1vcGFjaXR5PSIxIi8+CiAgICA8c3RvcCBvZmZzZXQ9IjEwMCUiIHN0b3AtY29sb3I9IiM2NmFkZjEiIHN0b3Atb3BhY2l0eT0iMSIvPgogIDwvbGluZWFyR3JhZGllbnQ+CiAgPHJlY3QgeD0iMCIgeT0iMCIgd2lkdGg9IjEiIGhlaWdodD0iMSIgZmlsbD0idXJsKCNncmFkLXVjZ2ctZ2VuZXJhdGVkKSIgLz4KPC9zdmc+);background:-moz-linear-gradient(top,#84c4e2 0,#369ad6 36%,#3786c9 61%,#66adf1 100%);background:-webkit-gradient(linear,left top,left bottom,color-stop(0%,#84c4e2),color-stop(36%,#369ad6),color-stop(61%,#3786c9),color-stop(100%,#66adf1));background:-webkit-linear-gradient(top,#84c4e2 0,#369ad6 36%,#3786c9 61%,#66adf1 100%);background:-o-linear-gradient(top,#84c4e2 0,#369ad6 36%,#3786c9 61%,#66adf1 100%);background:-ms-linear-gradient(top,#84c4e2 0,#369ad6 36%,#3786c9 61%,#66adf1 100%);background:linear-gradient(top,#84c4e2 0,#369ad6 36%,#3786c9 61%,#66adf1 100%);filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#84c4e2', endColorstr='#66adf1', GradientType=0)}#tsc_continue_control{font-size:14px}#tsc_review_answers_control{margin-bottom:7px}#tsc_review_control{font-size:14px}#tsc_confirm_control{margin-bottom:7px}.chat-bubble-arrow-border{border-color:#CCC transparent transparent;border-style:solid;border-width:15px;height:0;width:0;position:absolute;bottom:-30px;left:130px}.chat-bubble-arrow{border-color:#FFF transparent transparent;border-style:solid;border-width:15px;height:0;width:0;position:absolute;bottom:-28px;left:130px}.preRoll{position:absolute;z-index:20;overflow:hidden;border:0}.preRollHidden{visibility:hidden}.preRoll-disableMouse{pointer-events:none}.preRoll-fullPage{top:0;left:0;width:100%;height:100%}.spritesheet{display:inline-block;overflow:hidden;background-repeat:no-repeat;background-image:url(spritesheet.png)}.sprite_repeat{background-repeat:repeat-x!important}.rewind_button_normal{width:43px;height:43px;background-position:-192px -226px}.rewind_button_over{width:43px;height:43px;background-position:-240px -226px}.rewind_button_down{width:43px;height:43px;background-position:-144px -288px}.rewind_button_disabled{width:43px;height:43px;background-position:-192px -226px}.play_button_normal{width:43px;height:43px;background-position:-144px -0px}.play_button_over{width:43px;height:43px;background-position:-144px -48px}.play_button_down{width:43px;height:43px;background-position:-96px -288px}.play_button_disabled{width:43px;height:43px;background-position:-144px -0px}.pause_button_normal{width:43px;height:43px;background-position:-96px -192px}.pause_button_over{width:43px;height:43px;background-position:-96px -240px}.pause_button_down{width:43px;height:43px;background-position:-96px -144px}.pause_button_disabled{width:43px;height:43px;background-position:-96px -192px}.previous_button_normal{width:43px;height:43px;background-position:-144px -192px}.previous_button_over{width:43px;height:43px;background-position:-144px -240px}.previous_button_down{width:43px;height:43px;background-position:-144px -144px}.previous_button_disabled{width:43px;height:43px;background-position:-144px -96px}.next_button_normal{width:43px;height:43px;background-position:-96px -48px}.next_button_over{width:43px;height:43px;background-position:-96px -96px}.next_button_down{width:43px;height:43px;background-position:-96px -0px}.next_button_disabled{width:43px;height:43px;background-position:-48px -288px}.settings_button_normal{width:43px;height:43px;background-position:-380px -0px}.settings_button_over{width:43px;height:43px;background-position:-428px -0px}.settings_button_down{width:43px;height:43px;background-position:-332px -0px}.settings_button_disabled{width:43px;height:43px;background-position:-380px -0px}.settings_off_button_normal{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_over{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_down{width:43px;height:43px;background-position:-476px -0px}.settings_off_button_disabled{width:43px;height:43px;background-position:-476px -0px}.closed_caption_button_normal{width:43px;height:43px;background-position:-0px -48px}.closed_caption_button_over{width:43px;height:43px;background-position:-0px -96px}.closed_caption_button_down{width:43px;height:43px;background-position:-0px -0px}.closed_caption_button_disabled{width:43px;height:43px;background-position:-0px -48px}.closed_caption_off_button_normal{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_over{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_down{width:43px;height:43px;background-position:-0px -144px}.closed_caption_off_button_disabled{width:43px;height:43px;background-position:-0px -144px}.toc_button_normal{width:43px;height:43px;background-position:-353px -48px}.toc_button_over{width:43px;height:43px;background-position:-401px -48px}.toc_button_down{width:43px;height:43px;background-position:-305px -48px}.toc_button_disabled{width:43px;height:43px;background-position:-353px -48px}.toc_off_button_normal{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_over{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_down{width:43px;height:43px;background-position:-449px -48px}.toc_off_button_disabled{width:43px;height:43px;background-position:-449px -48px}.fullscreen_enter_button_normal{width:43px;height:43px;background-position:-48px -48px}.fullscreen_enter_button_over{width:43px;height:43px;background-position:-48px -96px}.fullscreen_enter_button_down{width:43px;height:43px;background-position:-48px -0px}.fullscreen_enter_button_disabled{width:43px;height:43px;background-position:-48px -48px}.fullscreen_leave_button_normal{width:43px;height:43px;background-position:-48px -192px}.fullscreen_leave_button_over{width:43px;height:43px;background-position:-48px -240px}.fullscreen_leave_button_down{width:43px;height:43px;background-position:-48px -144px}.fullscreen_leave_button_disabled{width:43px;height:43px;background-position:-48px -192px}.fullframe_enter_button_normal{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_over{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_down{width:43px;height:43px;background-position:-0px -240px}.fullframe_enter_button_disabled{width:43px;height:43px;background-position:-0px -240px}.fullframe_leave_button_normal{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_over{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_down{width:43px;height:43px;background-position:-0px -288px}.fullframe_leave_button_disabled{width:43px;height:43px;background-position:-0px -288px}.play_button_overlay_normal{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_over{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_down{width:108px;height:108px;background-position:-192px -0px}.play_button_overlay_disabled{width:108px;height:108px;background-position:-192px -0px}.replay_button_overlay_normal{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_over{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_down{width:108px;height:108px;background-position:-192px -113px}.replay_button_overlay_disabled{width:108px;height:108px;background-position:-192px -113px}.scroll_down_arrow_normal{width:16px;height:16px;background-position:-14px -213px}.scroll_down_arrow_over{width:16px;height:16px;background-position:-192px -274px}.scroll_down_arrow_down{width:16px;height:16px;background-position:-14px -213px}.scroll_down_arrow_disabled{width:16px;height:16px;background-position:-14px -213px}.scroll_up_arrow_normal{width:16px;height:16px;background-position:-232px -313px}.scroll_up_arrow_over{width:16px;height:16px;background-position:-253px -292px}.scroll_up_arrow_down{width:16px;height:16px;background-position:-232px -292px}.scroll_up_arrow_disabled{width:16px;height:16px;background-position:-232px -313px}.scroll_thumb_bottom_normal{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_over{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_down{width:14px;height:50px;background-position:-192px -295px}.scroll_thumb_bottom_disabled{width:14px;height:50px;background-position:-192px -295px}.scroll_track_normal{width:15px;height:13px;background-position:-232px -274px}.scroll_track_over{width:16px;height:4px;background-position:-69px -336px}.scroll_track_down{width:16px;height:4px;background-position:-48px -336px}.scroll_track_disabled{width:15px;height:13px;background-position:-232px -274px}.scrubbar_scrubber_normal{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_over{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_down{width:10px;height:43px;background-position:-305px -0px}.scrubbar_scrubber_disabled{width:10px;height:43px;background-position:-305px -0px}.unmute_button_normal{width:43px;height:43px;background-position:-545px -48px}.unmute_button_over{width:43px;height:43px;background-position:-305px -96px}.unmute_button_down{width:43px;height:43px;background-position:-497px -48px}.unmute_button_disabled{width:43px;height:43px;background-position:-545px -48px}.volume_button_normal{width:43px;height:43px;background-position:-353px -192px}.volume_button_over{width:43px;height:43px;background-position:-353px -240px}.volume_button_down{width:43px;height:43px;background-position:-305px -144px}.volume_button_disabled{width:43px;height:43px;background-position:-353px -192px}.volume_button_low_normal{width:43px;height:43px;background-position:-401px -96px}.volume_button_low_over{width:43px;height:43px;background-position:-449px -96px}.volume_button_low_down{width:43px;height:43px;background-position:-353px -96px}.volume_button_low_disabled{width:43px;height:43px;background-position:-401px -96px}.volume_button_med_normal{width:43px;height:43px;background-position:-545px -96px}.volume_button_med_over{width:43px;height:43px;background-position:-353px -144px}.volume_button_med_down{width:43px;height:43px;background-position:-497px -96px}.volume_button_med_disabled{width:43px;height:43px;background-position:-545px -96px}.volume_button_high_normal{width:43px;height:43px;background-position:-305px -240px}.volume_button_high_over{width:43px;height:43px;background-position:-305px -288px}.volume_button_high_down{width:43px;height:43px;background-position:-305px -192px}.volume_button_high_disabled{width:43px;height:43px;background-position:-305px -240px}.volumebar_slider_normal{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_over{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_down{width:13px;height:9px;background-position:-96px -336px}.volumebar_slider_disabled{width:13px;height:9px;background-position:-96px -336px}.scrubbar_loaded_track_end{width:2px;height:43px;background-position:-288px -226px}.scrubbar_track_left{width:1px;height:43px;background-position:-295px -226px}.scrubbar_track_right{width:1px;height:43px;background-position:-320px -0px}.scrubbar_track{width:2px;height:43px;background-position:-0px -479px}.scrubbar_loaded_track{width:2px;height:43px;background-position:-0px -393px}.scrubbar_played_track{width:2px;height:43px;background-position:-0px -436px}.seperator{width:1px;height:43px;background-position:-326px -0px}.volumebar_track{width:5px;height:2px;background-position:-35px -192px}.volumebar_track_end{width:5px;height:2px;background-position:-35px -199px}.volumebar_backdrop{width:31px;height:97px;background-position:-401px -144px}.control_backdrop_left{width:2px;height:43px;background-position:-0px -192px}.control_backdrop_right{width:2px;height:43px;background-position:-7px -192px}.toc_title_backdrop{width:8px;height:18px;background-position:-0px -522px}.control_backdrop{width:2px;height:43px;background-position:-0px -350px}.quizMarker{width:3px;color:rgba(255,255,255,.5);display:none}#videoClickToPlay,#videoClickToReplay{margin:-54px 0 0 -54px}#progress .seperator{display:none}#play_time{padding:0 5px 0 13px;font-size:15px;line-height:43px;color:#fff}#progress_scrubbar_track{height:43px;margin:0 1px}#scrubbar_scrubber{margin-right:-6px}#volume_slider_container{left:6px;margin-bottom:-4px}#volume_slider_vertical{height:61px;margin-top:19px}#volume_slider_vertical .ui-slider-handle{left:9px;width:13px;height:9px;background-image:url(spritesheet.png);background-position:-96px -336px}#volume_slider_vertical .ui-slider-range{margin-left:15px;width:1px;background-color:#151515}#playerSettingsContainer{margin-bottom:1px;background-color:#4b4b4b;color:#fff}#videoSidebar{bottom:43px}.captionVAlignBottom{bottom:53px}
\ No newline at end of file
diff --git a/src/ADDBEDLV.F90 b/src/ADDBEDLV.F90
new file mode 100644
index 0000000..39feeb7
--- /dev/null
+++ b/src/ADDBEDLV.F90
@@ -0,0 +1,18 @@
+ SUBROUTINE ADDBEDLV
+
+ USE BLK1MOD
+
+! process node with weighting values
+ DO N=1,NP
+! IF(ICN(N) .EQ. 2) THEN
+ IF(NRIVCR1(N) .GT. 0) THEN
+ NC1=NRIVCR1(N)
+ NC2=NRIVCR2(N)
+ WT1=WTRIVCR1(N)
+ WT2=WTRIVCR2(N)
+ WD(N)=CRSDAT(NC1,1,1)*WT1+CRSDAT(NC2,1,1)*WT2
+ ENDIF
+! ENDIF
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/ADDCRS.f90 b/src/ADDCRS.f90
new file mode 100644
index 0000000..e8412d5
--- /dev/null
+++ b/src/ADDCRS.f90
@@ -0,0 +1,136 @@
+ SUBROUTINE ADDSLOT
+
+! ADD SLOT TO 1-D
+
+ USE BLK1MOD
+
+! GET SLOT PARAMETERS
+
+ CALL GETSLOTPARAM(ISLTYP,SLDEP,SLRNG,SLPOR)
+ IF(ISLTYP .EQ. -1) RETURN
+
+! SEARCH FOR CROSS-SECTION REACH/TYPE
+ IF(ISLTYP .EQ. 0) THEN
+ DO N=1,MCRS
+ IF(IVMIL(N) .LT. 1) EXIT
+ MM=NRIVL(IVMIL(N))
+ IF(MM .GT. 0) THEN
+ CALL ADDSLOTDATA(IVMIL(N),MM,SLDEP,SLRNG,SLPOR)
+ ENDIF
+ NRIVL(IVMIL(N))=MM
+ ENDDO
+ ELSE
+! SEARCH FOR CROSS-SECTION REACH/TYPE
+!
+! IVMIL = CROSS-SECTION NUMBER
+! NRIVL = NUMBER OF POINTS IN SECTION
+! NOREACH = REACH/TYPE NUMBER
+! CRSDAT 1 = ELEVATION
+! CRSDAT 2 = AREA
+! CRSDAT 3 = WIDTH
+
+ DO N=1,MCRS
+ IF(ISLTYP .EQ. NOREACH(N)) THEN
+ MM=NRIVL(IVMIL(N))
+ CALL ADDSLOTDATA(IVMIL(N),MM,SLDEP,SLRNG,SLPOR)
+ NRIVL(IVMIL(N))=MM
+ ENDIF
+ ENDDO
+ ENDIF
+! APPLY CHANGE
+
+ RETURN
+ END
+
+ SUBROUTINE GETSLOTPARAM(ISLTYP,SLDEP,SLRNG,SLPOR)
+ use winteracter
+ USE BLK1MOD
+
+!-
+
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IERR,ISET,IBOX
+ REAL :: ASET
+ CHARACTER*1 :: IFLAG
+
+ call wdialogload(IDD_ADDSLOT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_ADDSLOT)
+ ierr=infoerror(1)
+
+ ISLTYP=0
+ SLDEP=4.
+ SLRNG=0.5
+ SLPOR=0.1
+ 100 continue
+
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,ISLTYP)
+ CALL WDialogPutReal(idf_real1,SLDEP)
+ CALL WDialogPutReal(idf_real2,SLRNG)
+ CALL WDialogPutReal(idf_real3,SLPOR)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ DO
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,ISLTYP)
+ CALL WDialogGetReal(idf_real1,SLDEP)
+ CALL WDialogGetReal(idf_real2,SLRNG)
+ CALL WDialogGetReal(idf_real3,SLPOR)
+ GO TO 200
+ else
+ ISLTYP=-1
+ RETURN
+ endif
+ ENDDO
+ 200 CONTINUE
+ RETURN
+ END
+ SUBROUTINE ADDSLOTDATA(N,M,SLDEP,SLRNG,SLPOR)
+ USE BLK1MOD
+ BLEVL=CRSDAT(N,1,1)
+ BWIDT=CRSDAT(N,1,3)
+ IF(BWIDT .LT. 1) THEN
+ CRSDAT(N,1,3)=1.0
+ CRSDAT(N,0,1)=BLEVL-SLRNG
+ CRSDAT(N,0,3)=SLPOR
+ CRSDAT(N,-1,1)=CRSDAT(N,0,1)-SLDEP
+ CRSDAT(N,-1,3)=SLPOR
+ MLT=-1
+ ELSE
+ CRSDAT(N,0,1)=BLEVL-SLRNG
+ CRSDAT(N,0,3)=1.0
+ CRSDAT(N,-1,1)=BLEVL-2.*SLRNG
+ CRSDAT(N,-1,3)=SLPOR
+ CRSDAT(N,-2,1)=CRSDAT(N,0,1)-SLDEP
+ CRSDAT(N,-2,3)=SLPOR
+ MLT=-2
+ ENDIF
+ DO I=M,MLT,-1
+ DO J=1,3
+ CRSDAT(N,I+1-MLT,J)=CRSDAT(N,I,J)
+ ENDDO
+ ENDDO
+ M=M+1-MLT
+ DO I=2,M
+ if(i .gt. 1) then
+ CRSDAT(N,I,2)=CRSDAT(N,I-1,2)+&
+ (CRSDAT(N,I,1)-CRSDAT(N,I-1,1))*&
+ (CRSDAT(N,I,3)+CRSDAT(N,I-1,3))/2.
+ endif
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/BLK1.f90 b/src/BLK1.f90
index 539c563..a9d6bed 100644
--- a/src/BLK1.f90
+++ b/src/BLK1.f90
@@ -74,7 +74,7 @@
NCSPTS,XELVP(50),YELVP(50),ZELVP(50),SELVP(50),&
ZREF,DFACTOR,ZMIN,IXNOD,LCROSS&
,IVMIL(MCRS),NRIVL(MCRS),NOREACH(MCRS)&
- ,CRSDAT(MCRS,MPTS,3),NCRSEC,XCRS(MCRS),YCRS(MCRS)
+ ,CRSDAT(MCRS,-4:MPTS,3),NCRSEC,XCRS(MCRS),YCRS(MCRS)
ALLOCATABLE NRIVCR1(:),WTRIVCR1(:),NRIVCR2(:),WTRIVCR2(:)
diff --git a/src/D.INC b/src/D.INC
index d57a9ba..135319c 100644
--- a/src/D.INC
+++ b/src/D.INC
@@ -1,4 +1,4 @@
-! Winteracter resource identifiers. Created : 03/Mar/2017 13:04:04
+! Winteracter resource identifiers. Created : 19/Oct/2017 10:30:12
!
! This file is generated by the Winteracter resource editor.
! It should not be edited manually. It is also not advisable to load this
@@ -403,3 +403,7 @@
INTEGER, PARAMETER :: IDF_GREEN = 1036
INTEGER, PARAMETER :: IDF_BLUE = 1038
INTEGER, PARAMETER :: IDD_DIALOG002 = 169
+ INTEGER, PARAMETER :: ID_ADDSLOT = 40150
+ INTEGER, PARAMETER :: IDF_CANCEL = 1088
+ INTEGER, PARAMETER :: IDD_ADDSLOT = 171
+ INTEGER, PARAMETER :: ID_ADDBEDLEV = 40151
diff --git a/src/EVENT.F90 b/src/EVENT.F90
index e1897f3..13e9360 100644
--- a/src/EVENT.F90
+++ b/src/EVENT.F90
@@ -772,8 +772,8 @@
INQUIRE (FILE = fname, EXIST = exists)
IF (.NOT. exists) THEN
- CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'ORG file does not exist!!'//CHAR(13)// &
- 'Do you wish to create file and view image','Looking for ORG file')
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Location file does not exist!!'//CHAR(13)// &
+ 'Do you wish to create file and view image','Looking for location file')
! If answer 'Yes' set ifrmel to 0
!
IF (WInfoDialog(4) .ne. 2) then
@@ -1075,10 +1075,16 @@
IACTVFIL=IOLDACT
CALL ADDTOMESH(IFILADD,1)
GO TO 100
+
!ipk sep16 ADD MESH FROM POINTS
CASE (ID_ADDMESHTR)
CALL ADDMESHT
GO TO 100
+
+!ipk sep16 ADD MESH FROM POINTS
+ CASE (ID_ADDBEDLEV)
+ CALL ADDBEDLV
+ GO TO 100
!ipk may03
CASE (ID_TRIANG) ! add a triangle of elements
CALL ADDTRIANG
@@ -1201,6 +1207,11 @@
CASE (ID_SAVELTLD)
CALL SAVEEQ
GO TO 100
+
+ CASE (ID_ADDSLOT)
+ CALL ADDSLOT
+ GO TO 100
+
CASE (ID_ITEM17) ! Exit option
!IPK SEP02
diff --git a/src/GETCRS.F90 b/src/GETCRS.F90
index 767afdc..5d6e328 100644
--- a/src/GETCRS.F90
+++ b/src/GETCRS.F90
@@ -43,7 +43,15 @@
IF(ID1(1:3) .EQ. 'ICS') THEN
READ(DLIN1,'(2I8,8x,2f16.0)') IVMIL(N),NRIVL(IVMIL(N)),XCRS(IVMIL(N)),YCRS(IVMIL(N))
- write(90,'(a)') 'ics',id1,dlin1
+!
+! IVMIL = CROSS-SECTION NUMBER
+! NRIVL = NUMBER OF POINTS IN SECTION
+! NOREACH = REACH/TYPE NUMBER
+! CRSDAT 1 = ELEVATION
+! CRSDAT 2 = AREA
+! CRSDAT 3 = WIDTH
+
+ write(90,'(a)') 'ics',id1,dlin1
NOREACH(IVMIL(N))=NOREACHTMP
IF(NRIVL(IVMIL(N)) .GT. MPTS) THEN
CALL WMessageBox(0,3,1,'Allowable number of points in a cross-section (75) exceeded'//char(13)//&
diff --git a/src/GETTRIANG.F90 b/src/GETTRIANG.F90
index 06f8e7a..64c8c9b 100644
--- a/src/GETTRIANG.F90
+++ b/src/GETTRIANG.F90
@@ -104,7 +104,8 @@
DO J=1,NEDGE
IF(IEDGE(J,1) .NE. 0) THEN
- CALL FORMT(XMAP1,YMAP1,J,N,NGAP,KK)
+!ipk dec17 add wd
+ CALL FORMT(XMAP1,YMAP1,J,N,NGAP,KK,wd)
ENDIF
END DO
diff --git a/src/INOUT.F90 b/src/INOUT.F90
index 0d054db..0888a57 100644
--- a/src/INOUT.F90
+++ b/src/INOUT.F90
@@ -1702,6 +1702,12 @@
ELSEIF(ID .EQ. 'E4Q') THEN
ICOUNT=5
GO TO 90
+ ELSEIF(ID .EQ. 'E6T') THEN
+ ICOUNT=7
+ GO TO 90
+ ELSEIF(ID .EQ. 'E8Q') THEN
+ ICOUNT=9
+ GO TO 90
ENDIF
ENDDO
90 CONTINUE
@@ -1723,6 +1729,14 @@
NTMP(4)=0
NTMP(6)=0
NTMP(8)=0
+ ELSEIF(ICOUNT .EQ. 7) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,6),NTMP(9)
+ IF(NTMP(9) .EQ. 0) NTMP(9)=1
+ NTMP(7)=0
+ NTMP(8)=0
+ ELSEIF(ICOUNT .EQ. 9) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,9)
+ IF(NTMP(9) .EQ. 0) NTMP(9)=1
ENDIF
ELSE
READ(DLIN1,*) J, (NTMP(K),K=1,9)
diff --git a/src/NEWRMGN.F90 b/src/NEWRMGN.F90
index 6f2ccbd..18c7fed 100644
--- a/src/NEWRMGN.F90
+++ b/src/NEWRMGN.F90
@@ -700,8 +700,8 @@
ENDIF
INQUIRE (FILE = fname, EXIST = exists)
IF (.NOT. exists) THEN
- CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'ORG file does not exist!!'//CHAR(13)// &
- 'Do you wish to create file and view image','Looking for ORG file')
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Location file does not exist!!'//CHAR(13)// &
+ 'Do you wish to create file and view image','Looking for location file')
! If answer 'Yes' set ifrmel to 0
!
IF (WInfoDialog(4) .ne. 2) then
diff --git a/src/PLOTR1.F90 b/src/PLOTR1.F90
index d3510c9..6adcc20 100644
--- a/src/PLOTR1.F90
+++ b/src/PLOTR1.F90
@@ -1537,14 +1537,24 @@
D2=CORD(NOP(N,1),2)
ELSE
DIR=ATAN2(DIRX,-DIRY)
- D1=CORD(NOP(N,2),1)
- D2=CORD(NOP(N,2),2)
+ IF(NOP(N,2) .NE. 0) THEN
+ D1=CORD(NOP(N,2),1)
+ D2=CORD(NOP(N,2),2)
+ ELSE
+ D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
+ D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
+ ENDIF
ENDIF
- DIR1=DIR+2.35619
- DIR2=DIR-2.35619
+ DIR1=DIR+2.35619
+ DIR2=DIR-2.35619
IF(IESKP(N) .EQ. 0) THEN
- D1=CORD(NOP(N,2),1)
- D2=CORD(NOP(N,2),2)
+ IF(NOP(N,2) .NE. 0) THEN
+ D1=CORD(NOP(N,2),1)
+ D2=CORD(NOP(N,2),2)
+ ELSE
+ D1=(CORD(NOP(N,1),1)+CORD(NOP(N,3),1))/2.
+ D2=(CORD(NOP(N,1),2)+CORD(NOP(N,3),2))/2.
+ ENDIF
DE1=D1+0.4*COS(DIR)
DE2=D2+0.4*SIN(DIR)
DEA1=DE1+0.1*COS(DIR1)
diff --git a/src/REFINB.F90 b/src/REFINB.F90
index 72fabb6..28f71a0 100644
--- a/src/REFINB.F90
+++ b/src/REFINB.F90
@@ -592,7 +592,10 @@
!ipk sep99 add test for line element
- if(ncn .eq. 3) go to 500
+ if(ncn .eq. 3) then
+ if(nef(i,2) .eq. nop(n,2)) go to 600
+ go to 500
+ endif
!
! Loop on sides
!
@@ -665,7 +668,26 @@
!ipk sep99 add test for line element
- if(ncn .eq. 3) go to 500
+ if(ncn .eq. 3) then
+ do i=1,nentry
+ if(nop(n,2) .eq. nef(i,2)) then
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ nop(nem,1)=nef(I,2)
+ nop(nem,3)=nef(I,3)
+ imat(nem)=imat(n)
+ ncorn(nem)=3
+ IESKP(NEM)=0
+ IERC=0
+ CALL PLTELM(NEM,IERC)
+ nop(n,2)=0
+ nop(n,3)=nef(I,2)
+ go to 500
+ endif
+ enddo
+ go to 500
+ endif
!
! Loop on sides
!
@@ -892,8 +914,10 @@
INTEGER*2 IRGEN
DIMENSION NTRAN(9),IRGEN(8,5,5)
!
- DATA IRGEN /1,0,2,0,9,0,8,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0, &
- & 7,0,8,0,9,0,6,0,8*0, &
+! DATA IRGEN /1,0,2,0,9,0,8,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0, &
+! & 7,0,8,0,9,0,6,0,8*0, &
+ DATA IRGEN /1,0,2,0,9,0,8,0,2,0,3,0,4,0,9,0,9,0,4,0,5,0,6,0, &
+ & 8,0,9,0,6,0,7,0,8*0, &
& 1,0,2,0,7,8,0,0,3,4,5,0,2,0,0,0,5,6,7,0,2,0,0,0,16*0, &
& 1,0,2,0,7,8,0,0,3,0,4,0,2,0,0,0,5,6,7,0,4,0,0,0, &
& 7,0,2,0,4,0,0,0,8*0, &
@@ -948,7 +972,7 @@
!
DO 300 N=1,4
IF(ITGEN(1,N,NTYP) .EQ. 0) GO TO 310
- CALL GETELM(NEM)
+ CALL GETELM(NEM)
NEUNDO=NEUNDO+1
IELDEL(NEUNDO)=NEM
DO 250 K=1,7,2
diff --git a/src/RMAGENV83e.rc b/src/RMAGENV83e.rc
index 8486c40..9076675 100644
--- a/src/RMAGENV83e.rc
+++ b/src/RMAGENV83e.rc
@@ -8,7 +8,7 @@
//
// Winteracter resource script.
//
-// Modified : 03/Mar/2017 13:04:04
+// Modified : 19/Oct/2017 10:30:12
//
///////////////////////////////////////////////////
//
@@ -413,6 +413,10 @@
#define IDF_GREEN 1036
#define IDF_BLUE 1038
#define IDD_DIALOG002 169
+#define ID_ADDSLOT 40150
+#define IDF_CANCEL 1088
+#define IDD_ADDSLOT 171
+#define ID_ADDBEDLEV 40151
///////////////////////////////////////////////////
//
@@ -2208,6 +2212,30 @@ BEGIN
,0
END
+IDD_ADDSLOT DIALOG 0, 0, 160, 139
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ADD SLOT TO 1-D"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 17, 40, 14
+ CONTROL "Type Number",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 18, 74, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 20, 107, 40, 14
+ CONTROL "Cancel",IDF_CANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 100, 107, 40, 14
+ CONTROL "Slot Depth",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 40, 74, 14
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 40, 40, 14
+ CONTROL "Slot Range",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 60, 74, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 60, 40, 14
+ CONTROL "Slot Porosity",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 80, 74, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 80, 40, 14
+END
+
+IDD_ADDSLOT RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
///////////////////////////////////////////////////
//
// Menus
@@ -2385,6 +2413,7 @@ BEGIN
MENUITEM "Fill a Gap Between Elements", ID_FILLAGAP
MENUITEM "Set Type by Level", ID_SETTYPLEV
MENUITEM "Form a complex line of elements", ID_Complex
+ MENUITEM "Add bed levels from cross-sections", ID_ADDBEDLEV
MENUITEM "Interpolate Map File for Stress File", ID_GETSTRESSFIL
MENUITEM "Smooth Map Contours", ID_SMOOTHMAP
MENUITEM "Smooth Mesh Using Reversal", ID_RVSDIAG
@@ -2395,6 +2424,7 @@ BEGIN
MENUITEM "Re-Show Element Loads", ID_RESHOWELTLD
MENUITEM "Save Element Load File", ID_SAVELTLD
MENUITEM "Form Elements from Map File", ID_FILLTR
+ MENUITEM "Add Slot to 1-D Sections", ID_ADDSLOT
END
MENUITEM "E&xit", ID_EXIT
END
diff --git a/src/RMAGENV83e.res b/src/RMAGENV83e.res
index 82e9228..165b772 100644
Binary files a/src/RMAGENV83e.res and b/src/RMAGENV83e.res differ
diff --git a/src/SYMBL.F90 b/src/SYMBL.F90
index 4278653..e60cdb2 100644
--- a/src/SYMBL.F90
+++ b/src/SYMBL.F90
@@ -975,6 +975,8 @@
ELSE
N1=NOP(IELEM,1)
N2=NOP(IELEM,3)
+!ipk dec17
+ if(ncorn(ielem) .eq. 2) n2=nop(ielem,2)
IF(IPW1 .EQ. 1) THEN
wd11=width(n1)/txscal
wd2=width(n2)/txscal
diff --git a/src/src83e/ADD999.F90 b/src/src83e/ADD999.F90
new file mode 100644
index 0000000..905ee4e
--- /dev/null
+++ b/src/src83e/ADD999.F90
@@ -0,0 +1,487 @@
+ SUBROUTINE ADD999(ISWT9,NELC)
+
+! add type 999 elements to all 1-d elements
+
+ USE BLK1MOD
+ USE BLK2MOD
+ COMMON ISEQ(4000,10),LIST1(2000),LIST2(2000)
+ INCLUDE 'TXFRM.COM'
+
+ IF(.NOT. ALLOCATED(IUSEDM)) THEN
+ ALLOCATE (IUSEDM(MAXE))
+ IUSEDM=0
+ ENDIF
+ IF(.NOT. ALLOCATED(HSET)) THEN
+ ISWTH=0
+ ELSE
+ ISWTH=1
+ ENDIF
+! loop on elements looking for 1-d
+ PI2=3.14159/2.
+
+ NTEMPLC=0
+ NCM=MAXECON
+ NCMi=MAXECON
+ IUSEDM=0
+ DO N=1,NE
+ IF(IMAT(N) .NE. 999) CYCLE
+ CALL KCON(0)
+ GO TO 75
+ ENDDO
+ GO TO 90
+ 75 CONTINUE
+ DO N=1,NE
+ IF(IMAT(N) .EQ. 999) THEN
+ DO J=1,NCMi
+ IF(NCORN(ICON(N,J)) .EQ. 3) THEN
+ M=ICON(N,J)
+ IF(NOP(M,1) .EQ. NOP(N,1) .AND. NOP(M,3) .EQ. NOP(N,3) .OR.&
+ NOP(M,1) .EQ. NOP(N,3) .AND. NOP(M,3) .EQ. NOP(N,1)) THEN
+ IUSEDM(ICON(N,J))=1
+ GO TO 80
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ 80 CONTINUE
+ ENDDO
+90 n=1
+ ICL=0
+ do k=1,10
+ iseqp=2000
+ iseqm=2000
+ do ns=n,ne
+ if(imat(ns) .eq. 0 .or. (imat(ns) .ge. 900 .and. imat(ns) .lt. 2000)) cycle
+ if(ncorn(ns) .gt. 3) cycle
+ if(IUSEDM(ns) .eq. 1) cycle
+! renumber elements to put them in order
+ N=NS
+ N1=NOP(NS,1)
+ N3=NOP(NS,3)
+ iseq(iseqp,k)=ns
+ IUSEDM(n)=1
+ go to 100
+ enddo
+ go to 200
+ 100 continue
+! search for element connected to n1 or n3
+ do m=1,ne
+ if(imat(ns) .eq. 0 .or. (imat(ns) .ge. 900 .and. imat(ns) .lt. 2000)) cycle
+! if(imat(m) .gt. 0 .and. imat(m) .lt. 900) then
+ if(ncorn(m) .lt. 4) then
+ if(IUSEDM(m) .eq. 1) cycle
+ if(nop(m,1) .eq. n3) then
+ IUSEDM(m)=1
+ iseqp=iseqp+1
+ iseq(iseqp,k)=m
+! n1=nop(m,1)
+ n3=nop(m,3)
+ n=m
+ go to 100
+ elseif(nop(m,1) .eq. n1) then
+ nop(m,1)=nop(m,3)
+ nop(m,3)=n1
+ IUSEDM(m)=1
+ iseqm=iseqm-1
+ iseq(iseqm,k)=m
+ n1=nop(m,1)
+! n3=nop(m,3)
+ n=m
+ go to 100
+ elseif(nop(m,3) .eq. n1) then
+ IUSEDM(m)=1
+ iseqm=iseqm-1
+ iseq(iseqm,k)=m
+ n1=nop(m,1)
+! n3=nop(m,3)
+ n=m
+ go to 100
+ elseif(nop(m,3) .eq. n3) then
+ nop(m,3)=nop(m,1)
+ nop(m,1)=n3
+ IUSEDM(m)=1
+ iseqp=iseqp+1
+ iseq(iseqp,k)=m
+! n1=nop(m,1)
+ n3=nop(m,3)
+ n=m
+ go to 100
+ endif
+ endif
+! endif
+ enddo
+ enddo
+200 continue
+! do n=990,1005
+! write(150,*) n,(iseq(n,m),m=1,5)
+! enddo
+ NETEMP=NE
+
+ do k=1,10
+ nss=0
+ do ns=1,4000
+ if(iseq(ns,k) .eq. 0) cycle
+ n=iseq(ns,k)
+ N1=NOP(N,1)
+ N2=NOP(N,2)
+ N3=NOP(N,3)
+
+ if(nss .eq. 0) then
+ ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
+ CALL GETNOD(J1)
+ INEW(J1) = 1
+ INSKP(J1) =0
+ IF(ISWTH .EQ. 1) THEN
+ WD(J1)=HSET(N1,3)
+ ELSE
+ WD(J1)=-9999.
+ ENDIF
+ CALL GETNOD(J2)
+ INEW(J2) = 1
+ INSKP(J2) =0
+ IF(ISWTH .EQ. 1) THEN
+ WD(J2)=HSET(N1,1)
+ ELSE
+ WD(J2)=-9999.
+ ENDIF
+
+! XUSR(J1)=+WIDTHD(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
+! YUSR(J1)=+WIDTHD(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
+ XUSR(J1)=+WIDTH(N1)/2.*COS(ELDIR-PI2)+XUSR(N1)
+ YUSR(J1)=+WIDTH(N1)/2.*SIN(ELDIR-PI2)+YUSR(N1)
+ CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
+ CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
+ IF(ISWT9 .EQ. 2) THEN
+ WD(J1)=WD(N1)
+ ENDIF
+ nnn=iseq(ns+1,k)
+ if(nnn .eq. 0) then
+ ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
+ else
+ n4=nop(nnn,3)
+ ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
+ endif
+! XUSR(J2)=+WIDTHD(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
+! YUSR(J2)=+WIDTHD(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
+ XUSR(J2)=+WIDTH(N1)/2.*COS(ELDIR+PI2)+XUSR(N1)
+ YUSR(J2)=+WIDTH(N1)/2.*SIN(ELDIR+PI2)+YUSR(N1)
+ CORD(J2,1)=(XUSR(J2)+XS)/TXSCAL
+ CORD(J2,2)=(YUSR(J2)+YS)/TXSCAL
+ IF(ISWT9 .EQ. 2) THEN
+ WD(J2)=WD(N1)
+ ENDIF
+ nss=1
+ else
+ nnn=iseq(ns+1,k)
+ if(nnn .eq. 0) then
+ ELDIR=ATAN2(YUSR(N3)-YUSR(N1),XUSR(N3)-XUSR(N1))
+ else
+ n4=nop(nnn,3)
+ ELDIR=ATAN2(YUSR(N4)-YUSR(N1),XUSR(N4)-XUSR(N1))
+ endif
+ endif
+ N0=N1
+! get two node numbers and store in ntempc
+ CALL GETNOD(J3)
+ INEW(J3) = 1
+ INSKP(J3) =0
+ IF(ISWTH .EQ. 1) THEN
+ WD(J3)=HSET(N3,3)
+ ELSE
+ WD(J3)=-9999.
+ ENDIF
+ CALL GETNOD(J4)
+ INEW(J4) = 1
+ INSKP(J4) =0
+ IF(ISWTH .EQ. 1) THEN
+ WD(J4)=HSET(N3,1)
+ ELSE
+ WD(J4)=-9999.
+ ENDIF
+ IF(J4 .GT. NP) NP=J4
+ nn= imat(n)
+ if(nn .gt. 1999) then
+! XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
+! YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
+! XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
+! YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
+ XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
+ YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
+ XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
+ YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
+ ELSEIF(KID(nn,1) .NE. 0) THEN
+ JR2=KID(IMAT(N),2)
+ JR1=KID(IMAT(N),3)
+ JR4=KID(IMAT(N),4)
+ JR3=KID(IMAT(N),5)
+ XUSR(J1)=XUSR(JR1)
+ YUSR(J1)=YUSR(JR1)
+ XUSR(J2)=XUSR(JR2)
+ YUSR(J2)=YUSR(JR2)
+ XUSR(J3)=XUSR(JR3)
+ YUSR(J3)=YUSR(JR3)
+ XUSR(J4)=XUSR(JR4)
+ YUSR(J4)=YUSR(JR4)
+! nop(n-1,7)=jr3
+ ELSE
+! XUSR(J3)=+WIDTHD(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
+! YUSR(J3)=+WIDTHD(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
+! XUSR(J4)=+WIDTHD(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
+! YUSR(J4)=+WIDTHD(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
+ XUSR(J3)=+WIDTH(N3)/2.*COS(ELDIR-PI2)+XUSR(N3)
+ YUSR(J3)=+WIDTH(N3)/2.*SIN(ELDIR-PI2)+YUSR(N3)
+ XUSR(J4)=+WIDTH(N3)/2.*COS(ELDIR+PI2)+XUSR(N3)
+ YUSR(J4)=+WIDTH(N3)/2.*SIN(ELDIR+PI2)+YUSR(N3)
+ ENDIF
+
+ CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
+ CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
+ CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
+ CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
+ IF(ISWT9 .EQ. 2) THEN
+ WD(J3)=WD(N3)
+ WD(J4)=WD(N3)
+ ENDIF
+350 CONTINUE
+ CALL GETELM(I3)
+! RECORD IN LIST FOR FUTURE
+ ICL=ICL+1
+ LIST1(ICL)=I3
+ LIST2(I3)=icl
+ NCORN(I3) = 8
+ IESKP(I3) = 0
+ NOP(I3,1)=J1
+ NOP(I3,3)=J3
+ NOP(I3,5)=N3
+ NOP(I3,6)=N2
+ NOP(I3,7)=N1
+ IF(ISWT9 .EQ. 0) THEN
+ IMAT(I3)=999
+ ELSE
+ IMAT(I3)=IMAT(N)
+ ENDIF
+ CALL GETELM(I4)
+! RECORD IN LIST FOR FUTURE
+ ICL=ICL+1
+ LIST1(ICL)=I4
+ LIST2(I4)=-icl
+ NCORN(I4) = 8
+ IESKP(I4) = 0
+ IF(I4 .GT. NETEMP) NETEMP=I4
+ IMAT(I4)=999
+ NOP(I4,1)=J4
+ NOP(I4,2)= 0
+ NOP(I4,3)=J2
+ NOP(I4,5)=N1
+ NOP(I4,6)=N2
+ NOP(I4,7)=N3
+ IF(ISWT9 .EQ. 0) THEN
+ IMAT(I4)=999
+ ELSE
+ IMAT(I4)=IMAT(N)
+ CALL DELTEL(N)
+ ENDIF
+ J2=J4
+ J1=J3
+ ENDDO
+ enddo
+ NE=NETEMP
+ ICLM=ICL
+ NELCT=2
+400 CONTINUE
+ CALL FILM(1)
+ call KCON(0)
+
+ do n=1,ne
+
+ if(imat(n) .eq. 2000) then
+ nm=nop(n,4)
+ if(necon(nm,1) .eq. n) then
+ nat=necon(nm,2)
+ else
+ nat=necon(nm,1)
+ endif
+ if(list2(n) .gt. 0) then
+ nm=nop(n,4)
+ if(necon(nm,1) .eq. n) then
+ nat=necon(nm,2)
+ else
+ nat=necon(nm,1)
+ endif
+ n1=nop(nat,7)
+ n2=nop(nat,1)
+ j1=nop(n,5)
+ j2=nop(n,7)
+ j3=nop(n,1)
+ j4=nop(n,3)
+ else
+ nm=nop(n,8)
+ if(necon(nm,1) .eq. n) then
+ nat=necon(nm,2)
+ else
+ nat=necon(nm,1)
+ endif
+ n1=nop(nat,3)
+ n2=nop(nat,5)
+ j1=nop(n,1)
+ j2=nop(n,3)
+ j3=nop(n,5)
+ j4=nop(n,7)
+ endif
+ xusr(j1)=xusr(n1)
+ yusr(j1)=yusr(n1)
+ cord(j1,1)=cord(n1,1)
+ cord(j1,2)=cord(n1,2)
+ xusr(j2)=xusr(n1)
+ yusr(j2)=yusr(n1)
+ cord(j2,1)=cord(n1,1)
+ cord(j2,2)=cord(n1,2)
+ xusr(j3)=xusr(n2)
+ yusr(j3)=yusr(n2)
+ cord(j3,1)=cord(n2,1)
+ cord(j3,2)=cord(n2,2)
+ xusr(j4)=xusr(n2)
+ yusr(j4)=yusr(n2)
+ cord(j4,1)=cord(n2,1)
+ cord(j4,2)=cord(n2,2)
+ elseif(imat(n) .eq. 2001) then
+ if(list2(n) .gt. 0) then
+ nm=nop(n,8)
+ if(necon(nm,1) .eq. n) then
+ nat=necon(nm,2)
+ else
+ nat=necon(nm,1)
+ endif
+ n1=nop(nat,5)
+ n2=nop(nat,3)
+ j1=nop(n,5)
+ j2=nop(n,7)
+ j3=nop(n,1)
+ j4=nop(n,3)
+ else
+ nm=nop(n,4)
+ if(necon(nm,1) .eq. n) then
+ nat=necon(nm,2)
+ else
+ nat=necon(nm,1)
+ endif
+ n1=nop(nat,1)
+ n2=nop(nat,7)
+ j1=nop(n,1)
+ j2=nop(n,3)
+ j3=nop(n,5)
+ j4=nop(n,7)
+ endif
+ xusr(j1)=xusr(n1)
+ yusr(j1)=yusr(n1)
+ cord(j1,1)=cord(n1,1)
+ cord(j1,2)=cord(n1,2)
+ xusr(j2)=xusr(n1)
+ yusr(j2)=yusr(n1)
+ cord(j2,1)=cord(n1,1)
+ cord(j2,2)=cord(n1,2)
+ xusr(j3)=xusr(n2)
+ yusr(j3)=yusr(n2)
+ cord(j3,1)=cord(n2,1)
+ cord(j3,2)=cord(n2,2)
+ xusr(j4)=xusr(n2)
+ yusr(j4)=yusr(n2)
+ cord(j4,1)=cord(n2,1)
+ cord(j4,2)=cord(n2,2)
+ endif
+ enddo
+ 450 CALL DELETM(0)
+ IF(NELC .LE. NELCT) THEN
+ do n=1,ne
+ if(imat(n) .gt. 1000) then
+ CALL DELTEL(n)
+ endif
+ enddo
+ RETURN
+ ENDIF
+ DO I=1,ICLM,2
+ NEL=LIST1(I)
+ IF(IMAT(NEL) .EQ. 0) CYCLE
+ IF(I .GT. 1) THEN
+ J3=J4
+ ELSE
+ CALL GETNOD(J3)
+ XUSR(J3)=(XUSR(NOP(NEL,7))+XUSR(NOP(NEL,1)))/2.
+ YUSR(J3)=(YUSR(NOP(NEL,7))+YUSR(NOP(NEL,1)))/2.
+ CORD(J3,1)=(XUSR(J3)+XS)/TXSCAL
+ CORD(J3,2)=(YUSR(J3)+YS)/TXSCAL
+ WD(J3)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
+ INEW(J3) = 1
+ INSKP(J3) =0
+ IF(J3 .GT. NP) NP=J3
+ ENDIF
+
+ CALL GETNOD(J4)
+ XUSR(J4)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
+ YUSR(J4)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
+ CORD(J4,1)=(XUSR(J4)+XS)/TXSCAL
+ CORD(J4,2)=(YUSR(J4)+YS)/TXSCAL
+ WD(J4)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
+ INEW(J4) = 1
+ INSKP(J4) =0
+ IF(J4 .GT. NP) NP=J4
+ CALL GETELM(I3)
+! RECORD IN LIST FOR FUTURE
+ ICL=ICL+1
+ LIST1(ICL)=I3
+ NCORN(I3) = 8
+ IESKP(I3) = 0
+ IF(I3 .GT. NETEMP) NETEMP=I3
+ NOP(I3,5)=J4
+ NOP(I3,7)=J3
+ NOP(I3,1)=NOP(NEL,1)
+ NOP(I3,3)=NOP(NEL,3)
+ NOP(NEL,1)=J3
+ NOP(NEL,3)=J4
+ IMAT(I3)=IMAT(NEL)
+
+ NEL=LIST1(I+1)
+ IF(IMAT(NEL) .EQ. 0) CYCLE
+ IF(I .GT. 1) THEN
+ J3A=J4A
+ ELSE
+ CALL GETNOD(J3A)
+ XUSR(J3A)=(XUSR(NOP(NEL,3))+XUSR(NOP(NEL,5)))/2.
+ YUSR(J3A)=(YUSR(NOP(NEL,3))+YUSR(NOP(NEL,5)))/2.
+ CORD(J3A,1)=(XUSR(J3A)+XS)/TXSCAL
+ CORD(J3A,2)=(YUSR(J3A)+YS)/TXSCAL
+ WD(J3A)=(WD(NOP(NEL,3))+WD(NOP(NEL,5)))/2.
+ INEW(J3A) = 1
+ INSKP(J3A) =0
+ IF(J3A .GT. NP) NP=J3A
+ ENDIF
+ CALL GETNOD(J4A)
+ XUSR(J4A)=(XUSR(NOP(NEL,1))+XUSR(NOP(NEL,7)))/2.
+ YUSR(J4A)=(YUSR(NOP(NEL,1))+YUSR(NOP(NEL,7)))/2.
+ CORD(J4A,1)=(XUSR(J4A)+XS)/TXSCAL
+ CORD(J4A,2)=(YUSR(J4A)+YS)/TXSCAL
+ WD(J4A)=(WD(NOP(NEL,1))+WD(NOP(NEL,7)))/2.
+ INEW(J4A) = 1
+ INSKP(J4A) =0
+ IF(J4A .GT. NP) NP=J4A
+ CALL GETELM(I3)
+! RECORD IN LIST FOR FUTURE
+ ICL=ICL+1
+ LIST1(ICL)=I3
+ NCORN(I3) = 8
+ IESKP(I3) = 0
+ IF(I3 .GT. NETEMP) NETEMP=I3
+ NOP(I3,1)=J4A
+ NOP(I3,3)=J3A
+ NOP(I3,5)=NOP(NEL,5)
+ NOP(I3,7)=NOP(NEL,7)
+ NOP(NEL,5)=J3A
+ NOP(NEL,7)=J4A
+ IMAT(I3)=IMAT(NEL)
+
+ ENDDO
+ NELCT=NELCT*2
+ GO TO 450
+! RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/ADDLAY.F90 b/src/src83e/ADDLAY.F90
new file mode 100644
index 0000000..fad4044
--- /dev/null
+++ b/src/src83e/ADDLAY.F90
@@ -0,0 +1,343 @@
+! Last change: IPK 12 Jan 98 11:21 am
+!
+!****************************************************************
+!
+ SUBROUTINE ADDLAY
+!
+! Add nodal layer data and write to file
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 IFLAG,ANSW(10)
+ REAL RLAY(9)
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+!
+ 4 CONTINUE
+
+ call openlay
+
+ NHTP=0
+ NBRR=0
+ NMESS=45
+ CALL HEDR
+ NMESS=4
+ xprt=3.2
+!
+ IPOS=ILAYTP
+ call GETLAYDAT(NLAY,ipos,RLAY)
+ ILAYTP=IPOS
+! call getint(nlay)
+! READ(*,*) NLAY
+!
+! Write out current layers
+!
+ 7 CONTINUE
+ NHTP=0
+ NMESS=0
+ NBRR=4
+ CALL HEDR
+ CALL RCYAN
+ DO 10 K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .GT. 5) THEN
+ DO 9 N=1,NCORN(K),2
+ J=NOP(K,N)
+ FPN = LAY(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.0) THEN
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ ENDIF
+ 9 CONTINUE
+ ENDIF
+ ENDIF
+ 10 END DO
+ CALL RBLUE
+!
+! Input new layers
+!
+ 5 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+
+ IF(IRMAIN .EQ. 1) THEN
+ REWIND 102
+ DO J=1,NP
+ IF(LAY(J) .GT. -9998) THEN
+ if(ILAYTP .eq. 1) then
+ write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6000 format('LD2 ',2i8,9F8.2)
+ else
+ write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6001 format('LD3 ',2i8,9F8.2)
+ endif
+ ENDIF
+ ENDDO
+ RETURN
+ ENDIF
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 4
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ NLAYD=1
+ REWIND 102
+ DO J=1,NP
+ IF(LAY(J) .GT. -9998) THEN
+ if(ILAYTP .eq. 1) then
+ write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ else
+ write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ endif
+ ENDIF
+ ENDDO
+ CALL WRTOUT(0)
+ RETURN
+ ENDIF
+!
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.2,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ LAY(INODE) = NLAY
+ DO J=1,7
+ WTLAY(INODE,J)=RLAY(J)
+ ENDDO
+ FPN = NLAY
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ CALL RBLUE
+!
+ ELSEIF(IFLAG .EQ. 'a') THEN
+ DO 100 K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .GT. 5) THEN
+ DO 90 N=1,NCORN(K),2
+ J=NOP(K,N)
+ DO I=1,7
+ WTLAY(J,I)=RLAY(I)
+ ENDDO
+ LAY(J)=NLAY
+ FPN=NLAY
+ X = CORD(J,1)
+ Y = CORD(J,2) + .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.0) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ CALL RBLUE
+ ENDIF
+ 90 CONTINUE
+ ENDIF
+ ENDIF
+ 100 CONTINUE
+ NLAYD=1
+ CALL WRTOUT(0)
+ ELSEIF(IFLAG .EQ. 'f') THEN
+ DO 120 K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .GT. 5) THEN
+ DO 110 N=1,NCORN(K),2
+ J=NOP(K,N)
+ IF(LAY(J) .EQ. -9999.) THEN
+ LAY(J)=NLAY
+ DO I=1,7
+ WTLAY(J,I)=RLAY(I)
+ ENDDO
+ FPN=NLAY
+ X = CORD(J,1)
+ Y = CORD(J,2) + .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.0) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ CALL RBLUE
+ ENDIF
+ ENDIF
+ 110 CONTINUE
+ ENDIF
+ ENDIF
+ 120 CONTINUE
+ NLAYD=1
+ CALL WRTOUT(0)
+!
+ ELSE
+!ipk jan98 WRITE(*,*) CHAR(7),CHAR(7)
+ ENDIF
+!
+ GOTO 5
+!
+ END
+ subroutine openlay
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ LOGICAL :: OPENED
+ INTEGER :: IERR
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INQUIRE(102, OPENED=OPENED)
+ if(.not. opened) then
+ CALL WSelectFile(ID_STRING9,SaveDialog+PromptOn,FNAME,'Save layer file')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='lay'
+ CALL ADDSUB(FNAME,SUB)
+ open(102,file=fname, form='formatted', status='unknown')
+ ENDIF
+ endif
+
+ RETURN
+ END
+
+ SUBROUTINE RDLAYER
+!
+! Read nodal layer data
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*8 ID
+ CHARACTER*72 DLIN
+ DIMENSION WTTEMP(7)
+
+!
+ 100 CONTINUE
+ READ(103,7000,END=400) ID,DLIN
+ 7000 FORMAT(A8,A72)
+ IF(ID(1:2) .EQ. 'LD') THEN
+ READ(DLIN,5000) NODNUM,NLAYD,(WTTEMP(I),I=1,7)
+ 5000 FORMAT(2I8,7F8.0)
+ IF(NODNUM .EQ. 0) THEN
+ DO N=0,NP
+ LAY(N)=NLAYD
+ IF(NLAYD .GT. 0) THEN
+ DO I=0,NLAYD
+ WTLAY(N,I)=WTTEMP(I)
+ ENDDO
+ ENDIF
+ ENDDO
+ ELSEIF(NODNUM .GT. 0) THEN
+ LAY(NODNUM)=NLAYD
+ IF(NLAYD .GT. 0) THEN
+ DO I=1,NLAYD
+ WTLAY(NODNUM,I)=WTTEMP(I)
+ ENDDO
+ ENDIF
+
+ ENDIF
+ ENDIF
+ IF(ID(3:3) .EQ. '2') THEN
+ ILAYTP=1
+ ELSE
+ ILAYTP=0
+ ENDIF
+ GO TO 100
+ 400 CONTINUE
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ NCN=NCORN(K)
+ IF(NCN .EQ. 5) NCN=3
+ DO N=1,NCORN(K),2
+ J=NOP(K,N)
+ FPN=LAY(N)
+ X = CORD(J,1)
+ Y = CORD(J,2) + .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.0) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ CALL RBLUE
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE WRTLAYER
+ use winteracter
+
+!
+! Read nodal layer data
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*8 ID
+ CHARACTER*72 DLIN
+ DIMENSION WTTEMP(7)
+ LOGICAL :: OPENED
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INQUIRE(102, OPENED=OPENED)
+ if(.not. opened) then
+ CALL WSelectFile(ID_STRING9,SaveDialog+PromptOn,FNAME,'Save layer file')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='lay'
+ CALL ADDSUB(FNAME,SUB)
+ open(102,file=fname, form='formatted', status='unknown')
+ ENDIF
+ else
+ rewind 102
+ endif
+
+ DO J=0,NP
+ IF(LAY(J) .GT. -9998) THEN
+ if(j .gt. 0) then
+ if(lay(j) .ne. lay(0)) then
+ go to 300
+ else
+ do i=1,lay(j)
+ if(wtlay(j,i) .ne. wtlay(0,i)) then
+ go to 300
+ endif
+ enddo
+ endif
+ go to 500
+ 300 continue
+ if(ILAYTP .eq. 1) then
+ write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6000 format('LD2 ',2i8,9F8.2)
+ else
+ write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6001 format('LD3 ',2i8,9F8.2)
+ endif
+ else
+ if(ILAYTP .eq. 1) then
+ write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ else
+ write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ endif
+ endif
+ ENDIF
+ 500 CONTINUE
+ ENDDO
+ RETURN
+ END
diff --git a/src/src83e/ADDQUAD.F90 b/src/src83e/ADDQUAD.F90
new file mode 100644
index 0000000..a273dae
--- /dev/null
+++ b/src/src83e/ADDQUAD.F90
@@ -0,0 +1,192 @@
+ SUBROUTINE ADDQUAD
+
+! Subroutine to add a quadrilateral block
+
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ INCLUDE 'TXFRM.COM'
+
+ CHARACTER*1 IFLAG
+
+ DATA N1,N2,N3,N4/1,1,1,1/
+
+! Initiliaze list etc
+
+ NHTPSV=NHTP
+ NMESSSV=NMESS
+ NBRRSV=NBRR
+
+ DO N=1,NP
+ LIST(N)=0
+ ENDDO
+! Get the points that form the triangle
+
+ 4 CONTINUE
+ NHTP=0
+ NMESS=8
+ NBRR = 3
+ CALL HEDR
+!
+! Get screen coordinates of each end of line
+!
+ 7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ALX=XTEMP
+ ALY=YTEMP
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ CALL WRTOUT(0)
+ RETURN
+ elseif(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ ENDIF
+!
+! Exit input
+!
+! 9 CALL PLOTT(XTEMP,YTEMP,3)
+! CALL PLOTT(XTEMP,YTEMP,2)
+ NBRR=0
+ CALL HEDR
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ARX=XTEMP
+ ARY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ CALL PLOTT(ALX,ALY,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ BRX=XTEMP
+ BRY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ 16 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ BLX=XTEMP
+ BLY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ 20 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL PLOTT(ALX,ALY,2)
+
+! Get the number of element information
+
+ CALL PANELQUAD(N1,N2,N3,N4)
+
+! Get number For 1 and 3 and 2 and 4
+
+ NMID1=(N1+N3)/2
+ NMID2=(N2+N4)/2
+
+! Form the new nodes
+
+ CALL DEFNOD(ALX,ALY)
+ CALL DEFNOD(ARX,ARY)
+ CALL DEFNOD(BRX,BRY)
+ CALL DEFNOD(BLX,BLY)
+
+! Now work on sides
+
+ DO N=1,N1-1
+ RATIO=FLOAT(N)/FLOAT(N1)
+ X1=ALX+RATIO*(ARX-ALX)
+ Y1=ALY+RATIO*(ARY-ALY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ DO N=1,N2-1
+ RATIO=FLOAT(N)/FLOAT(N2)
+ X1=ARX+RATIO*(BRX-ARX)
+ Y1=ARY+RATIO*(BRY-ARY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ DO N=1,N3-1
+ RATIO=FLOAT(N)/FLOAT(N3)
+ X1=BRX+RATIO*(BLX-BRX)
+ Y1=BRY+RATIO*(BLY-BRY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ DO N=1,N4-1
+ RATIO=FLOAT(N)/FLOAT(N4)
+ X1=BLX+RATIO*(ALX-BLX)
+ Y1=BLY+RATIO*(ALY-BLY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ CALL FRMNODQ(ALX,ALY,ARX,ARY,BRX,BRY,BLX,BLY,NMID1,NMID2)
+
+! Form triangles for the added nodes
+
+ CALL DELN2(NP,1)
+
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+
+ RETURN
+ END
+
+ SUBROUTINE PANELQUAD(N1,N2,N3,N4)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,N4,IERR
+! real ::
+ character*3 :: sub
+
+ call wdialogload(IDD_QUAD)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,n1)
+ CALL WDialogPutInteger(idf_integer2,n2)
+ CALL WDialogPutInteger(idf_integer3,n3)
+ CALL WDialogPutInteger(idf_integer4,n4)
+
+
+ CALL WDialogSelect(IDD_QUAD)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(idf_integer1,n1)
+ CALL WDialogGetInteger(idf_integer2,n2)
+ CALL WDialogGetInteger(idf_integer3,n3)
+ CALL WDialogGetInteger(idf_integer4,n4)
+
+
+ ENDIF
+ RETURN
+ END
diff --git a/src/src83e/ADDTRIANG.F90 b/src/src83e/ADDTRIANG.F90
new file mode 100644
index 0000000..9694a10
--- /dev/null
+++ b/src/src83e/ADDTRIANG.F90
@@ -0,0 +1,191 @@
+ SUBROUTINE ADDTRIANG
+
+! Subroutine to add a triangular block
+
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ INCLUDE 'TXFRM.COM'
+
+ CHARACTER*1 IFLAG
+
+ DATA N1,N2,N3/1,1,1/
+
+! Initiliaze list etc
+
+ NHTPSV=NHTP
+ NMESSSV=NMESS
+ NBRRSV=NBRR
+
+ DO N=1,NP
+ LIST(N)=0
+ ENDDO
+! Get the points that form the triangle
+
+ 4 CONTINUE
+ NHTP=0
+ NMESS=8
+ NBRR = 3
+ CALL HEDR
+!
+! Get screen coordinates of each end of line
+!
+ 7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ALX=XTEMP
+ ALY=YTEMP
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ CALL WRTOUT(0)
+ RETURN
+ elseif(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ ENDIF
+!
+! Exit input
+!
+! 9 CALL PLOTT(ALX,ALY,3)
+! CALL PLOTT(ALX,ALY,2)
+ NBRR=0
+ CALL HEDR
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ARX=XTEMP
+ ARY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! 12 CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(ALX,ALY,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ BRX=XTEMP
+ BRY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ 16 CONTINUE
+ ! CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL PLOTT(ALX,ALY,2)
+
+! Get the number of element information
+
+ CALL PANELTRG(N1,N2,N3)
+
+! Get middle number
+
+ IF(N1 .GT. N2) THEN
+ IF(N1 .GT. N3) THEN
+ IF(N2 .GT. N3) THEN
+ NMID=N2
+ ELSE
+ NMID=N1
+ ENDIF
+ ELSE
+ NMID=N1
+ ENDIF
+ ELSE
+ IF(N2 .GT. N3) THEN
+ IF(N1 .GT. N3) THEN
+ NMID=N1
+ ELSE
+ NMID=N3
+ ENDIF
+ ELSE
+ NMID=N2
+ ENDIF
+ ENDIF
+
+! Form the new nodes
+
+ CALL DEFNOD(ALX,ALY)
+ CALL DEFNOD(ARX,ARY)
+ CALL DEFNOD(BRX,BRY)
+
+! Now work on sides
+
+ DO N=1,N1-1
+ RATIO=FLOAT(N)/FLOAT(N1)
+ X1=ALX+RATIO*(ARX-ALX)
+ Y1=ALY+RATIO*(ARY-ALY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ DO N=1,N2-1
+ RATIO=FLOAT(N)/FLOAT(N2)
+ X1=ARX+RATIO*(BRX-ARX)
+ Y1=ARY+RATIO*(BRY-ARY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ DO N=1,N3-1
+ RATIO=FLOAT(N)/FLOAT(N3)
+ X1=BRX+RATIO*(ALX-BRX)
+ Y1=BRY+RATIO*(ALY-BRY)
+ CALL DEFNOD(X1,Y1)
+ ENDDO
+ CALL FRMNODT(ALX,ALY,ARX,ARY,BRX,BRY,NMID)
+
+! For triangles for the added nodes
+
+ CALL DELN2(NP,1)
+
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+
+ RETURN
+ END
+
+ SUBROUTINE PANELTRG(N1,N2,N3)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+! real ::
+ character*3 :: sub
+
+ call wdialogload(IDD_TRIANG)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,n1)
+ CALL WDialogPutInteger(idf_integer2,n2)
+ CALL WDialogPutInteger(idf_integer3,n3)
+
+
+ CALL WDialogSelect(IDD_TRIANG)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(idf_integer1,n1)
+ CALL WDialogGetInteger(idf_integer2,n2)
+ CALL WDialogGetInteger(idf_integer3,n3)
+
+
+ ENDIF
+ RETURN
+ END
diff --git a/src/src83e/ADDWID.F90 b/src/src83e/ADDWID.F90
new file mode 100644
index 0000000..abfd900
--- /dev/null
+++ b/src/src83e/ADDWID.F90
@@ -0,0 +1,464 @@
+!IPK LAST UPDATE JULY 18 1998 MAJOR CHANGES
+! Last change: IPK 12 Jan 98 11:22 am
+!ipk jan98 delete old call to char(7)
+!****************************************************************
+!
+ SUBROUTINE ADDWID
+!
+! Add nodal width data
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 IFLAG,ANSW(10),ANSW1(10)
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+ DATA ANSW1/ 'w','1','2','d','e','s','b','z','r','q'/
+!
+ 4 CONTINUE
+ NHTP=13
+ NMESS=0
+ NBRR=0
+!ipk apr95 add call to flushwn
+ call flushwn
+ CALL HEDR
+ 102 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW1(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'w') THEN
+!
+! get width
+!
+ 104 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = WIDTH(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=5
+ xprt=3.2
+ call getfpn(cwid)
+!
+! Input new widths
+!
+ 105 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 104
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ WIDTH(INODE) = CWID
+ FPN = WIDTH(INODE)
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 105
+ elseif(iflag .eq. '1') then
+!
+! get ss1
+!
+ 204 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = ss1(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=22
+ xprt=3.2
+ call getfpn(ss1tp)
+!
+! Input new ss1
+!
+ 205 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 204
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ SS1(INODE) = SS1TP
+ FPN = SS1TP
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 205
+ elseif(iflag .eq. '2') then
+!
+! get ss2
+!
+ 304 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = ss2(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=23
+ xprt=3.2
+ call getfpn(ss2tp)
+!
+! Input new ss2
+!
+ 305 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 304
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ SS2(INODE) = SS2TP
+ FPN = SS2TP
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 305
+ elseif(iflag .eq. 'd') then
+!
+! get storage width
+!
+ 404 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = wids(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=24
+ xprt=3.2
+ call getfpn(wids1tp)
+!
+! Input new storgae width
+!
+ 405 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 404
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ WIDS(INODE) = wids1TP
+ FPN = wids1TP
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 405
+ elseif(iflag .eq. 'e') then
+!
+! get storage elevation
+!
+ 504 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = widbs(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=39
+ xprt=3.2
+ call getfpn(widbs1tp)
+!
+! Input new storage elevations
+!
+ 505 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 504
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ WIDBS(INODE) = widbs1TP
+ FPN = widbs1tp
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 505
+ elseif(iflag .eq. 's') then
+!
+! get storage slopes
+!
+ 604 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = sso(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=40
+ xprt=3.2
+ call getfpn(widslp)
+!
+! Input new storage slopes
+!
+ 605 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 604
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ SSO(INODE) = widslp
+ FPN = widslp
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 605
+!ipk mar02
+!
+! get bed slopes
+!
+ elseif(iflag .eq. 'b') then
+ 704 continue
+ call plotot(1)
+ CALL RCYAN
+ DO K=1,NE
+ IF(IMAT(K) .GT. 0) THEN
+ IF(NCORN(K) .LT. 6) THEN
+ IF(NCORN(K) .GT. 2 .AND. IMAT(K) .LT. 900) THEN
+ DO N=1,3,2
+ J=NOP(K,N)
+ FPN = BS1(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) - .11
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ enddo
+ ENDIF
+ ENDIF
+ ENDIF
+ enddo
+ CALL RBLUE
+ nmess=45
+ nhtp=0
+ nbrr=4
+ call flushwn
+ CALL HEDR
+ nmess=44
+ xprt=3.2
+ call getfpn(bedslp)
+!
+! Input new bed slopes
+!
+ 705 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'n') THEN
+ GO TO 704
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ CALL WRTOUT(0)
+ go to 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= INODE
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ BS1(INODE) = bedslp
+ FPN = bedslp
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) + .11
+ CALL RRED
+ CALL NUMBR(X,Y,0.20,FPN,0.0,-1)
+ CALL RBLUE
+ endif
+ go to 705
+
+ elseif(iflag .eq. 'q') then
+ return
+ endif
+ go to 4
+ END
diff --git a/src/src83e/AREA.F90 b/src/src83e/AREA.F90
new file mode 100644
index 0000000..2cbf190
--- /dev/null
+++ b/src/src83e/AREA.F90
@@ -0,0 +1,457 @@
+!IPK LAST UPDATE JULY 7 2016 ADD TEST FOR ZERO WIDTH
+ SUBROUTINE CHKAREA
+
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+
+ dimension itran(0:16)
+ data itran/0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
+
+ DATA I1,I2,I3,I4/1,0,0,0/,EMAX/-1./
+
+ WRITE(90,*) 'GOING TO CHKOPT'
+ CALL GETCHOPT(I1,I2,I3,I4,EREF,WIDEL)
+ WRITE(90,*) I1
+ IF(I1 .LT. 0) THEN
+ I1=1
+ I2=0
+ RETURN
+ ENDIF
+ IF(I1 .EQ. 1) THEN
+! and see if all corner nodes exist
+!
+! Test for areas of each element
+!
+ INEG = 0
+!IPK JUL16
+ IERW=0
+ DO 250 N=1,NE
+ IF(IMAT(N) .GT. 0 .AND. NCORN(N) .GT. 5) THEN
+ J1=NOP(N,1)
+ J2=NOP(N,3)
+ J3=NOP(N,5)
+ if(cord(j1,1) .lt. -1.e9 .or. cord(j2,1) .lt. -1.e9 .or. cord(j3,1) .lt. -1.e9) then
+ WRITE(90,*) ' NODE UNDEFINED FOR ELEMENT NUMBER',N
+ CALL DELTEL(N)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Element removed','ELEMENT REMOVED')
+ GO TO 250
+ ENDIF
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+ WRITE(90,*) ' NEGATIVE AREA FOR ELEMENT NUMBER',N
+ INEG = 1
+ GO TO 250
+ ENDIF
+ IF(NCORN(N) .EQ. 8) THEN
+ J1=NOP(N,3)
+ J2=NOP(N,5)
+ J3=NOP(N,7)
+ if(cord(j1,1) .lt. -1.e9 .or. cord(j2,1) .lt. -1.e9 .or. cord(j3,1) .lt. -1.e9) then
+ WRITE(90,*) ' NODE UNDEFINED FOR ELEMENT NUMBER',N
+ CALL DELTEL(N)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Element removed','ELEMENT REMOVED')
+ GO TO 250
+ ENDIF
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+ WRITE(90,*) ' NEGATIVE AREA FOR ELEMENT NUMBER',N
+ INEG = 1
+ ENDIF
+ ENDIF
+!IPK JUL16 ADD TEST FOR MISSING WIDTH
+ ELSEIF(IMAT(N) .GT. 0) THEN
+ IF(WIDTH(NOP(N,1)) .EQ. 0. .OR. WIDTH(NOP(N,3)) .EQ. 0) THEN
+ IF(IERW .EQ. 0) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Nodal width missing in 1-D element'//Char(13)//&
+ 'See file MESSGEN.OUT for details' ,'WARNING 1-D WIDTH MISSING')
+ write(90,6000)
+ write(90,6001) n,nop(n,1),width(nop(n,1)),nop(n,3),width(nop(n,3))
+6000 FORMAT(' NODAL WIDTH MISSING FOR 1-D ELEMENT'/' ELEMENT NODE1 WIDTH1 NODE2 WIDTH2')
+6001 FORMAT(I8,2(I10,F10.2))
+ IERW=1
+ ELSE
+ write(90,6001) n,nop(n,1),width(nop(n,1)),nop(n,3),width(nop(n,3))
+ ENDIF
+ ENDIF
+ ENDIF
+ 250 END DO
+
+ IF(INEG .EQ. 1) THEN
+!cipk aug00
+
+ Call WMessageBox(3,2,1,'Negative Areas have been found'//Char(13)//&
+ 'See file MESSGEN.OUT for details'//'Press YES to set positive',&
+ 'ERROR IN NETWORK AREAS!!')
+
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+!
+! Test for areas of each element
+!
+ INEG=0
+ DO 300 N=1,NE
+ IF(IMAT(N) .GT. 0 .AND. NCORN(N) .GT. 5) THEN
+ J1=NOP(N,1)
+ J2=NOP(N,3)
+ J3=NOP(N,5)
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+ if(NCORN(N) .EQ. 6) THEN
+ JM12=NOP(N,2)
+ JM23=NOP(N,4)
+ JM31=NOP(N,6)
+ NOP(N,2)=JM31
+ NOP(N,3)=J3
+ NOP(N,4)=JM23
+ NOP(N,5)=J2
+ NOP(N,6)=JM12
+ GO TO 300
+ ELSEIF(NCORN(N) .EQ. 8) THEN
+ INEG=1
+ ENDIF
+ ENDIF
+ IF(NCORN(N) .EQ. 8) THEN
+ J1=NOP(N,3)
+ J2=NOP(N,5)
+ J3=NOP(N,7)
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+ IF(INEG .EQ. 1) THEN
+ J0=NOP(N,1)
+ JM01=NOP(N,2)
+ JM12=NOP(N,4)
+ JM23=NOP(N,6)
+ JM30=NOP(N,8)
+ NOP(N,2)=JM30
+ NOP(N,3)=J3
+ NOP(N,4)=JM23
+ NOP(N,5)=J2
+ NOP(N,6)=JM12
+ NOP(N,7)=J1
+ NOP(N,8)=JM01
+ ELSE
+ WRITE(90,*) ' CROSS OVER NEGATIVE AREA FOR ELEMENT NUMBER',N
+ Call WMessageBox(3,2,1,'cross-over element diagonals have been found'//Char(13)//&
+ 'See file MESSGEN.OUT for details'//'Press YES to set delete',&
+ 'ERROR IN NETWORK AREAS!!')
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ CALL DELTEL(N)
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ 300 END DO
+ ENDIF
+ ENDIF
+ ENDIF
+! CARRY OUT TEST FOR ELEMENT ELEVATION DIFFERENCES
+ IF(I2 .EQ. 1) THEN
+ EMAX=0.
+ DO N=1,NE
+ EDIF(N)=0
+ IF(IMAT(N) .LE. 0) GO TO 400
+ IF(NCORN(N) .GT. 5) THEN
+ DO M=1,NCORN(N)-1,2
+ DO MM=M,NCORN(N)-1,2
+ EDIF(N)=MAX(ABS(WD(NOP(N,M))-WD(NOP(N,MM))),EDIF(N))
+ ENDDO
+ ENDDO
+ ELSE
+ IF(I4 .EQ. 0) THEN
+ EDIF(N)=ABS(WD(NOP(N,3))-WD(NOP(N,1)))
+ ELSE
+ if(icrin .eq. 0) then
+ CALL WMessageBox(0, 4, 1,'Cross-section data not loaded '//CHAR(13)// &
+ 'Click OK start again','ERROR GETTING NO SECTION DATA')
+ RETURN
+ endif
+ N1=NOP(N,1)
+ N2=NOP(N,3)
+ BT1= &
+ CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
+ CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
+ BT2= &
+ CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
+ CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
+ H1=WIDEL-BT1
+ H2=WIDEL-BT2
+ IF(H1 .LT. 0. .OR. H2 .LT. 0.) THEN
+ CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
+ 'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
+ if(WInfoDialog(4) .eq. 0) then
+ RETURN
+ else
+ IF(H1 .LT. 0.) H1=1.0
+ IF(H2 .LT. 0.) H2=1.0
+ endif
+ ENDIF
+ CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
+ CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
+ IF(I4 .EQ. 1) THEN
+ EDIF(N)=ABS(WR1-WR2)
+ ELSE
+ EDIF(N)=ABS(AR1-AR2)
+ ENDIF
+ ENDIF
+ ENDIF
+ IF(EDIF(N) .GT. EMAX) EMAX=EDIF(N)
+ 400 CONTINUE
+ ENDDO
+ NUMV=11
+ CONTUR(1)=0.
+ DO K=2,11
+ CONTUR(K)=EMAX/10.+CONTUR(K-1)
+ ENDDO
+
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ ICOL=EDIF(N)*10./EMAX+.999
+ icll=itran(icol)
+ CALL FILLEMC(N,ICLL)
+ ENDIF
+ ENDDO
+ XLEG=8.8
+ YLEG=7.4
+
+ CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
+
+ ENDIF
+ EDIF(0)=EMAX
+ CALL WMenuSetState(ID_SECGRP,ItemEnabled,1)
+ IF(I2 .EQ. 1) RETURN
+! CARRY OUT TEST FOR ELEMENT NORMAILZED DEPTH DIFFERENCES
+ IF(I3 .EQ. 1) THEN
+ EMAX=0.
+ DO N=1,NE
+ EDIF(N)=0
+ IF(IMAT(N) .LE. 0) GO TO 500
+ IF(NCORN(N) .GT. 5) THEN
+ DO M=1,NCORN(N)-1,2
+ DO MM=M,NCORN(N)-1,2
+ D1=EREF-WD(NOP(N,M))
+ D2=EREF-WD(NOP(N,MM))
+ if(d1 .lt. 0.0) d1=0.0
+ if(d2 .lt. 0.0) d2=0.0
+ DMEAN=(D1+D2)/2.
+ if(DMEAN .LE. 1.) DMEAN=1.0
+ EDIF(N)=MAX(ABS(D1-D2)/DMEAN,EDIF(N))
+ ENDDO
+ ENDDO
+ ELSE
+ IF(I4 .EQ. 0) THEN
+ D1=EREF-WD(NOP(N,1))
+ D2=EREF-WD(NOP(N,3))
+ IF(D1 .LT. 0. .OR. D2 .LT. 0.) THEN
+ CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
+ 'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
+ if(WInfoDialog(4) .eq. 0) then
+ RETURN
+ else
+ IF(D1 .LT. 0.) D1=1.0
+ IF(D2 .LT. 0.) D2=1.0
+ endif
+ ENDIF
+
+ DMEAN=(D1+D2)/2.
+ if(DMEAN .LE. 1.) DMEAN=1.0
+ EDIF(N)=ABS(D1-D2)/DMEAN
+ ELSE
+ if(icrin .eq. 0) then
+ CALL WMessageBox(0, 4, 1,'Cross-section data not loaded '//CHAR(13)// &
+ 'Click OK start again','ERROR GETTING NO SECTION DATA')
+ RETURN
+ endif
+ N1=NOP(N,1)
+ N2=NOP(N,3)
+ BT1= &
+ CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
+ CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
+ BT2= &
+ CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
+ CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
+ H1=WIDEL-BT1
+ H2=WIDEL-BT2
+ IF(H1 .LT. 0. .OR. H2 .LT. 0.) THEN
+ CALL WMessageBox(1, 4, 1,'Depth negative '//CHAR(13)// &
+ 'Click OK to continue with depth=1.'//CHAR(13)//'Click Cancel to start again','ERROR GETTING SECTION DATA')
+ if(WInfoDialog(4) .eq. 0) then
+ RETURN
+ else
+ IF(H1 .LT. 0.) H1=1.0
+ IF(H2 .LT. 0.) H2=1.0
+ endif
+ ENDIF
+ CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
+ CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
+ IF(I4 .EQ. 1) THEN
+ EDIF(N)=ABS(WR1-WR2)*2./(WR1+WR2)
+ ELSE
+ EDIF(N)=ABS(AR1-AR2)*2./(AR1+AR2)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ IF(EDIF(N) .GT. EMAX) EMAX=EDIF(N)
+ 500 CONTINUE
+ ENDDO
+ NUMV=11
+ CONTUR(1)=0.
+ DO K=2,11
+ CONTUR(K)=EMAX/10.+CONTUR(K-1)
+ ENDDO
+
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ ICOL=EDIF(N)*10./EMAX+.999
+ icll=itran(icol)
+ CALL FILLEMC(N,ICLL)
+ ENDIF
+ ENDDO
+ XLEG=8.8
+ YLEG=7.4
+
+ CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
+
+ ENDIF
+ EDIF(0)=EMAX
+ CALL WMenuSetState(ID_SECGRP,ItemEnabled,1)
+ FLUSH(90)
+ IF(I3 .EQ. 1) RETURN
+
+ CALL PLOTOT(0)
+ CALL HEDR
+ RETURN
+ END
+
+
+ SUBROUTINE GETCHOPT(I1,I2,I3,I4,EREF,WIDEL)
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ include 'd.inc'
+ SAVE
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: I1,I2,I3,I4,I4A,ITIME,IPOS
+
+ REAL :: WIDEL
+
+ REAL :: EREF
+
+ data itime/0/
+
+ IF(ITIME .EQ. 0) THEN
+ EREF=0.
+ WIDEL=0.
+ itime=1.
+ I4=0
+ ENDIF
+
+ call wdialogload(IDD_CHKOPT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_CHKOPT)
+ ierr=infoerror(1)
+
+ I4A=I4
+ IF(I4 .GT. 0) I4A=1
+ call wdialogputCheckBox(idf_check1,I1)
+ call wdialogputCheckBox(idf_check2,I4A)
+ if(i2 .eq. 1) then
+ CALL WDialogPutRadioButton(IDF_RADIO1)
+ elseif(i3 .eq. 1) then
+ CALL WDialogPutRadioButton(IDF_RADIO2)
+ endif
+ CALL WDialogPutReal(IDF_REAL1,EREF)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialogGetCheckBox(idf_check1,I1)
+ call wdialogGetCheckBox(idf_check2,I4A)
+ call wdialogGetRadioButton(idf_radio1,IPOS)
+ IF(IPOS .EQ. 1) THEN
+ I2=1
+ I3=0
+ ELSEIF(IPOS .EQ. 2) THEN
+ I2=0
+ I3=1
+ ELSE
+ I2=0
+ I3=0
+ ENDIF
+ CALL WDialoggetReal(IDF_REAL1,EREF)
+ GO TO 100
+
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ I1=-1
+ I2=0
+ I3=0
+ WRITE(90,*) 'CANCEL',I1,I2,I3,I4A
+ return
+ ENDIF
+
+ enddo
+ 100 CONTINUE
+ WRITE(90,*) 'IN CHKOPT',I1,I2,I3,I4A
+
+ IF(I4A .NE. 0) THEN
+ call wdialogload(IDD_CHK1DOPT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_CHK1DOPT)
+ ierr=infoerror(1)
+
+ if(i4 .le. 1) then
+ CALL WDialogPutRadioButton(IDF_RADIO1)
+ elseif(i4 .eq. 2) then
+ CALL WDialogPutRadioButton(IDF_RADIO2)
+ endif
+ CALL WDialogPutReal(IDF_REAL1,WIDEL)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialogGetRadioButton(idf_radio1,I4)
+ CALL WDialogGetReal(IDF_REAL1,WIDEL)
+
+ WRITE(90,*) 'OUT OF CHKOPT',I1,I2,I3,I4A
+ return
+
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+
+ I4=0
+ I4A=0
+
+ ENDIF
+
+ enddo
+
+ ENDIF
+ WRITE(90,*) 'OUT OF CHKOPT',I1,I2,I3,I4A
+ return
+ end
+
\ No newline at end of file
diff --git a/src/src83e/ASSIGNEQ.f90 b/src/src83e/ASSIGNEQ.f90
new file mode 100644
index 0000000..497f782
--- /dev/null
+++ b/src/src83e/ASSIGNEQ.f90
@@ -0,0 +1,33 @@
+ SUBROUTINE ASSIGNEQ
+
+ USE BLK1MOD
+ USE BLKELTLD
+ COMMON XCEN(5000),YCEN(5000)
+ DIST(I,J)=(XYCEL(I,1)-XCEN(J))**2+(XYCEL(I,2)-YCEN(J))**2
+ VOID=1.E20
+
+! get centroids of mesh
+ XCEN=VOID
+ YCEN=VOID
+ DO J=1,NE
+ CALL GETXCL(J,XCJ,YCJ)
+ XCEN(J)=XCJ
+ YCEN(J)=YCJ
+ ENDDO
+
+! test for nearest centroid
+ DO I=1,NQHYD
+ NCLINE(I)=0
+ DISTM=VOID
+ DO J=1,NE
+ IF(XCEN(J) .GE. VOID) CYCLE
+ IF(DIST(I,J) .LT. DISTM) THEN
+ DISTM=DIST(I,J)
+ NCLINE(I)=J
+ ENDIF
+ ENDDO
+ WRITE(103,6001) NCLINE(I),ILAYRE(1,NQHYD),HAE(1,I),(HDE(1,I,K),K=1,3)
+6001 FORMAT('EFE',5X,2I8,7X,'1',F8.3,3F8.2,7X,'1')
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/BFILES.I90 b/src/src83e/BFILES.I90
new file mode 100644
index 0000000..3e14d2f
--- /dev/null
+++ b/src/src83e/BFILES.I90
@@ -0,0 +1,9 @@
+ INTEGER :: NBKFL,ISWBKFL,IACTVFIL,ITOTFIL,I3DVIEW,IRDONE
+ REAL :: BFMINMAX
+ CHARACTER(LEN=255) :: BFNAME,BFNAMR,FNAMKEP,DIRECT
+ CHARACTER(LEN=48) :: FNAMEDISP
+ COMMON /BFLSI/ NBKFL,ISWBKFL(10),I3DVIEW,IRDONE
+ COMMON /BFLSR/ BFMINMAX(10,4)
+ COMMON /BFLSC/ BFNAME(10),BFNAMR(10),FNAMKEP,DIRECT,FNAMEDISP
+ CHARACTER(LEN=255) :: FNAMEOUT
+ COMMON /RSTOR/ IACTVFIL,ITOTFIL,FNAMEOUT(10)
diff --git a/src/src83e/BLK1.f90 b/src/src83e/BLK1.f90
new file mode 100644
index 0000000..539c563
--- /dev/null
+++ b/src/src83e/BLK1.f90
@@ -0,0 +1,123 @@
+ MODULE BLK1MOD
+
+ INCLUDE 'PARAM.COM'
+! BLK1
+!-
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ INTEGER MAXP,MAXE,MAXLIN,MAXSTO,MAXECON,MAXLN,MAELN
+
+
+ INTEGER*2 INSKP,IESKP,INEW,NCORN,IJUN,ISWTAGN,iswtintp
+!IPK MAY02 INTEGER*2 NOP,IMAT,IEM,NEF,NEFLAG,LINTYP,LAY
+ INTEGER*2 IMAT,LINTYP,LAY,IRTYP
+ INTEGER*4 NOP,IEM,NEF,NEFLAG,ILINEL
+! REAL*8 CORD,XUSR,YUSR,XC,YC,CMAP,XMAP,YMAP,pscale,xref,yref
+ REAL*8 CORD,XUSR,YUSR,XC,YC,pscale,xref,yref
+ REAL*8 ALXX,ALYY,ALWD,BLXX,BLYY,BLWD,XBRLEN,CNX,CNY,WIDTHD,HLEFT,HMID,HRIGHT,HSET
+
+ INTEGER*2 MSN
+ ALLOCATABLE MSN(:)
+
+
+ ALLOCATABLE CORD(:,:),XUSR(:),YUSR(:),XC(:),YC(:),IRTYP(:)&
+ ,NOP(:,:),IMAT(:),THTA(:),IMATL(:),CORDSN(:,:)&
+ ,WD(:) ,WD1(:),INSKP(:), IESKP(:),NCORN(:)&
+ ,WIDTH(:), SS1(:), SS2(:), WIDS(:)&
+ ,IJUN(:),INEW(:),IEM(:),LINTYP(:),NEFLAG(:),NEF(:,:),LAY(:),WTLAY(:,:)&
+ ,WIDBS(:),SSO(:),NODDEL(:),IELDEL(:)&
+ ,NOPSV(:,:),nefsv(:,:),IMATSV(:),LOCK(:),BS1(:),NKEY1(:),EDIF(:),ANGOP(:)&
+ ,IGRPNUM(:,:),MAXENT(:),IGRPSER(:),IUSEDM(:),IOD(:)&
+ ,ALXX(:),ALYY(:),BLXX(:),BLYY(:),ALWD(:),BLWD(:),ITYPBC(:),CNX(:,:),CNY(:,:),XBRLEN(:)&
+ ,HLEFT(:),HMID(:),HRIGHT(:),HSET(:,:),WIDTHD(:)
+ ALLOCATABLE NRF(:),AREF(:),LEVREM(:),TRANSEL(:),WLEN(:),WHGT(:)
+ INTEGER*8 MAXPTS
+ COMMON /BLK/ MAXPTS,PSCALE,xref,yref&
+ , IPNN, IPEN, XMIN, YMIN, XMAX, YMAX, NLAYD,ILAYTP&
+ ,VOID, VDX, XSCALE, YSCALE,AMAP,IRESTT&
+ ,NXPMIN, NYPMIN, NXPMAX, NYPMAX, IPP&
+ ,XPMIN, YPMIN, XPMAX, YPMAX, WDSCAL,IESW&
+ ,NPLAST,NELAST,NEFL,NENTRY,IECHG,ICHG&
+ ,IIN, IBAK, LUNIT,IGIN,IS11,IMP,IGFG,ISWAP,ITRIAN&
+ ,klint,jlint,lmpnam,IDELV,nmapf,NSIGF,NPUNDO,NEUNDO,nefsav,nesav&
+ ,xadded,yadded,icolsw,rad,colint,ielvsw,ISWTAGN,iswtintp,eref,igrp,igrpout,MAXIGRP&
+ ,JPTSB,ILINEL
+!IPK MAR02 ADD BS1
+!IPK FEB02 ADD LOCK
+!IPK MAY01 ADD NODDEL AND IELDEL
+!IPK JUL98 WIDBS AND SSO ADDED
+!IPK JAN98 IDELV ADDED
+!ipk feb94 line above added, two lines changed may 94 to add xref,yref
+! 9 ,LINTYP(MAXLIN),NEFLAG(150),NEF(600,3),LAY(MAXP)
+!
+!IPK MAR04 INTEGER*2 ILIST,LLIST
+ INTEGER*4 ILIST,LLIST
+
+ ALLOCATABLE ILIST(:,:),LLIST(:)
+ COMMON /BLK1/ NLST, ICCLN(140,350),NCLM
+!
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+!ipk feb94 add
+ character*40 mpnam
+!ipk dec97 line above modified
+
+ CHARACTER*1 ALABL(10)
+ COMMON /BLKA1/ TITLE,HLABL,ALABL,MPNAM
+!ipk dec97 line above modified
+!
+!IPK JAN01 INCREASE IPSW TO 10
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!ycw mar97 add
+ COMMON /CROSS/ ICRS,XPCS(2),YPCS(2),NCSNOD,XCND(50),YCND(50),&
+ NCSPTS,XELVP(50),YELVP(50),ZELVP(50),SELVP(50),&
+ ZREF,DFACTOR,ZMIN,IXNOD,LCROSS&
+ ,IVMIL(MCRS),NRIVL(MCRS),NOREACH(MCRS)&
+ ,CRSDAT(MCRS,MPTS,3),NCRSEC,XCRS(MCRS),YCRS(MCRS)
+
+ ALLOCATABLE NRIVCR1(:),WTRIVCR1(:),NRIVCR2(:),WTRIVCR2(:)
+
+!NRIVCR1(MAXP),WTRIVCR1(MAXP)&
+! ,NRIVCR2(MAXP),WTRIVCR2(MAXP),
+
+ LOGICAL LCROSS
+
+ COMMON /UNITS/IOT,IOT1
+
+ COMMON /INTERPL/ IGRID(MAXGRD,MAXGRD),NX,NY,XGRID,YGRID
+
+ real*8 xusrsto,yusrsto
+ INTEGER*2 IMATSTO
+
+ ALLOCATABLE xusrsto(:,:),yusrsto(:,:),wdsto(:,:),&
+ WIDTHsto(:,:), SS1sto(:,:), SS2sto(:,:), WIDSsto(:,:)&
+ ,WIDBSsto(:,:),SSOsto(:,:),bs1sto(:,:)&
+ ,nopsto(:,:,:),imatsto(:,:),thtasto(:,:)
+
+! loaded/ xusrsto(maxp,maxsto),yusrsto(maxp,maxsto),wdsto(maxp,maxsto),&
+! WIDTHsto(MAXP,maxsto), SS1sto(MAXP,maxsto), SS2sto(MAXP,maxsto), WIDSsto(MAXP,maxsto)&
+! ,WIDBSsto(MAXP,maxsto),SSOsto(MAXP,maxsto),bs1sto(maxp,maxsto)&
+! ,nopsto(maxe,8,maxsto),imatsto(maxe,maxsto),thtasto(maxe,maxsto)
+
+ ALLOCATABLE ICCLNSTO(:,:,:)&
+ ,NPSTO(:),NESTO(:),NLSTSTO(:),NCLMSTO(:)
+
+
+ INTEGER*4 ILISTSTO,LLISTSTO
+ ALLOCATABLE ILISTSTO(:,:,:),LLISTSTO(:,:)
+
+ COMMON /TMPLIST/ ilisttmp(100),INREORD
+
+ ALLOCATABLE ICN(:)
+
+ ALLOCATABLE ICONNCT(:,:),NKEP(:)
+
+ ALLOCATABLE IOUTLST(:,:),NOUTLST(:),XOUT(:,:),YOUT(:,:)
+
+ COMMON /VIEWS/ HANG,VANG,VRTSCAL,HANGOLD,VANGOLD,VRTORIG,IASPCT
+
+ INTEGER KID(900,5)
+
+
+ END MODULE
\ No newline at end of file
diff --git a/src/src83e/BLK1OLD.COM b/src/src83e/BLK1OLD.COM
new file mode 100644
index 0000000..ce4fbc1
--- /dev/null
+++ b/src/src83e/BLK1OLD.COM
@@ -0,0 +1,85 @@
+
+
+ INCLUDE 'PARAM.COM'
+! BLK1
+!-
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+
+ INTEGER*2 INSKP,IESKP,INEW,NCORN,IJUN,ISWTAGN,iswtintp
+!IPK MAY02 INTEGER*2 NOP,IMAT,IEM,NEF,NEFLAG,LINTYP,LAY
+ INTEGER*2 IMAT,LINTYP,LAY
+ INTEGER*4 NOP,IEM,NEF,NEFLAG
+! REAL*8 CORD,XUSR,YUSR,XC,YC,CMAP,XMAP,YMAP,pscale,xref,yref
+ REAL*8 CORD,XUSR,YUSR,XC,YC,pscale,xref,yref
+!
+ COMMON /BLK/ CORD(MAXP,2),XUSR(MAXP),YUSR(MAXP),XC(MAXP),YC(MAXP)&
+ ,PSCALE,xref,yref&
+ , IPNN, IPEN, XMIN, YMIN, XMAX, YMAX, NLAYD,ILAYTP&
+ ,VOID, VDX, XSCALE, YSCALE,AMAP,IRESTT&
+ ,NXPMIN, NYPMIN, NXPMAX, NYPMAX, IPP&
+ ,XPMIN, YPMIN, XPMAX, YPMAX, WDSCAL,IESW&
+ ,MAXPTS,NPLAST,NELAST,NEFL,NENTRY,IECHG,ICHG&
+ ,NOP(MAXE,8),IMAT(MAXE),THTA(MAXE),IMATL(MAXE),CORDSN(MAXP,2)&
+ ,WD(MAXP) ,WD1(MAXP) ,INSKP(MAXP), IESKP(MAXE)&
+ ,NCORN(MAXP),IIN, IBAK, LUNIT,IGIN,IS11,IMP,IGFG,ISWAP,ITRIAN&
+ ,WIDTH(MAXP), SS1(MAXP), SS2(MAXP), WIDS(MAXP)&
+ ,IJUN(MAXP),INEW(MAXP),IEM(MAXE)&
+ ,LINTYP(MAXLIN),NEFLAG(MAXP),NEF(MAXP,3),LAY(0:MAXP+1),WTLAY(0:MAXP,9)&
+ ,klint,jlint,lmpnam,IDELV&
+ ,WIDBS(MAXP),SSO(MAXP),nmapf,NSIGF,NODDEL(MAXP),IELDEL(MAXE)&
+ ,NPUNDO,NEUNDO,NOPSV(MAXE,8),nesav,nefsv(maxp,3),nefsav,IMATSV(MAXE)&
+ ,LOCK(MAXP),xadded,yadded,BS1(MAXP),icolsw,rad,colint,ielvsw,ISWTAGN,iswtintp
+!IPK MAR02 ADD BS1
+!IPK FEB02 ADD LOCK
+!IPK MAY01 ADD NODDEL AND IELDEL
+!IPK JUL98 WIDBS AND SSO ADDED
+!IPK JAN98 IDELV ADDED
+!ipk feb94 line above added, two lines changed may 94 to add xref,yref
+! 9 ,LINTYP(MAXLIN),NEFLAG(150),NEF(600,3),LAY(MAXP)
+!
+!IPK MAR04 INTEGER*2 ILIST,LLIST
+ INTEGER*4 ILIST,LLIST
+ COMMON /BLK1/ ILIST(MAXLN,MAELN),LLIST(MAXLN),NLST&
+ , ICCLN(50,350),NCLM
+!
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+!ipk feb94 add
+ character*40 mpnam
+!ipk dec97 line above modified
+
+ CHARACTER*1 ALABL(10)
+ COMMON /BLKA1/ TITLE,HLABL,ALABL,MPNAM
+!ipk dec97 line above modified
+!
+!IPK JAN01 INCREASE IPSW TO 10
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!ycw mar97 add
+ COMMON /CROSS/ ICRS,XPCS(2),YPCS(2),NCSNOD,XCND(50),YCND(50),&
+ NCSPTS,XELVP(50),YELVP(50),ZELVP(50),SELVP(50),&
+ ZREF,DFACTOR,ZMIN,IXNOD,LCROSS&
+ ,IVMIL(MCRS),NRIVL(MCRS),NOREACH(MCRS)&
+ ,CRSDAT(MCRS,MPTS,3),NRIVCR1(MAXP),WTRIVCR1(MAXP)&
+ ,NRIVCR2(MAXP),WTRIVCR2(MAXP),NCRSEC,XCRS(MCRS),YCRS(MCRS)
+ LOGICAL LCROSS
+
+ COMMON /UNITS/IOT,IOT1
+
+ COMMON /INTERPL/ IGRID(MAXGRD,MAXGRD),NX,NY,XGRID,YGRID
+
+ real*8 xusrsto,yusrsto
+ INTEGER*2 IMATSTO
+ common /loaded/ xusrsto(maxp,maxsto),yusrsto(maxp,maxsto),wdsto(maxp,maxsto),&
+ WIDTHsto(MAXP,maxsto), SS1sto(MAXP,maxsto), SS2sto(MAXP,maxsto), WIDSsto(MAXP,maxsto)&
+ ,WIDBSsto(MAXP,maxsto),SSOsto(MAXP,maxsto),bs1sto(maxp,maxsto)&
+ ,nopsto(maxe,8,maxsto),imatsto(maxe,maxsto),thtasto(maxe,maxsto)&
+ ,ICCLNSTO(50,350,MAXSTO)&
+ ,NPSTO(MAXSTO),NESTO(MAXSTO),NLSTSTO(MAXSTO),NCLMSTO(MAXSTO)
+
+
+ INTEGER*4 ILISTSTO,LLISTSTO
+ COMMON /LOADED2/ ILISTSTO(MAXLN,MAELN,MAXSTO),LLISTSTO(MAXLN,MAXSTO)
+
+ COMMON /TMPLIST/ ilisttmp(100),INREORD
\ No newline at end of file
diff --git a/src/src83e/BLK2.COM b/src/src83e/BLK2.COM
new file mode 100644
index 0000000..740bd0d
--- /dev/null
+++ b/src/src83e/BLK2.COM
@@ -0,0 +1,23 @@
+!IPK LAST UPDATED OCT 18 1996
+!
+! BLK2
+!
+ INTEGER*8 MTSUM,MRSUM,MTSUMSV,MSUM
+ COMMON /BLKKB4/MTSUM,MRSUM,MTSUMSV(0:100),MSUM
+ INTEGER ENXT,NCM,NCMI,KNT,NDP,NNEW,MP,NAD,NAE,MLIST,NDELM &
+ ,LIST,NINC,LNEW,NDROP,NELIM,NITST,NFWSAV,MTSUM1,NSEQ,NFWSV
+ COMMON /BLKB/ NCM,NCMI,KNT,NDP,NNEW,MP,NAD,NAE &
+ ,MLIST(MAXE),ENXT(MAXE),NDELM(MAXP),LIST(MAXP) &
+ ,NINC(MAXP),LNEW(8),NDROP(8),NELIM(MAXE),NITST &
+ ,NFWS,NFWSAV,mtsum1,NSEQ,NFWSV(0:100)
+!IPK MAY94 LINE ABOVE ADDED
+!
+ INTEGER ICON
+ COMMON /BLKB1/ ICON(MAXE,MAXECON)
+!
+ INTEGER NECON
+ COMMON /BLKB2/ NECON(MAXP,MAXECON)
+!
+ INTEGER ITRAC,NTRAC
+ COMMON /BLKB3/ ITRAC(350),NTRAC,JTRAC(350),KTRAC(350)
+!
\ No newline at end of file
diff --git a/src/src83e/BLK2MOD.F90 b/src/src83e/BLK2MOD.F90
new file mode 100644
index 0000000..811cf15
--- /dev/null
+++ b/src/src83e/BLK2MOD.F90
@@ -0,0 +1,30 @@
+ MODULE BLK2MOD
+
+!IPK LAST UPDATED OCT 18 1996
+!
+! BLK2
+!
+ INTEGER*8 MTSUM,MRSUM,MTSUMSV,MSUM,MTSUM1
+ COMMON /BLKKB4/MTSUM,MRSUM,MTSUMSV(0:100),MSUM
+ INTEGER ENXT,NCM,NCMI,KNT,NDP,NNEW,MP,NAD,NAE,MLIST,NDELM &
+ ,LIST,NINC,LNEW,NDROP,NELIM,NITST,NFWSAV,NSEQ,NFWSV
+ COMMON /BLKB/ mtsum1,NCM,NCMI,KNT,NDP,NNEW,MP,NAD,NAE &
+ ,LNEW(8),NDROP(8),NITST &
+ ,NFWS,NFWSAV,NSEQ,NFWSV(0:100)
+!IPK MAY94 LINE ABOVE ADDED
+
+ ALLOCATABLE MLIST(:),ENXT(:),NDELM(:),LIST(:) &
+ ,NINC(:),NELIM(:)
+
+!
+ INTEGER ICON
+ ALLOCATABLE ICON(:,:)
+!
+ INTEGER NECON
+ ALLOCATABLE NECON(:,:)
+!
+ INTEGER ITRAC,NTRAC,NTRACT
+ COMMON /BLKB3/ ITRAC(1000),NTRAC,JTRAC(1000),KTRAC(1000)
+!
+ END MODULE
+
\ No newline at end of file
diff --git a/src/src83e/BLKELTLD.F90 b/src/src83e/BLKELTLD.F90
new file mode 100644
index 0000000..eb21fdc
--- /dev/null
+++ b/src/src83e/BLKELTLD.F90
@@ -0,0 +1,6 @@
+ MODULE BLKELTLD
+ REAL DYE,TAE,HAE,XYCEL
+ INTEGER NCLINE,NEST,IYDATE,NHYE,IQUENIT,IBINEL,NQHYD,NQP,IRMATYP
+ ALLOCATABLE DYE(:,:),TAE(:,:),HAE(:,:),NCLINE(:),NEST(:),IYDATE(:),NHYE(:),ILAYRE(:,:),HDE(:,:,:),XYCEL(:,:)
+
+ END
\ No newline at end of file
diff --git a/src/src83e/BLKMAP.COM b/src/src83e/BLKMAP.COM
new file mode 100644
index 0000000..a7b70e2
--- /dev/null
+++ b/src/src83e/BLKMAP.COM
@@ -0,0 +1,14 @@
+
+ PARAMETER (MAXPL=500000,MAXELMP=50000)
+
+ REAL*8 XCEN,YCEN,RADS,MAP,XMAP,YMAP,CMAP
+
+ COMMON /MAPBLK/ NOPEL(MAXELMP,3),XCEN(MAXELMP),YCEN(MAXELMP)&
+ ,RADS(MAXELMP) ,NKEY(MAXELMP),IEDGE(500,2),IGAP(500),CMAP(MAXPL,2)&
+ ,XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL),NELFM(500)
+
+
+ COMMON /MAPINFO/ NELTS
+
+ common /mapc/imap(maxpl),NCRS(MAXPL)
+
diff --git a/src/src83e/BRKDWN.F90 b/src/src83e/BRKDWN.F90
new file mode 100644
index 0000000..3f5039b
--- /dev/null
+++ b/src/src83e/BRKDWN.F90
@@ -0,0 +1,856 @@
+!ipk lsdt update nov 10 1995
+ SUBROUTINE BRKDWN(NCN,NELNO)
+! SUBROUTINE BRKDWN(X,Y,VL,NCN)
+ SAVE
+ DOUBLE PRECISION XN,XLN,YLN,XLP,YLP
+ PARAMETER (NTB=100)
+!
+! Routine to subdivide quadrilaterals and triangles for plotting
+!
+!ipkoct93 COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ COMMON /PLTC/IPSAV,IFLG,XLL,YLL
+ LOGICAL SWITCH
+!
+! DIMENSION X(10),Y(10),VL(10)
+ COMMON /BRK/ X(10),Y(10),VL(10),DL(10),VLM(10)
+ DIMENSION IQ(3,8),RIX(3,8),RIY(3,8)
+ DIMENSION IT(3,4),ZIX(3,4),ZIY(3,4)
+ DIMENSION IST(3,3)
+ DIMENSION CX(3,NTB),CY(3,NTB),VAL(3,NTB),XLC(3,NTB),YLC(3,NTB)
+ DIMENSION ISPLT(3),XP(6),YP(6),VP(6),XLP(6),YLP(6)
+ DATA IQ / 1, 2, 9, 2, 3, 4, 2, 4, 9, 4, 5, 9,&
+ 1, 9, 8, 8, 9, 6, 8, 6, 7, 9, 5, 6/
+ DATA RIX/ -1.,0.,0., 0.,1.,1., 0.,1.,0., 1.,1.,0.,&
+ -1.,0.,-1., -1.,0.,0., -1.,0.,-1., 0.,1.,0./
+ DATA RIY/ -1.,-1.,0., -1.,-1.,0., -1.,0.,0., 0.,1.,0.,&
+ -1.,0.,0., 0.,0.,1., 0.,1.,1., 0.,1.,1./
+ DATA IT / 1, 2, 6, 3, 4, 2, 5, 6, 4, 2, 4, 6/
+ DATA ZIX/0.,.5,0., 1.,.5,.5, 0.,0.,.5, .5,.5,0./
+ DATA ZIY/0.,0.,.5, 0.,.5,0., 1.,.5,.5, 0.,.5,.5/
+ DATA IST/ 1,4,5, 4,2,5, 1,5,3/
+! DATA XCSQ/1.0/
+!
+! Distance function squared
+!
+ DISTSQ(AX,AY,BX,BY)=(AX-BX)**2+(AY-BY)**2
+
+! do n=1,ncn
+! write(90,*) n,x(n),y(n),vl(n)
+! enddo
+ IF(NCN .LT. 6) THEN
+ CALL EXPND(NCN,NELNO)
+ ENDIF
+
+ XCSQ=0.25
+!
+! If NCN = 3 then copy over values
+!
+ IF(NCN .EQ. 3) THEN
+ ITT=-1
+ DO 180 L=1,3
+ CX(L,1)=X(L)
+ CY(L,1)=Y(L)
+ VAL(L,1)=VL(L)
+ 180 CONTINUE
+ XLC(1,1)=0.
+ XLC(2,1)=1.
+ XLC(3,1)=0.
+ YLC(1,1)=0.
+ YLC(2,1)=0.
+ YLC(3,1)=0.
+ NTAB=1
+!
+! Subdivide quadrilateral to 2 triangles and develop list
+!
+ ELSEIF(NCN .EQ. 4) THEN
+ ITT=0
+ DO 190 I=1,3
+ X(I+4)=X(I)
+ Y(I+4)=Y(I)
+ VL(I+4)=VL(I)
+ 190 CONTINUE
+!
+! Pick long side for diagonal
+!
+ IF (DISTSQ(X(1),Y(1),X(3),Y(3)) .GT. DISTSQ(X(2),Y(2),X(4),Y(4))) THEN
+!
+! Rotate if its longer
+!
+ DO 200 I=1,5
+ X(I)=X(I+1)
+ Y(I)=Y(I+1)
+ VL(I)=VL(I+1)
+ 200 CONTINUE
+ ENDIF
+!
+! Now process it
+!
+ DO 210 L=1,3
+ CX(L,1)=X(L)
+ CY(L,1)=Y(L)
+ VAL(L,1)=VL(L)
+ 210 CONTINUE
+ XLC(1,1)=-1.
+ XLC(2,1)=1.
+ XLC(3,1)=1.
+ YLC(1,1)=-1.
+ YLC(2,1)=-1.
+ YLC(3,1)=1.
+ DO 220 L=1,3
+ CX(L,2)=X(L+2)
+ CY(L,2)=Y(L+2)
+ VAL(L,2)=VL(L+2)
+ 220 CONTINUE
+ XLC(1,2)=1.
+ XLC(2,2)=-1.
+ XLC(3,2)=-1.
+ YLC(1,2)=1.
+ YLC(2,2)=1.
+ YLC(3,2)=-1.
+ NTAB=2
+!
+! Subdivide 6 node triangle to 4 triangles and develop list
+!
+ ELSEIF(NCN .EQ. 6) THEN
+ ITT=2
+! write(90,*) (x(i),i=1,8)
+ DO 300 K=1,4
+ DO 280 L=1,3
+ CX(L,K)=X(IT(L,K))
+ CY(L,K)=Y(IT(L,K))
+ VAL(L,K)=VL(IT(L,K))
+ XLC(L,K)=ZIX(L,K)
+ YLC(L,K)=ZIY(L,K)
+ 280 CONTINUE
+ 300 CONTINUE
+ NTAB=4
+!
+! Subdivide 8 node quadrilateral to 8 triangles and develop list
+!
+ ELSEIF(NCN .GE. 8) THEN
+ IF(NCN .EQ. 8) THEN
+ ITT=1
+ ELSE
+ ITT=0
+ X9=X(9)
+ Y9=Y(9)
+ VL9=VL(9)
+ ENDIF
+ DO 310 I=1,2
+ X(I+8)=X(I)
+ Y(I+8)=Y(I)
+ VL(I+8)=VL(I)
+ 310 CONTINUE
+!
+! Pick long side for diagonal
+!
+ IF (DISTSQ(X(1),Y(1),X(5),Y(5)) .GT. &
+ DISTSQ(X(3),Y(3),X(7),Y(7))) THEN
+!
+! Rotate if its longer
+!
+ DO 320 I=1,8
+ X(I)=X(I+2)
+ Y(I)=Y(I+2)
+ VL(I)=VL(I+2)
+ 320 CONTINUE
+ ENDIF
+!
+! Define center point
+!
+ IF(NCN .LT. 9) THEN
+ X(9)=0.
+ Y(9)=0.
+ VL(9)=0.
+ DO 360 I=1,8
+ SH=XN(ITT,I,0.d0,0.d0)
+ X(9)=X(9)+SH*X(I)
+ Y(9)=Y(9)+SH*Y(I)
+ VL(9)=VL(9)+SH*VL(I)
+ 360 CONTINUE
+ ELSE
+ X(9)=X9
+ Y(9)=Y9
+ VL(9)=VL9
+ ENDIF
+ DO 400 K=1,8
+ DO 380 L=1,3
+ CX(L,K)=X(IQ(L,K))
+ CY(L,K)=Y(IQ(L,K))
+ VAL(L,K)=VL(IQ(L,K))
+ XLC(L,K)=RIX(L,K)
+ YLC(L,K)=RIY(L,K)
+ 380 CONTINUE
+ 400 CONTINUE
+ NTAB=8
+ ENDIF
+!
+! Start at bottom of list
+!
+ 420 CONTINUE
+ N=NTAB
+!
+! Check lengths of sides and nore values
+!
+ ISTART=0
+ ICNT=0
+ IF(DISTSQ(CX(1,N),CY(1,N),CX(2,N),CY(2,N)) .GT. XCSQ) THEN
+ ICNT=1
+ ISPLT(1)=1
+ ISTART=1
+ ELSE
+ ISPLT(1)=0
+ ENDIF
+ IF(DISTSQ(CX(2,N),CY(2,N),CX(3,N),CY(3,N)) .GT. XCSQ) THEN
+ ICNT=ICNT+1
+ ISPLT(2)=1
+ ISTART=2
+ ELSE
+ ISPLT(2)=0
+ ENDIF
+ IF(DISTSQ(CX(3,N),CY(3,N),CX(1,N),CY(1,N)) .GT. XCSQ) THEN
+ ICNT=ICNT+1
+ ISPLT(3)=1
+ ISTART=3
+ ELSE
+ ISPLT(3)=0
+ ENDIF
+ IF(ICNT .EQ. 0) THEN
+!
+! Call to plot contours for each triangle
+!
+ IF(IPSAV .EQ. 0) THEN
+ CALL CBLOK(CX(1,N),CY(1,N),VAL(1,N))
+ ELSE
+ CALL CONTRD(CX(1,N),CY(1,N),VAL(1,N))
+ ENDIF
+ NTAB=N-1
+ IF(NTAB .EQ. 0) THEN
+ RETURN
+ ELSE
+ GO TO 420
+ ENDIF
+ ELSEIF(ICNT .EQ. 1) THEN
+!
+! We must split the triangle into 2. Rotate first into temporary array.
+!
+ IF(NTAB .GT. NTB-1) THEN
+ WRITE(*,*) 'ELEMENT TABLE SIZE EXCEEDED PLOT CURTAILED'
+ RETURN
+ ENDIF
+ DO 440 I=1,3
+ J=MOD(ISTART+I-2,3)+1
+ XP(I)=CX(J,N)
+ YP(I)=CY(J,N)
+ VP(I)=VAL(J,N)
+ XLP(I)=XLC(J,N)
+ YLP(I)=YLC(J,N)
+ 440 CONTINUE
+ XLN=(XLP(1)+XLP(2))/2.
+ YLN=(YLP(1)+YLP(2))/2.
+ XNEW=0.
+ YNEW=0.
+ VNEW=0.
+ DO 460 I=1,NCN
+ SH=XN(ITT,I,XLN,YLN)
+ XNEW=XNEW+SH*X(I)
+ YNEW=YNEW+SH*Y(I)
+ VNEW=VNEW+SH*VL(I)
+ 460 CONTINUE
+ CX(1,N)=XP(1)
+ CX(2,N)=XNEW
+ CX(3,N)=XP(3)
+ CY(1,N)=YP(1)
+ CY(2,N)=YNEW
+ CY(3,N)=YP(3)
+ VAL(1,N)=VP(1)
+ VAL(2,N)=VNEW
+ VAL(3,N)=VP(3)
+ XLC(1,N)=XLP(1)
+ XLC(2,N)=XLN
+ XLC(3,N)=XLP(3)
+ YLC(1,N)=YLP(1)
+ YLC(2,N)=YLN
+ YLC(3,N)=YLP(3)
+
+ CX(1,N+1)=XP(2)
+ CX(2,N+1)=XP(3)
+ CX(3,N+1)=XNEW
+ CY(1,N+1)=YP(2)
+ CY(2,N+1)=YP(3)
+ CY(3,N+1)=YNEW
+ VAL(1,N+1)=VP(2)
+ VAL(2,N+1)=VP(3)
+ VAL(3,N+1)=VNEW
+ XLC(1,N+1)=XLP(2)
+ XLC(2,N+1)=XLP(3)
+ XLC(3,N+1)=XLN
+ YLC(1,N+1)=YLP(2)
+ YLC(2,N+1)=YLP(3)
+ YLC(3,N+1)=YLN
+ NTAB=N+1
+ ELSEIF(ICNT .EQ. 2) THEN
+ IF(NTAB .GT. NTB-2) THEN
+ WRITE(*,*) 'ELEMENT TABLE SIZE EXCEEDED PLOT CURTAILED'
+ RETURN
+ ENDIF
+!
+! We must split the triangle into 3. Rotate first into temporary array.
+!
+ IF(ISTART .EQ. 3) THEN
+ IF(ISPLT(1) .EQ. 1) ISTART=3
+ IF(ISPLT(2) .EQ. 1) ISTART=2
+ ELSE
+ ISTART=1
+ ENDIF
+ DO 540 I=1,3
+ J=MOD(ISTART+I-2,3)+1
+ XP(I)=CX(J,N)
+ YP(I)=CY(J,N)
+ VP(I)=VAL(J,N)
+ XLP(I)=XLC(J,N)
+ YLP(I)=YLC(J,N)
+ 540 CONTINUE
+ XLP(4)=(XLP(1)+XLP(2))/2.
+ YLP(4)=(YLP(1)+YLP(2))/2.
+ XLP(5)=(XLP(2)+XLP(3))/2.
+ YLP(5)=(YLP(2)+YLP(3))/2.
+ XP(4)=0.
+ YP(4)=0.
+ VP(4)=0.
+ XP(5)=0.
+ YP(5)=0.
+ VP(5)=0.
+ DO 560 I=1,NCN
+ SH=XN(ITT,I,XLP(4),YLP(4))
+ XP(4)=XP(4)+SH*X(I)
+ YP(4)=YP(4)+SH*Y(I)
+ VP(4)=VP(4)+SH*VL(I)
+ SH=XN(ITT,I,XLP(5),YLP(5))
+ XP(5)=XP(5)+SH*X(I)
+ YP(5)=YP(5)+SH*Y(I)
+ VP(5)=VP(5)+SH*VL(I)
+ 560 CONTINUE
+ N=NTAB-1
+ DO 600 K=1,3
+ N=N+1
+ DO 580 L=1,3
+ CX(L,N)=XP(IST(L,K))
+ CY(L,N)=YP(IST(L,K))
+ VAL(L,N)=VP(IST(L,K))
+ XLC(L,N)=XLP(IST(L,K))
+ YLC(L,N)=YLP(IST(L,K))
+ 580 CONTINUE
+ 600 CONTINUE
+ NTAB=N
+ ELSEIF(ICNT .EQ. 3) THEN
+ IF(NTAB .GT. NTB-3) THEN
+ WRITE(*,*) 'ELEMENT TABLE SIZE EXCEEDED PLOT CURTAILED'
+ RETURN
+ ENDIF
+!
+! We must split the triangle into 4. Fill midsides
+!
+ DO 640 I=1,3
+ XP(2*I-1)=CX(I,N)
+ YP(2*I-1)=CY(I,N)
+ VP(2*I-1)=VAL(I,N)
+ XLP(2*I-1)=XLC(I,N)
+ YLP(2*I-1)=YLC(I,N)
+ 640 CONTINUE
+ XLP(2)=(XLP(1)+XLP(3))/2.
+ YLP(2)=(YLP(1)+YLP(3))/2.
+ XLP(4)=(XLP(3)+XLP(5))/2.
+ YLP(4)=(YLP(3)+YLP(5))/2.
+ XLP(6)=(XLP(5)+XLP(1))/2.
+ YLP(6)=(YLP(5)+YLP(1))/2.
+ XP(2)=0.
+ YP(2)=0.
+ VP(2)=0.
+ XP(4)=0.
+ YP(4)=0.
+ VP(4)=0.
+ XP(6)=0.
+ YP(6)=0.
+ VP(6)=0.
+ DO 660 I=1,NCN
+ SH=XN(ITT,I,XLP(2),YLP(2))
+ XP(2)=XP(2)+SH*X(I)
+ YP(2)=YP(2)+SH*Y(I)
+ VP(2)=VP(2)+SH*VL(I)
+ SH=XN(ITT,I,XLP(4),YLP(4))
+ XP(4)=XP(4)+SH*X(I)
+ YP(4)=YP(4)+SH*Y(I)
+ VP(4)=VP(4)+SH*VL(I)
+ SH=XN(ITT,I,XLP(6),YLP(6))
+ XP(6)=XP(6)+SH*X(I)
+ YP(6)=YP(6)+SH*Y(I)
+ VP(6)=VP(6)+SH*VL(I)
+ 660 CONTINUE
+ N=NTAB-1
+ DO 700 K=1,4
+ N=N+1
+ DO 680 L=1,3
+ CX(L,N)=XP(IT(L,K))
+ CY(L,N)=YP(IT(L,K))
+ VAL(L,N)=VP(IT(L,K))
+ XLC(L,N)=XLP(IT(L,K))
+ YLC(L,N)=YLP(IT(L,K))
+ 680 CONTINUE
+ 700 CONTINUE
+ NTAB=N
+ ENDIF
+ GO TO 420
+!
+ END
+ SUBROUTINE CONTRD(X,Y,V)
+ SAVE
+!
+! Routine to draw contours across triangle
+!
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ LOGICAL SWITCH
+ DIMENSION X(3),Y(3),V(3),XX(2),YY(2)
+!
+! Get VMIN and VMAX
+!
+ VMIN=MIN(V(1),V(2),V(3))
+ VMAX=MAX(V(1),V(2),V(3))
+!
+! Process each contour value
+!
+ DO 500 N=1,NUMV
+!
+! Test if contour lies in range
+!
+ IF(CONTUR(N) .LT. VMIN) GO TO 500
+ IF(CONTUR(N) .GT. VMAX) GO TO 500
+!
+! Its active
+!
+ I=0
+!
+! Look for an intercept V(1) AND V(2)
+!
+ IF(CONTUR(N) .GE. MIN(V(1),V(2)) &
+ .AND. CONTUR(N) .LE. MAX(V(1),V(2))) THEN
+!
+! We have an intercept
+!
+ I=I+1
+ if(v(2) .ne. v(1)) then
+ FACT=(CONTUR(N)-V(1))/(V(2)-V(1))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX(I)=X(1)+FACT*(X(2)-X(1))
+ YY(I)=Y(1)+FACT*(Y(2)-Y(1))
+ ENDIF
+!
+! Look for an intercept V(2) AND V(3)
+!
+ IF(CONTUR(N) .GE. MIN(V(2),V(3)) &
+ .AND. CONTUR(N) .LE. MAX(V(2),V(3))) THEN
+!
+! We have an intercept
+!
+ I=I+1
+ if(v(3) .ne. v(2)) then
+ FACT=(CONTUR(N)-V(2))/(V(3)-V(2))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX(I)=X(2)+FACT*(X(3)-X(2))
+ YY(I)=Y(2)+FACT*(Y(3)-Y(2))
+ IF(I .EQ. 2) GO TO 450
+ ENDIF
+!
+! Look for an intercept V(3) AND V(1)
+!
+ IF(CONTUR(N) .GE. MIN(V(3),V(1)) &
+ .AND. CONTUR(N) .LE. MAX(V(3),V(1))) THEN
+!
+! We have an intercept
+!
+ I=I+1
+ if(v(1) .ne. v(3)) then
+ FACT=(CONTUR(N)-V(3))/(V(1)-V(3))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX(I)=X(3)+FACT*(X(1)-X(3))
+ YY(I)=Y(3)+FACT*(Y(1)-Y(3))
+ ENDIF
+!
+! Test for no intercept *ERROR*
+!
+ IF(I .LT. 2) THEN
+ WRITE(*,*) 'ERROR NO INTERCEPT NOTED, PLOT CURTAILED'
+ WRITE(90,*) ' NON INTERCEPT VALUES ARE'
+ WRITE(90,*) v(1),v(2),v(3),contur(n)
+ RETURN
+ ENDIF
+!
+! Now draw line
+!
+ 450 CONTINUE
+ CALL PLOTT(XX(1),YY(1),3)
+ CALL PLOTT(XX(2),YY(2),2)
+!
+! Go back for next contour
+!
+ 500 CONTINUE
+!
+! We are done
+!
+ RETURN
+ END
+ SUBROUTINE CBLOK(X,Y,V)
+!
+! Given a triangle (X,Y) with values V Draw polygons of the
+! contours in CONTUR that cross the triangle
+!
+ DIMENSION X(3),Y(3),V(3),AX(10),AY(10)
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ LOGICAL SWITCH
+!
+! Sort out order for values of V
+!
+ 200 IF(V(1) .LE. V(2)) THEN
+ IF(V(3) .LT. V(2)) THEN
+ VT=V(2)
+ V(2)=V(3)
+ V(3)=VT
+ XT=X(2)
+ X(2)=X(3)
+ X(3)=XT
+ YT=Y(2)
+ Y(2)=Y(3)
+ Y(3)=YT
+ GO TO 200
+ ENDIF
+ ELSE
+ VT=V(1)
+ V(1)=V(2)
+ V(2)=VT
+ XT=X(1)
+ X(1)=X(2)
+ X(2)=XT
+ YT=Y(1)
+ Y(1)=Y(2)
+ Y(2)=YT
+ GO TO 200
+ ENDIF
+!
+! INITIALIZE
+!
+ IPAN12=0
+ IPAN23=0
+!
+! Loop on contours
+!
+ cjfact=1.001
+ DO 900 N=1,NUMV
+ nn=float(n)*cjfact
+ if(numv .le. 10) nn=nn+2
+!
+! Check for passing lowest contour
+!
+ IF(CONTUR(N) .GE. V(1)) THEN
+!
+! Possible active contour
+!
+ IF(CONTUR(N) .LE. V(3)) THEN
+!
+! Definitely active. Get intercept on 1-3
+!
+ if(v(3) .ne. v(1)) then
+ FACT=(CONTUR(N)-V(1))/(V(3)-V(1))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX1=X(1)+FACT*(X(3)-X(1))
+ YY1=Y(1)+FACT*(Y(3)-Y(1))
+ IF(CONTUR(N) .LE. V(2)) THEN
+!
+! Second intercept is on 1-2
+!
+ IPAN12=IPAN12+1
+ if(v(2) .ne. v(1)) then
+ FACT=(CONTUR(N)-V(1))/(V(2)-V(1))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX2=X(1)+FACT*(X(2)-X(1))
+ YY2=Y(1)+FACT*(Y(2)-Y(1))
+ IF(IPAN12 .EQ. 1) THEN
+!
+! This is the first contour across 1-2
+!
+ AX(1)=X(1)
+ AX(2)=XX1
+ AX(3)=XX2
+ AY(1)=Y(1)
+ AY(2)=YY1
+ AY(3)=YY2
+ XX1F=XX1
+ XX2F=XX2
+ YY1F=YY1
+ YY2F=YY2
+ CALL POLYG(AX,AY,3,NN)
+ ELSE
+!
+! This is a second contour line
+!
+ AX(1)=XX1
+ AX(2)=XX2
+ AX(3)=XX2F
+ AX(4)=XX1F
+ AY(1)=YY1
+ AY(2)=YY2
+ AY(3)=YY2F
+ AY(4)=YY1F
+ XX1F=XX1
+ XX2F=XX2
+ YY1F=YY1
+ YY2F=YY2
+ CALL POLYG(AX,AY,4,NN)
+ ENDIF
+ ELSE
+!
+! Second intercept is on 2-3
+!
+ IPAN23=IPAN23+1
+ if(v(3) .ne. v(2)) then
+ FACT=(CONTUR(N)-V(2))/(V(3)-V(2))
+ else
+ fact=0.5
+ endif
+!
+! Locate point
+!
+ XX2=X(2)+FACT*(X(3)-X(2))
+ YY2=Y(2)+FACT*(Y(3)-Y(2))
+ IF(IPAN23 .EQ. 1) THEN
+!
+! This is the first contour on 2-3
+!
+ IF(IPAN12 .EQ. 0) THEN
+!
+! There is no previous contour across this element
+!
+ AX(1)=X(1)
+ AX(2)=XX1
+ AX(3)=XX2
+ AX(4)=X(2)
+ AY(1)=Y(1)
+ AY(2)=YY1
+ AY(3)=YY2
+ AY(4)=Y(2)
+ XX1F=XX1
+ XX2F=XX2
+ YY1F=YY1
+ YY2F=YY2
+ CALL POLYG(AX,AY,4,NN)
+ ELSE
+!
+! There is a previous contour across 1-2
+!
+ AX(1)=XX1
+ AX(2)=XX2
+ AX(3)=X(2)
+ AX(4)=XX2F
+ AX(5)=XX1F
+ AY(1)=YY1
+ AY(2)=YY2
+ AY(3)=Y(2)
+ AY(4)=YY2F
+ AY(5)=YY1F
+ XX1F=XX1
+ XX2F=XX2
+ YY1F=YY1
+ YY2F=YY2
+ CALL POLYG(AX,AY,5,NN)
+ ENDIF
+ ELSE
+!
+! This is a second contour line on 2-3
+!
+ AX(1)=XX1
+ AX(2)=XX2
+ AX(3)=XX2F
+ AX(4)=XX1F
+ AY(1)=YY1
+ AY(2)=YY2
+ AY(3)=YY2F
+ AY(4)=YY1F
+ XX1F=XX1
+ XX2F=XX2
+ YY1F=YY1
+ YY2F=YY2
+ CALL POLYG(AX,AY,4,NN)
+ ENDIF
+ ENDIF
+ ELSE
+!
+! Complete drawing of contour checking to see where previous
+! contour was
+!
+ IF(IPAN23 .GT. 0) THEN
+!
+! It was on 2-3
+!
+ AX(1)=X(3)
+ AX(2)=XX2F
+ AX(3)=XX1F
+ AY(1)=Y(3)
+ AY(2)=YY2F
+ AY(3)=YY1F
+ CALL POLYG(AX,AY,3,NN)
+ ELSEIF(IPAN12 .GT. 0) THEN
+!
+! It was on 1-2
+!
+ AX(1)=X(3)
+ AX(2)=X(2)
+ AX(3)=XX2F
+ AX(4)=XX1F
+ AY(1)=Y(3)
+ AY(2)=Y(2)
+ AY(3)=YY2F
+ AY(4)=YY1F
+ CALL POLYG(AX,AY,4,NN)
+ ELSE
+ AX(1)=X(3)
+ AX(2)=X(2)
+ AX(3)=X(1)
+ AY(1)=Y(3)
+ AY(2)=Y(2)
+ AY(3)=Y(1)
+ CALL POLYG(AX,AY,3,NN)
+ ENDIF
+ GO TO 905
+ ENDIF
+ ENDIF
+ 900 CONTINUE
+ 905 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE EXPND(NCN,N)
+
+ USE BLK1MOD
+
+ INCLUDE 'TXFRM.COM'
+! INCLUDE 'PARAM.COM'
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLKBRK.COM'
+! INCLUDE 'BFILES.I90'
+! WRITE(90,*) 'BEFORE',N,X(1),X(2),X(3),Y(1),Y(2),Y(3)
+ COMMON /BRK/ X(10),Y(10),VL(10),DL(10),VLM(10)
+! expand
+ DSTRTN1=1.0
+ N1=NOP(N,1)
+ N2=NOP(N,2)
+ N3=NOP(N,3)
+ x1= cord(n1,1)
+ x2= cord(n3,1)
+ y1= cord(n1,2)
+ y2= cord(n3,2)
+ eldir=atan2(y2-y1,x2-x1)
+ ALFAN1=eldir-1.5708
+ ALFAN2=ALFAN1
+ ALFAN3=ALFAN1
+ NCN=8
+ width(n2)=(width(n1)+width(n3))/2.
+ TX2=X(2)
+ TY2=Y(2)
+ TX3=X(3)
+ TY3=Y(3)
+ VL2=VL(2)
+ VL3=VL(3)
+ X(6)=X(3)
+ Y(6)=Y(3)
+ VL(6)=VL(3)
+ X(2)=X(1)
+ Y(2)=Y(1)
+ VL(2)=VL(1)
+ VL(3)=VL(1)
+ X(1)=X(2)-WIDTH(N1)*COS(ALFAN1)/(2.*TXSCAL)*DSTRTN1
+ X(3)=X(2)+WIDTH(N1)*COS(ALFAN1)/(2.*TXSCAL)*DSTRTN1
+ Y(1)=Y(2)-WIDTH(N1)*SIN(ALFAN1)/(2.*TXSCAL)*DSTRTN1
+ Y(3)=Y(2)+WIDTH(N1)*SIN(ALFAN1)/(2.*TXSCAL)*DSTRTN1
+ VL(4)=VL2
+ VL(8)=VL2
+ X(4)=TX2+WIDTH(N2)*COS(ALFAN2)/(2.*TXSCAL)*DSTRTN1
+ X(8)=TX2-WIDTH(N2)*COS(ALFAN2)/(2.*TXSCAL)*DSTRTN1
+ Y(4)=TY2+WIDTH(N2)*SIN(ALFAN2)/(2.*TXSCAL)*DSTRTN1
+ Y(8)=TY2-WIDTH(N2)*SIN(ALFAN2)/(2.*TXSCAL)*DSTRTN1
+ VL(5)=VL3
+ VL(7)=VL3
+ X(5)=TX3+WIDTH(N3)*COS(ALFAN3)/(2.*TXSCAL)*DSTRTN1
+ X(7)=TX3-WIDTH(N3)*COS(ALFAN3)/(2.*TXSCAL)*DSTRTN1
+ Y(5)=TY3+WIDTH(N3)*SIN(ALFAN3)/(2.*TXSCAL)*DSTRTN1
+ Y(7)=TY3-WIDTH(N3)*SIN(ALFAN3)/(2.*TXSCAL)*DSTRTN1
+! check areas
+
+ aj=x(3)-x(1)
+ bj=y(3)-y(1)
+ ak=x(5)-x(1)
+ bk=y(5)-y(1)
+ a1=aj*bk-ak*bj
+ if(a1 .lt. 0.) then
+ tx1=x(1)
+ ty1=y(1)
+ x(1)=x(3)
+ y(1)=y(3)
+ x(3)=tx1
+ y(3)=ty1
+
+ endif
+ aj=x(5)-x(1)
+ bj=y(5)-y(1)
+ ak=x(7)-x(1)
+ bk=y(7)-y(1)
+ a2=aj*bk-ak*bj
+ if(a2 .lt. 0) then
+ tx1=x(5)
+ ty1=y(5)
+ x(5)=x(7)
+ y(5)=y(7)
+ x(7)=tx1
+ y(7)=ty1
+ endif
+
+ aj=x(4)-x(1)
+ bj=y(4)-y(1)
+ ak=x(8)-x(1)
+ bk=y(8)-y(1)
+ a1=aj*bk-ak*bj
+ if(a1 .lt. 0.) then
+ tx1=x(4)
+ ty1=y(4)
+ x(4)=x(8)
+ y(4)=y(8)
+ x(8)=tx1
+ y(8)=ty1
+ endif
+ RETURN
+ END
+
diff --git a/src/src83e/BUTTON.ICO b/src/src83e/BUTTON.ICO
new file mode 100644
index 0000000..90b9993
Binary files /dev/null and b/src/src83e/BUTTON.ICO differ
diff --git a/src/src83e/CANCEL.ICO b/src/src83e/CANCEL.ICO
new file mode 100644
index 0000000..b1028bf
Binary files /dev/null and b/src/src83e/CANCEL.ICO differ
diff --git a/src/src83e/CCLINE.F90 b/src/src83e/CCLINE.F90
new file mode 100644
index 0000000..cb883b8
--- /dev/null
+++ b/src/src83e/CCLINE.F90
@@ -0,0 +1,496 @@
+! Last change: IPK 2 Mar 1999 12:58 pm
+!IPK NEW ROUTINE OCT 23 1996
+ SUBROUTINE CCLINE(ISW)
+!
+! Generate continuity lines
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ CHARACTER*1 IFLAG
+ DIMENSION XLIN(350),YLIN(350),INODE1(350)
+! DIMENSION ICN(MAXP)
+ LOGICAL :: OPENED
+ DO J=1,MAXP
+ ICN(J)=0
+ ENDDO
+
+ IF(ISW .EQ. 1) THEN
+ call opencln(ipos)
+ if(ipos .eq. 0) return
+ ELSE
+ ipos=2
+ ENDIF
+!
+! First sort out the potential midsides
+! Note that transition elements caues a problem
+! Find these first
+ DO N=1,NE
+ IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
+!
+! We have a transition mark node number as if it were corner
+!
+ ICN(NOP(N,3))=1
+ ICN(NOP(N,1))=2
+ ICN(NOP(N,4))=2
+ ICN(NOP(N,5))=2
+ ELSE
+!
+! Store ICN = 2 for corner nodes
+!
+ NCN=NCORN(N)
+!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ MST=1
+ ELSE
+ MST=2
+ ENDIF
+ DO M=1,NCN,MST
+ ICN(NOP(N,M))=2
+ ENDDO
+ ENDIF
+ ENDDO
+
+!
+! Get connections
+!
+ CALL NTONCON(ipos)
+ 100 CONTINUE
+ NHTP=0
+ NMESS=26
+ NBRR=8
+ NTRACT=0
+
+ CALL HEDR
+ NCLL=0
+!
+! Get first point
+!
+ 110 CONTINUE
+ K=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE1(1),IFLAG,INSKP,IBOX)
+ if(inode1(1) .eq. 0) go to 110
+ IF(IRMAIN .EQ. 1) THEN
+ NTRACT=0
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'q') THEN
+ NTRACT=0
+ GO TO 500
+ ENDIF
+!IPK JAN01
+ IF(IBOX .EQ. 7 .OR. IFLAG .EQ. 'n' .or. &
+ IBOX .EQ. 5 .OR. IFLAG .EQ. 'd') THEN
+ ipos=ncll+1
+ CALL GETCLN(ipos)
+!IPK JAN02
+ IF(ISW .EQ. 1) THEN
+ IF(IPOS .EQ. 0) THEN
+ DO NCLL=1,140
+ DO KK=1,350
+ ICCLN(NCLL,KK)=0
+ ENDDO
+ ENDDO
+ NCLM=0
+ ELSE
+ ncll=ipos
+ DO KK=1,350
+ ICCLN(NCLL,KK)=0
+ ENDDO
+ IF(NCLM .EQ. NCLL) NCLM=NCLM-1
+ ENDIF
+ GO TO 100
+ ENDIF
+ ENDIF
+ IF(ICN(INODE1(1)) .NE. 2) THEN
+ NMESS=28
+ CALL HEDR
+ GO TO 110
+ ENDIF
+
+ NBRR=5
+ NMESS=27
+ CALL HEDR
+ fpn=inode1(1)
+ CALL NUMBR(0.5,7.2,0.2,FPN,0.0,-1)
+ call pltnod(inode1(1),0)
+!
+! Get second point
+!
+ 150 CONTINUE
+ K=K+1
+ 160 CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE1(K),IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NTRACT=0
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'q') THEN
+ NTRACT=0
+ GO TO 500
+ ENDIF
+ NMESS=26
+ CALL HEDR
+ IF(IBOX .EQ. 6 .OR. IFLAG .EQ. 'b' ) THEN
+ K=K-2
+ GO TO 150
+ ELSEIF(IBOX .EQ. 7 .OR. IFLAG .EQ. 'n') THEN
+ KL=K-2
+
+ IF(ISW .EQ. 1) THEN
+
+!IPK Get continuity line number
+ ipos=ncll+1
+ CALL GETCLN(ipos)
+ ncll=ipos
+ IF(NCLL .EQ. 0) GO TO 500
+ ENDIF
+!
+! Trace along line
+!
+ NTRACT=1
+ IF(KL .GT. 0) THEN
+ DO LS=1,KL
+ CALL TRACE(INODE1(LS),INODE1(LS+1))
+ ENDDO
+ ELSE
+ NTRACT=1
+ ITRAC(1)=INODE1(1)
+ ENDIF
+!
+! Output line to file
+!
+! WRITE(90,6000) (ITRAC(KK),KK=1,NTRAC)
+!ipk jan01
+ INQUIRE(98, OPENED=OPENED)
+ if(opened) then
+ IF(IPOS .EQ. 1) THEN
+ DO KK=1,NTRACT
+ WRITE(98,6001) ITRAC(KK),XUSR(ITRAC(KK)),YUSR(ITRAC(KK))
+6001 FORMAT('NODE',I7,2F15.3)
+ ENDDO
+ ELSE
+ WRITE(98,6000) NCLL,(ITRAC(KK),KK=1,NTRACT)
+ ENDIF
+ endif
+!IPK JAN01
+ 6000 FORMAT('CC1',I5,9I8/('CC2',5X,9I8))
+ DO KK=1,NTRACT
+ XLIN(KK)=CORD(ITRAC(KK),1)
+ YLIN(KK)=CORD(ITRAC(KK),2)
+ ENDDO
+
+!ipk jan01
+! Save to an array by line number
+!
+ IF(ISW .EQ. 1) THEN
+ DO KK=1,NTRACT
+ ICCLN(NCLL,KK)=ITRAC(KK)
+ ENDDO
+ IF(NCLL .GT. NCLM) NCLM=NCLL
+ ENDIF
+
+ CALL RRED
+!ipk jan01
+ CALL THICKL
+ CALL DASHLN(XLIN,YLIN,NTRACT,0)
+!ipk jan01
+
+ CALL THINL
+!
+! Go to get another line
+!
+ IF(ISW .EQ. 2) RETURN
+ GO TO 100
+ ELSE
+ IF(ICN(INODE1(K)) .NE. 2) THEN
+ NMESS=27
+ CALL HEDR
+ GO TO 160
+ ENDIF
+ KL=K-1
+!
+! Trace along line
+!
+ call pltnod(inode1(1),0)
+ NTRACT=1
+ DO LS=1,KL
+ CALL TRACE(INODE1(LS),INODE1(LS+1))
+ call pltnod(inode1(ls+1),0)
+ ENDDO
+ if(ntracT .gt. 0) then
+ DO KK=1,NTRACT
+ if(itrac(kk) .eq. 0) go to 300
+ XLIN(KK)=CORD(ITRAC(KK),1)
+ YLIN(KK)=CORD(ITRAC(KK),2)
+ ENDDO
+ CALL RRED
+!ipk jan01
+ CALL THICKL
+ CALL DASHLN(XLIN,YLIN,NTRACT,0)
+!ipk jan01
+ CALL THINL
+ endif
+ 300 CONTINUE
+ fpn=inode1(KL+1)
+ CALL NUMBR(0.5+KL*0.5,7.2,0.2,FPN,0.0,-1)
+!
+! Get another point
+!
+ GO TO 150
+ ENDIF
+!
+! Exit
+!
+ 500 CONTINUE
+ END
+ SUBROUTINE NTONCON(ipos)
+!
+! Generate Connections
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! Initialize to zero
+!
+ NCM=MAXECON
+ DO N=1,NP
+ DO L=1,NCM
+ NECON(N,L)=0
+ ENDDO
+ ENDDO
+!
+! Loop on elements
+!
+ DO N=1,NE
+!
+! Check to see that this element is active
+!
+ IF(IMAT(N) .NE. 0) THEN
+ NCN=NCORN(N)
+!
+! Search to see if connection M and K made
+!
+
+! DO M=1,NCN,2
+ DO M=1,NCN,ipos
+
+
+! IF(M .GT. NCN-1) GO TO 200
+! K=M+2
+ K=M+ipos
+ IF(K .GT. NCN) K=1
+ DO L=1,NCM
+ IF(NECON(NOP(N,M),L) .EQ. 0) THEN
+!
+! This is new connection
+!
+ NECON(NOP(N,M),L)=NOP(N,K)
+ GO TO 150
+ ELSEIF(NECON(NOP(N,M),L) .EQ. NOP(N,K)) THEN
+!
+! This is an old connection
+!
+ GO TO 150
+ ENDIF
+ ENDDO
+ 150 CONTINUE
+!
+! Now look in the revers direction
+!
+ DO L=1,NCM
+ IF(NECON(NOP(N,K),L) .EQ. 0) THEN
+ NECON(NOP(N,K),L)=NOP(N,M)
+!
+! This is new connection
+!
+ GO TO 175
+ ELSEIF(NECON(NOP(N,K),L) .EQ. NOP(N,M)) THEN
+!
+! This is an old connection
+!
+ GO TO 175
+ ENDIF
+ ENDDO
+ 175 CONTINUE
+ ENDDO
+ ENDIF
+ 200 CONTINUE
+ ENDDO
+
+!
+ RETURN
+ END
+ SUBROUTINE TRACE(INODE1,INODE2)
+!
+! Generate continuity lines
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ DIST(N,M)=(cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2
+!
+! Start at INODE1
+!
+ ITRAC(NTRACT)=INODE1
+ LAT=INODE1
+ 100 CONTINUE
+!
+! Look for new nearer node to INODE2
+!
+ CURR=1.E30
+ LAT1=0
+ DO K=1,NCM
+ LATTMP=NECON(LAT,K)
+ IF(LATTMP .NE. 0) THEN
+ IF(DIST(INODE2,LATTMP) .LT. CURR) THEN
+ LAT1=LATTMP
+ CURR=DIST(INODE2,LATTMP)
+ ENDIF
+ ELSE
+ GO TO 150
+ ENDIF
+ ENDDO
+ 150 CONTINUE
+ IF(LAT1 .EQ. 0) RETURN
+ NTRACT=NTRACT+1
+ ITRAC(NTRACT)=LAT1
+ IF(LAT1 .EQ. INODE2) RETURN
+ IF(NTRACT .GT. 350) RETURN
+ LAT=LAT1
+ GO TO 100
+ END
+
+ subroutine opencln(ipos)
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ LOGICAL :: OPENED
+ INTEGER :: IPOS,IERR
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INQUIRE(98, OPENED=OPENED)
+ if(.not. opened) then
+ CALL WSelectFile(ID_STRING8,SaveDialog+PromptOn,FNAME,'Save continuity line')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='cln'
+ CALL ADDSUB(FNAME,SUB)
+ open(98,file=fname, form='formatted', status='unknown')
+ ENDIF
+ endif
+
+ call wdialogload(IDD_DIALOG08)
+ ierr=infoerror(1)
+
+
+ call wdialogputRadioButton(idf_radio1)
+
+
+ CALL WDialogSelect(IDD_DIALOG08)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ipos)
+ ipos=3-ipos
+ return
+ endif
+ ipos= 0
+ RETURN
+ enddo
+ ipos= 2
+ RETURN
+ END
+
+
+!ipk jan01
+ subroutine getcln(ipos)
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+
+ INTEGER :: IPOS,IERR
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ call wdialogload(IDD_DIALOG010)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG010)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,IPOS)
+
+ write(90,*) 'iposin',ipos
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,IPOS)
+ write(90,*) 'iposout',ipos
+
+ return
+ endif
+ return
+ enddo
+
+ RETURN
+ END
+ SUBROUTINE CHKLIN
+!
+! Generate continuity lines
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ IPOS=2
+ CALL NTONCON(ipos)
+
+ DO I=1,NCLM
+ NTRACT=1
+ ITRAC(1)=ICCLN(I,1)
+ DO J=1,350
+ INODE1=ICCLN(I,J)
+ INODE2=ICCLN(I,J+1)
+ IF(INODE2 .EQ. 0) GO TO 300
+ CALL TRACE(INODE1,INODE2)
+ ENDDO
+ 300 DO J=1,NTRACT
+ ICCLN(I,J)=ITRAC(J)
+ ENDDO
+ ENDDO
+
+ RETURN
+ END
diff --git a/src/src83e/COMPACT.F90 b/src/src83e/COMPACT.F90
new file mode 100644
index 0000000..369a921
--- /dev/null
+++ b/src/src83e/COMPACT.F90
@@ -0,0 +1,120 @@
+!IPK LAST UPDATE jAN 25 2001 CORRECT REFERENCE TO INEW
+ SUBROUTINE COMPACT(ISW)
+!
+! Compact nodes or element numbers
+! ISW = 3 compact nodes
+! ISW = 4 compact elements
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ DIMENSION ICREFN(MAXP),ICREFE(MAXE)
+!
+!
+ IF(ISW .EQ. 3) THEN
+!
+! First compact node list and create cross reference
+!
+ JJ=1
+ DO J=1,NP
+!IPK JAN01 FIX TEST
+ IF(INEW(J) .NE. 0) THEN
+ INEW(JJ)= INEW(J)
+ CORD(JJ,1)=CORD(J,1)
+ CORD(JJ,2)=CORD(J,2)
+ XUSR(JJ)=XUSR(J)
+ YUSR(JJ)=YUSR(J)
+ WD(JJ)=WD(J)
+ LAY(JJ)=LAY(J)
+ WIDTH(JJ)=WIDTH(J)
+ SS1(JJ)=SS1(J)
+ SS2(JJ)=SS2(J)
+ WIDS(JJ)=WIDS(J)
+ WIDBS(JJ)=WIDBS(J)
+ SSO(JJ)=SSO(J)
+ INSKP(JJ)=INSKP(J)
+ LOCK(JJ)=LOCK(J)
+ ICREFN(J)=JJ
+ JJ=JJ+1
+ ENDIF
+ ENDDO
+ DO J=JJ,NP
+ CORD(J,1)=-1.D20
+ CORD(J,2)=-1.D20
+ XUSR(J)=-1.D20
+ YUSR(J)=-1.D20
+ WD(J)=-9999.
+ LAY(J)=-9999
+ WIDTH(J)=0.
+ SS1(J)=0
+ SS2(J)=0.
+ WIDS(J)=0.
+ WIDBS(J)=0.
+ SSO(J)=0.
+ INSKP(J)=1
+!IPK JAN01 ADD INEW
+ INEW(J)=0
+ LOCK(J)=0
+ ENDDO
+ NP=JJ-1
+!
+! Next renumber element connections
+!
+ DO N=1,NE
+ DO M=1,8
+ IF(NOP(N,M) .NE. 0) THEN
+ NOP(N,M)=ICREFN(NOP(N,M))
+ ENDIF
+ ENDDO
+ ENDDO
+
+! Renumber continuity lines
+
+ DO I=1,NCLM
+ DO J=1,350
+ IF(ICCLN(I,J) .GT. 0) THEN
+ ICCLN(I,J)=ICREFN(ICCLN(I,J))
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ELSEIF(ISW .EQ. 4) THEN
+!
+! Compact elements
+!
+ JJ=1
+ DO J=1,NE
+ IF(NOP(J,1) .NE. 0) THEN
+ DO M=1,8
+ NOP(JJ,M)=NOP(J,M)
+ ENDDO
+ ICREFE(J)=JJ
+ XC(JJ)=XC(J)
+ YC(JJ)=YC(J)
+ IMAT(JJ)=IMAT(J)
+ THTA(JJ)=THTA(J)
+ IEM(JJ)=0
+ NCORN(JJ)=NCORN(J)
+ IESKP(JJ)=IESKP(J)
+ JJ=JJ+1
+ ENDIF
+ ENDDO
+ DO J=JJ,NE
+ DO M=1,8
+ NOP(J,M)=0
+ ENDDO
+ IMAT(J)=0
+ THTA(J)=0
+ IEM(J)=0
+ NCORN(J)=0
+ IESKP(JJ)=-1
+ ENDDO
+ NE=JJ-1
+ DO J=1,NLST
+ DO I=1,LLIST(J)
+ ILIST(J,I)=ICREFE(ILIST(J,I))
+ ENDDO
+ ENDDO
+ ENDIF
+ RETURN
+ END
diff --git a/src/src83e/COMPSCAL.F90 b/src/src83e/COMPSCAL.F90
new file mode 100644
index 0000000..4248ab6
--- /dev/null
+++ b/src/src83e/COMPSCAL.F90
@@ -0,0 +1,147 @@
+ SUBROUTINE COMPWGT
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+! COMMON/ICN1/ ICN(MAXP)
+
+ DIST(X1,X2,Y1,Y2)=SQRT((X1-X2)**2+(Y1-Y2)**2)
+
+ DO J=1,MAXP
+ ICN(J)=0
+ END DO
+! First sort out the potential midsides
+! Note that transition elements caues a problem
+! Find these first
+ DO 200 N=1,NE
+ if(NCORN(N) .GT. 5) GO TO 200
+ IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
+!
+! We have a transition mark node number as if it were corner
+!
+ ICN(NOP(N,3))=-1
+ ICN(NOP(N,1))=IMAT(N)
+ ICN(NOP(N,4))=IMAT(N)
+ ICN(NOP(N,5))=IMAT(N)
+ ELSE
+!
+! Store ICN = 2 for corner nodes
+!
+ NCN=NCORN(N)
+!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ GO TO 185
+ ELSE
+ MST=2
+ ENDIF
+
+ DO 180 M=1,NCN,MST
+ ICN(NOP(N,M))=IMAT(N)
+ 180 CONTINUE
+ 185 CONTINUE
+ ENDIF
+ 200 END DO
+
+ DO N=1,NP
+ IF(ICN(N) .GT. 0) THEN
+ ADIST=1.E20
+ DO J=1,NCRSEC
+ IF(ICN(N) .EQ. NOREACH(IVMIL(J))) THEN
+ A1=DIST(XUSR(N),XCRS(IVMIL(J)),YUSR(N),YCRS(IVMIL(J)))
+ IF(A1 .LT. ADIST) THEN
+ ADIST=A1
+ NSEC1=IVMIL(J)
+ ENDIF
+ ENDIF
+ ENDDO
+!IPK JUN04
+ IF(ADIST .EQ. 1.E20) THEN
+ NRIVCR1(N)=0
+ NRIVCR2(N)=0
+ WTRIVCR1(N)=0
+ WTRIVCR2(N)=0
+ ELSE
+ BDIST=1.E20
+ DO J=1,NCRSEC
+ IF(ICN(N) .EQ. NOREACH(IVMIL(J))) THEN
+ IF(IVMIL(J) .NE. NSEC1) THEN
+ A1=DIST(XUSR(N),XCRS(IVMIL(J)),YUSR(N),YCRS(IVMIL(J)))
+ A2=DIST(XCRS(NSEC1),XCRS(IVMIL(J)),YCRS(NSEC1),YCRS(IVMIL(J)))
+
+! A1 IS DISTANCE TO NODE
+! A2 IS DISTANCE TO RECORDED POINT
+
+ IF(A2 .GE. A1) THEN
+ IF(A1 .LT. BDIST) THEN
+ BDIST=A1
+ NSEC2=IVMIL(J)
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ IF(BDIST .EQ. 1.E20) NSEC2=NSEC1
+ NRIVCR1(N)=NSEC1
+ NRIVCR2(N)=NSEC2
+ WTRIVCR1(N)=BDIST/(ADIST+BDIST)
+ WTRIVCR2(N)=ADIST/(ADIST+BDIST)
+ ENDIF
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE GETCSLOC
+ use winteracter
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+!-
+
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IERR,ISET,IBOX
+ REAL :: ASET
+ CHARACTER*1 :: IFLAG
+
+ call wdialogload(IDD_CSLOC)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_CSLOC)
+ ierr=infoerror(1)
+
+ ISET=1
+ 100 continue
+
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,ISET)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ DO
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,ISET)
+ GO TO 200
+ else
+ RETURN
+ endif
+ ENDDO
+ 200 CONTINUE
+
+ CALL XYLOC(XX,YY,IFLAG,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ XCRS(ISET) = XX*TXSCAL - XS
+ YCRS(ISET) = YY*TXSCAL - YS
+ GO TO 100
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/CONT.F90 b/src/src83e/CONT.F90
new file mode 100644
index 0000000..1b16844
--- /dev/null
+++ b/src/src83e/CONT.F90
@@ -0,0 +1,300 @@
+ SUBROUTINE CONOUT(MENUS)
+!
+ USE WINTERACTER
+ USE BLK1MOD
+ SAVE
+! INCLUDE 'BLK1.COM'
+!
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+!
+ DIMENSION VALUS(MAXP)
+
+ CHARACTER*60 STRELS
+
+ DATA STRELS/' You have tried to reorder before executing "FILL"'/
+!
+!
+! Test to make sure fill has been executed.
+!
+ IF(MENUUS .EQ. 13) ifilltmp=0
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ DO M=2,NCORN(N),2
+!ipkoct93
+ if(imat(n) .LT. 900) THEN
+ IF(NOP(N,M) .EQ. 0) THEN
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'You have tried to plot contours before filling'//char(13)//&
+ 'Do you wish to temporarily fill and proceed?'//&
+ CHAR(13)//' ','PLOTTING CONTOURS WITHOUT A FILLED NETWORK?')
+!
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) THEN
+ RETURN
+ ENDIF
+ CALL FILM(1)
+ ifilltmp=1
+ call hedr
+ GO TO 300
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+!
+300 CONTINUE
+ DO N=1,NP
+ VALUS(N)=WD(N)
+ ENDDO
+!
+ CALL TOLMAX(VALUS,TTMIN,TTMAX)
+
+ ISZ=0
+ IF(MENUS .EQ. 13) THEN
+ ISZ=1
+ CALL CSET(TTMIN,TTMAX,isz)
+ RETURN
+ ENDIF
+
+ PSCL=1.0
+ CALL ELCONT(VALUS,PSCL)
+
+ if(ifilltmp .eq. 1) CALL DELETM(0)
+
+ RETURN
+ END
+ SUBROUTINE ELCONT(VALUS,PSCL)
+!
+! Routine to draw element contours
+!
+ USE BLK1MOD
+
+! INCLUDE 'BLK1.COM'
+!
+ INCLUDE 'BFILES.I90'
+ COMMON /BRK/ X(10),Y(10),VL(10),DL(10),VLM(10)
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ LOGICAL SWITCH
+! DIMENSION X(10),Y(10),VL(10),VALUS(*)
+ DIMENSION VALUS(*)
+ DATA PSCL1/1.0/ITIME/0/
+
+ IF(PSCL .eq. 0.) then
+ PSCL=PSCL1
+ ELSE
+ PSCL1=PSCL
+ ENDIF
+ CALL RRed
+
+ CALL GETXC
+
+ IF(.NOT. ALLOCATED(NKEY1)) THEN
+ ALLOCATE (NKEY1(MAXE))
+ ENDIF
+ CALL SORTDB(YC,NKEY1,NE)
+
+ DO 500 NN=NE,1,-1
+ N=NKEY1(NN)
+ IF(IESKP(N) .EQ. 1) GO TO 500
+ NCN=NCORN(N)
+ IF(NCN .EQ. 9) NCN=8
+ DO M=1,NCN,2
+ if(nop(n,m) .eq. 0) go to 500
+ IF(VALUS(NOP(N,M)) .LT. -9998.) GO TO 500
+ ENDDO
+!
+! Copy values into work array
+!
+ NCN=NCORN(N)
+! if(ncn .lt. 6) go to 500
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) GO TO 500
+ IOK=0
+ DO 300 M=1,NCN
+ IF(NOP(N,M) .EQ. 0) GO TO 500
+ X(M)=CORD(NOP(N,M),1)
+ Y(M)=CORD(NOP(N,M),2)
+ IF(I3DVIEW .EQ. 1) THEN
+ IF(VRTSCAL .GT. 0.) THEN
+ Y(M)=Y(M)+(WD(NOP(N,M))-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
+ ENDIF
+ ENDIF
+
+ IF(X(M) .GT. 0. .AND. X(M) .LT. HSIZE) THEN
+ IF(Y(M) .GT. 0. .AND. Y(M) .LT. 7.) THEN
+ IOK=1
+ ENDIF
+ ENDIF
+ VL(M)=VALUS(NOP(N,M))*PSCL
+ 300 CONTINUE
+ IF(IOK .EQ. 0) GO TO 500
+! CALL BRKDWN(X,Y,VL,NCN)
+ NELNO=N
+ CALL BRKDWN(NCN,NELNO)
+
+!ipkoct93
+ if(ipsw(4) .eq. 1) then
+ NLINP=NCN+1
+ X(NLINP)=X(1)
+ Y(NLINP)=Y(1)
+ CALL DASHLN(X,Y,NLINP,0)
+ endif
+
+ 500 CONTINUE
+!
+! Print title
+!
+ ncharr=lenstr(title)
+ call rblue
+ IF(NCHARR .GT. 1) CALL SYMBL(0.5,7.25,0.20,TITLE,0.0,ncharr)
+
+ XLEG=8.8
+ YLEG=7.4
+
+ CALL LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
+ CALL RBlue
+ RETURN
+ END
+
+ SUBROUTINE LEGND(XLEG,YLEG,CONTUR,NUMV,NUMCOL)
+ SAVE
+ DIMENSION CONTUR(99),X(10),Y(10)
+ DATA LDIGO/2/
+ XLOC=XLEG+0.5
+ YLOC=YLEG
+ csfact=1.0001
+ DO 80 N=1,NUMV
+ IF(N .LT. NUMV) THEN
+!
+! Define polygon
+!
+ X(1)=XLEG
+ X(2)=XLEG
+ X(3)=XLEG+0.4
+ X(4)=XLEG+0.4
+ Y(1)=YLOC
+ Y(2)=YLOC-0.3
+ Y(3)=YLOC-0.3
+ Y(4)=YLOC
+ nn=(n+1)*csfact
+ if(numv .le. 10) nn=nn+2
+ CALL POLYG(X,Y,4,nn)
+ ENDIF
+!
+! Plot the value on the screen
+!
+ if(contur(n) .ne. 0.) then
+ DIG = ALOG10(ABS(CONTUR(N)))
+ else
+ dig = -2.
+ endif
+ IF(DIG .GT. 2.999) THEN
+ LDIG=-DIG - 1
+ ELSEIF (DIG .GT. 1.999) THEN
+ LDIG = 0
+ ELSEIF (DIG .GT. 0.999) THEN
+ LDIG = 1
+ ELSEIF (DIG .GT. 0) THEN
+ LDIG = 2
+ ELSE
+ LDIG = DIG - 2. + .01
+ LDIG = -LDIG
+ ENDIF
+ IF(LDIG .LT. 0) GO TO 70
+ DO 60 KK=1,3
+ ANUM=10.**(-LDIG)
+ IF(N .EQ. 1) THEN
+ IF(ABS(CONTUR(2)-CONTUR(1)) .LT. ANUM) THEN
+ LDIG = LDIG + 1
+ ELSE
+ GO TO 70
+ ENDIF
+ ELSE
+ IF(ABS(CONTUR(N)-CONTUR(N-1)) .LT. ANUM) THEN
+ LDIG = LDIG + 1
+ ELSE
+ GO TO 70
+ ENDIF
+ ENDIF
+ 60 CONTINUE
+ 70 CONTINUE
+ call rblue
+ CTMP=CONTUR(N)
+ IF(ABS(CTMP) .LT. 1.E-7) THEN
+ CTMP=0.
+ LDIG=LDIGO
+ ENDIF
+
+ CALL rblack
+ CALL NUMBR(XLOC,YLOC-0.09,0.2,CTMP,0.0,LDIG)
+ LDIGO=LDIG
+ CALL rblack
+!
+ CALL PLOTT(X(1),Y(1),3)
+ CALL PLOTT(X(2),Y(2),2)
+ CALL PLOTT(X(3),Y(3),2)
+ CALL PLOTT(X(4),Y(4),2)
+ CALL PLOTT(X(1),Y(1),2)
+!
+ YLOC=YLOC-0.30
+ 80 CONTINUE
+ CALL RBlue
+ RETURN
+ END
+
+
+ SUBROUTINE TOLMAX(VALUS,TTMIN,TTMAX)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ DIMENSION VALUS(*)
+!
+ TMAX = -1.E+20
+ TMIN = 1.E+20
+ DO 218 J=1,NP
+ IF (VALUS(J) .GT. TMAX) THEN
+ TMAX = VALUS(J)
+ ITMAX = J
+ ENDIF
+ IF (VALUS(J) .LT. TMIN) THEN
+ TMIN = VALUS(J)
+ ITMIN = J
+ ENDIF
+ 218 CONTINUE
+ WRITE(90,*) ' '
+ WRITE(90,*) ' Max, Min for entire network '
+ WRITE(90,*) ' MAX value = ', TMAX, ' at node ', ITMAX
+ WRITE(90,*) ' MIN value = ', TMIN, ' at node ', ITMIN
+ WRITE(90,*) ' '
+!
+! Check for max and min values of elements in the plotting area
+!
+ TTMAX = -1.E+20
+ TTMIN = 1.E+20
+ DO 228 N=1,NE
+ IF(IESKP(N) .EQ. 0) THEN
+ DO 220 M=1,NCORN(N)
+ J=NOP(N,M)
+!ipk sep99
+ if(j .eq. 0) go to 220
+ IF (VALUS(J) .GT. TTMAX) THEN
+ TTMAX = VALUS(J)
+ ITTMAX = J
+ ENDIF
+ IF (VALUS(J) .LT. TTMIN) THEN
+ TTMIN = VALUS(J)
+ ITTMIN = J
+ ENDIF
+ 220 CONTINUE
+ ENDIF
+ 228 CONTINUE
+!
+ WRITE(90,*) ' '
+ WRITE(90,*) ' Max, Min for plot area '
+ WRITE(90,*) ' MAX value = ', TTMAX, ' at node ', ITTMAX
+ WRITE(90,*) ' MIN value = ', TTMIN, ' at node ', ITTMIN
+!
+ RETURN
+ END
+
+
diff --git a/src/src83e/CREATGRID.f90 b/src/src83e/CREATGRID.f90
new file mode 100644
index 0000000..57b3a04
--- /dev/null
+++ b/src/src83e/CREATGRID.f90
@@ -0,0 +1,193 @@
+ PROGRAM creatgrid
+ dimension XL(100,2),YL(100,2),mappt(2),XL1(100),XL2(100)
+ REAL*8 GRIDX(100),GRIDY(100)
+!
+! define line numbers in map file
+!
+ DIST(A,B,C,D)=SQRT((C-A)*2+(D-C)**2)
+ XL(1,1)=0.
+ XL(2,1)=320.
+ XL(3,1)=530.
+ YL(1,1)=0.
+ YL(2,1)=20.
+ YL(3,1)=50.
+ MAPPT(1)=3
+ XL(1,2)=0.
+ XL(2,2)=600.
+ YL(1,2)=70.
+ YL(2,2)=90.
+ MAPPT(2)=2
+ K1=1
+ K2=2
+
+!
+! compute line length
+!
+ XL1=0.
+ nlpts1=mappt(k1)
+ do n=2,nlpts1
+ XL1(n)=XL1(n-1)+dist(XL(n-1,1),YL(n-1,1),XL(n,1),YL(n,1))
+ enddo
+ XL2=0.
+ nlpts2=mappt(k2)
+ do n=2,nlpts2
+ XL2(n)=XL2(n-1)+dist(XL(n-1,2),YL(n-1,2),XL(n,2),YL(n,2))
+ enddo
+ xmean=(XL1(nlpts1)+XL2(nlpts2))/2.
+!
+! get size spacing
+!
+! read xsz,NY
+ XSZ=100.
+ NY=5
+ along=xmean/xsz
+ NX=(along+0.99)
+
+ NXP=NX+1
+ NYP=NY+1
+ NRL=NX*NYP+1
+ NRT=NXP*NYP
+
+! DO N=1,NE
+! DO M=1,8
+! NOPSV(N,M)=NOP(N,M)
+! ENDDO
+! IMATSV(N)=IMAT(N)
+! ENDDO
+! NESAV=NE
+! NEFSAV=NENTRY
+! NPUNDO=NRT
+!
+! Initialize GRIDX and GRIDY
+!
+ DO N=1,NRT
+ GRIDX(N)=0.
+ GRIDY(N)=0.
+! IGSKP(N)=0
+ END DO
+!
+! calculate lengths
+!
+ xalong1=XL1(nlpts1)/NX
+ xalong2=XL2(nlpts2)/NX
+!
+! compute cords along the edges
+!
+ XALONG=0.
+ XXALONG=0.
+ GRIDX(1)=XL(1,1)
+ GRIDY(1)=YL(1,1)
+ GRIDX(NYP)=XL(1,2)
+ GRIDY(NYP)=YL(1,2)
+ NRT=NXP*NYP
+ DO N=NY+2,NRT,NYP
+ XALONG=XALONG+XALONG1
+ NX1=2
+ DO M=NX1,NLPTS1
+ IF(XALONG .LT. XL1(M)) THEN
+ M1=M
+ GO TO 200
+ ENDIF
+ ENDDO
+ 200 CONTINUE
+ FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
+ GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
+ GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
+ NX1=M1
+ XXALONG=XXALONG+XALONG2
+ NX2=2
+ DO M=NX2,NLPTS2
+ IF(XXALONG .LT. XL2(M)) THEN
+ M2=M
+ GO TO 250
+ ENDIF
+ ENDDO
+ 250 CONTINUE
+ FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
+ GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
+ GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
+ NX2=M2
+ ENDDO
+!
+!
+! check if points ok allow for move
+!
+!
+! form elements and other coordinates
+!
+!
+! Interpolate interior points
+!
+ DO M=1,NRT,NYP
+ NFS=NRL+M-1
+ CALL INTERP(GRIDX,GRIDY,M,M+NY,1,GRIDX(M),GRIDY(M),GRIDX(M+NY) &
+ & ,GRIDY(M+NY),NY,0)
+! DO N=M,NFS
+! XTEMP=GRIDX(N)
+! YTEMP=GRIDY(N)
+! GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+! GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+! CALL RRed
+! call drawcr(xtemp,ytemp,siz)
+! CALL RBlue
+! ENDDO
+ END DO
+!
+! query for depths
+!
+!
+! query for happY
+ STOP
+ end
+ SUBROUTINE INTERP(GRIDX,GRIDY,NL,NH,INT,ALX,ALY,ATX,ATY,NINT,ISWT)
+!
+! Routine to fill GRIDX and GRIDY by interpolation
+! NL = START OF GENERATED
+! NH = END OF GENERATED
+! INT = INTERVAL
+! ALX, ALY = START LOC
+! ATX, ATY = END LOC
+! NINT = NUMBER OF POINTS
+! ISWT = 0 BASELINE = 1 APPLY CHANGES
+!IPK MAY02
+ REAL*8 GRIDX(NH),GRIDY(NH),ALX,ALY,ATX,ATY
+!
+! Compute intervals
+!
+ XINT=(ATX-ALX)/FLOAT(NINT)
+ YINT=(ATY-ALY)/FLOAT(NINT)
+!
+! Generate points
+!
+ IF(ISWT .EQ. 0) THEN
+ KP=0
+ DO 200 K=NL,NH,INT
+ IF(KP .EQ. 0) THEN
+ GRIDX(K)=ALX
+ GRIDY(K)=ALY
+ ELSE
+ GRIDX(K)=GRIDX(KP)+XINT
+ GRIDY(K)=GRIDY(KP)+YINT
+ ENDIF
+ KP=K
+ 200 CONTINUE
+ ELSE
+ XAD=ALX
+ YAD=ALY
+ KP=0
+ DO 220 K=NL,NH,INT
+ IF(KP .EQ. 0) THEN
+ GRIDX(K)=GRIDX(K)+XAD
+ GRIDY(K)=GRIDY(K)+YAD
+ ELSE
+ XAD=XAD+XINT
+ YAD=YAD+YINT
+ GRIDX(K)=GRIDX(K)+XAD
+ GRIDY(K)=GRIDY(K)+YAD
+ ENDIF
+ KP=K
+ 220 CONTINUE
+ ENDIF
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/CREATM.F90 b/src/src83e/CREATM.F90
new file mode 100644
index 0000000..dcfe928
--- /dev/null
+++ b/src/src83e/CREATM.F90
@@ -0,0 +1,278 @@
+ SUBROUTINE CREATM
+
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! Routine to create mesh from map contour lines
+
+ COMMON /CRMAP/ NCONT,CVALUE(1000),MSTART(1000),MFIN(1000),CINTDIS(1000),IACTCV(1000)
+
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+! Search map data for contoour lines and setup values
+
+ JS=1
+ NCONT=0
+!
+ K=0
+ DO 20 J=1,MAXPTS
+ MLEN=J-JS
+ IF(XMAP(J) .LE. VDX .or. j .eq. maxpts) THEN
+!
+! We have found a line end, is itmore than 1 point long?
+!
+ K=K+1
+ IF(MLEN .GT. 1) THEN
+ LTP=LINTYP(K)
+
+ IF(LTP .NE. 2) THEN
+ IF(LTP .GT. 0) THEN
+ NCONT=NCONT+1
+ CVALUE(NCONT)=VAL(JS)
+ MSTART(NCONT)=JS
+ IF(XMAP(J) .LE. VDX) THEN
+ MFIN(NCONT)=J-1
+ ELSE
+ MFIN(NCONT)=J
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ IF(MLEN .EQ. 0 .AND. LINTYP(K) .EQ. -999) GO TO 30
+ JS=J+1
+ ENDIF
+ 20 CONTINUE
+ 30 CONTINUE
+
+
+! Choose options and intervals
+
+ CALL PANELCRT(NCONT,CVALUE,IACTCV,CINTDIS,ICAN)
+ IF(ICAN .EQ. 1) RETURN
+
+! First form list of nodes working along contour lines
+
+ CALL CFORM
+
+! Now generate elements
+
+ do n=1,np
+ list(n)=1
+ enddo
+
+ call deln2(np,0)
+
+ call checkpoly
+
+ RETURN
+ END
+
+ SUBROUTINE PANELCRT(N1,R2,N3,R4,N5)
+
+! Choose options and intervals
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3(1000),IERR,ITIME,K,N5,NA,NB
+ real :: R2(1000),R4(1000)
+ data itime/0/
+
+ if(itime .eq. 0) then
+ n2=0
+ na=1
+ nb=1
+ itime=1
+ do k=1,1000
+ r4(k)=500.
+ n3(k)=1
+ enddo
+ endif
+
+ call wdialogload(IDD_CREATM1)
+ ierr=infoerror(1)
+
+ CALL WDialogPutCheckBox(idf_check1,na)
+ CALL WDialogPutCheckBox(idf_check2,nb)
+ CALL WDialogPutReal(idf_real1,r4(1))
+
+ CALL WDialogSelect(IDD_CREATM1)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetCheckBox(idf_check1,na)
+ CALL WDialogGetCheckBox(idf_check2,nb)
+ if(nb .eq. 1) then
+ CALL WDialogGetReal(idf_real1,r4(1))
+ do k=1,1000
+ r4(k)=r4(1)
+ enddo
+ endif
+ N5=0
+ ELSE
+ N5=1
+ RETURN
+
+ ENDIF
+
+ if(na .eq. 1 .and. nb .eq. 1) return
+
+ call wdialogload(IDD_CREATM)
+ ierr=infoerror(1)
+
+ CALL WGridPutCheckBox(idf_grid1,1,n3,n1)
+ CALL WGridPutReal(idf_grid1,2,r2,n1)
+ CALL WGridPutReal(idf_grid1,3,r4,n1)
+
+ CALL WDialogSelect(IDD_CREATM)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WGridGetCheckBox(idf_grid1,1,n3,n1)
+ CALL WGridGetReal(idf_grid1,2,r2,n1)
+ CALL WGridGetReal(idf_grid1,3,r4,n1)
+ N5=0
+ ELSE
+ N5=1
+ RETURN
+
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE CFORM
+
+! Form list of nodes working along contour lines
+
+ USE BLKMAP
+ USE BLK1MOD
+
+ COMMON /CRMAP/ NCONT,CVALUE(1000),MSTART(1000),MFIN(1000),CINTDIS(1000),IACTCV(1000)
+
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+
+ DISTC(N1,N2)=SQRT((XMAP(N1)-XMAP(N2))**2 &
+ & +(YMAP(N1)-YMAP(N2))**2)
+
+! Loop through each active contour
+
+ DO N=1,NCONT
+ IF(IACTCV(N) .EQ. 1) THEN
+ JS=MSTART(N)
+ JF=MFIN(N)
+ IF(XMAP(JS) .EQ. XMAP(JF) .AND. YMAP(JS) .EQ. YMAP(JF)) THEN
+ IF(JF .GT. JS) JF=JF-1
+ ENDIF
+ IEND=0
+ DO J=JS,JF
+ IF(J .EQ. JS) THEN
+ CDONE=0.
+ CNODE=0
+ CALL GETNOD(JJ)
+ INSKP(JJ)=0
+ INEW(JJ) = 1
+!
+ XUSR(JJ) = XMAP(J)
+ YUSR(JJ) = YMAP(J)
+ CORD(JJ,1)=(XUSR(JJ)+XS)/TXSCAL
+ CORD(JJ,2)=(YUSR(JJ)+YS)/TXSCAL
+ WD(JJ)=CVALUE(N)
+ WIDTH(JJ)=0.
+ SS1(JJ)=0.
+ SS2(JJ)=0.
+ WIDS(JJ)=0.
+ WIDBS(JJ)=0.
+ SSO(JJ)=0.
+ IF (JJ .GT. NP) NP = JJ
+ CALL PLTNOD(JJ,0)
+ ICHG=0
+ ELSE
+ CNODEO=CNODE
+ CNODE=CNODE+DISTC(J,J-1)
+ 200 CONTINUE
+ CDIS=CDONE+CINTDIS(N)
+ IF(CDIS .LE. CNODE .OR. J .EQ. JF) THEN
+ IF(CDIS .LE. CNODE) THEN
+ FACT=(CDIS-CNODEO)/(DISTC(J,J-1))
+ IF(J .EQ. JF .AND. FACT .GT. 0.999) IEND=1
+ ELSE
+ FACT=1.0
+ IEND=1
+ ENDIF
+ CALL GETNOD(JJ)
+ INSKP(JJ)=0
+ INEW(JJ) = 1
+!
+ XUSR(JJ) = (1.-FACT)*XMAP(J-1)+FACT*XMAP(J)
+ YUSR(JJ) = (1.-FACT)*YMAP(J-1)+FACT*YMAP(J)
+ CORD(JJ,1)=(XUSR(JJ)+XS)/TXSCAL
+ CORD(JJ,2)=(YUSR(JJ)+YS)/TXSCAL
+ WD(JJ)=CVALUE(N)
+ WIDTH(JJ)=0.
+ SS1(JJ)=0.
+ SS2(JJ)=0.
+ WIDS(JJ)=0.
+ WIDBS(JJ)=0.
+ SSO(JJ)=0.
+ IF (JJ .GT. NP) NP = JJ
+ CALL PLTNOD(JJ,0)
+ ICHG=0
+ CDONE=CDIS
+ IF(IEND .NE. 1) GO TO 200
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE CHECKPOLY
+
+! CHECK IF ELEMENTS ARE OUTSIDE POLYGON BY LOOKING AT CENTROID
+ USE BLKOUT
+ USE BLK1MOD
+
+ IF(NOUTLIN .EQ. 0) RETURN
+
+ call FILM(1)
+ NETEMP=NE
+ DO N=1,NETEMP
+ IF(IMAT(N) .EQ. 0) CYCLE
+ XM=(XUSR(NOP(N,1))+XUSR(NOP(N,3))+XUSR(NOP(N,5)))/3.
+ YM=(YUSR(NOP(N,1))+YUSR(NOP(N,3))+YUSR(NOP(N,5)))/3.
+! do k=2,6,2
+! xm=xusr(nop(n,k))
+! ym=yusr(nop(n,k))
+ if( IGRInsidePolygon(xoutl,youtl,noutlin,xm,ym)) then
+
+ else
+ CALL DELTEL(n)
+ go to 200
+ endif
+! enddo
+
+200 continue
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/CRGRID.f90 b/src/src83e/CRGRID.f90
new file mode 100644
index 0000000..59feea3
--- /dev/null
+++ b/src/src83e/CRGRID.f90
@@ -0,0 +1,376 @@
+ SUBROUTINE crgrid
+ USE BLK1MOD
+ USE BLKMAP
+ REAL*8 GRIDX,GRIDY,GRIDXL,GRIDYL,XL,YL,ANGD,GETANG1,A,B,C,D
+ INTEGER*2 IGSKP
+ dimension XL(1500,3),YL(1500,3),mappt(2),XL1(500),XL2(500)
+ INCLUDE 'TXFRM.COM'
+ COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
+ ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
+!
+! define line numbers in map file
+!
+ ITEST=1
+ CALL PANELGENBLK(NY,XSZ,KL1,KL2,ISW1,ISW2,ITEST)
+ JS=1
+!
+ K=0
+ KL=1
+ CALL RCyan
+ DO 20 J=1,MAXPTS
+ MLEN=J-JS
+ IF(XMAP(J) .LE. VDX .or. j .eq. maxpts) THEN
+ IF(J .EQ. MAXPTS .AND. XMAP(J) .GT. VDX) MLEN=MLEN+1
+!
+!
+ K=K+1
+ IF(K .EQ. KL2) THEN
+ DO KK=1,MLEN
+ XL(KK,1)=XMAP(KK+JS-1)
+ YL(KK,1)=YMAP(KK+JS-1)
+ ENDDO
+ IF(ISW2 .EQ. 1) THEN
+ DO KK=MLEN,1,-1
+ XL(KK,3)=XL(MLEN-KK+1,1)
+ YL(KK,3)=YL(MLEN-KK+1,1)
+ ENDDO
+ DO KK=1,MLEN
+ XL(KK,1)=XL(KK,3)
+ YL(KK,1)=YL(KK,3)
+ ENDDO
+ ENDIF
+ MAPPT(1)=MLEN
+ ENDIF
+ IF(K .EQ. KL1) THEN
+ DO KK=1,MLEN
+ XL(KK,2)=XMAP(KK+JS-1)
+ YL(KK,2)=YMAP(KK+JS-1)
+ ENDDO
+ IF(ISW1 .EQ. 1) THEN
+ DO KK=MLEN,1,-1
+ XL(KK,3)=XL(MLEN-KK+1,2)
+ YL(KK,3)=YL(MLEN-KK+1,2)
+ ENDDO
+ DO KK=1,MLEN
+ XL(KK,2)=XL(KK,3)
+ YL(KK,2)=YL(KK,3)
+ ENDDO
+ ENDIF
+ MAPPT(2)=MLEN
+ ENDIF
+ JS=J+1
+ KL=2
+ ENDIF
+ 20 CONTINUE
+ K1=1
+ K2=2
+!
+! compute line length
+!
+ XL1=0.
+ nlpts1=mappt(k1)
+ do n=2,nlpts1
+ XL1(n)=XL1(n-1)+SQRT((XL(N,1)-XL(n-1,1))**2+(YL(n,1)-YL(n-1,1))**2)
+ enddo
+ XL2=0.
+ nlpts2=mappt(k2)
+ do n=2,nlpts2
+ XL2(n)=XL2(n-1)+SQRT((XL(N,2)-XL(n-1,2))**2+(YL(n,2)-YL(n-1,2))**2)
+ enddo
+ xmean=(XL1(nlpts1)+XL2(nlpts2))/2.
+!
+! get size spacing
+!
+ along=xmean/xsz
+ NX=(along+0.99)
+
+ NXP=NX+1
+ NYP=NY+1
+ NRL=NX*NYP+1
+ NRT=NXP*NYP
+
+ DO N=1,NE
+ DO M=1,8
+ NOPSV(N,M)=NOP(N,M)
+ ENDDO
+ IMATSV(N)=IMAT(N)
+ ENDDO
+ NESAV=NE
+ NEFSAV=NENTRY
+ NPUNDO=NRT
+
+! Initialize GRIDX and GRIDY
+
+ DO N=1,NRT
+ GRIDX(N)=0.
+! GRIDY(N)=0.
+ IGSKP(N)=0
+ END DO
+!
+! calculate lengths
+!
+ xalong1=XL1(nlpts1)/NX
+ xalong2=XL2(nlpts2)/NX
+!
+! compute cords along the edges
+!
+ XALONG=0.
+ XXALONG=0.
+ GRIDX(1)=XL(1,1)
+ GRIDY(1)=YL(1,1)
+ GRIDX(NYP)=XL(1,2)
+ GRIDY(NYP)=YL(1,2)
+ NRT=NXP*NYP
+ NX1=2
+ NX2=2
+ NCR=1
+ DO N=NY+2,NRT,NYP
+ NCR=NCR+1
+ XALONG=XALONG+XALONG1
+ DO M=NX1,NLPTS1
+ IF(XALONG .LT. XL1(M)) THEN
+ M1=M
+ GO TO 200
+ ENDIF
+ ENDDO
+ 200 CONTINUE
+ FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
+ GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
+ GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
+ NX1=M1
+ XXALONG=XXALONG+XALONG2
+ DO M=NX2,NLPTS2
+ IF(XXALONG .LT. XL2(M)) THEN
+ M2=M
+ GO TO 250
+ ENDIF
+ ENDDO
+ 250 CONTINUE
+ FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
+ GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
+ GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
+ NX2=M2
+
+ ANGD1=GETANG1(GRIDX(N-NY-1),GRIDY(N-NY-1),GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY))
+ ANGD2=GETANG1(GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY),GRIDX(N-1),GRIDY(N-1))
+ ANGM1=(ANGD1+180-ANGD2)/2.
+! WRITE(151,*) N,ANGD1,ANGD2,ANGM1
+ IF(ITEST .EQ. 1) THEN
+ XALONGKP=XALONG
+ XXALONGKP=XXALONG
+! write(151,*) 'b',xalong,xxalong
+ IF(ANGM1 .GT. 100. .OR. ANGM1 .LT. 80.) THEN
+ IF(ANGM1 .GT. 100) THEN
+ XALONG=XALONG+XALONG1/2.
+ XXALONG=XXALONG-XALONG2/2.
+ ELSE
+ XALONG=XALONG-XALONG1/2.
+ XXALONG=XXALONG+XALONG2/2.
+ ENDIF
+! WRITE(151,*) 'a',XALONG,XXALONG
+ itag=0
+ 275 CONTINUE
+ DO M=1,NLPTS1
+ IF(XALONG .LT. XL1(M)) THEN
+ M1=M
+ GO TO 300
+ ENDIF
+ ENDDO
+ 300 CONTINUE
+ FRAC1=(XALONG-XL1(M1-1))/(XL1(M1)-XL1(M1-1))
+ GRIDX(N)=XL(m1-1,1)+FRAC1*(XL(m1,1)-XL(m1-1,1))
+ GRIDY(N)=YL(m1-1,1)+FRAC1*(YL(m1,1)-YL(m1-1,1))
+ NX1=M1
+ DO M=1,NLPTS2
+ IF(XXALONG .LT. XL2(M)) THEN
+ M2=M
+ GO TO 350
+ ENDIF
+ ENDDO
+ 350 CONTINUE
+ FRAC1=(XXALONG-XL2(M2-1))/(XL2(M2)-XL2(M2-1))
+ GRIDX(N+NY)=XL(m2-1,2)+FRAC1*(XL(m2,2)-XL(m2-1,2))
+ GRIDY(N+NY)=YL(m2-1,2)+FRAC1*(YL(m2,2)-YL(m2-1,2))
+ NX2=M2
+ ANGD3=GETANG1(GRIDX(N-NY-1),GRIDY(N-NY-1),GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY))
+ ANGD4=GETANG1(GRIDX(N),GRIDY(N),GRIDX(N+NY),GRIDY(N+NY),GRIDX(N-1),GRIDY(N-1))
+ ANGM2=(ANGD3+180-ANGD4)/2.
+! WRITE(151,*) N,ANGD3,ANGD4,ANGM2
+ if(itag .eq. itest) go to 375
+ IF(ANGM1 .LT. 80. .AND. ANGM2 .GT. 100.) THEN
+ FRAC=(ANGM2-90)/(ANGM2-ANGM1)
+ XALONG=XALONG+XALONG1/2.*FRAC
+ XXALONG=XXALONG-XALONG2/2.*FRAC
+ itag=1
+! WRITE(151,*) XALONG,XXALONG
+ GO TO 275
+ ELSEIF(ANGM1 .GT. 100. .AND. ANGM2 .LT. 80.) THEN
+ FRAC=(90-ANGM2)/(ANGM1-ANGM2)
+ XALONG=XALONG-XALONG1/2.*FRAC
+ XXALONG=XXALONG+XALONG2/2.*FRAC
+ itag=1
+! WRITE(151,*) XALONG,XXALONG
+ GO TO 275
+! WRITE(151,*) XALONG,XXALONG
+ ENDIF
+ XALONG1=(XL1(nlpts1)-XALONG)/(NXP-NCR)
+ XALONG2=(XL2(nlpts2)-XXALONG)/(NXP-NCR)
+ 375 continue
+ ENDIF
+ ENDIF
+ ENDDO
+!
+!
+! check if points ok allow for move
+!
+!
+! form elements and other coordinates
+!
+!
+! Interpolate interior points
+!
+ DO M=1,NRT,NYP
+ NFS=NRL+M-1
+ CALL INTERP(GRIDX,GRIDY,M,M+NY,1,GRIDX(M),GRIDY(M),GRIDX(M+NY) &
+ & ,GRIDY(M+NY),NY,0)
+ DO N=M,M+NY
+ GRIDXL(N)=GRIDX(N)
+ GRIDYL(N)=GRIDY(N)
+ GRIDX(N) =(GRIDXL(N)+XS)/TXSCAL
+ GRIDY(N) =(GRIDYL(N)+YS)/TXSCAL
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ SIZ=0.1
+ CALL RRed
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ ENDDO
+ END DO
+!
+! query for depths
+!
+!
+! query for happY
+ DO 500 N=1,NRT
+!
+! Find next blank node in CORD
+!
+ CALL GETNOD(J)
+ NODDEL(N)=J
+!
+! Store GRIDX and GRIDY into it
+!
+ CORD(J,1) = GRIDX(N)
+ CORD(J,2) = GRIDY(N)
+ IGRIDE(N) = J
+ INEW(J) = 1
+ INSKP(J) = 0
+ WD(J)=-9999.
+!
+ XUSR(J) = GRIDX(N)*TXSCAL - XS
+ YUSR(J) = GRIDY(N)*TXSCAL - YS
+!
+! Display point
+!
+ CALL PLTNOD(J,1)
+!
+ 500 END DO
+!
+! Generate elements
+!
+ CALL GETELM(K)
+ IECHG=0
+!
+ DO 600 I=1,NX
+ DO 590 J=1,NY
+ CALL GETELM(K)
+ NOP(K,1)=IGRIDE((I-1)*NYP+J)
+ NOP(K,2)=0
+ NOP(K,3)=IGRIDE(I*NYP+J)
+ NOP(K,4)=0
+ NOP(K,5)=IGRIDE(I*NYP+J+1)
+ NOP(K,6)=0
+ NOP(K,7)=IGRIDE((I-1)*NYP+J+1)
+ NOP(K,8)=0
+ IMAT(K)=1
+! IF(K .GT. NE) NE=K
+ NCORN(K)=8
+ IESKP(K)=0
+!IPK JAN98
+ IERC=0
+ CALL PLTELM(K,IERC)
+ 590 CONTINUE
+ 600 END DO
+ CALL WRTOUT(0)
+ RETURN
+ end
+
+ REAL*8 FUNCTION GETANG1(X1,Y1,X2,Y2,X3,Y3)
+ REAL*8 X1,Y1,X2,Y2,X3,Y3,CAN
+ C=SQRT((X2-X1)**2+(Y2-Y1)**2)
+ B=SQRT((X3-X2)**2+(Y3-Y2)**2)
+ A=SQRT((X1-X3)**2+(Y1-Y3)**2)
+ CAN=(B**2+C**2-A**2)/(2.*B*C)
+ GETANG1=DACOSD(CAN)
+ RETURN
+ END
+
+ SUBROUTINE PANELgenblk(N1,XL,N2,N3,ISW1,ISW2,ITEST)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR,IFIRST,ISW1,ISW2,ITEST
+ real :: XL
+ character*3 :: sub
+ DATA IFIRST/0/
+
+ IF(IFIRST .EQ. 0) THEN
+ IFIRST=1
+ N1=1
+ N2=1
+ N3=2
+ XL=5.
+ isw1=0
+ isw2=0
+ ENDIF
+ call wdialogload(IDD_GENBLK)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,n1)
+ CALL WDialogPutInteger(idf_integer2,n2)
+ CALL WDialogPutInteger(idf_integer3,n3)
+ CALL WDialogPutInteger(idf_integer5,ITEST)
+ CALL WDialogPutReal(idf_real1,xl)
+ CALL WDialogPutCheckBox(idf_check1,isw1)
+ CALL WDialogPutCheckBox(idf_check2,isw2)
+ CALL WDialogSelect(IDD_GENBLK)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(idf_integer1,n1)
+ CALL WDialogGetInteger(idf_integer2,n2)
+ CALL WDialogGetInteger(idf_integer3,n3)
+ CALL WDialogGetReal(idf_real1,xl)
+ CALL WDialogGetInteger(idf_integer5,ITEST)
+ CALL WDialogGetCheckBox(idf_check1,isw1)
+ CALL WDialogGetCheckBox(idf_check2,isw2)
+
+
+ ENDIF
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/CRSECT.F90 b/src/src83e/CRSECT.F90
new file mode 100644
index 0000000..5e50547
--- /dev/null
+++ b/src/src83e/CRSECT.F90
@@ -0,0 +1,158 @@
+!-----------------------------------------------------------------crsect
+ subroutine crsect
+!----------------------------------------------------------------------c
+! purpose: c
+! To plot a selected cross section and calculate width and c
+! slopes. c
+! ycw mar97 c
+!----------------------------------------------------------------------c
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! include 'BLK1.COM'
+! include 'BLK2.COM'
+
+ real XPL(5),YPL(5),ss0(50)
+ CHARACTER*1 ANS,ANSW(0:4),IFLAG
+ CHARACTER*6 DESCR
+
+ INCLUDE 'TXFRM.COM'
+
+ COMMON /XYGRPH/ XVALUES(10000,10),YVALUES(10000,10),TIMMIN,VALMIN,TIMMAX,VALMAX,NVALUES,NSETS,LINPROP(10)
+
+ COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)
+ DATA MAN/1/
+
+!
+!------get cross section number
+!
+! 100 NHTP=0
+! NMESS=29
+! NBRR=6
+ call selcrs(man)
+
+ if(man .eq. 2) then
+ call setlim(timmin,timmax,valmin,valmax)
+ else
+
+!
+!......establish shape of curve
+!
+
+ timmin=1.e20
+ valmin=1.e20
+ timmax=-1.e20
+ valmax=-1.e20
+ endif
+
+ DO J=1,5
+ icr=icrsr(j)
+ if(icr .gt. 0) then
+ do i=nrivl(icr),1,-1
+
+ ii=nrivl(icr)-i+1
+ xvalues(ii,j)=-crsdat(icr,i,3)/2.
+ yvalues(ii,j)=crsdat(icr,i,1)
+ ij=nrivl(icr)+i
+ xvalues(ij,j)=crsdat(icr,i,3)/2.
+ yvalues(ij,j)=crsdat(icr,i,1)
+
+ enddo
+ nsets=j
+
+ if(man .eq. 1) then
+ timmin=min(timmin,-crsdat(icr,nrivl(icr),3)/2.)
+ valmin=min(valmin,crsdat(icr,1,1))
+ timmax=max(timmax,crsdat(icr,nrivl(icr),3)/2.)
+ valmax=max(valmax,crsdat(icr,nrivl(icr),1))
+ endif
+
+ NVALUES=2*nrivl(icr)
+ write(DESCR(j),'(i6)') ICR
+ endif
+ enddo
+ call dograph(2,icurwin)
+ iscrns(icurwin)=3
+
+ return
+ END
+
+ subroutine selcrs(MAN)
+
+ USE WINTERACTER
+ INCLUDE 'D.INC'
+ CHARACTER*6 DESCR
+
+ COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)
+
+ call wdialogload(IDD_SELCRSEC)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_SECCRSEC)
+ ierr=infoerror(1)
+
+ do i=1,5
+ CALL WGridPutCellInteger(IDF_GRID1,i,1,icrsr(i))
+ enddo
+
+ if(man .eq. 1) then
+ CALL WDialogPutRadioButton(IDF_RADIO1)
+ else
+ CALL WDialogPutRadioButton(IDF_RADIO2)
+ endif
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ do i=1,5
+ CALL WGridGetCellInteger(IDF_GRID1,i,1,icrsr(i))
+ enddo
+ CALL WDialogGetRadioButton(IDF_RADIO1,man)
+ return
+ else
+ return
+ endif
+
+ enddo
+ return
+
+ end
+
+ subroutine setlim(timmin,timmax,valmin,valmax)
+
+ USE WINTERACTER
+ INCLUDE 'D.INC'
+ CHARACTER*6 DESCR
+
+ call wdialogload(IDD_LIMITS)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_LIMITS)
+ ierr=infoerror(1)
+
+
+ CALL WDialogPutReal(IDF_REAL1,TIMMIN)
+ CALL WDialogPutReal(IDF_REAL2,TIMMAX)
+ CALL WDialogPutReal(IDF_REAL3,VALMIN)
+ CALL WDialogPutReal(IDF_REAL4,VALMAX)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetReal(IDF_REAL1,TIMMIN)
+ CALL WDialogGetReal(IDF_REAL2,TIMMAX)
+ CALL WDialogGetReal(IDF_REAL3,VALMIN)
+ CALL WDialogGetReal(IDF_REAL4,VALMAX)
+ return
+ else
+ return
+ endif
+
+ enddo
+ return
+
+ end
\ No newline at end of file
diff --git a/src/src83e/CSETNEW.F90 b/src/src83e/CSETNEW.F90
new file mode 100644
index 0000000..d31ff3a
--- /dev/null
+++ b/src/src83e/CSETNEW.F90
@@ -0,0 +1,407 @@
+ SUBROUTINE CSET(TTMIN,TTMAX,isz)
+
+ USE WINTERACTER
+ SAVE
+ INTEGER ICK5
+!
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+!IPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+ DIMENSION NKEY(99)
+ CHARACTER*80 ILIND
+ LOGICAL SWITCH
+ DATA ITIM,VDM /0,-1.E15/
+!
+ call setd(24)
+ IF(ITIM .EQ. 0) THEN
+ OMAX=VDM
+ OMIN=VDM
+ ick5=0
+ DO 200 N=1,99
+ CONTUR(N)=VDM
+ 200 CONTINUE
+ ITIM=ITIM+1
+ ELSE
+ ITIM=ITIM+1
+ ENDIF
+!
+!
+ 13 continue
+!
+! isz = 0 means no choice for data
+! = 1 means data selectd
+!
+ IF(TTMAX .EQ. TTMIN) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,&
+ 'There are no contours for this case MAX=MIN'//CHAR(13)//'The model will return ','CONTOUR ERROR')
+ 5010 FORMAT(F5.2)
+ RETURN
+!ipk apr94
+ ENDIF
+ IF(ICK5 .EQ. 1) GO TO 250
+!
+! get an estimate of contour values
+!
+ AT=ALOG10(TTMAX-TTMIN)
+ IF(AT .LT. 0.) THEN
+ CINTER = 10. ** (IFIX(AT - .5) - 1)
+ ELSE
+ CINTER = 10. ** (IFIX(AT + .5) - 1)
+ ENDIF
+! CINTER = 10. ** (IFIX(ALOG10(TTMAX-TTMIN) + .5) - 1)
+ 235 FINTER = CINTER
+! write(*,*) cinter,numv
+ IF(TTMIN .GT. 0.) THEN
+ CONTUR(1)=IFIX(TTMIN/CINTER)*CINTER+0.001*cinter
+ ELSE
+ CONTUR(1)=IFIX((TTMIN-CINTER)/CINTER)*CINTER+0.001*cinter
+ ENDIF
+ NUMV=1
+ DO 240 N=2,99
+ CONTUR(N)=CONTUR(N-1)+FINTER
+ IF(CONTUR(N) .GT. TTMAX) THEN
+ NUMV=N
+ GO TO 245
+ ENDIF
+ 240 END DO
+ NUMV=99
+ 245 IF(NUMV .GT. 16) THEN
+ CINTER=CINTER*2.
+ GO TO 235
+ ENDIF
+ DO 247 N=NUMV+1,99
+ CONTUR(N)=VDM
+ 247 END DO
+ 250 CONTINUE
+!
+! print options when no startup data available
+!
+ if(isz .eq. 1) then
+ call conpanel(icsp,ttmin,ttmax,numv,contur,omax,omin,ick5)
+ if(icsp .lt. 0) then
+ GO TO 405
+ elseif(icsp .eq. 0) then
+ go to 405
+ endif
+
+
+ IF(ABS(ICSP) .EQ. 1) THEN
+ icsp=0
+!
+! this is log spacing
+!
+ IF(TTMAX .GT. 0.) THEN
+ ALMAX=ALOG10(TTMAX)
+ ELSE
+ call clscrn
+ call symbl (0.1,7.0,0.25, &
+ & 'Maximum contour value is negative',0.0,33)
+ call symbl (0.1,6.5,0.25, &
+ & 'Reconsider your choice',0.0,22)
+ GO TO 250
+ ENDIF
+ IF(TTMIN .GT. 0.) THEN
+ ALMIN=ALOG10(TTMIN)
+!ipk oct94 add a switch
+ IMINSW=0
+ ELSE
+ call clscrn
+ call symbl (0.1,7.0,0.25, &
+ & 'Minimum contour value is negative',0.0,33)
+ call symbl (0.1,6.5,0.25, &
+ & 'Value set to 10**10 less than max value',0.0,39)
+ ALMIN=ALMAX-10.
+!ipk oct 94 add a switch
+ IMINSW=1
+ ENDIF
+!
+ ALMIN=ALMAX-4.
+!
+ IF(ALMAX .GT. 0.) THEN
+ LMAX=ALMAX
+ ELSE
+ LMAX=ALMAX-1.
+ ENDIF
+ IF(ALMIN .GT. 0.) THEN
+ LMIN=ALMIN+1.
+ ELSE
+ LMIN=ALMIN
+ ENDIF
+!ipk oct94 NUMV=LMAX-LMIN+1
+ NUMV=LMAX-LMIN+1+IMINSW
+ IF(NUMV .LT. 8) THEN
+ NUMV=NUMV*2
+ IDB=2
+ ELSE
+ IDB=1
+ ENDIF
+!ipk oct94
+ IF(IMINSW .EQ. 1) THEN
+ CONTUR(1)=0.
+ CONTUR(2)=10.**LMIN
+ K=2
+ ELSE
+ CONTUR(1)=10.**LMIN
+ K=1
+ ENDIF
+ IPW=LMIN
+ DO 350 N=IMINSW+2,NUMV,IDB
+ IF(IDB .EQ. 2) THEN
+ K=K+1
+ CONTUR(K)=CONTUR(K-1)*3.
+ ENDIF
+ IPW=IPW+1
+ K=K+1
+ CONTUR(K)=10.**IPW
+ 350 CONTINUE
+ numv=k
+!
+! this is for entry of chosen contours
+!
+ ELSEIF(abs(ICSP) .EQ. 2) THEN
+ icsp=0
+ CALL SORT(CONTUR,NKEY,NUMV)
+ ELSEIF(abs(ICSP) .EQ. 3) THEN
+ icsp=0
+ cinter=omax-omin
+ if(cinter .gt. 0.) then
+ cinter=cinter/(numv-1)
+ else
+ cinter=1.0
+ endif
+ contur(1)=omin
+ do i=2,numv
+ contur(i)=contur(i-1)+cinter
+ enddo
+ ENDIF
+ GO TO 250
+!ipk july 1995 add this line
+ 405 CONTINUE
+ ENDIF
+ call setd(2)
+ RETURN
+ END
+
+
+
+ subroutine conpanel(icsp,ttmin,ttmax,numv,contur,omax,omin,ick5)
+
+ use winteracter
+ implicit none
+
+ save
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: icsp,numv,nlim,ict,ictx,ick1,ick2,ick3,ick4,ick5,ierr,idf,ipos,numvold
+ real :: ttmin,ttmax,contur(99),omax,omin,VDX
+ character*80 labmax,labmin,labnum,labcon(30),labomax,labomin
+ VDX=-1.E14
+ write(labmax,'(f10.3)') ttmax
+ write(labmin,'(f10.3)') ttmin
+
+ if(omax .lt. vdx) then
+ labomax=labmax
+ else
+ write(labomax,'(f10.3)') omax
+ endif
+
+ if(omin .lt. vdx) then
+ labomin=labmin
+ else
+ write(labomin,'(f10.3)') omin
+ endif
+ write(labnum,'(i10)') numv
+ nlim=numv
+ if(nlim .gt. 30) nlim=numv
+ do ict=1,nlim
+ write(labcon(ict),'(f10.3)') contur(ict)
+ enddo
+ if(numv .lt. 30) then
+ do ict=numv+1,30
+ labcon(ict)=' '
+ enddo
+ endif
+
+ 90 continue
+ numvold=numv
+
+ call wdialogload(IDD_DIALOG02)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(idf_string1,labmax)
+ CALL WDialogPutString(idf_string2,labmin)
+ CALL WDialogPutString(idf_string3,labomax)
+ CALL WDialogPutString(idf_string22,labomin)
+ CALL WDialogPutString(idf_string23,labnum)
+
+ ictx=0
+ do ict=idf_string4,idf_string4+18-1
+ ictx=ictx+1
+ CALL WDialogPutString(ict,labcon(ictx))
+ enddo
+ ictx=ictx+1
+ ICT=idf_string24
+ CALL WDialogPutString(ict,labcon(ictx))
+
+ DO ict=idf_string25,idf_string25+9
+ ictx=ictx+1
+ CALL WDialogPutString(ict,labcon(ictx))
+ enddo
+ ictx=ictx+1
+ ICT=idf_string35
+ CALL WDialogPutString(ict,labcon(ictx))
+
+! call wdialogputcheckbox(idf_check1,0)
+! call wdialogputcheckbox(idf_check2,0)
+! call wdialogputcheckbox(idf_check3,0)
+! call wdialogputcheckbox(idf_check4,0)
+ call wdialogputcheckbox(idf_check5,ick5)
+! if(icsp .eq. 0) then
+ call wdialogputRadioButton(idf_check1)
+! endif
+
+
+ CALL WDialogSelect(IDD_DIALOG02)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+! call wdialoggetcheckbox(idf_check1,ick1)
+! call wdialoggetcheckbox(idf_check2,ick2)
+! call wdialoggetcheckbox(idf_check3,ick3)
+! call wdialoggetcheckbox(idf_check4,ick4)
+ call wdialoggetcheckbox(idf_check5,ick5)
+ CALL WDialoggetString(idf_string1,labmax)
+ CALL WDialoggetString(idf_string2,labmin)
+ CALL WDialoggetString(idf_string3,labomax)
+ CALL WDialoggetString(idf_string22,labomin)
+ CALL WDialoggetString(idf_string23,labnum)
+ call wdialoggetradiobutton(idf_check1,ipos)
+ call IStringToInteger(labnum,numv)
+ write(90,*) 'numvold',numvold,numv,ipos
+ if(numvold .ne. numv .and. ipos .ne. 4) ipos=3
+!C if(ick1 .eq. 1) then
+!C icsp=0
+!C else
+ icsp=0
+ if(ipos .eq. 2) then
+ icsp=1
+ elseif(ipos .eq. 3) then
+ icsp=3
+ write(90,'(a)') 'numv',labnum
+ call IStringToInteger(labnum,numv)
+ if(infoError(1) .gt. 0) then
+ call wdialogload(IDD_DIALOG04)
+ CALL WDialogSelect(IDD_DIALOG04)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ 120 continue
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ go to 90
+ endif
+ go to 120
+ endif
+ call IStringToReal(labomax,omax)
+ if(infoError(1) .gt. 0) then
+ call wdialogload(IDD_DIALOG04)
+ CALL WDialogSelect(IDD_DIALOG04)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ 130 continue
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ go to 90
+ endif
+ go to 130
+ endif
+ call IStringToReal(labomin,omin)
+ if(infoError(1) .gt. 0) then
+ call wdialogload(IDD_DIALOG04)
+ CALL WDialogSelect(IDD_DIALOG04)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ 140 continue
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ go to 90
+ endif
+ go to 140
+ endif
+ elseif(ipos .eq. 4) then
+ icsp=2
+ write(90,'(a)') 'numv-4',labnum
+! read(labnum,*) numv
+ call IStringToInteger(labnum,numv)
+ if(infoError(1) .gt. 0) then
+ call wdialogload(IDD_DIALOG04)
+ CALL WDialogSelect(IDD_DIALOG04)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ 150 continue
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ go to 90
+ endif
+ go to 150
+ endif
+ write(90,*) numv
+ ictx=0
+ do ict=idf_string4,idf_string4+18-1
+ ictx=ictx+1
+ CALL WDialogGetString(ict,labcon(ictx))
+ enddo
+ ictx=ictx+1
+ ICT=idf_string24
+ CALL WDialogGetString(ict,labcon(ictx))
+ do ict=idf_string25,idf_string25+9
+ ictx=ictx+1
+ CALL WDialogGetString(ict,labcon(ictx))
+ enddo
+ ictx=ictx+1
+ ICT=idf_string35
+ CALL WDialogGetString(ict,labcon(ictx))
+ do ict=1,numv
+! read(labcon(ict),*) contur(ict)
+ call IStringToReal(labcon(ict),contur(ict))
+ if(infoError(1) .gt. 0) then
+ call wdialogload(IDD_DIALOG04)
+ CALL WDialogSelect(IDD_DIALOG04)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ 160 continue
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ go to 90
+ endif
+ go to 160
+ endif
+ write(90,*) 'con',ict,contur(ict)
+ enddo
+ endif
+
+ if(ipos .eq. 5) then
+ icsp=-5
+! abs(icsp)
+ endif
+ write(90,*) 'icsp',icsp,omax,omin,numv,ipos
+! write(90,*) 'ick',ick1,ick2,ick3,ick4,ick5
+ return
+
+ endif
+ return
+ enddo
+ return
+ end
diff --git a/src/src83e/D.INC b/src/src83e/D.INC
new file mode 100644
index 0000000..70b1d42
--- /dev/null
+++ b/src/src83e/D.INC
@@ -0,0 +1,367 @@
+! Winteracter resource identifiers. Created : 13/Feb/2017 12:04:28
+!
+! This file is generated by the Winteracter resource editor.
+! It should not be edited manually. It is also not advisable to load this
+! file in a text editor, while working on the associated resource file,
+! since this may prevent the resource identifiers file from being updated.
+! To view the names and values of resource identifiers, use the
+! "Identifier Names and Values" or "Used Identifiers" options on the
+! resource editor's "View" menu. Both dialogs also include a "Copy id"
+! button which allows identifier names to be copied via the clipboard.
+! Opening this file in an editor should therefore not be necessary.
+!
+ INTEGER, PARAMETER :: IDR_MENU1 = 30001
+ INTEGER, PARAMETER :: ID_FILE = 40001
+ INTEGER, PARAMETER :: ID_EXIT = 40002
+ INTEGER, PARAMETER :: ID_NODE = 40003
+ INTEGER, PARAMETER :: ID_ELTS = 40004
+ INTEGER, PARAMETER :: ID_ORDRT = 40005
+ INTEGER, PARAMETER :: ID_CCLNA = 40006
+ INTEGER, PARAMETER :: ID_CSEC1 = 40007
+ INTEGER, PARAMETER :: ID_ZOOM = 40008
+ INTEGER, PARAMETER :: ID_DRAW = 40009
+ INTEGER, PARAMETER :: ID_HELP = 40010
+ INTEGER, PARAMETER :: ID_STRING1 = 50001
+ INTEGER, PARAMETER :: ID_STRING2 = 50002
+ INTEGER, PARAMETER :: ID_STRING3 = 50003
+ INTEGER, PARAMETER :: ID_STRING4 = 50004
+ INTEGER, PARAMETER :: ID_STRING5 = 50005
+ INTEGER, PARAMETER :: ID_STRING6 = 50006
+ INTEGER, PARAMETER :: ID_STRING7 = 50007
+ INTEGER, PARAMETER :: ID_STRING8 = 50008
+ INTEGER, PARAMETER :: ID_STRING9 = 50009
+ INTEGER, PARAMETER :: ID_STRING10 = 50010
+ INTEGER, PARAMETER :: ID_STRING11 = 50011
+ INTEGER, PARAMETER :: ID_ITEM11 = 40011
+ INTEGER, PARAMETER :: ID_ITEM12 = 40012
+ INTEGER, PARAMETER :: ID_ITEM13 = 40013
+ INTEGER, PARAMETER :: ID_ITEM14 = 40014
+ INTEGER, PARAMETER :: ID_ITEM15 = 40015
+ INTEGER, PARAMETER :: ID_ITEM16 = 40016
+ INTEGER, PARAMETER :: ID_ITEM17 = 40017
+ INTEGER, PARAMETER :: ID_ITEM18 = 40018
+ INTEGER, PARAMETER :: ID_ITEM19 = 40019
+ INTEGER, PARAMETER :: IDF_STRING24 = 1041
+ INTEGER, PARAMETER :: IDD_DIALOG1 = 101
+ INTEGER, PARAMETER :: IDF_LABEL5 = 1042
+ INTEGER, PARAMETER :: IDC_BUTTON2 = 20001
+ INTEGER, PARAMETER :: ID_ITEM20 = 40021
+ INTEGER, PARAMETER :: ID_ITEM73 = 40022
+ INTEGER, PARAMETER :: ID_ITEM23 = 40023
+ INTEGER, PARAMETER :: ID_ITEM24 = 40024
+ INTEGER, PARAMETER :: ID_TOOLBAR1 = 30101
+ INTEGER, PARAMETER :: ID_ZIN = 40025
+ INTEGER, PARAMETER :: ID_ZOUT = 40026
+ INTEGER, PARAMETER :: ID_OUT2 = 40027
+ INTEGER, PARAMETER :: ID_OUT4 = 40028
+ INTEGER, PARAMETER :: ID_RSET = 40029
+ INTEGER, PARAMETER :: ID_PLEFT = 40031
+ INTEGER, PARAMETER :: ID_PRIGHT = 40032
+ INTEGER, PARAMETER :: ID_PUP = 40033
+ INTEGER, PARAMETER :: ID_PDOWN = 40034
+ INTEGER, PARAMETER :: ID_IDRWT = 40035
+ INTEGER, PARAMETER :: ID_TYPD = 40039
+ INTEGER, PARAMETER :: ID_DRAWD = 40041
+ INTEGER, PARAMETER :: ID_MAPOPD = 40042
+ INTEGER, PARAMETER :: ID_CONTR = 40060
+ INTEGER, PARAMETER :: IDF_LABEL1 = 1001
+ INTEGER, PARAMETER :: IDF_LABEL2 = 1002
+ INTEGER, PARAMETER :: IDF_LABEL3 = 1003
+ INTEGER, PARAMETER :: IDF_LABEL4 = 1004
+ INTEGER, PARAMETER :: IDF_STRING1 = 1013
+ INTEGER, PARAMETER :: IDF_STRING2 = 1014
+ INTEGER, PARAMETER :: IDF_STRING3 = 1015
+ INTEGER, PARAMETER :: IDF_STRING4 = 1016
+ INTEGER, PARAMETER :: IDF_STRING5 = 1017
+ INTEGER, PARAMETER :: IDF_STRING6 = 1018
+ INTEGER, PARAMETER :: IDF_STRING7 = 1019
+ INTEGER, PARAMETER :: IDF_STRING8 = 1020
+ INTEGER, PARAMETER :: IDF_STRING9 = 1021
+ INTEGER, PARAMETER :: IDF_STRING10 = 1022
+ INTEGER, PARAMETER :: IDF_STRING11 = 1023
+ INTEGER, PARAMETER :: IDF_STRING12 = 1024
+ INTEGER, PARAMETER :: IDD_DIALOG02 = 102
+ INTEGER, PARAMETER :: IDF_STRING13 = 1025
+ INTEGER, PARAMETER :: IDF_STRING14 = 1026
+ INTEGER, PARAMETER :: IDF_STRING15 = 1027
+ INTEGER, PARAMETER :: IDF_STRING16 = 1028
+ INTEGER, PARAMETER :: IDF_STRING17 = 1029
+ INTEGER, PARAMETER :: IDF_STRING18 = 1030
+ INTEGER, PARAMETER :: IDF_STRING19 = 1031
+ INTEGER, PARAMETER :: IDF_STRING20 = 1032
+ INTEGER, PARAMETER :: IDF_STRING21 = 1033
+ INTEGER, PARAMETER :: IDF_STRING22 = 1034
+ INTEGER, PARAMETER :: IDF_STRING23 = 1035
+ INTEGER, PARAMETER :: IDF_CHECK1 = 1036
+ INTEGER, PARAMETER :: IDF_CHECK2 = 1037
+ INTEGER, PARAMETER :: IDF_CHECK3 = 1038
+ INTEGER, PARAMETER :: IDF_CHECK4 = 1039
+ INTEGER, PARAMETER :: IDF_CHECK5 = 1040
+ INTEGER, PARAMETER :: ID_DCONTR = 40056
+ INTEGER, PARAMETER :: ID_CONTOPT = 40061
+ INTEGER, PARAMETER :: ID_ITYPN = 40064
+ INTEGER, PARAMETER :: ID_ITYPC = 40065
+ INTEGER, PARAMETER :: ID_ICOPY = 40067
+ INTEGER, PARAMETER :: IDD_DIALOG04 = 104
+ INTEGER, PARAMETER :: ID_BACGD = 40050
+ INTEGER, PARAMETER :: ID_ITEM26 = 40071
+ INTEGER, PARAMETER :: IDD_DIALOG05 = 103
+ INTEGER, PARAMETER :: IDF_CMAP8 = 1005
+ INTEGER, PARAMETER :: IDF_CMAP9 = 1006
+ INTEGER, PARAMETER :: IDF_CMAP0 = 1007
+ INTEGER, PARAMETER :: IDF_CMAP1 = 1008
+ INTEGER, PARAMETER :: IDF_CMAP2 = 1009
+ INTEGER, PARAMETER :: IDF_CMAP10 = 1010
+ INTEGER, PARAMETER :: IDF_CMAP11 = 1011
+ INTEGER, PARAMETER :: IDF_CMAP3 = 1012
+ INTEGER, PARAMETER :: IDF_CMAP4 = 1043
+ INTEGER, PARAMETER :: IDF_CMAP5 = 1044
+ INTEGER, PARAMETER :: IDF_CMAP6 = 1045
+ INTEGER, PARAMETER :: IDF_CMAP7 = 1046
+ INTEGER, PARAMETER :: IDD_DIALOG006 = 105
+ INTEGER, PARAMETER :: IDF_RADIO1 = 1047
+ INTEGER, PARAMETER :: IDF_RADIO2 = 1048
+ INTEGER, PARAMETER :: IDF_RADIO3 = 1049
+ INTEGER, PARAMETER :: IDF_RADIO4 = 1050
+ INTEGER, PARAMETER :: IDF_RADIO5 = 1051
+ INTEGER, PARAMETER :: IDF_RADIO6 = 1052
+ INTEGER, PARAMETER :: IDF_RADIO7 = 1053
+ INTEGER, PARAMETER :: IDF_RADIO8 = 1054
+ INTEGER, PARAMETER :: IDF_RADIO9 = 1055
+ INTEGER, PARAMETER :: ID_MMAP = 40043
+ INTEGER, PARAMETER :: IDD_DIALOG07 = 106
+ INTEGER, PARAMETER :: IDD_DIALOG08 = 107
+ INTEGER, PARAMETER :: ID_Help1 = 40040
+ INTEGER, PARAMETER :: ID_Help2 = 40044
+ INTEGER, PARAMETER :: IDD_DIALOG09 = 108
+ INTEGER, PARAMETER :: IDF_LABEL7 = 1056
+ INTEGER, PARAMETER :: IDD_DIALOG10 = 109
+ INTEGER, PARAMETER :: IDF_INTEGER1 = 1057
+ INTEGER, PARAMETER :: IDF_INTEGER2 = 1058
+ INTEGER, PARAMETER :: ID_LAYFL = 40046
+ INTEGER, PARAMETER :: IDF_RADIO10 = 1056
+ INTEGER, PARAMETER :: IDD_DIALOG010 = 110
+ INTEGER, PARAMETER :: IDD_DIALOG001 = 111
+ INTEGER, PARAMETER :: ID_BKF = 40047
+ INTEGER, PARAMETER :: IDD_DIALOG012 = 113
+ INTEGER, PARAMETER :: IDF_CHECK6 = 1041
+ INTEGER, PARAMETER :: IDF_CHECK7 = 1042
+ INTEGER, PARAMETER :: IDF_CHECK8 = 1043
+ INTEGER, PARAMETER :: IDF_CHECK9 = 1044
+ INTEGER, PARAMETER :: IDF_CHECK10 = 1045
+ INTEGER, PARAMETER :: IDF_CHECK11 = 1059
+ INTEGER, PARAMETER :: ID_Clip = 40020
+ INTEGER, PARAMETER :: ID_UNDOM = 40030
+ INTEGER, PARAMETER :: ID_BSEL = 40036
+ INTEGER, PARAMETER :: ID_REGST = 40037
+ INTEGER, PARAMETER :: IDD_REGST = 112
+ INTEGER, PARAMETER :: IDF_LABEL6 = 1005
+ INTEGER, PARAMETER :: IDF_REAL1 = 1060
+ INTEGER, PARAMETER :: IDF_REAL2 = 1061
+ INTEGER, PARAMETER :: IDF_REAL3 = 1062
+ INTEGER, PARAMETER :: IDF_REAL4 = 1063
+ INTEGER, PARAMETER :: IDF_LABEL8 = 1006
+ INTEGER, PARAMETER :: IDF_LABEL9 = 1007
+ INTEGER, PARAMETER :: IDF_LABEL10 = 1008
+ INTEGER, PARAMETER :: IDF_LABEL11 = 1043
+ INTEGER, PARAMETER :: IDF_REAL5 = 1064
+ INTEGER, PARAMETER :: IDF_REAL6 = 1065
+ INTEGER, PARAMETER :: IDF_REAL7 = 1066
+ INTEGER, PARAMETER :: IDF_REAL8 = 1067
+ INTEGER, PARAMETER :: IDF_LABEL12 = 1009
+ INTEGER, PARAMETER :: IDADJUST = 1068
+ INTEGER, PARAMETER :: IDFSWITCH = 1069
+ INTEGER, PARAMETER :: IDD_SLRGNO = 114
+ INTEGER, PARAMETER :: IDD_CONFIRM = 115
+ INTEGER, PARAMETER :: ID_network = 40038
+ INTEGER, PARAMETER :: ID_NMAP = 40045
+ INTEGER, PARAMETER :: ID_ITEM56 = 40048
+ INTEGER, PARAMETER :: ID_Nodedata = 40049
+ INTEGER, PARAMETER :: ID_Eltdata = 40051
+ INTEGER, PARAMETER :: IDD_nodedata = 116
+ INTEGER, PARAMETER :: IDF_REAL9 = 1068
+ INTEGER, PARAMETER :: IDF_REAL10 = 1069
+ INTEGER, PARAMETER :: IDD_eltdata = 117
+ INTEGER, PARAMETER :: IDF_INTEGER3 = 1059
+ INTEGER, PARAMETER :: IDF_INTEGER4 = 1060
+ INTEGER, PARAMETER :: IDF_INTEGER5 = 1061
+ INTEGER, PARAMETER :: IDF_INTEGER6 = 1062
+ INTEGER, PARAMETER :: IDF_INTEGER7 = 1063
+ INTEGER, PARAMETER :: IDF_INTEGER8 = 1064
+ INTEGER, PARAMETER :: IDF_INTEGER9 = 1070
+ INTEGER, PARAMETER :: IDF_INTEGER10 = 1071
+ INTEGER, PARAMETER :: IDD_SELNODE = 118
+ INTEGER, PARAMETER :: IDNEXT = 1072
+ INTEGER, PARAMETER :: IDD_SELELT = 119
+ INTEGER, PARAMETER :: IDD_ELTERR = 120
+ INTEGER, PARAMETER :: ID_DRAG = 40052
+ INTEGER, PARAMETER :: ID_DELM = 40103
+ INTEGER, PARAMETER :: ID_FILL = 40102
+ INTEGER, PARAMETER :: IDF_Delete = 1073
+ INTEGER, PARAMETER :: IDFROTATE = 1074
+ INTEGER, PARAMETER :: IDF_RADIO11 = 1057
+ INTEGER, PARAMETER :: ID_GETELM = 40053
+ INTEGER, PARAMETER :: ID_mapm = 40054
+ INTEGER, PARAMETER :: ID_map = 40055
+ INTEGER, PARAMETER :: IDD_GETINTP = 160
+ INTEGER, PARAMETER :: ID_SBIN = 40057
+ INTEGER, PARAMETER :: IDD_headertp = 121
+ INTEGER, PARAMETER :: ID_TRIAN = 40058
+ INTEGER, PARAMETER :: ID_SWMAP = 40059
+ INTEGER, PARAMETER :: ID_SWRM1 = 40062
+ INTEGER, PARAMETER :: IDD_TRIAN = 122
+ INTEGER, PARAMETER :: IDD_NODERR = 123
+ INTEGER, PARAMETER :: IDF_STRING25 = 1106
+ INTEGER, PARAMETER :: IDF_STRING26 = 1107
+ INTEGER, PARAMETER :: IDF_STRING27 = 1108
+ INTEGER, PARAMETER :: IDF_STRING28 = 1109
+ INTEGER, PARAMETER :: IDF_STRING29 = 1110
+ INTEGER, PARAMETER :: IDF_STRING30 = 1111
+ INTEGER, PARAMETER :: IDF_STRING31 = 1112
+ INTEGER, PARAMETER :: IDF_STRING32 = 1113
+ INTEGER, PARAMETER :: IDF_STRING33 = 1114
+ INTEGER, PARAMETER :: IDF_STRING34 = 1115
+ INTEGER, PARAMETER :: IDD_SELTFL2 = 148
+ INTEGER, PARAMETER :: ID_LOADRM1 = 40063
+ INTEGER, PARAMETER :: ID_cdata = 40066
+ INTEGER, PARAMETER :: ID_SELRM1 = 40068
+ INTEGER, PARAMETER :: ID_addmesh = 40069
+ INTEGER, PARAMETER :: ID_MRGMESH = 40070
+ INTEGER, PARAMETER :: ID_ITEM22 = 40072
+ INTEGER, PARAMETER :: ID_ALLNODES = 40073
+ INTEGER, PARAMETER :: ID_UNUSNODES = 40074
+ INTEGER, PARAMETER :: ID_TRIANG = 40075
+ INTEGER, PARAMETER :: IDD_TRIANG = 124
+ INTEGER, PARAMETER :: IDD_QUAD = 125
+ INTEGER, PARAMETER :: ID_QUAD = 40076
+ INTEGER, PARAMETER :: ID_JOIN = 40104
+ INTEGER, PARAMETER :: ID_CSEC = 40077
+ INTEGER, PARAMETER :: ID_CRSCAL = 40078
+ INTEGER, PARAMETER :: ID_SAVCRS = 40079
+ INTEGER, PARAMETER :: ID_crsf = 40080
+ INTEGER, PARAMETER :: IDD_DIALOG06 = 126
+ INTEGER, PARAMETER :: IDF_RADIO13 = 1076
+ INTEGER, PARAMETER :: IDF_RADIO12 = 1058
+ INTEGER, PARAMETER :: IDD_GETFPN = 154
+ INTEGER, PARAMETER :: IDD_GETINT = 153
+ INTEGER, PARAMETER :: ID_CSLOC = 40081
+ INTEGER, PARAMETER :: IDD_CSLOC = 127
+ INTEGER, PARAMETER :: ID_UNDO = 40082
+ INTEGER, PARAMETER :: ID_UNDOS = 40083
+ INTEGER, PARAMETER :: ID_CREATM = 40084
+ INTEGER, PARAMETER :: IDD_CREATM = 128
+ INTEGER, PARAMETER :: IDD_TEMPLATE001 = 129
+ INTEGER, PARAMETER :: IDF_GRID1 = 1075
+ INTEGER, PARAMETER :: ISS1 = 1077
+ INTEGER, PARAMETER :: ISS2 = 1078
+ INTEGER, PARAMETER :: ISS3 = 1079
+ INTEGER, PARAMETER :: IDD_CREATM1 = 130
+ INTEGER, PARAMETER :: ID_CGEN = 40085
+ INTEGER, PARAMETER :: IDF_STRING35 = 1042
+ INTEGER, PARAMETER :: IDD_ORDEROUT = 131
+ INTEGER, PARAMETER :: IDD_TEMPLATE002 = 132
+ INTEGER, PARAMETER :: IDF_RADIO14 = 1080
+ INTEGER, PARAMETER :: IDF_RADIO15 = 1081
+ INTEGER, PARAMETER :: IDF_RADIO16 = 1082
+ INTEGER, PARAMETER :: ID_selarea = 40086
+ INTEGER, PARAMETER :: ID_crsect = 40087
+ INTEGER, PARAMETER :: IDD_selcrsec = 133
+ INTEGER, PARAMETER :: IDD_TEMPLATE003 = 134
+ INTEGER, PARAMETER :: ISS4 = 1083
+ INTEGER, PARAMETER :: ISS5 = 1084
+ INTEGER, PARAMETER :: IDD_LIMITS = 135
+ INTEGER, PARAMETER :: IDF_RADIO17 = 1059
+ INTEGER, PARAMETER :: IDD_lAY = 136
+ INTEGER, PARAMETER :: IDD_TEMPLATE004 = 137
+ INTEGER, PARAMETER :: ISS6 = 1085
+ INTEGER, PARAMETER :: ISS7 = 1086
+ INTEGER, PARAMETER :: ID_EDLAY = 40088
+ INTEGER, PARAMETER :: IDF_RADIO18 = 1062
+ INTEGER, PARAMETER :: ID_ORDR = 40089
+ INTEGER, PARAMETER :: ID_ORDR1 = 40090
+ INTEGER, PARAMETER :: id_chk = 2002
+ INTEGER, PARAMETER :: id_chck = 2001
+ INTEGER, PARAMETER :: idchk = 2003
+ INTEGER, PARAMETER :: ID_SPLITN = 40091
+ INTEGER, PARAMETER :: IDD_DISPLIT = 138
+ INTEGER, PARAMETER :: IDD_DIRSPLIT = 139
+ INTEGER, PARAMETER :: ID_OUTLAY = 40093
+ INTEGER, PARAMETER :: ID_FORM999 = 40092
+ INTEGER, PARAMETER :: ID_g1d = 40094
+ INTEGER, PARAMETER :: IDD_SETOPT = 140
+ INTEGER, PARAMETER :: ID_CCLN = 40095
+ INTEGER, PARAMETER :: ID_CHKCCLN = 40096
+ INTEGER, PARAMETER :: ID_GOUTLIN = 40097
+ INTEGER, PARAMETER :: ID_XOUTLIN = 40098
+ INTEGER, PARAMETER :: IDD_SETMAXMAP = 141
+ INTEGER, PARAMETER :: ID_RESETLIM = 40099
+ INTEGER, PARAMETER :: IDD_MLIMITS = 143
+ INTEGER, PARAMETER :: IDD_VIEWANG = 174
+ INTEGER, PARAMETER :: ID_3DVIEW = 40100
+ INTEGER, PARAMETER :: ID_VIEWANGLE = 40101
+ INTEGER, PARAMETER :: ID_ROTATE = 40106
+ INTEGER, PARAMETER :: ID_RESETRG = 40105
+ INTEGER, PARAMETER :: IDD_CHKOPT = 142
+ INTEGER, PARAMETER :: ID_ITEM103 = 40107
+ INTEGER, PARAMETER :: ID_SECGRP = 40108
+ INTEGER, PARAMETER :: IDD_SETSEL = 144
+ INTEGER, PARAMETER :: ID_SELPR = 40109
+ INTEGER, PARAMETER :: IDD_CHK1DOPT = 145
+ INTEGER, PARAMETER :: ID_VROTATE = 40110
+ INTEGER, PARAMETER :: id_mchck = 40111
+ INTEGER, PARAMETER :: ID_MOVMESH = 40112
+ INTEGER, PARAMETER :: IDD_DIALOG047 = 146
+ INTEGER, PARAMETER :: IDD_DIALOG048 = 147
+ INTEGER, PARAMETER :: ID_SELELTYP = 40113
+ INTEGER, PARAMETER :: IDD_SELELTYP = 149
+ INTEGER, PARAMETER :: ID_OPENGP = 40114
+ INTEGER, PARAMETER :: ID_SAVGP = 40115
+ INTEGER, PARAMETER :: IDF_RADIO19 = 1063
+ INTEGER, PARAMETER :: ID_IGPN = 40116
+ INTEGER, PARAMETER :: ID_IGPC = 40117
+ INTEGER, PARAMETER :: ID_DISPTYP = 40118
+ INTEGER, PARAMETER :: ID_TRANSFORM = 40119
+ INTEGER, PARAMETER :: IDD_TRANSFORM = 151
+ INTEGER, PARAMETER :: ID_deletelm = 40120
+ INTEGER, PARAMETER :: IDD_ELTERR2 = 152
+ INTEGER, PARAMETER :: ID_FORM2D = 40121
+ INTEGER, PARAMETER :: ID_JOINALL = 40122
+ INTEGER, PARAMETER :: ID_MOVGRP = 40123
+ INTEGER, PARAMETER :: ID_CRGRID = 40124
+ INTEGER, PARAMETER :: IDD_GENBLK = 155
+ INTEGER, PARAMETER :: ID_SETUPLEV = 40125
+ INTEGER, PARAMETER :: IDD_SETWRS = 156
+ INTEGER, PARAMETER :: ID_findnode = 40126
+ INTEGER, PARAMETER :: ID_findelem = 40127
+ INTEGER, PARAMETER :: IDD_FORMLINE = 157
+ INTEGER, PARAMETER :: ID_FILLAGAP = 40129
+ INTEGER, PARAMETER :: IDD_MATTYP = 158
+ INTEGER, PARAMETER :: ID_ITEM126 = 40130
+ INTEGER, PARAMETER :: ID_SETTYPLEV = 40131
+ INTEGER, PARAMETER :: IDD_LEVSETTYP = 159
+ INTEGER, PARAMETER :: ID_Complex = 40132
+ INTEGER, PARAMETER :: ID_attach = 40133
+ INTEGER, PARAMETER :: IDD_CHSTYP = 161
+ INTEGER, PARAMETER :: ID_SAVSHP = 40128
+ INTEGER, PARAMETER :: ID_ADDMAP = 40134
+ INTEGER, PARAMETER :: ID_OUTLINFL = 40135
+ INTEGER, PARAMETER :: ID_GETSTRESSFIL = 40136
+ INTEGER, PARAMETER :: IDD_FBED = 162
+ INTEGER, PARAMETER :: IDD_SETYRDT = 163
+ INTEGER, PARAMETER :: ID_SMOOTHMAP = 40137
+ INTEGER, PARAMETER :: IDD_GETINTR = 164
+ INTEGER, PARAMETER :: ID_RVSDIAG = 40138
+ INTEGER, PARAMETER :: ID_TESTOUT = 40139
+ INTEGER, PARAMETER :: ID_LOADELTLD = 40140
+ INTEGER, PARAMETER :: ID_SHOWELTLD = 40141
+ INTEGER, PARAMETER :: IDD_CHOOSEMODEL = 165
+ INTEGER, PARAMETER :: IDD_SETUPELDISP = 166
+ INTEGER, PARAMETER :: ID_SAVELTLD = 40142
+ INTEGER, PARAMETER :: ID_RESHOWELTLD = 40143
+ INTEGER, PARAMETER :: ID_ASSIGNELTLD = 40144
+ INTEGER, PARAMETER :: ID_FILLTR = 40145
+ INTEGER, PARAMETER :: IDD_FTRIAN = 167
+ INTEGER, PARAMETER :: ID_addmeshtr = 40146
+ INTEGER, PARAMETER :: ID_UNDOGEN = 40147
+ INTEGER, PARAMETER :: IDD_GETFL = 168
+ INTEGER, PARAMETER :: ID_DDRAW = 40148
diff --git a/src/src83e/DELAN2.F90 b/src/src83e/DELAN2.F90
new file mode 100644
index 0000000..64d9341
--- /dev/null
+++ b/src/src83e/DELAN2.F90
@@ -0,0 +1,451 @@
+ SUBROUTINE SUPERT(XPT,YPT,NVERT)
+
+ USE BLKMAP
+! INCLUDE 'BLK1.COM'
+ REAL*8 XPT(*),YPT(*)
+
+ REAL*8 XMINM,YMINM,X45
+ DATA VDX9/-9.E9/
+! Find minimum x and y
+ xminm=1.e20
+ yminm=1.e20
+ x45=-1.e20
+ DO J=1,NVERT
+ IF(XPT(J) .GT. VDX9) THEN
+ if(xminm .GT. XPT(j) ) then
+ xminm=XPT(j)
+ end if
+ IF(yminm .GT. YPT(j)) then
+ yminm=YPT(j)
+ endif
+ ENDIF
+ ENDDO
+! Find max at 45 degrees
+ DO J=1,NVERT
+ IF(XPT(J) .GT. VDX9) THEN
+ X45T=((XPT(J)-XMINM)+(YPT(J)-YMINM))/1.414
+ IF(x45 .LT. X45T) THEN
+ X45=X45T
+ ENDIF
+ ENDIF
+ END DO
+ XPT(NVERT+1)=XMINM-5
+ YPT(NVERT+1)=YMINM-5.
+ XPT(NVERT+2)=XMINM+1.414*X45+10.
+ YPT(NVERT+2)=YMINM-5.
+ XPT(NVERT+3)=XMINM-5.
+ YPT(NVERT+3)=YMINM+1.414*X45+10.
+ NELT=1
+ NOPEL(1,1)=NVERT+1
+ NOPEL(1,2)=NVERT+2
+ NOPEL(1,3)=NVERT+3
+ NVERT=NVERT+3
+ CALL CCENTRE(XPT(NOPEL(1,1)),XPT(NOPEL(1,2)),XPT(NOPEL(1,3)) &
+ &,YPT(NOPEL(1,1)),YPT(NOPEL(1,2)),YPT(NOPEL(1,3)) &
+ &,XCEN(1),YCEN(1),RADS(1))
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE INSIDCIRC(XPT,YPT,J,N,ISWT)
+
+! Test for point inside circumcircle
+
+ USE BLKMAP
+! INCLUDE 'BLK1.COM'
+
+ REAL*8 XPT(*),YPT(*)
+ REAL*8 DISQ
+
+! Get the distance for this element
+
+ DISQ=(XCEN(J)-XPT(N))**2+(YCEN(J)-YPT(N))**2
+
+! Test against the radius
+
+ IF(DISQ .GT. RADS(J)*RADS(J)) THEN
+ ISWT=0
+ ELSE
+ ISWT=1
+ ENDIF
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE PROCESS(J,NEDGE,NGAP)
+
+! Drop triangle and form edge buffers
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ NEDGE=NEDGE+3
+ IEDGE(NEDGE-2,1)=NOPEL(J,1)
+ IEDGE(NEDGE-1,1)=NOPEL(J,2)
+ IEDGE(NEDGE,1) =NOPEL(J,3)
+ IEDGE(NEDGE-2,2)=NOPEL(J,2)
+ IEDGE(NEDGE-1,2)=NOPEL(J,3)
+ IEDGE(NEDGE,2) =NOPEL(J,1)
+ NOPEL(J,1)=0
+ NOPEL(J,2)=0
+ NOPEL(J,3)=0
+ NGAP=NGAP+1
+ IGAP(NGAP)=J
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE FORMT(XPT,YPT,J,N,NGAP,K,WD)
+
+! Form the triangle
+
+ USE BLKMAP
+
+ REAL*8 XPT(*),YPT(*)
+ REAL WD(*)
+! INCLUDE 'BLK1.COM'
+
+ IF(NGAP .GT. 0) THEN
+ K=IGAP(NGAP)
+ NGAP=NGAP-1
+ ELSE
+ NELTS=NELTS+1
+ K=NELTS
+ ENDIF
+ NOPEL(K,1)=IEDGE(J,1)
+ NOPEL(K,2)=IEDGE(J,2)
+ NOPEL(K,3)=N
+
+ CALL TESTANG(XPT,YPT,K,WD)
+
+! Now get circumcircle data
+
+ CALL CCENTRE(XPT(NOPEL(K,1)),XPT(NOPEL(K,2)),XPT(NOPEL(K,3)) &
+ &,YPT(NOPEL(K,1)),YPT(NOPEL(K,2)),YPT(NOPEL(K,3)) &
+ &,XCEN(K),YCEN(K),RADS(K))
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE CCENTRE(X1,X2,X3,Y1,Y2,Y3,XC,YC,RC)
+
+! get circumcentre and radius
+
+ REAL*8 X1,Y1,X2,Y2,X3,Y3,A,B,C,D,AF,R1,R2,RC,XC,YC
+ A=X2-X1
+ B=Y2-Y1
+ C=X3-X1
+ D=Y3-Y1
+ AF=2.*(B*C-A*D)
+ R1=(-D*(A**2+B**2) + B*(C**2+D**2))/AF
+ R2=( C*(A**2+B**2) - A*(C**2+D**2))/AF
+ RC=SQRT(R1**2+R2**2)
+ XC=X1+R1
+ YC=Y1+R2
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE RIDPOINT(NVERT)
+
+ USE BLKMAP
+
+ NCOUNT=0
+ DO N=1,NELTS
+ DO K=1,3
+ IF(NOPEL(N,K) .GT. NVERT-3) THEN
+ DO L=1,3
+ NOPEL(N,L)=0
+ ENDDO
+ GO TO 500
+ ENDIF
+ ENDDO
+ NCOUNT=NCOUNT+1
+ DO K=1,3
+ NOPEL(NCOUNT,K)=NOPEL(N,K)
+ ENDDO
+ XCEN(NCOUNT)=XCEN(N)
+ YCEN(NCOUNT)=YCEN(N)
+ RADS(NCOUNT)=RADS(N)
+ 500 CONTINUE
+ ENDDO
+ NELTS=NCOUNT
+ RETURN
+ END
+
+ SUBROUTINE SORTDB(A,NKEY,N)
+!*********************************** .....SORT.....
+!-
+!......SORT IS A SIMPLE SHELL SORT ROUTINE IN DOUBLE PRECISION
+!-
+! SHELL SORT
+ SAVE
+!
+!IPK JAN94 INTEGER*2 NKEY
+ REAL*8 A(*)
+ INTEGER NKEY(*)
+
+ IF(N.LT.2) RETURN
+ DO 90 J=1,N
+ NKEY(J)=J
+ 90 END DO
+ ID = N
+ 100 ID = ID / 2
+ 110 IB = 1
+ 120 GO TO 200
+ 130 IB = IB + 1
+ IF( IB .LE. ID ) GO TO 200
+ IF( ID .GT. 1 ) GO TO 100
+ RETURN
+ 200 I = IB
+ 210 K = I + ID
+ 220 IF( A(NKEY(I)) .LE. A(NKEY(K)) ) GO TO 250
+ NKT = NKEY(K)
+ NKEY(K) = NKEY(I)
+ J = I
+ 230 K = J - ID
+ IF( K .LT. 1 ) GO TO 240
+ IF( A(NKT) .GT. A(NKEY(K)) ) GO TO 240
+ NKEY(J) = NKEY(K)
+ J = K
+ GO TO 230
+ 240 NKEY(J) = NKT
+ 250 I = I + ID
+ IF( I + ID .LE. N ) GO TO 210
+ GO TO 130
+ END
+
+ SUBROUTINE SETEDG(NEDGE)
+
+ USE BLKMAP
+
+! Setup to form new triangles
+
+ DO J=1,NEDGE
+ IF(J .LT. NEDGE) THEN
+ DO K=J+1,NEDGE
+ IF(IEDGE(K,1) .EQ. IEDGE(J,1)) THEN
+ IF(IEDGE(K,2) .EQ. IEDGE(J,2)) THEN
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ IEDGE(K,1)=0
+ IEDGE(K,2)=0
+ ENDIF
+ ELSEIF(IEDGE(K,1) .EQ. IEDGE(J,2)) THEN
+ IF(IEDGE(K,2) .EQ. IEDGE(J,1)) THEN
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ IEDGE(K,1)=0
+ IEDGE(K,2)=0
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+
+ RETURN
+ END
+
+ SUBROUTINE TESTANG(XPT,YPT,K,WD)
+
+ USE BLKMAP
+ REAL*8 XPT(*),YPT(*)
+ REAL WD(*)
+ DATA PI/3.14159/
+
+ ! IF(WD(NOPEL(K,1)) .EQ. WD(NOPEL(K,2)) .and. wd(nopel(k,1)) .gt. -9990. ) THEN
+ ! RETURN
+ ! ENDIF
+ !
+ IFD=0
+ DO N=1,NELTS
+ IF(N .NE. K) THEN
+ DO J=1,3
+ IF(NOPEL(K,1) .EQ. NOPEL(N,J)) THEN
+ IF(J .GT. 1) THEN
+ IF(NOPEL(K,2) .EQ. NOPEL(N,J-1)) THEN
+ IFD=N
+ ISIDE=J
+ GO TO 400
+ ENDIF
+ ELSE
+ IF(NOPEL(K,2) .EQ. NOPEL(N,3)) THEN
+ IFD=N
+ ISIDE=J
+ GO TO 400
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ RETURN
+ 400 CONTINUE
+
+ J1=ISIDE+1
+ IF(J1 .GT. 3) J1=1
+ !
+ ! IF(WD(NOPEL(K,3)) .EQ. WD(NOPEL(IFD,J1)) .and. wd(nopel(k,1)) .gt. -9990. ) THEN
+ ! WRITE(148,'(12I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+ ! IF(NELTS .GT. 20) WRITE(148,'(12I8)') NOPEL(21,1),NOPEL(21,2),NOPEL(21,3)
+ ! NOPEL(IFD,1)=NOPEL(K,3)
+ ! NOPEL(IFD,2)=NOPEL(K,1)
+ ! NOPEL(IFD,3)=NOPEL(IFD,J1)
+ ! NOPEL(K,1)=NOPEL(IFD,3)
+ !
+ ! WRITE(148,'(12I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+ ! IF(NELTS .GT. 20) WRITE(148,'(12I8)') NOPEL(21,1),NOPEL(21,2),NOPEL(21,3)
+ !
+ ! CALL CCENTRE(XPT(NOPEL(IFD,1)),XPT(NOPEL(IFD,2)),XPT(NOPEL(IFD,3)) &
+ !& ,YPT(NOPEL(IFD,1)),YPT(NOPEL(IFD,2)),YPT(NOPEL(IFD,3)) &
+ !& ,XCEN(IFD),YCEN(IFD),RADS(K))
+ ! CALL CCENTRE(XPT(NOPEL(K,1)),XPT(NOPEL(K,2)),XPT(NOPEL(K,3)) &
+ !& ,YPT(NOPEL(K,1)),YPT(NOPEL(K,2)),YPT(NOPEL(K,3)) &
+ !& ,XCEN(K),YCEN(K),RADS(K))
+ !
+ ! RETURN
+ ! ENDIF
+ A1=ATAN2(YPT(NOPEL(K,1))-YPT(NOPEL(K,3)),XPT(NOPEL(K,1))-XPT(NOPEL(K,3)))
+ A2=ATAN2(YPT(NOPEL(K,2))-YPT(NOPEL(K,3)),XPT(NOPEL(K,2))-XPT(NOPEL(K,3)))
+ IF(A1 .LT. 0) A1=A1+2.*PI
+ IF(A2 .LT. 0) A2=A2+2.*PI
+ DIFFA=A2-A1
+! WRITE(148,*) 'DIFFA',K,DIFFA,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3)
+ IF(DIFFA .LT. 0) DIFFA=DIFFA+PI*2.
+ IF(DIFFA .LT. 2./3.*PI) RETURN
+
+! WRITE(148,'(9I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+
+ B1=ATAN2(YPT(NOPEL(IFD,J1))-YPT(NOPEL(K,2)),XPT(NOPEL(IFD,J1))-XPT(NOPEL(K,2)))
+ B2=ATAN2(YPT(NOPEL(K, 3))-YPT(NOPEL(K,2)),XPT(NOPEL(K, 3))-XPT(NOPEL(K,2)))
+ IF(B1 .LT. 0) B1=B1+2.*PI
+ IF(B2 .LT. 0) B2=B2+2.*PI
+
+ DIFFB=B2-B1
+
+! WRITE(148,*) 'DIFFB',DIFFB,B2,B1
+ IF(DIFFB .LT. 0) DIFFB=DIFFB+2.*PI
+ IF(DIFFB .GT. DIFFA) RETURN
+
+ C1=ATAN2(YPT(NOPEL(K, 3))-YPT(NOPEL(K,1)),XPT(NOPEL(K, 3))-XPT(NOPEL(K,1)))
+ C2=ATAN2(YPT(NOPEL(IFD,J1))-YPT(NOPEL(K,1)),XPT(NOPEL(IFD,J1))-XPT(NOPEL(K,1)))
+ IF(C1 .LT. 0) C1=C1+2.*PI
+ IF(C2 .LT. 0) C2=C2+2.*PI
+
+ DIFFC=C2-C1
+! WRITE(148,*) 'DIFFC',DIFFC,C2,C1
+ IF(DIFFC .LT. 0) DIFFC=DIFFC+2.*PI
+ IF(DIFFC .GT. DIFFA) RETURN
+
+ NOPEL(IFD,1)=NOPEL(K,3)
+ NOPEL(IFD,2)=NOPEL(K,1)
+ NOPEL(IFD,3)=NOPEL(IFD,J1)
+ NOPEL(K,1)=NOPEL(IFD,3)
+
+! WRITE(148,'(9I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+
+ CALL CCENTRE(XPT(NOPEL(IFD,1)),XPT(NOPEL(IFD,2)),XPT(NOPEL(IFD,3)) &
+ &,YPT(NOPEL(IFD,1)),YPT(NOPEL(IFD,2)),YPT(NOPEL(IFD,3)) &
+ &,XCEN(IFD),YCEN(IFD),RADS(IFD))
+
+ RETURN
+ END
+
+
+ SUBROUTINE TESTTR(XPT,YPT,K,WD)
+
+ USE BLKMAP
+ REAL WD(*)
+ REAL*8 XPT(*),YPT(*)
+ DATA PI/3.14159/
+
+ IF(WD(NOPEL(K,1)) .EQ. WD(NOPEL(K,2)) .and. wd(nopel(k,1)) .gt. -9990. ) THEN
+ RETURN
+ ENDIF
+
+
+ IFD=0
+ DO N=1,NELTS
+ IF(N .NE. K) THEN
+ DO J=1,3
+ IF(NOPEL(K,2) .EQ. NOPEL(N,J)) THEN
+ IF(J .GT. 1) THEN
+ IF(NOPEL(K,3) .EQ. NOPEL(N,J-1)) THEN
+ IFD=N
+ ISIDE=J
+ GO TO 400
+ ENDIF
+ ELSE
+ IF(NOPEL(K,3) .EQ. NOPEL(N,3)) THEN
+ IFD=N
+ ISIDE=J
+ GO TO 400
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ RETURN
+ 400 CONTINUE
+
+ WRITE(148,'(9I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+ write(148,'(9x,6f8.0)')wd(NOPEL(K,1)),wd(NOPEL(K,2)),wd(NOPEL(K,3)),wd(NOPEL(IFD,1)),wd(NOPEL(IFD,2)),wd(NOPEL(IFD,3))
+ J1=ISIDE+1
+ IF(J1 .GT. 3) J1=1
+ WRITE(148,*) J1
+
+ IF(WD(NOPEL(K,1)) .EQ. WD(NOPEL(IFD,J1)) .and. wd(nopel(k,1)) .gt. -9990. ) THEN
+ ITEMP=NOPEL(IFD,J1)
+ NOPEL(IFD,1)=NOPEL(K,3)
+ NOPEL(IFD,2)=NOPEL(K,1)
+ NOPEL(IFD,3)=ITEMP
+ NOPEL(K,1)=NOPEL(IFD,3)
+
+ WRITE(148,'(9I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+
+ CALL CCENTRE(XPT(NOPEL(IFD,1)),XPT(NOPEL(IFD,2)),XPT(NOPEL(IFD,3)) &
+ & ,YPT(NOPEL(IFD,1)),YPT(NOPEL(IFD,2)),YPT(NOPEL(IFD,3)) &
+ & ,XCEN(IFD),YCEN(IFD),RADS(IFD))
+
+ RETURN
+ ENDIF
+ A1=ATAN2(YPT(NOPEL(K,2))-YPT(NOPEL(K,1)),XPT(NOPEL(K,2))-XPT(NOPEL(K,1)))
+ A2=ATAN2(YPT(NOPEL(K,3))-YPT(NOPEL(K,1)),XPT(NOPEL(K,3))-XPT(NOPEL(K,1)))
+ IF(A1 .LT. 0) A1=A1+2.*PI
+ IF(A2 .LT. 0) A2=A2+2.*PI
+ DIFFA=A2-A1
+! WRITE(148,*) 'DIFFA',K,DIFFA,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3)
+ IF(DIFFA .LT. 0) DIFFA=DIFFA+PI*2.
+ IF(DIFFA .LT. 2./3.*PI) RETURN
+
+ B1=ATAN2(YPT(NOPEL(IFD,J1))-YPT(NOPEL(K,3)),XPT(NOPEL(IFD,J1))-XPT(NOPEL(K,3)))
+ B2=ATAN2(YPT(NOPEL(K, 1))-YPT(NOPEL(K,3)),XPT(NOPEL(K, 1))-XPT(NOPEL(K,3)))
+ IF(B1 .LT. 0) B1=B1+2.*PI
+ IF(B2 .LT. 0) B2=B2+2.*PI
+
+ DIFFB=B2-B1
+
+! WRITE(148,*) 'DIFFB',DIFFB,B2,B1
+ IF(DIFFB .LT. 0) DIFFB=DIFFB+2.*PI
+ IF(DIFFB .GT. DIFFA) RETURN
+
+ C1=ATAN2(YPT(NOPEL(K, 1))-YPT(NOPEL(K,2)),XPT(NOPEL(K, 1))-XPT(NOPEL(K,2)))
+ C2=ATAN2(YPT(NOPEL(IFD,J1))-YPT(NOPEL(K,2)),XPT(NOPEL(IFD,J1))-XPT(NOPEL(K,2)))
+ IF(C1 .LT. 0) C1=C1+2.*PI
+ IF(C2 .LT. 0) C2=C2+2.*PI
+
+ DIFFC=C2-C1
+! WRITE(148,*) 'DIFFC',DIFFC,C2,C1
+ IF(DIFFC .LT. 0) DIFFC=DIFFC+2.*PI
+ IF(DIFFC .GT. DIFFA) RETURN
+ ITEMP=NOPEL(IFD,J1)
+ NOPEL(IFD,1)=NOPEL(K,1)
+ NOPEL(IFD,2)=NOPEL(K,2)
+ NOPEL(IFD,3)=ITEMP
+ NOPEL(K,2)=NOPEL(IFD,3)
+
+! WRITE(148,'(9I8)') K,J,IFD,NOPEL(K,1),NOPEL(K,2),NOPEL(K,3),NOPEL(IFD,1),NOPEL(IFD,2),NOPEL(IFD,3)
+
+ CALL CCENTRE(XPT(NOPEL(IFD,1)),XPT(NOPEL(IFD,2)),XPT(NOPEL(IFD,3)) &
+ &,YPT(NOPEL(IFD,1)),YPT(NOPEL(IFD,2)),YPT(NOPEL(IFD,3)) &
+ &,XCEN(IFD),YCEN(IFD),RADS(IFD))
+
+ RETURN
+ END
diff --git a/src/src83e/DELAUNAY.F90 b/src/src83e/DELAUNAY.F90
new file mode 100644
index 0000000..a443ab9
--- /dev/null
+++ b/src/src83e/DELAUNAY.F90
@@ -0,0 +1,264 @@
+ SUBROUTINE TRIANG
+
+ USE WINTERACTER
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ DATA VOID10/-1.E10/,SPAC/0.0/
+
+ NELTS=0
+ NVERT=MAXPTS
+ NINTV=1
+ CALL TRIANOPT(NINTV,SPAC)
+
+
+! FIRST WRITE EXISTING MAP TO SCRATCH
+ OPEN(99,FORM='BINARY',STATUS='SCRATCH')
+
+ CALL WRTMAP(99)
+ REWIND 99
+
+ DO N=1,NVERT
+ IF(MOD(N-1,NINTV) .EQ. 0) THEN
+ IMAP(N)=1
+ ELSE
+ IMAP(N)=0
+ ENDIF
+ ENDDO
+
+ IF(SPAC .GT. 0.) THEN
+ DO N=1,NVERT
+ IF(IMAP(N) .EQ. 1) THEN
+ IF(N .LT. NVERT) THEN
+ DO M=N+1,NVERT
+ DISQ=(XMAP(M)-XMAP(N))**2+(YMAP(M)-YMAP(N))**2
+ IF(DISQ .LT. SPAC**2) THEN
+ IMAP(M)=0
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ NN=0
+ DO N=1,NVERT
+ IF(IMAP(N) .GT. 0) THEN
+ NN=NN+1
+ XMAP(NN)=XMAP(N)
+ YMAP(NN)=YMAP(N)
+ IMAP(NN)=IMAP(N)
+ ENDIF
+ ENDDO
+ NVERT=NN
+! WRITE(185,*) 'NEW NVERT',NVERT
+
+
+ call WcursorShape(CurHourGlass)
+ CALL DELAUNAY(NVERT)
+ call WcursorShape(CurArrow)
+
+
+ RETURN
+ END
+
+
+
+! Last change: IPK 2 Feb 2003 6:25 pm
+ SUBROUTINE DELAUNAY(NVERT)
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*80 LIND
+ CHARACTER*1 ANS
+ DATA VDX9/-9.E9/,NEDGE/0/
+
+! Get location of supertriangle
+
+ iprt=0
+ ngap=0
+ YLV=7.5
+
+
+
+ call supert(XMAP,YMAP,NVERT)
+
+ NELTS=1
+
+ NVERTM=NVERT-3
+ IF(NVERT .GT. MAXP) THEN
+ DEALLOCATE (NKEY)
+ ALLOCATE (NKEY(NVERT))
+ NKEY=0
+ ENDIF
+
+! Sort points into ascending x order
+
+ CALL SORTDB(XMAP,NKEY,NVERTM)
+
+! Loop on the vertices
+
+ DO NN=1,NVERT-3
+
+! IF(MOD(NN,5) .EQ. 0) WRITE(185,*) 'LOOP',NN
+ if(mod(NN,2500) .eq. 0) then
+ WRITE(90,*) NN,' points processed'
+ ylv=ylv-0.3
+ if(ylv .lt. 0.1) then
+ ylv=7.9
+ call clscrn
+ endif
+ write(lind,6010) NN
+ 6010 format(i8,' points processed')
+ call symbl &
+ & (1.1,ylv,0.20,LIND,0.0,80)
+ endif
+
+! process next point
+
+ N=NKEY(NN)
+
+! Skip out if inactive point
+ IF(N .EQ. 0) GO TO 500
+ IF(IMAP(N) .EQ. 0) GO TO 500
+ IF(XMAP(N) .LT. VDX9) GO TO 500
+ IF(VAL(N) .LT. -9000.) GO TO 500
+! IF(NN .GT. 1700. .AND. MOD(NN,5) .EQ. 0) WRITE(185,*) 'N',N,IMAP(N),XMAP(N),VAL(N)
+
+! WRITE(45,*) NN,N,NVERT,XMAP(N),YMAP(N)
+ IF(NN .LT. NVERTM) THEN
+ DO KK=NN+1,NVERTM
+ K=NKEY(KK)
+! IF(NN .GT. 1700) WRITE(185,*) 'NKEY',K,KK
+
+ IF(K .NE. 0) THEN
+ IF(XMAP(N) .EQ. XMAP(K)) THEN
+ IF(YMAP(N) .EQ. YMAP(K)) THEN
+ WRITE(45,*) 'IDENT',N,K
+ NKEY(KK)=0
+ ENDIF
+ ELSE
+ GO TO 200
+ ENDIF
+ ENDIF
+ 200 CONTINUE
+ ENDDO
+ ENDIF
+
+! Set edge buffers to zero
+! IF(NN .GT. 1700 .AND. MOD(NN,5) .EQ. 0) WRITE(185,*) 'AFTER 200 NEDGE',NEDGE
+
+ IF(NEDGE .GT. 0) THEN
+ DO J=1,NEDGE
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ELSE
+ DO J=1,100
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ENDIF
+ NEDGE=0
+
+! test for point in circumcircle
+
+ DO J=1,NELTS
+ CALL INSIDCIRC(XMAP,YMAP,J,N,ISWT)
+
+! If inside process edges
+
+ IF(ISWT .EQ. 1) THEN
+ CALL PROCESS(J,NEDGE,NGAP)
+ ENDIF
+ END DO
+
+! Setup to form new triangles
+
+ CALL SETEDG(NEDGE)
+
+! Now form triangles as needed
+
+ DO J=1,NEDGE
+ IF(IEDGE(J,1) .NE. 0) THEN
+ CALL FORMT(XMAP,YMAP,J,N,NGAP,KK,WD)
+ ENDIF
+ END DO
+
+ NEDGE=0
+ if(iprt .eq. 0) go to 500
+ DO J=1,NELTS
+ IF(NOPEL(J,1) .GT. 0) THEN
+ WRITE(3,'(2i5,2i10,19x,''1'')') J,(NOPEL(J,K),K=1,3)
+ ENDIF
+ END DO
+
+
+ IF(NN .EQ. 1) THEN
+ write(41,'('' 9999'')')
+ do j=1,nvert
+ write(41,'(i10,2f20.4,F10.3)') j,XMAP(j),YMAP(j),VAL(J)
+ enddo
+ write(41,'('' 9999'')')
+ write(41,'('' 9999'')')
+ write(41,'('' 0 NENTRY'')')
+ write(41,'('' 0 NCLM'')')
+ WRITE(41,'(''ENDDATA'')')
+ ENDIF
+ 500 continue
+ END DO
+
+! Get rid of elements from super point
+
+ CALL RIDPOINT(NVERT)
+
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE TRIANOPT(NINTV,SPAC)
+
+ USE WINTERACTER
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: NINTV
+ INTEGER :: IERR
+ REAL :: SPAC
+ CHARACTER*1 :: IFLAG
+
+ call wdialogload(IDD_TRIAN)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_TRIAN)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,NINTV)
+ CALL WDialogPutReal(IDF_REAL1,SPAC)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,NINTV)
+ IF(NINTV .EQ. 0) NINTV=1
+ CALL WDialogGetREAL(IDF_REAL1,SPAC)
+ ELSE
+ SPAC=0.0
+ NINTV=1
+ ENDIF
+ RETURN
+ enddo
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/DEMOS.F90 b/src/src83e/DEMOS.F90
new file mode 100644
index 0000000..9e4f93e
--- /dev/null
+++ b/src/src83e/DEMOS.F90
@@ -0,0 +1,45 @@
+ SUBROUTINE DEMOS
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ COMMON /RECOD/ IRECD,TSPC
+ COMMON /PAGE/ XL,XH,YL,YH
+ common /cols/ ibakk,icolr,iblkk
+
+ CHARACTER*255 FNAME
+ CHARACTER*40 LIND,dlin
+
+ xl=0.
+ yl=0.
+ xh=HSIZE
+ yh=8.0
+ ibakk=8
+ icolr=11
+ iblkk=14
+ OPEN(75,FILE='DINFO.OUT',FORM='FORMATTED',STATUS='UNKNOWN')
+
+ WRITE(75,*) 'IN DEMOS'
+ FNAME='RECORD.REC'
+ OPEN(9,FILE='PALMIS.MAP',STATUS='OLD', FORM='FORMATTED')
+ IMP=9
+ IIN=0
+
+ OPEN(91,FILE=FNAME,STATUS='OLD')
+ CALL RBLUE
+ nmess=45
+ call getfpn(tspc)
+! WRITE(LIND,6005)
+! 6005 FORMAT('Enter time interval between events')
+! call symbl(1.1,3.5,0.25,LIND,0.0,80)
+! ndig=32
+! CALL GTFPNX(TSPC,NDEC,NDIG,5.0,6.0)
+! write(75,'(a)') 'demos-lind',lind
+! call get_label(lind,dlin)
+! write(75,'(a)') 'label',dlin
+! read(dlin,'(f20.2)') tspc
+ IRECD=2
+ WRITE(75,*) 'tspc', tspc
+
+ RETURN
+ END
diff --git a/src/src83e/DOGRAPH.F90 b/src/src83e/DOGRAPH.F90
new file mode 100644
index 0000000..3b4e231
--- /dev/null
+++ b/src/src83e/DOGRAPH.F90
@@ -0,0 +1,306 @@
+ SUBROUTINE dograph(noptt,icurrwin)
+!!!!!! (XVALUES,YVALUES,NVALUES,XMIN,XMAX,VALMIN,YMAX)
+!
+! Graph plotting code generated by GraphEd at 21:20 on 11 Apr 1999.
+!
+! XVALUES = Array of X values to plot
+! YVALUES = Array of Y values to plot
+! NVALUES = Number of values
+! TIMMIN = Min X
+! TIMMAX = Max X
+! VALMIN = Min Y
+! VALMAX = Max Y
+!
+!
+! USE module containing routine definitions and symbolic names.
+!
+ USE WINTERACTER
+!
+!
+! Common arguments.
+!
+ CHARACTER*6 DESCR
+ CHARACTER*48 XLABEL, YYLABEL
+ CHARACTER*48 PTITL
+ CHARACTER*4 AXTYPE, YAXTYPE
+ COMMON /XYGRPH/ XVALUES(10000,10),YVALUES(10000,10),TIMMIN,VALMIN,TIMMAX,VALMAX,NVALUES,NSETS,LINPROP(10)
+ COMMON /PAXC/ PTITL,AXTYPE,XLABEL,YAXTYPE,YYLABEL
+
+ COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10)
+
+
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ character*40 mpnam
+ CHARACTER*1 ALABL(10)
+ COMMON /BLKA1/ TITLE,HLABL,ALABL,MPNAM
+
+ character*8 labl
+ character*72 data
+ CHARACTER*20 TITL1,TITL4
+ CHARACTER*64 TITL2,TITL3
+ COMMON /BLKA11/ TITL1,TITL2,TITL3,TITL4&
+ , labl(400),data(400)
+
+!IPK JAN03
+
+ INTEGER IHANDLE1
+
+! REAL, INTENT(IN), DIMENSION(NVALUES) :: XVALUES
+! REAL, INTENT(IN), DIMENSION(NVALUES) :: YVALUES
+! REAL TIMMIN,TIMMAX,VALMIN,VALMAX
+! INTEGER NVALUES
+
+
+ nopt=abs(noptt)
+ WRITE(90,*) 'IN DOGRAPH',NOPT,icurrwin
+
+! nopt = 999 skip to draw current page
+! nopt = -2 skip to draw current page
+! nopt = 2 draw time plots
+! nopt = 4 from brkarea
+
+ if(nopt .eq. 999) go to 300
+ IF(NOPTT .EQ. -2) GO TO 300
+ if(nopt .ne. 3) then
+
+! do this only for nopt = 4 or nopt = 2 first search for empty window
+
+ do n=1,nwindws
+ if(iwndws(n) .eq. 0) then
+ icurrwin=n
+ go to 290
+ endif
+ enddo
+
+! or increase window count
+
+
+ nwindws=nwindws+1
+ if(nwindws .eq. 10) then
+ call WMessageBox(0,3,1,'Warning 10 windows now open','WARNING')
+ IF(WInfoDialog(4) .eq. 1) then
+ ENDIF
+ endif
+ icurrwin=nwindws
+ 290 continue
+ else
+
+! do this for nopt = 3 ie
+! draw the bitmap in icurrwin and return
+
+ call backp(2,icurrwin)
+ return
+ endif
+!ipk jan03
+
+! if no window defined yet open a child window for it and give it a handle
+
+ IF(Iwndws(icurrwin) .EQ. 0) THEN
+ CALL WindowOpenChild(IHANDLE1,FLAGS=SysMenuOn+MinButton+MaxButton, &
+ TITLE='Cross-Section')
+ Iwndws(icurrwin)=ihandle1
+ ENDIF
+
+! setup to draw bitmap in icurrwin
+
+ CALL BACKP(1,icurrwin)
+ 300 continue
+!
+! Start new presentation graphics plot
+!
+! CALL IPgNewGraph(NSETS,NVALUES,' ',' ','X')
+ CALL IPgNewPlot(6,nsets,nvalues)
+!
+! Set Clipping Rectangle
+!
+ CALL IPgClipRectangle('G')
+!
+! Set style for each data set
+!
+! CALL IPgStyle( 1, 0, 0, 0,223, 96)
+! CALL IPgStyle( 2, 1, 0, 0, 31,128)
+! CALL IPgStyle( 3, 2, 0, 0,159,160)
+! CALL IPgStyle( 4, 3, 0, 0, 95,192)
+! CALL IPgStyle( 5, 5, 0, 0,223,224)
+
+ ICL=255+256*255+256*256*255
+ IF(LINPROP(1) .EQ. 0) THEN
+ CALL IPgStyle( 1, 0, 0, 0,223,195)
+ ELSE
+ CALL IPgStyle( 1, 0, 3, 0,ICL,195)
+ ENDIF
+ IF(LINPROP(2) .EQ. 0) THEN
+ CALL IPgStyle( 2, 1, 0, 0,33405,33405)
+ ELSE
+ CALL IPgStyle( 2, 1, 3, 0,ICL,33405)
+ ENDIF
+ IF(LINPROP(3) .EQ. 0) THEN
+ CALL IPgStyle( 3, 2, 0, 0,8551680,8551680)
+ ELSE
+ CALL IPgStyle( 3, 2, 3, 0,ICL,8551680)
+ ENDIF
+ IF(LINPROP(4) .EQ. 0) THEN
+ CALL IPgStyle( 4, 3, 0, 0,65415,65415)
+ ELSE
+ CALL IPgStyle( 4, 3, 3, 0,ICL,65415)
+ ENDIF
+ IF(LINPROP(5) .EQ. 0) THEN
+ CALL IPgStyle( 5, 5, 0, 0,0,0)
+ ELSE
+ CALL IPgStyle( 5, 5, 3, 0,ICL,0)
+ ENDIF
+!
+! Set marker number for data sets not using default marker
+!
+ CALL IPgMarker( 1, 1)
+ CALL IPgMarker( 2, 2)
+ CALL IPgMarker( 3, 2)
+ CALL IPgMarker( 4, 2)
+ CALL IPgMarker( 5, 2)
+!
+! Set units for plot
+!
+ CALL IPgUnits( TIMMIN, VALMIN, TIMMAX, VALMAX)
+!
+! Set presentation graphics area
+!
+ CALL IPgArea( .150, .100, .900, .800)
+!
+! Draw main title
+!
+ CALL IGrCharSet('H')
+ CALL IGrCharFont( 1)
+ CALL IGrCharSpacing('F')
+ CALL IGrCharSize( 0.67, 0.67)
+ CALL IGrColourN( 208)
+
+ CALL IPgTitle('CROSS-SECTION','C')
+!
+! Label bottom X axis
+!
+ CALL IPgXLabelPos( .70)
+ CALL IPgXLabel('Section Dimension','C')
+
+!
+! Label left Y axis
+!
+ CALL IPgYLabelPos( .80)
+
+ CALL IPgYLabelLeft('Elevation','C9')
+!
+! Draw axes
+!
+ CALL IGrColourN( 208)
+ CALL IPgAxes(TIMMIN,VALMIN)
+!
+! Adjust tick position for X Axes
+!
+ CALL IPgXTickPos(VALMIN,VALMAX)
+!DEC09 CALL IPgXTickPos(1,TIMMIN)
+!
+! Scale for bottom X Axis
+!
+ CALL IPgXUserScale((/0.0/),0)
+ CALL IPgXScaleAngle( .00, .00)
+ CALL IPgXScalePos( .38)
+ CALL IPgXScale('NT')
+!
+! Adjust tick position for Y Axes
+!
+ CALL IPgYTickPos( TIMMIN , TIMMAX )
+!DEC09 CALL IPgYTickPos( 1,VALMIN)
+!DEC09 ISIDE=1
+!DEC09 CALL IPgYTickPos( ISIDE,TIMMAX)
+! Scale for left Y Axis
+!
+ CALL IPgYUserScale((/0.0/),0)
+ CALL IPgYScaleAngle( .00, .00)
+ CALL IPgYScalePos( 1.50)
+ CALL IPgYScaleLeft('NT')
+!
+! Draw graph.
+!
+ DO ISET = 1,NSETS
+
+ CALL IPgXYPairs(XVALUES(1,iset),YVALUES(1,ISET))
+
+ END DO
+
+ call IPgKeyAll(DESCR,' ')
+
+! CALL SYMBL(0.1,7.60,0.18,TITL2,0.0,+64)
+
+
+ if(nopt .ne. 999 .and. NOPTT .NE. -2) CALL BACKP(2,icurrwin)
+
+ RETURN
+ END SUBROUTINE dograph
+
+
+ SUBROUTINE BACKP(IENT,icurrwin)
+
+! ient = 1 means either set to draw bitmap or create window for plotting ihandle(icurrwin)
+! then select to draw bitmap
+! ient = 2 means select drawing of window and putting the bitmap into it, folloed by return
+! to main window
+! ient = 3 means destroy slected window
+
+
+ use winteracter
+
+ implicit none
+
+ include 'D.INC'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: iw,ih,ihandle,ient,icurrwin,ihandlem
+ common /handP/ ihandle(10)
+! write(128,*) 'ient',ient,icurrwin,ihandle(icurrwin)
+ if(ient .eq. 1) then
+ iw=WinfoWindow(WindowWidth)
+ ih=WinfoWindow(WindowHeight)
+ IF(IHANDLE(icurrwin) .EQ. 0) THEN
+ call WBitmapCreate(ihandle(icurrwin),iw,ih)
+ call IGrSelect(DrawBitmap,ihandle(icurrwin))
+ ELSE
+ call IGrSelect(DrawBitmap,ihandle(icurrwin))
+ ENDIF
+ return
+ elseif(ient .eq. 2) then
+ call IGrSelect(DrawWin)
+ call WBitmapPut(ihandle(icurrwin),0,1)
+!!! call WBitmapDestroy(ihandle)
+ ihandlem=0
+ call WindowSelect(ihandlem)
+ else
+ CALL WBitmapDestroy(ihandle(icurrwin))
+
+ endif
+ return
+ end
+
+ SUBROUTINE DOPLOT(IMZ)
+
+
+ COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10)
+
+ if(nwindws .gt. 0) then
+ do n=1,nwindws
+ if(iscrns(n) .eq. 3) then
+ call WindowSelect(iwndws(n))
+ call clscrn
+ call dograph(3,n)
+ endif
+ enddo
+ call WindowSelect(0)
+ endif
+
+ RETURN
+ END
diff --git a/src/src83e/DUMMY.F90 b/src/src83e/DUMMY.F90
new file mode 100644
index 0000000..eb13a5d
--- /dev/null
+++ b/src/src83e/DUMMY.F90
@@ -0,0 +1,12 @@
+
+ SUBROUTINE PLOTSV(I)
+ RETURN
+ END
+
+ SUBROUTINE NDPLSV
+ RETURN
+ END
+
+ SUBROUTINE SETD(I)
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/EGEN.F90 b/src/src83e/EGEN.F90
new file mode 100644
index 0000000..98bb2ac
--- /dev/null
+++ b/src/src83e/EGEN.F90
@@ -0,0 +1,1163 @@
+
+! Last change: IPK 12 Jan 98 1:44 pm
+!
+ SUBROUTINE GNODE(ITYPC)
+!
+! Routine to create a series of nodes along a line
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ REAL*8 GRIDX(150),GRIDY(150),ALX,ALY,ATX,ATY,CURRENTX,CURRENTY,X11,Y11
+ INTEGER IREF(2000),JREF(2000)
+!
+ CHARACTER*1 IFLAG
+ data itime/0/
+ if(itime .eq. 0) then
+ ALLOCATE(ALXX(2000),ALYY(2000),ALWD(2000),BLXX(2000),BLYY(2000),BLWD(2000)&
+ ,CNX(2000,4),CNY(2000,4),ITYPBC(2000),XBRLEN(2000),HLEFT(2000),HMID(2000),HRIGHT(2000)&
+ ,HSET(MAXP,3),IRTYP(2000),WIDTHD(2000))
+ nh=1
+ itime=1
+ endif
+4 CONTINUE
+ IF(ITYPC .EQ. 1) THEN
+ NHTP = 0
+ NMESS = 6
+ NBRR = 3
+ CALL HEDR
+!
+! Get screen coordinates of each end of line
+!
+ 7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ALX=XTEMP
+ ALY=YTEMP
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ CALL WRTOUT(0)
+ RETURN
+ ENDIF
+!
+! Exit input
+!
+ 9 CONTINUE
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ CALL HEDR
+!
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ATX=XTEMP
+ ATY=YTEMP
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+!
+! Define number of nodes in a line
+!
+ NBRR = 0
+ NMESS=45
+ CALL HEDR
+ NMESS = 7
+ call getint(nh)
+! READ(*,*) NH
+ NINT=NH-1
+!
+! zero GRIDX and GRIDY to hold generated coordinates
+!
+ DO N=1,NH
+ GRIDX(N)=0.
+ GRIDY(N)=0.
+ END DO
+!
+! Interpolate points onto line
+!
+ CALL INTERP(GRIDX,GRIDY,1,NH,1,ALX,ALY,ATX,ATY,NINT,0)
+!
+! Copy points into the coordinate array
+!
+ DO N=1,NH
+!
+! Find next blank node in CORD
+!
+ CALL GETNOD(J)
+!
+! Store GRIDX and GRIDY into it
+!
+ CORD(J,1) = GRIDX(N)
+ CORD(J,2) = GRIDY(N)
+ INEW(J) = 1
+ INSKP(J) = 0
+!
+ XUSR(J) = GRIDX(N)*TXSCAL - XS
+ YUSR(J) = GRIDY(N)*TXSCAL - YS
+!
+! Display point
+!
+ CALL PLTNOD(J,1)
+!
+ END DO
+ ELSE
+ KID=0
+ ITYP=2
+ CALL FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH,ITYPIN,NELC,NBRID)
+ IF(I1D .EQ. -999) RETURN
+ IF(IFIN .EQ. 0) THEN
+ NHTP = 0
+ NMESS = 6
+ NBRR = 3
+ CALL HEDR
+!
+! Get screen coordinates of each end of line
+!
+ DO J=1,2000
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ IF(IFLAG .EQ. 'q' .or. ibox .eq. 10) go to 300
+ ALXX(J)=XTEMP
+ ALYY(J)=YTEMP
+ JPTS=J
+ ENDDO
+300 CONTINUE
+ ELSE
+ CALL FILEDAT(JPTS,NBRID)
+ ENDIF
+! SORT OUT A NEW ORDER
+
+ IREF=1
+ CURRENTX=ALXX(1)
+ CURRENTY=ALYY(1)
+ KS=2
+ KSP=1
+ DO J=2,JPTS
+ IF(JPTSB .GT. 0) THEN
+ IF(KSP .LE. JPTSB) THEN
+ DO K=KSP,JPTSB
+ TOTLEN=SQRT((ALXX(J)-CURRENTX)**2+(ALYY(J)-CURRENTY)**2)
+ TOTLENB=SQRT((BLXX(K)-CURRENTX)**2+(BLYY(K)-CURRENTY)**2)
+ IF(ABS(TOTLENB - TOTLEN) .LT. 1.0) THEN
+! THIS IS A BREAKPOINT
+ IREF(KS)=-K
+ KS=KS+1
+ KSP=KSP+1
+ CURRENTX=BLXX(K)
+ CURRENTY=BLYY(K)
+ GO TO 320
+ ENDIF
+ IF(TOTLENB .LT. TOTLEN) THEN
+! THIS IS A BREAKPOINT
+ IREF(KS)=-K
+ KS=KS+1
+ KSP=KSP+1
+ CURRENTX=BLXX(K)
+ CURRENTY=BLYY(K)
+ GO TO 310
+ ELSE
+ IREF(KS)=J
+ KS=KS+1
+ CURRENTX=ALXX(J)
+ CURRENTY=ALYY(J)
+ GO TO 320
+ ENDIF
+310 CONTINUE
+ ENDDO
+ ELSE
+315 CONTINUE
+ IREF(KS)=J
+ KS=KS+1
+ CURRENTX=ALXX(J)
+ CURRENTY=ALYY(J)
+ ENDIF
+320 CONTINUE
+ ELSE
+ IREF(KS)=J
+ IF(KS .LT. JPTS)KS=KS+1
+ CURRENTX=ALXX(J)
+ CURRENTY=ALYY(J)
+ ENDIF
+
+ ENDDO
+! IREF(KS)=JPTS
+ IF(IFIN .GT. 0) THEN
+ IREF(KS)=JPTS
+ DO K=KS,1,-1
+ IF(IREF(K) .LT. 0) THEN
+ ALXX(K)=BLXX(-IREF(K))
+ ALYY(K)=BLYY(-IREF(K))
+ ALWD(K)=BLWD(-IREF(K))
+ HMID(K)=BLWD(-IREF(K))
+ HLEFT(K)=HMID(K)
+ HRIGHT(K)=HMID(K)
+ ELSE
+ ALXX(K)=ALXX(IREF(K))
+ ALYY(K)=ALYY(IREF(K))
+ ALWD(K)=ALWD(IREF(K))
+ HMID(K)=HMID(IREF(K))
+ HLEFT(K)=HLEFT(IREF(K))
+ HRIGHT(K)=HRIGHT(IREF(K))
+ ENDIF
+ ENDDO
+ DO J=1,KS
+ ALXX(J)=(ALXX(J)+XS)/TXSCAL
+ ALYY(J)=(ALYY(J)+YS)/TXSCAL
+ ENDDO
+ DO J=1,KS
+ BLXX(J)=(BLXX(J)+XS)/TXSCAL
+ BLYY(J)=(BLYY(J)+YS)/TXSCAL
+ ENDDO
+! KS=KS-1
+ ENDIF
+ JST=1
+ JKP=0
+ K=2
+ 321 IF(IREF(K) .LT. 0) THEN
+ 323 IF(IREF(K+1) .GT. 0) THEN
+ IREF(K+1)=0
+ K=K+1
+ GO TO 323
+ ELSE
+ K=K+2
+ IF(K .GE. KS) GO TO 325
+ GO TO 321
+ ENDIF
+ ELSE
+ K=K+1
+ IF(K .GE. KS) GO TO 325
+ GO TO 321
+ ENDIF
+325 CONTINUE
+ KC=0
+ DO K=1,KS
+ IF(IREF(K) .EQ. 0) CYCLE
+ KC=KC+1
+ JREF(KC)=IREF(K)
+ ALXX(KC)=ALXX(K)
+ ALYY(KC)=ALYY(K)
+ ALWD(KC)=ALWD(K)
+ HLEFT(KC)=HLEFT(K)
+ HMID(KC)=HMID(K)
+ HRIGHT(KC)=HRIGHT(K)
+ ENDDO
+ IREF=JREF
+ KS=KC
+ ICTYP=NBRID
+ KFS=1
+ DO K=1,KS
+ III=K
+ X11=ALXX(III)*TXSCAL - XS
+ Y11=ALYY(III)*TXSCAL - XS
+ ENDDO
+ DO K=2,KS
+ IF(IREF(K) .LT. 0 .OR. K .EQ. KS) THEN
+ ! IF(K .LT. KS) THEN
+ ! IF(IREF(K) .LT. 0 .AND. IREF(K+1) .GT. 0) THEN
+ ! ITYPB=ICTYP+1
+ ! ICTYP=ICTYP+1
+ ! ELSE
+ ! ITYPB=ITYPIN
+ ! ENDIF
+ ! ELSE
+ ! ITYPB=ITYPIN
+ ! ENDIF
+ IF(KFS .EQ. 2 .OR. JPTSB .EQ. 0) THEN
+ ITYPB=ICTYP
+ ICTYP=ICTYP+1
+ KFS=1
+ ELSE
+ KFS=KFS+1
+ ITYPB=ITYPIN
+ ENDIF
+ IF(ITYPB .GT. NBRID-1) THEN
+ ICTT=(ITYPB-NBRID+1)*2
+ ICTT=ITYPBC(ICTT)
+ IRTYP(ITYPB)=ICTT
+ ELSE
+ ICTT=0
+ IRTYP(ITYPB)=0
+ ENDIF
+ JEND=K
+ XLENGTHP=XLENGTH
+! GO AND FORM A LINE
+! IF(ICTT .EQ. 2) XLENGTHP=XBRLEN((ITYPB-39)*2)
+ CALL FORMLINEL(I1D,I2D,JST,JEND,JKP,XLENGTHP,ITYPB,ICTT)
+ JST=JEND
+ ENDIF
+ ENDDO
+ IF(I2D .EQ. 1) CALL FORM999(1,1,NELC)
+ ENDIF
+
+
+! GO TO 4
+!
+ END
+ SUBROUTINE INTERP(GRIDX,GRIDY,NL,NH,INT,ALX,ALY,ATX,ATY,NINT,ISWT)
+!
+! Routine to fill GRIDX and GRIDY by interpolation
+! NL = START OF GENERATED
+! NH = END OF GENERATED
+! INT = INTERVAL
+! ALX, ALY = START LOC
+! ATX, ATY = END LOC
+! NINT = NUMBER OF POINTS
+! ISWT = 0 BASELINE = 1 APPLY CHANGES
+!IPK MAY02
+ REAL*8 GRIDX(NH),GRIDY(NH),ALX,ALY,ATX,ATY
+!
+! Compute intervals
+!
+ XINT=(ATX-ALX)/FLOAT(NINT)
+ YINT=(ATY-ALY)/FLOAT(NINT)
+!
+! Generate points
+!
+ IF(ISWT .EQ. 0) THEN
+ KP=0
+ DO 200 K=NL,NH,INT
+ IF(KP .EQ. 0) THEN
+ GRIDX(K)=ALX
+ GRIDY(K)=ALY
+ ELSE
+ GRIDX(K)=GRIDX(KP)+XINT
+ GRIDY(K)=GRIDY(KP)+YINT
+ ENDIF
+ KP=K
+ 200 CONTINUE
+ ELSE
+ XAD=ALX
+ YAD=ALY
+ KP=0
+ DO 220 K=NL,NH,INT
+ IF(KP .EQ. 0) THEN
+ GRIDX(K)=GRIDX(K)+XAD
+ GRIDY(K)=GRIDY(K)+YAD
+ ELSE
+ XAD=XAD+XINT
+ YAD=YAD+YINT
+ GRIDX(K)=GRIDX(K)+XAD
+ GRIDY(K)=GRIDY(K)+YAD
+ ENDIF
+ KP=K
+ 220 CONTINUE
+ ENDIF
+ RETURN
+ END
+ SUBROUTINE GEL
+!
+! Routine to create a block of elements
+!
+
+ USE WINTERACTER
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+! INCLUDE 'BLK1.COM'
+
+ include 'd.inc'
+
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ REAL*8 GRIDX,GRIDY,ALX,ALY,BLX,BLY,ARX,ARY,BRX,BRY,GRIDXL,GRIDYL
+ INTEGER*2 IGSKP
+ COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
+ ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
+!
+ CHARACTER*1 IFLAG
+ data itime/0/
+
+ if(itime .eq. 0) then
+ nx=0
+ ny=0
+ itime=1
+ endif
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to use'//&
+ CHAR(13)//'existing nodes?' ,&
+ 'ELEMENT CREATION OPTION')
+!
+! If answer 'No', point to location
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ noptcr=0
+ GO TO 4
+ else
+ noptcr=1
+ go to 1100
+ END IF
+
+ 4 CONTINUE
+ NHTP=0
+ NMESS=8
+ NBRR = 3
+ CALL HEDR
+!
+! Get screen coordinates of each end of line
+!
+ 7 CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ALX=XTEMP
+ ALY=YTEMP
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ CALL WRTOUT(0)
+ RETURN
+ elseif(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ ENDIF
+!
+! Exit input
+!
+ 9 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+! CALL PLOTT(XTEMP,YTEMP,2)
+ siz=0.1
+ call drawcr(xtemp,ytemp,siz)
+ NBRR=0
+ CALL HEDR
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ ARX=XTEMP
+ ARY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+12 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+! CALL PLOTT(XTEMP,YTEMP,2)
+ call drawcr(xtemp,ytemp,siz)
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ BRX=XTEMP
+ BRY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ 16 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+! CALL PLOTT(XTEMP,YTEMP,2)
+ call drawcr(xtemp,ytemp,siz)
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ BLX=XTEMP
+ BLY=YTEMP
+ if(iflag .eq. 'n') then
+ call getfpna(XTEMP)
+ call getfpna(YTEMP)
+ endif
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ 20 CONTINUE
+! CALL PLOTT(XTEMP,YTEMP,3)
+! CALL PLOTT(XTEMP,YTEMP,2)
+ call drawcr(xtemp,ytemp,siz)
+ go to 25
+
+1100 continue
+ CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE1,IFLAG,INSKP,IBOX)
+ ALX=CORD(INODE1,1)
+ ALY=CORD(INODE1,2)
+ CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE2,IFLAG,INSKP,IBOX)
+ ARX=CORD(INODE2,1)
+ ARY=CORD(INODE2,2)
+ CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE3,IFLAG,INSKP,IBOX)
+ BRX=CORD(INODE3,1)
+ BRY=CORD(INODE3,2)
+ CALL PROX(CORD(1,1),CORD(1,2),NP,xx,yy,INODE4,IFLAG,INSKP,IBOX)
+ BLX=CORD(INODE4,1)
+ BLY=CORD(INODE4,2)
+
+!
+! Define number of elements along x and y sides
+!
+ 25 CONTINUE
+ NMESS=45
+ CALL HEDR
+ NMESS = 9
+ call getint(nx)
+! READ(*,*) NX
+ NMESS=45
+ CALL HEDR
+ NMESS = 10
+ call getint(ny)
+! READ(*,*) NY
+ NXP=NX+1
+ NYP=NY+1
+ NRL=NX*NYP+1
+ NRT=NXP*NYP
+
+! ipk jul01 test for limit exceeded
+ if(nrt .gt. maxpgen) then
+ call panelegn
+ go to 25
+ endif
+
+ DO N=1,NE
+ DO M=1,8
+ NOPSV(N,M)=NOP(N,M)
+ ENDDO
+ IMATSV(N)=IMAT(N)
+ ENDDO
+ NESAV=NE
+ NEFSAV=NENTRY
+ NPUNDO=NRT
+!
+! Initialize GRIDX and GRIDY
+!
+ DO 100 N=1,NRT
+ GRIDX(N)=0.
+ GRIDY(N)=0.
+ IGSKP(N)=0
+ 100 END DO
+!
+! Interpolate left and right side
+!
+ CALL INTERP(GRIDX,GRIDY,1,NYP,1,ALX,ALY,BLX,BLY,NY,0)
+ CALL INTERP(GRIDX,GRIDY,NRL,NRT,1,ARX,ARY,BRX,BRY,NY,0)
+!
+! plot points
+!
+ DO 200 N=1,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ siz=0.1
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ 200 END DO
+ DO 220 N=NRL,NRT
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ 220 END DO
+!
+! Interpolate bottom and top sides
+!
+ CALL INTERP(GRIDX,GRIDY,1,NRL,NYP,ALX,ALY,ARX,ARY,NX,0)
+ CALL INTERP(GRIDX,GRIDY,NYP,NRT,NYP,BLX,BLY,BRX,BRY,NX,0)
+!
+! plot points
+!
+ DO 240 N=1,NRL,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ 240 END DO
+ DO 260 N=NYP,NRT,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ 260 END DO
+!
+! Interpolate interior points
+!
+ DO 300 M=2,NYP
+ NFS=NRL+M-1
+ CALL INTERP(GRIDX,GRIDY,M,NFS,NYP,GRIDX(M),GRIDY(M),GRIDX(NFS) &
+ & ,GRIDY(NFS),NX,0)
+ DO N=M,NFS
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ CALL RRed
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ ENDDO
+ 300 END DO
+ 305 CONTINUE
+ NMESS=11
+ NBRR=10
+ CALL HEDR
+310 IBOX=1
+ ip=0
+ CALL PROX(GRIDX(1),GRIDY(1),NRT,XX,YY,IP,IFLAG,IGSKP,IBOX)
+ IF(IBOX .NE. 6 .and. (ip .gt. 0 .and. ip .le. nrt)) THEN
+ XKP=GRIDX(IP)
+ YKP=GRIDY(IP)
+ IPK=IP
+ ENDIF
+ IF(IRMAIN .EQ. 1 .OR. IBOX .EQ. 7) RETURN
+ IF(IFLAG .EQ. 'q') THEN
+ GO TO 400
+ ENDIF
+ DO N=1,NRT
+ GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
+ GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
+ ENDDO
+ IF(IBOX .EQ. 6) THEN
+ XX=XKP
+ YY=YKP
+ IP=IPK
+ GO TO 315
+ ENDIF
+ write(90,*) 'back prox irdisp',IRDISP
+ IF(IRDISP .EQ. 1) THEN
+ CALL PLTPT
+ ENDIF
+!
+! Get screen coordinate of new node location
+!
+ CALL XYLOC(XX,YY,IFLAG,IBOX)
+ write(90,*) 'back xyloc irdisp',IRDISP
+ IF(IRMAIN .EQ. 1 .OR. IBOX .EQ. 7) RETURN
+ 315 IF(IRDISP .EQ. 1) THEN
+ DO N=1,NRT
+ GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
+ GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
+ ENDDO
+ CALL PLTPT
+ ENDIF
+!
+! Establish difference from movement
+!
+ ALX=XX-GRIDX(IP)
+ ALY=YY-GRIDY(IP)
+ CALL PLOTT(XX,YY,3)
+ CALL PLOTT(XX,YY,2)
+ FPN = IP
+! CALL RRed
+! CALL NUMBR(XX,YY,0.20,FPN,0.0,-1)
+! CALL RBlue
+!
+! Find location on boundary
+!
+ IF(IP .LE. NYP) THEN
+! Left boundary
+ NLW=IP
+ NUP=NRL+IP-1
+ NSTP=NYP
+ BLX=0.
+ BLY=0.
+ NS=NX
+ ELSEIF(IP .GE. NRL) THEN
+! Right boundary
+ NLW=IP-NX*NYP
+ NUP=IP
+ NSTP=NYP
+ BLX=ALX
+ BLY=ALY
+ ALX=0.
+ ALY=0.
+ NS=NX
+ ELSE
+ LINENO=(IP-1)/NYP
+ IF(IP-LINENO*NYP .EQ. 1) THEN
+! Lower boundary
+ NLW=IP
+ NUP=IP+NY
+ NSTP=1
+ BLX=0.
+ BLY=0.
+ NS=NY
+ ELSEIF(IP-LINENO*NYP .EQ. NYP) THEN
+! Upper boundary
+ NLW=IP-NY
+ NUP=IP
+ NSTP=1
+ BLX=ALX
+ BLY=ALY
+ ALX=0.
+ ALY=0.
+ NS=NY
+ ELSE
+ GO TO 305
+ ENDIF
+ ENDIF
+!
+! Interpolate change along x line
+! 14935011
+ IF(IRGB .EQ. 14935011) THEN
+ call rgrey
+ ELSE
+ CALL RWHITEB
+ ENDIF
+ do n=1,nrt
+ XTEMP=gridx(n)
+ YTEMP=gridy(n)
+ call drawcr(xtemp,ytemp,siz)
+ enddo
+ CALL RRed
+ CALL INTERP(GRIDX,GRIDY,NLW,NUP,NSTP,ALX,ALY,BLX,BLY,NS,1)
+ do n=1,nrt
+ XTEMP=gridx(n)
+ YTEMP=gridy(n)
+ call drawcr(xtemp,ytemp,siz)
+ GRIDXL(N) = GRIDX(N)*TXSCAL - XS
+ GRIDYL(N) = GRIDY(N)*TXSCAL - YS
+ enddo
+ call Rblue
+ GO TO 310
+!
+! Copy points into cord array
+!
+ 400 CONTINUE
+ DO 500 N=1,NRT
+!
+! Find next blank node in CORD
+!
+ IF(NOPTCR .EQ. 1) THEN
+ IF(N .EQ. 1) THEN
+ NODDEL(N)=0
+ GO TO 500
+ ELSEIF(N .EQ. NYP) THEN
+ NODDEL(N)=0
+ GO TO 500
+ ELSEIF(N .EQ. 1+NYP*NX) THEN
+ NODDEL(N)=0
+ GO TO 500
+ ELSEIF(N .EQ. NRT) THEN
+ NODDEL(N)=0
+ GO TO 500
+ ENDIF
+ ENDIF
+ CALL GETNOD(J)
+ NODDEL(N)=J
+!
+! Store GRIDX and GRIDY into it
+!
+ CORD(J,1) = GRIDX(N)
+ CORD(J,2) = GRIDY(N)
+ IGRIDE(N) = J
+ INEW(J) = 1
+ INSKP(J) = 0
+!
+ XUSR(J) = GRIDX(N)*TXSCAL - XS
+ YUSR(J) = GRIDY(N)*TXSCAL - YS
+!
+! Display point
+!
+ CALL PLTNOD(J,1)
+!
+ 500 END DO
+!
+! Generate elements
+!
+ CALL GETELM(K)
+ IECHG=0
+!
+ DO 600 I=1,NX
+ DO 590 J=1,NY
+ CALL GETELM(K)
+ IF(I .EQ. 1 .AND. J .EQ. 1 .AND. NOPTCR .EQ. 1) THEN
+ NOP(K,1)=INODE1
+ ELSE
+ NOP(K,1)=IGRIDE((I-1)*NYP+J)
+ ENDIF
+ NOP(K,2)=0
+ IF(I .EQ. NX .AND. J .EQ. 1 .AND. NOPTCR .EQ. 1) THEN
+ NOP(K,3)=INODE2
+ ELSE
+ NOP(K,3)=IGRIDE(I*NYP+J)
+ ENDIF
+ NOP(K,4)=0
+ IF(I .EQ. NX .AND. J .EQ. NY .AND. NOPTCR .EQ. 1) THEN
+ NOP(K,5)=INODE3
+ ELSE
+ NOP(K,5)=IGRIDE(I*NYP+J+1)
+ ENDIF
+ NOP(K,6)=0
+ IF(I .EQ. 1 .AND. J .EQ. NY .AND. NOPTCR .EQ. 1) THEN
+ NOP(K,7)=INODE4
+ ELSE
+ NOP(K,7)=IGRIDE((I-1)*NYP+J+1)
+ ENDIF
+ NOP(K,8)=0
+ IMAT(K)=1
+! IF(K .GT. NE) NE=K
+ NCORN(K)=8
+ IESKP(K)=0
+!IPK JAN98
+ IERC=0
+ IRDONE=0
+ CALL PLTELM(K,IERC)
+ 590 CONTINUE
+ 600 END DO
+! CALL UNDO(IYES)
+! IF(IYES .EQ. 1) THEN
+! DO N=1,NEUNDO
+! J=IELDEL(N)
+! CALL DELTEL(J)
+! ENDDO
+! DO N=1,NPUNDO
+! J=NODDEL(N)
+! CALL DELETN(J)
+! ENDDO
+! ENDIF
+ CALL WRTOUT(0)
+ RETURN
+ END
+
+ SUBROUTINE PLTPT
+
+ USE BLK1MOD
+ INCLUDE 'TXFRM.COM'
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ REAL*8 GRIDX,GRIDY,GRIDXL,GRIDYL
+ INTEGER*2 IGSKP
+
+ COMMON /GBLK/ GRIDX(MAXPGEN),GRIDY(MAXPGEN),GRIDXL(MAXPGEN),GRIDYL(MAXPGEN)&
+ ,IGSKP(MAXPGEN),NRL,NRT,NYP,IGRIDE(MAXPGEN)
+
+ DO N=1,NRT
+ GRIDX(N)=(GRIDXL(N)+XS)/TXSCAL
+ GRIDY(N)=(GRIDYL(N)+YS)/TXSCAL
+ ENDDO
+
+!
+! plot points
+!
+ DO N=1,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ siz=0.1
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ END DO
+ DO N=NRL,NRT
+!IP MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ END DO
+!
+! plot points
+!
+ DO N=1,NRL,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ END DO
+ DO N=NYP,NRT,NYP
+!IPK MAY02
+ XTEMP=GRIDX(N)
+ YTEMP=GRIDY(N)
+ CALL PLOTT(XTEMP,YTEMP,3)
+ CALL PLOTT(XTEMP,YTEMP,2)
+ FPN = N
+ CALL RRed
+! CALL NUMBR(XTEMP,YTEMP,0.20,FPN,0.0,-1)
+ call drawcr(xtemp,ytemp,siz)
+ CALL RBlue
+ END DO
+ RETURN
+ END
+
+ subroutine panelegn
+
+ USE WINTERACTER
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'You have requested '//&
+ ' more than the allowable number of nodes.'//CHAR(13)//'The model will return '// &
+ 'to allow new numbers to be input','Limit error')
+!
+! If answer 'Yes', execute
+!
+ IF (WInfoDialog(4) .EQ. 1) then
+ return
+ ENDIF
+ return
+ end
+ SUBROUTINE FORMLINEMENU(ITYP,I1D,I2D,IFIN,XLENGTH,ITYPIN,NELC,NBRID)
+
+
+ use winteracter
+
+ implicit none
+ SAVE
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+ DATA ITIME/0/
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: ITYP,I1D,IERR,ITIME,I2D,IFIN,ITYPIN,NELC,NBRID
+ real :: XLENGTH
+! character*3 :: sub
+! DATA ITIME/0/
+! IF(ITIME .EQ. 0) THEN
+ XLENGTH=250.
+ ITIME=1
+ I1D=0
+ I2D=1
+ IFIN=1
+ ITYPIN=30
+ NELC=2
+ NBRID=40
+! idf_radio1=2
+ ! ENDIF
+
+
+
+ call wdialogload(IDD_FORMLINE)
+ ierr=infoerror(1)
+
+ call wdialogputRadioButton(idf_radio2)
+ call wdialogputRadioButton(idf_radio3)
+ CALL WDialogPutREAL(idf_REAL1,XLENGTH)
+ CALL WDialogPutInteger(idf_INTEGER1,ITYPIN)
+ call wdialogPutCheckBox(idf_check3,IFIN)
+ CALL WDialogPutInteger(idf_INTEGER2,NELC)
+ CALL WDialogPutInteger(idf_INTEGER3,NBRID)
+
+
+ CALL WDialogSelect(IDD_FORMLINE)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ call wdialogGetRadioButton(idf_radio1,ITYP)
+ call wdialogGetRadioButton(idf_radio3,I1D)
+ call wdialogGetCheckBox(idf_check3,IFIN)
+ CALL WDialogGetREAL(idf_REAL1,XLENGTH)
+ CALL WDialogGetInteger(idf_INTEGER1,ITYPIN)
+ CALL WDialogGetInteger(idf_INTEGER2,NELC)
+ CALL WDialogGetInteger(idf_INTEGER3,NBRID)
+ if(I1D .eq. 1) then
+ I1D=0
+ I2D=0
+ ELSEIF(I1D .EQ. 2) THEN
+ I1D=1
+ I2D=0
+ ELSEIF(I1D .EQ. 3) THEN
+ I1D=0
+ I2D=1
+ ENDIF
+ RETURN
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ I1D=-999
+ RETURN
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE FILEDAT(JPTS,NBRID)
+ USE WINTERACTER
+ USE DFLIB
+ USE BLK1MOD
+!
+!
+! Define some parameters to match those in the resource file
+!
+ include 'd.inc'
+ REAL*8 ATMPAR
+ CHARACTER(LEN=255) :: FNAME,FILTER
+ CHARACTER(LEN=3) :: SUB
+ CHARACTER ID*8,DLIN*72
+ IINALN=45
+ Filter='ALIGNMENT file -- *.dat|'
+
+ CALL WSelectFile(Filter,PromptOn,FNAME,'Open Alignment File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IINALN,FILE=FNAME,STATUS='OLD',action='read')
+ ELSE
+ RETURN
+ ENDIF
+ DO K=1,2000
+ CALL GINPT(IINALN,ID,DLIN)
+ IF(ID(1:3) .EQ. 'XYW') THEN
+ READ(DLIN,*) ALXX(K),ALYY(K),ALWD(K),HLEFT(K),HMID(K),HRIGHT(K)
+ ELSEIF(ID(1:3) .EQ. 'XY ') THEN
+ READ(DLIN,*) ALXX(K),ALYY(K)
+ ALWD(K)=0.
+ ELSE
+ JPTS=K-1
+ BACKSPACE(IINALN)
+ GOTO 200
+ ENDIF
+ ENDDO
+200 CONTINUE
+ READ(IINALN,'(A8)') ID
+ IF(ID(1:7) .EQ. 'ENDFILE') RETURN
+
+ CALL GETBRIDCUL(IINALN,NBRID)
+! K=(JPTSB-2)/2+2
+! ALXX(K)=ALXX(2)
+! ALYY(K)=ALYY(2)
+! JPTS=K
+! DO K=2,JPTSB-2,2
+! ALXX(K+1)=(BLXX(K)+BLXX(K+1))/2.
+! ALYY(K+1)=(BLYY(K)+BLYY(K+1))/2.
+! ALWD(K+1)=(BLWD(K)+BLWD(K+1))/2.
+! ENDDO
+
+! DO K=1,1000
+! ATMPAR=BLXX(K)
+! BLXX(K)=ALXX(K)
+! ALXX(K)=ATMPAR
+! ATMPAR=BLYY(K)
+! BLYY(K)=ALYY(K)
+! ALYY(K)=ATMPAR
+! ENDDO
+! NTEMP=JPTSB
+! JPTSB=JPTS
+! NPTS=NTEMP
+ RETURN
+ END
+ SUBROUTINE GETBRIDCUL(IINALN,NBRID)
+ USE BLK1MOD
+ INCLUDE 'TXFRM.COM'
+ CHARACTER(LEN=140) :: DLINLARGE
+ CHARACTER(LEN=8) :: IDN,ID
+ REAL*8 TEMP(9),CPX,CPY,XCEN,YCEN,CW
+ KID=0
+ PI=3.14159
+ KK=1
+ DO K=1,2000
+ CALL GINPT1(IINALN,DLINLARGE)
+ IF(DLINLARGE(1:7) .EQ. 'CULVERT') THEN
+ READ(DLINLARGE(9:140),*) idn,(TEMP(J),J=2,9)
+ ITYPBC(KK)=1
+ ITYPBC(KK+1)=1
+ XCEN=(TEMP(2)+TEMP(4))/2.
+ YCEN=(TEMP(3)+TEMP(5))/2.
+ CW=TEMP(9)*TEMP(8)/2.
+ IF(KK .EQ. 1) THEN
+ CPX=ALXX(1)
+ CPY=ALYY(1)
+ ELSE
+ CPX=BLXX(KK-1)
+ CPY=BLYY(KK-1)
+ ENDIF
+ DNORM=ATAN2(YCEN-CPY,XCEN-CPX)
+ IF(DNORM .LT. 0.) DNORM=DNORM+PI
+ IF(DNORM .GT. PI) DNORM=DNORM-PI
+ BLXX(KK)=XCEN-CW*COS(DNORM)
+ BLYY(KK)=YCEN-CW*SIN(DNORM)
+ BLWD(KK)=TEMP(7)
+ CNX(KK,1)=BLXX(KK)-TEMP(6)/2.*COS(DNORM-PI/2.)
+ CNX(KK,2)=BLXX(KK)+TEMP(6)/2.*COS(DNORM-PI/2.)
+ CNY(KK,1)=BLYY(KK)-TEMP(6)/2.*SIN(DNORM-PI/2.)
+ CNY(KK,2)=BLYY(KK)+TEMP(6)/2.*SIN(DNORM-PI/2.)
+ KPT=NBRID+KK/2
+ KID(KPT,1)=KK
+ DO KLM=1,2
+ CALL GETNOD(J)
+ KID(KPT,KLM+1)=J
+ INEW(J) = 1
+ INSKP(J) =0
+ XUSR(J)=CNX(KK,KLM)
+ YUSR(J)=CNY(KK,KLM)
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ ENDDO
+
+ KK=KK+1
+ BLXX(KK)=XCEN+CW*COS(DNORM)
+ BLYY(KK)=YCEN+CW*SIN(DNORM)
+ BLWD(KK)=TEMP(7)
+ CNX(KK-1,3)=BLXX(KK)-TEMP(6)/2.*COS(DNORM-PI/2.)
+ CNX(KK-1,4)=BLXX(KK)+TEMP(6)/2.*COS(DNORM-PI/2.)
+ CNY(KK-1,3)=BLYY(KK)-TEMP(6)/2.*SIN(DNORM-PI/2.)
+ CNY(KK-1,4)=BLYY(KK)+TEMP(6)/2.*SIN(DNORM-PI/2.)
+
+ DO KLM=3,4
+ CALL GETNOD(J)
+ KID(KPT,KLM+1)=J
+ INEW(J) = 1
+ INSKP(J) =0
+ XUSR(J)=CNX(KK-1,KLM)
+ YUSR(J)=CNY(KK-1,KLM)
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ ENDDO
+ KK=KK+1
+ ELSEIF(DLINLARGE(1:6) .EQ. 'BRIDGE') THEN
+ READ(DLINLARGE(7:140),*) IDN,(TEMP(J),J=1,7)
+ ITYPBC(KK)=2
+ ITYPBC(KK+1)=2
+ BLXX(KK)=TEMP(1)
+ BLYY(KK)=TEMP(2)
+ BLWD(KK)=TEMP(3)
+ KK=KK+1
+ BLXX(KK)=TEMP(4)
+ BLYY(KK)=TEMP(5)
+ BLWD(KK)=TEMP(6)
+ XBRLEN(KK)=SQRT((BLXX(KK)-BLXX(KK-1))**2+(BLYY(KK)-BLYY(KK-1))**2)
+ KK=KK+1
+! READ(DLINLARGE(8:140),*) ID,(TEMP(J),J=1,6)
+ ELSEIF(DLINLARGE(1:7) .EQ. 'ENDFILE') THEN
+ JPTSB=KK-1
+ GO TO 200
+ ENDIF
+ ENDDO
+200 CONTINUE
+ RETURN
+ END
+
+
+
\ No newline at end of file
diff --git a/src/src83e/ELEVINT.F90 b/src/src83e/ELEVINT.F90
new file mode 100644
index 0000000..fbc222b
--- /dev/null
+++ b/src/src83e/ELEVINT.F90
@@ -0,0 +1,245 @@
+!----------------------------------------------------------------elevint
+ subroutine elevint(XX,YY,soln)
+!----------------------------------------------------------------------c
+! purpose: c
+! To interpolate elevation from map data. c
+!----------------------------------------------------------------------c
+! Input data: c
+! (XX, YY) -- a coordinate
+!----------------------------------------------------------------------c
+! Output data: c
+! soln -- elevation value c
+!----------------------------------------------------------------------c
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ INTEGER LISTM,NLIST
+ DIMENSION NLIST(200),ADIST(200)
+ DIMENSION LISTM(1000),listt(60,4),nlf(4),icomp(4),xnear(4)
+! common /mapc/imap(maxpl)
+!
+! Establish size for range
+!
+ JS=1
+ K=0
+ KPT=0
+ DO 120 J=1,MAXPTS
+!
+! Determine how long each line is
+!
+ MLEN=J-JS
+! print *,XMAP(J),VDX,MAXPTS,MLEN,J,JS
+ IF(CMAP(J,1) .LT. VDX) THEN
+!
+! Now check it.
+!
+ K=K+1
+ IF(MLEN .GT. 1) THEN
+! LTP=LINTYP(K)
+ DO 110 M=1,MLEN
+ IF(VAL(JS+M-1) .GT. -9000.) THEN
+ KPT=KPT+1
+ ENDIF
+ 110 CONTINUE
+ ENDIF
+ NMAP=J
+ IF(MLEN .EQ. 0) GO TO 130
+ JS=J+1
+ go to 120
+ ENDIF
+ cxcur=xmap(j)
+ cycur=ymap(j)
+ 120 END DO
+ 130 CONTINUE
+!
+! Estimate areal density to get 100 points
+!
+ ADEN=AMAP*40./(FLOAT(KPT)*TXSCAL**2)
+!
+! Find square coverage
+!
+ XNEARS=SQRT(ADEN)
+ xnearo=xnears
+!
+! initialize range
+!
+ ict=0
+ xnears=xnearo
+ do nang=1,4
+ XNEAR(nang)=XNEARO
+ icomp(nang)=0
+ enddo
+!
+! set imap to zero to start or -1 if no value
+!
+ 220 continue
+ do n=1,nmap
+ if(cmap(n,1) .lt. vdx) then
+ imap(n)=-1
+ elseif(val(n) .lt. -9000.) then
+ imap(n)=-1
+ else
+ imap(n)=0
+ endif
+ enddo
+!
+! initialize list and completeness test
+!
+ do nang=1,4
+ icomp(nang)=0
+ do n=1,50
+ listt(n,nang)=0
+ enddo
+ enddo
+!
+! start processing
+!
+ 280 continue
+!
+! check for completeness intialize counter
+!
+ do nang=1,4
+ if(icomp(nang) .eq. 0) then
+ nlf(nang)=0
+ else
+ ict=ict+1
+ endif
+ enddo
+!
+! if ict = 4 we are done
+!
+ if(ict .lt. 4) then
+!
+! loop through map points
+!
+ DO 300 N=1,NMAP
+!
+! skip if no useful value
+!
+ if(imap(n) .eq. -1) go to 300
+!
+! use nang if we have been through before
+!
+ if(imap(n) .gt. 0) then
+ nang=imap(n)
+!
+! skip to end if done
+!
+ if(icomp(nang) .eq. 1) then
+ go to 300
+ endif
+!
+! otherwise check range skipping out if out of range
+!
+ d1=cmap(n,1)-XX
+ d2=cmap(n,2)-YY
+ IF(ABS(D1) .GT. XNEAR(NANG)) THEN
+ IMAP(N)=-1
+ GO TO 300
+ ELSEIF(ABS(D2) .GT. XNEAR(NANG)) THEN
+ IMAP(N)=-1
+ GO TO 300
+ ENDIF
+!
+! process new point checking range and setting direction
+!
+ else
+ d1=cmap(n,1)-XX
+ d2=cmap(n,2)-YY
+ IF(ABS(D1) .LT. XNEAR(1)) THEN
+ IF(ABS(D2) .LT. XNEAR(1)) THEN
+ if(d1 .lt. 0) then
+ if(d2 .lt. 0) then
+ imap(n)=3
+ nang=3
+ else
+ imap(n)=2
+ nang=2
+ endif
+ elseif(d2 .lt. 0) then
+ imap(n)=4
+ nang=4
+ else
+ imap(n)=1
+ nang=1
+ endif
+!
+! set to skip out if out of range
+!
+ ELSE
+ imap(n)=-1
+ go to 300
+ ENDIF
+ ELSE
+ imap(n)=-1
+ go to 300
+ ENDIF
+ endif
+!
+! save value if total less then 50
+!
+ NLF(NANG)=NLF(NANG)+1
+ IF(NLF(NANG) .LT. 51) THEN
+ LISTT(NLF(NANG),NANG)=N
+ ENDIF
+ 300 CONTINUE
+!
+! now reset range if we need to
+!
+ ictz=0
+ do nang=1,4
+ if(nlf(nang) .gt. 50) then
+ rat=sqrt(45./nlf(nang))
+ if(rat .lt. 0.2) rat=0.2
+ xnear(nang)=xnear(nang)*rat
+ elseif(nlf(nang) .eq. 0) then
+ if(xnear(nang) .eq. xnears) then
+ ictz=ictz+1
+ else
+ icomp(nang)=1
+ endif
+ else
+ icomp(nang)=1
+ endif
+ enddo
+ if(ictz .gt. 1) then
+ do nang=1,4
+ xnear(nang)=xnear(nang)*2.
+ xnears=xnears*2.
+ enddo
+ if(xnear(1) .lt. 4.) then
+ go to 220
+ endif
+ endif
+!
+! go back and try again
+!
+ go to 280
+ endif
+!
+! finished now compact list
+!
+ nlg=0
+ do nang=1,4
+ nlim=nlf(nang)
+ if(nlim .eq. 0) then
+ nlim=50
+ endif
+ do nlgg=1,nlim
+ if(listt(nlgg,nang) .gt. 0) then
+ nlg=nlg+1
+ listm(nlg)=listt(nlgg,nang)
+ endif
+ enddo
+ enddo
+!
+!-----perform interpolation
+!
+ SOLN=-9999.0
+ CALL GRIDIN(XX,YY,SOLN,LISTM,NLG)
+ return
+ END
diff --git a/src/src83e/ELTDISP.F90 b/src/src83e/ELTDISP.F90
new file mode 100644
index 0000000..7bdc9e5
--- /dev/null
+++ b/src/src83e/ELTDISP.F90
@@ -0,0 +1,426 @@
+ Subroutine EltDisp(nsw)
+
+ USE WINTERACTER
+ USE BLK1MOD
+!
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: N,IBOX,NN,NOOP(16),NEAC(8)
+ INTEGER :: IERR
+ CHARACTER*1 :: IFLAG
+
+ DATA N/1/
+ ims=0
+ 100 continue
+ call wdialogload(IDD_ELTDATA)
+ ierr=infoerror(1)
+ IF(NSW .NE. 0) N=ABS(NSW)
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+ NN=N
+ DO N1=1,8
+ NOOP(N1)=NOP(N,N1)
+ NOOP(N1+8)=NOP(N,N1)
+ ENDDO
+ IMAAT=IMAT(N)
+ 120 CONTINUE
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+ CALL WDialogPutInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogPutInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogPutInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogPutInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogPutInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogPutInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogPutInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogPutInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogPutInteger(IDF_INTEGER10,IMAAT)
+ CALL WDialogSelect(IDD_ELTDATA)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modeless)
+ ierr=infoerror(1)
+
+ if(ims .eq. 1) go to 200
+ 150 CONTINUE
+ IF(NSW .LE. 0) THEN
+ call wdialogload(IDD_SELELT)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+
+ CALL WDialogSelect(IDD_SELELT)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ ims=1
+ go to 100
+ endif
+!ipksep02
+ ims=1
+ go to 100
+ enddo
+ ELSE
+ call wdialogload(IDD_ELTERR)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+
+ CALL WDialogSelect(IDD_ELTERR)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ ims=1
+ go to 100
+ endif
+!ipk sep02
+ ims=1
+ go to 100
+ enddo
+ ENDIF
+
+ 200 continue
+
+ DO
+ CALL WMessage(ITYPE,MESSAGE)
+ SELECT CASE (ITYPE)
+ CASE (PushButton)
+ IF(MESSAGE%VALUE1.EQ.IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
+ ISUM=0
+ DO N1=1,8
+ NOP(N,N1)=NOOP(N1)
+ ISUM=ISUM+NOOP(N1)
+ ENDDO
+ IMAT(N)=IMAAT
+ IF(ISUM .EQ. 0) THEN
+ XC(N)=VOID
+ YC(N)=VOID
+ IF(N .LT. NELAST) NELAST=N
+ IESKP(N)=1
+ NCORN(N)=0
+ IMAT(N)=0
+ ENDIF
+ call WDialogHide()
+ call wdialogUNload()
+ RETURN
+ ELSEIF(MESSAGE%VALUE1.EQ.IDNEXT) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
+ ISUM=0
+ DO N1=1,8
+ NOP(N,N1)=NOOP(N1)
+ ISUM=ISUM+NOOP(N1)
+ ENDDO
+ IMAT(N)=IMAAT
+ IF(ISUM .EQ. 0) THEN
+ XC(N)=VOID
+ YC(N)=VOID
+ IF(N .LT. NELAST) NELAST=N
+ IESKP(N)=1
+ NCORN(N)=0
+ IMAT(N)=0
+ ENDIF
+ GO TO 150
+ ELSEIF(MESSAGE%VALUE1.EQ.IDF_delete) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL DELTEL(N)
+ call WDialogHide()
+ call wdialogUNload()
+ RETURN
+ ELSEIF(MESSAGE%VALUE1.EQ.IDCANCEL) THEN
+ call WDialogHide()
+ call wdialogUNload()
+ RETURN
+ ELSEIF(MESSAGE%VALUE1.EQ.IDFROTATE) THEN
+ call WDialogHide()
+ call wdialogUNload()
+ call plotot(1)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select starting node','CHOOSE NODE')
+ IBOX=1
+ DO K=1,8
+ NEAC(K)=NOP(N,K)
+ ENDDO
+ CALL PROXEL(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX,NEAC)
+ DO K=1,NCORN(N)
+ IF(NOOP(K) .EQ. INODE) THEN
+ LL=K-1
+ DO L=1,NCORN(N)
+ LL=LL+1
+ IF(NCORN(N) .EQ. 6 .AND. LL .EQ. 7) LL=LL+2
+ NOOP(L)=NOOP(LL)
+ ENDDO
+ IF(NCORN(N) .EQ. 6) THEN
+ NOOP(7)=0
+ NOOP(8)=0
+ ENDIF
+ call wdialogload(IDD_ELTDATA)
+ GO TO 120
+ ENDIF
+ enddo
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Selected node not within element','CHOOSE NODE')
+ call wdialogload(IDD_ELTDATA)
+ GO TO 120
+
+ ENDIF
+ END SELECT
+ END DO
+
+ RETURN
+ END
+
+ SUBROUTINE GETELMNO
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 IFLAG
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select element','CHOOSE ELEMENT')
+ IBOX=1
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ INEG=-IELEM
+ CALL ELTDISP1(INEG)
+ RETURN
+ END
+
+
+ Subroutine EltDisp1(nsw)
+
+ USE WINTERACTER
+ USE BLK1MOD
+!
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: N,IBOX,NN,NOOP(16),NEAC(8)
+ INTEGER :: IERR
+ CHARACTER*1 :: IFLAG
+
+ DATA N/1/
+ ims=0
+ 100 continue
+ call wdialogload(IDD_ELTDATA)
+ ierr=infoerror(1)
+ IF(NSW .NE. 0) N=ABS(NSW)
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+ NN=N
+ DO N1=1,8
+ NOOP(N1)=NOP(N,N1)
+ NOOP(N1+8)=NOP(N,N1)
+ ENDDO
+ IMAAT=IMAT(N)
+ 120 CONTINUE
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+ CALL WDialogPutInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogPutInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogPutInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogPutInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogPutInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogPutInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogPutInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogPutInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogPutInteger(IDF_INTEGER10,IMAAT)
+ CALL WDialogSelect(IDD_ELTDATA)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ 150 CONTINUE
+
+ DO
+! Branch depending on type of message.
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
+ ISUM=0
+ DO N1=1,8
+ NOP(N,N1)=NOOP(N1)
+ ISUM=ISUM+NOOP(N1)
+ ENDDO
+ IMAT(N)=IMAAT
+ IF(ISUM .EQ. 0) THEN
+ XC(N)=VOID
+ YC(N)=VOID
+ IF(N .LT. NELAST) NELAST=N
+ IESKP(N)=1
+ NCORN(N)=0
+ IMAT(N)=0
+ ENDIF
+ CALL HEDR
+ RETURN
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDNEXT) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetInteger(IDF_INTEGER2,NOOP(1))
+ CALL WDialogGetInteger(IDF_INTEGER3,NOOP(2))
+ CALL WDialogGetInteger(IDF_INTEGER4,NOOP(3))
+ CALL WDialogGetInteger(IDF_INTEGER5,NOOP(4))
+ CALL WDialogGetInteger(IDF_INTEGER6,NOOP(5))
+ CALL WDialogGetInteger(IDF_INTEGER7,NOOP(6))
+ CALL WDialogGetInteger(IDF_INTEGER8,NOOP(7))
+ CALL WDialogGetInteger(IDF_INTEGER9,NOOP(8))
+ CALL WDialogGetInteger(IDF_INTEGER10,IMAAT)
+ ISUM=0
+ DO N1=1,8
+ NOP(N,N1)=NOOP(N1)
+ ISUM=ISUM+NOOP(N1)
+ ENDDO
+ IMAT(N)=IMAAT
+ IF(ISUM .EQ. 0) THEN
+ XC(N)=VOID
+ YC(N)=VOID
+ IF(N .LT. NELAST) NELAST=N
+ IESKP(N)=1
+ NCORN(N)=0
+ IMAT(N)=0
+ ENDIF
+ GO TO 150
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDF_DELETE) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL DELTEL(N)
+ RETURN
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDFROTATE) THEN
+ call plotot(1)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select starting node','CHOOSE NODE')
+ IBOX=1
+ DO K=1,8
+ NEAC(K)=NOP(N,K)
+ ENDDO
+ CALL PROXEL(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX,NEAC)
+ DO K=1,NCORN(N)
+ IF(NOOP(K) .EQ. INODE) THEN
+ LL=K-1
+ DO L=1,NCORN(N)
+ LL=LL+1
+ IF(NCORN(N) .EQ. 6 .AND. LL .EQ. 7) LL=LL+2
+ NOOP(L)=NOOP(LL)
+ ENDDO
+ IF(NCORN(N) .EQ. 6) THEN
+ NOOP(7)=0
+ NOOP(8)=0
+ ENDIF
+ call wdialogload(IDD_ELTDATA)
+ GO TO 120
+ ENDIF
+ enddo
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Selected node not within element','CHOOSE NODE')
+ call wdialogload(IDD_ELTDATA)
+ GO TO 120
+
+ ENDIF
+ END DO
+ RETURN
+ END
+
+ Subroutine EltERRDisp(nsw,ims)
+
+ USE WINTERACTER
+ USE BLK1MOD
+!
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: NSW,IBOX,NN,NOOP(16)
+ INTEGER :: IERR
+ CHARACTER*1 :: IFLAG
+
+ DATA N/1/
+ ims=0
+ 100 continue
+ call wdialogload(IDD_ELTERR2)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,NSW)
+
+ CALL WDialogSelect(IDD_ELTERR)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,NSW)
+ ims=1
+ return
+ else
+ ims=0
+ return
+ endif
+ enddo
+ return
+ end
+
+
+
+
\ No newline at end of file
diff --git a/src/src83e/ELTS.F90 b/src/src83e/ELTS.F90
new file mode 100644
index 0000000..8261fbd
--- /dev/null
+++ b/src/src83e/ELTS.F90
@@ -0,0 +1,712 @@
+! Last change: IPK 12 Jan 98 1:59 pm
+!ipk delete old calls to char(7)
+!ipk last updated Nov 18 1997
+!ipk last updated June 24 1996
+!
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!
+ SUBROUTINE ELTS
+
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 ANS,ANSW(0:9)
+ DATA ANSW/'s','j','f','g','t','i','h','z','r','q'/
+!
+! Draw box around selections
+!
+ 2 CONTINUE
+ NHTP=6
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+!
+! Get answer
+!
+ 3 call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(ANS .EQ. 'c') THEN
+ I=IBOX-1
+ if(i .lt. 0) go to 3
+ ANS=ANSW(I)
+ ENDIF
+!
+ IF(ANS .EQ. 's') THEN
+ CALL SELECT
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'j') THEN
+ CALL MKELEM
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'd') THEN
+ CALL DELEL
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'f') THEN
+ CALL FINDEL
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'g') THEN
+ CALL GEL
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 't') THEN
+ CALL MATTYP
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'i') THEN
+!ipk aug02
+ CALL FILM(0)
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'h') THEN
+ CALL HELPS(2)
+ IF(IRMAIN .EQ. 1) RETURN
+ ELSEIF (ANS .EQ. 'q') THEN
+ RETURN
+ ELSE
+ GO TO 3
+ ENDIF
+ GO TO 2
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE MATTYP
+!
+ USE BLK1MOD
+ SAVE
+! INCLUDE 'BLK1.COM'
+!
+!ipk feb97 CHARACTER*1 IFLAG
+!
+ CHARACTER*1 IFLAG,ANSW(10)
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+!
+!
+! Assign new material type
+!
+!
+!
+ data itime/0/
+
+ if(itime .eq. 0) then
+ mat=1
+ itime=1
+ endif
+ ht=0.2
+!ipk feb97
+ 4 CONTINUE
+ NHTP=0
+ NBRR=4
+!ipk feb97 NBRR=0
+ NMESS=45
+ CALL HEDR
+ NMESS=2
+ XPRT=3.2
+! READ(*,*) MAT
+!
+! Write out current material types
+!
+ IF(NEFL .GT. 0) GO TO 100
+!ipk feb97 4 HT = .20
+ HT = .15
+ DO 10 J=1,NE
+ IF (IMAT(J) .GT. 0 .AND. IMAT(J) .LT. 901) THEN
+ IF(IESKP(J) .EQ. 0) THEN
+ IF(IQSW(1) .EQ. 1 .OR. IQSW(2) .EQ. 1) FPN = IMAT(J)
+ IF(IQSW(1) .EQ. 2 .OR. IQSW(2) .EQ. 2) FPN = IGRPSER(J)
+ X = XC(J)
+!ipk jul02 Y = YC(J) - .11
+ Y = YC(J) + .01
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ ENDIF
+ ENDIF
+ ENDIF
+ 10 END DO
+ CALL GETINT(MAT)
+
+ 5 CONTINUE
+ IBOX=1
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. 9.6) XPRT=0.
+ FPN= IELEM
+ CALL NUMBR(XPRT,7.20,0.18,FPN,0.0,-1)
+!ipk feb97 new setup
+!
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+ RETURN
+ ELSEIF(IFLAG .EQ. 'e' .OR. IFLAG .EQ. 'n') THEN
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ GO TO 4
+ ENDIF
+ IF(IQSW(1) .EQ. 1 .OR. IQSW(2) .EQ. 1) IMAT(IELEM) = MAT
+ IF(IQSW(1) .EQ. 2 .OR. IQSW(2) .EQ. 2) IGRPSER(IELEM) = MAT
+ FPN = MAT
+ X = XC(IELEM)
+ Y = YC(IELEM) + .01
+ CALL NUMBR(X,Y,0.15,FPN,0.0,-1)
+!
+!ipk feb97 ELSEIF(IFLAG .EQ. 'q') THEN
+!ipkfeb94 CALL WRTOUT(0)
+!ipk feb97 RETURN
+!
+!ipk feb97 ELSE
+!ipk feb97 WRITE(*,*) CHAR(7),CHAR(7)
+!ipk feb97 ENDIF
+!
+ GOTO 5
+!
+! Process list from prior selection
+!
+ 100 CONTINUE
+ DO 150 K=1,NEFL
+ J=NEFLAG(K)
+ IMAT(J)=MAT
+ 150 END DO
+ NEFL=0
+ RETURN
+ END
+!
+ SUBROUTINE FINDEL
+!
+ USE BLK1MOD
+ SAVE NELSE
+! INCLUDE 'BLK1.COM'
+!
+! Read desired element number
+!
+ data itime/0/
+ if(itime .eq. 0) then
+ itime=1
+ nelse=0
+ endif
+ 2 CONTINUE
+ NHTPSAV=NHTP
+ NMESSAV=NMESS
+ NBRRSAV=NBRR
+ NHTP=0
+ NBRR=0
+ NMESS=3
+ CALL HEDR
+ NMESS=3
+ CALL GETINT(NELSE)
+! READ(*,*) NELSE
+!
+! Obtain location of centroid
+!
+!ipkdec93 IF(IMAT(NELSE) .EQ. 0) GO TO 2
+ IF(IMAT(NELSE) .EQ. 0) RETURN
+ DO 4 I=1,NP
+ IF(CORD(I,1) .GT. VOID) THEN
+ INSKP(I)=0
+ ENDIF
+ 4 END DO
+ DO 5 I=1,NE
+ IF(IMAT(I) .GT. 0) THEN
+ IESKP(I)=0
+ ENDIF
+ 5 END DO
+ NCN=NCORN(NELSE)
+ XX=0.
+ YY=0.
+ DO 150 K=1,NCN,2
+ XX=XX+CORD(NOP(NELSE,K),1)
+ YY=YY+CORD(NOP(NELSE,K),2)
+ 150 END DO
+ XP=XX/FLOAT((NCN+1)/2)
+ YP=YY/FLOAT((NCN+1)/2)
+!
+! Make it center of screen and redraw
+!
+ XMIN=XP-5.0*PSCALE
+ YMIN=YP-3.5*PSCALE
+! CALL PLOTS(0)
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ HT=0.15
+ FPN=NELSE
+ CALL RRED
+ CALL NUMBR(5.,3.5,HT,FPN,0.0,-1)
+ CALL RBLUE
+ NHTP=NHTPSAV
+ NMESS=NMESSAV
+ NBRR=NBRRSAV
+ CALL HEDR
+ RETURN
+ END
+!
+ SUBROUTINE DELEL
+!
+! Routine to define element for deleting
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 IFLAG
+ IF(NEFL .GT. 0) GO TO 150
+ 100 CONTINUE
+!
+! Check out mouse
+!
+ IBOX=0
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! Go and start again if quit called
+!
+ IF(IFLAG .EQ. 'q') RETURN
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL DELTEL(IELEM)
+ GO TO 100
+!
+! Call routine to delete elements in list
+!
+
+ 150 CONTINUE
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ DO 200 K=1,NEFL
+ J=NEFLAG(K)
+ CALL DELTEL(J)
+ 200 END DO
+ NEFL=0
+ RETURN
+ END
+!
+ SUBROUTINE DELTEL(J)
+!
+! Routine to delete a given element
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ IMAT(J)=0
+ XC(J)=VOID
+ YC(J)=VOID
+ IF(J .LT. NELAST) NELAST=J
+ DO 170 KK=1,8
+ NOP(J,KK)=0
+ 170 END DO
+ IESKP(J)=1
+ NCORN(J)=0
+ JJ=0
+!IPK FEB08 TEST FOR LOWERING NE
+ IF(J .EQ. NE) THEN
+ DO J=NE,1,-1
+ IF(IMAT(J) .NE. 0) THEN
+ JJ=J
+ GO TO 200
+ ENDIF
+ ENDDO
+ 200 NE=JJ
+ ENDIF
+ RETURN
+ END
+!
+ SUBROUTINE SELECT
+!
+! Routine to select elements
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 ANSW(10)
+ CHARACTER*1 IFLAG
+ DATA ANSW/'d','e','n','a','g','t','h','z','r','q'/
+ data itime/0/
+
+ if(itime .eq. 0) then
+ ielem=1
+ itime=1
+ endif
+
+!
+! Draw box around selections
+!
+
+ 2 CONTINUE
+!IPK MAY94 DROP THIS PLOTTING
+! CALL PLOTOT
+ NEFL=0
+ 95 NHTP=7
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+ 100 CONTINUE
+!
+! Check out mouse
+!
+ IBOX=1
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! Return if quit called
+!
+ IF(IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ELSEIF(IFLAG .EQ. 'c') THEN
+ GO TO 120
+ ENDIF
+!
+! Check for reading number
+!
+ IF(IFLAG .EQ. 'n') THEN
+ NHTP=0
+ NMESS=45
+ CALL HEDR
+ NMESS=20
+ CALL GETINT(IELEM)
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=IELEM
+ CALL FILLEM(IELEM)
+ GO TO 95
+!
+! Check for selecting all elements
+!
+ ELSEIF(IFLAG .EQ. 'a') THEN
+ DO I=1,NE
+ IF(IMAT(I) .GT. 0) THEN
+ IF(IMAT(I) .LT. 901 .or. imat(i) .gt. 903) THEN
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=I
+ CALL FILLEM(I)
+ ENDIF
+ ENDIF
+ ENDDO
+ GO TO 95
+!
+! Check for only rectangles
+!
+ ELSEIF(IFLAG .EQ. 'g') THEN
+ DO I=1,NE
+ IF(NCORN(I) .EQ. 8) THEN
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=I
+ CALL FILLEM(I)
+ ENDIF
+ ENDDO
+ GO TO 95
+!
+! Check for only triangles
+!
+ ELSEIF(IFLAG .EQ. 't') THEN
+ DO I=1,NE
+ IF(NCORN(I) .EQ. 6) THEN
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=I
+ CALL FILLEM(I)
+ ENDIF
+ ENDDO
+ GO TO 95
+!
+! Check for only line elements
+!
+ ELSEIF(IFLAG .EQ. 'l') THEN
+ DO I=1,NE
+ IF((NCORN(I) .LT. 6 .and. ncorn(i) .gt. 2) .and. &
+ (imat(i) .lt. 901 .or. imat(i) .gt. 903)) THEN
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=I
+ CALL FILLEM(I)
+ xa=(cord(nop(i,1),1)+cord(nop(i,3),1))/2.
+ ya=(cord(nop(i,1),2)+cord(nop(i,3),2))/2.
+ fpn=i
+ CALL NUMBR(xa,ya,0.18,FPN,0.0,-1)
+ ENDIF
+ ENDDO
+ GO TO 95
+!
+! Check for delete option
+!
+ ELSEIF(IFLAG .EQ. 'd') THEN
+ CALL DELEL
+!
+! Check for refine option
+!
+ ELSEIF(IFLAG .EQ. 'e') THEN
+ CALL REFB
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! Check for help
+!
+ ELSEIF (IFLAG .EQ. 'h') THEN
+ CALL HELPS(6)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ ELSEIF(IFLAG .EQ. 'U') THEN
+ NEFLAG(NEFL)=0
+ NEFL=NEFL-1
+ CALL PLOTOT(1)
+ CALL HEDR
+ DO IELEM=1,NEFL
+ CALL FILLEM(NEFLAG(IELEM))
+ ENDDO
+ GO TO 100
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ RETURN
+ ENDIF
+ GO TO 2
+ 120 NEFL=NEFL+1
+ NEFLAG(NEFL)=IELEM
+ CALL FILLEM(IELEM)
+ IF(NCORN(ielem) .LT. 6 .and. ncorn(ielem) .gt. 2) THEN
+
+ xa=(cord(nop(ielem,1),1)+cord(nop(ielem,3),1))/2.
+ ya=(cord(nop(ielem,1),2)+cord(nop(ielem,3),2))/2.
+ fpn=ielem
+ CALL NUMBR(xa,ya,0.18,FPN,0.0,-1)
+ endif
+ GO TO 100
+ END
+!
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!
+ SUBROUTINE MKELEM
+
+!
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 IFLAG
+ CHARACTER*32 IJNK
+ CHARACTER*23 ELTH
+!ipk jan98
+ CHARACTER*80 LIND
+ CHARACTER*60 MESSAGE,MESSAG1
+!ipk jun96 add messag2
+ CHARACTER*26 MESSAG2
+ DATA MESSAG2/' Press return to continue'/
+!ipkjul94 add a line
+ MEL=MAXE
+!
+! Form element nodal list by clicking on nodes with cursor
+!
+ 3 CONTINUE
+ CALL GETELM(J)
+ 5 CONTINUE
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ WRITE(ELTH,5000) j
+ 5000 FORMAT('Processing element',i5)
+ CALL CLRBOX
+!ipk jun96 clear a strip
+ call clrstp(7.2,7.5)
+ CALL SYMBL(0.,7.70,0.18,ELTH,0.,23)
+ XPRT=3.5
+
+ 6 DO 10 K=1,10,2
+!
+! Find node nearest to cursor
+!
+ 7 CONTINUE
+!ipk sep94 reset ibox
+ IBOX=1
+!ipk sep49 add call to hedr
+ nhtp=0
+!ipk jun96 nmess=22
+ nmess=15
+ nbrr=3
+ call hedr
+ write(155,*) width(1),width(2),width(3)
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! IF(IFLAG .EQ. 'z') THEN
+! DO 62 I=1,NP
+! IF(CORD(I,1) .GT. VOID) THEN
+! INSKP(I)=0
+! ENDIF
+! 62 CONTINUE
+! DO 63 I=1,NE
+! IF(IMAT(I) .GT. 0) THEN
+! IESKP(I)=0
+! ENDIF
+! 63 CONTINUE
+ CALL RBLUE
+ if(inode .lt. 1) return
+ CALL PLTNOD(INODE,1)
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. 9.6) then
+ XPRT=0.
+!ipk jun96 clear a strip
+ call clrstp(7.2,7.5)
+ endif
+ FPN= INODE
+ CALL RBLUE
+ CALL NUMBR(XPRT,7.30,0.18,FPN,0.0,-1)
+!
+ IF(K .EQ. 9) THEN
+ IF(IFLAG .EQ. 'm') THEN
+ NOP(J,K-1) = INODE
+ WD(INODE) = 0.
+!
+! Five node element
+!
+ ELSEIF (IFLAG .EQ. 'f') THEN
+ NOP(J,4)=NOP(J,5)
+ NOP(J,5)=NOP(J,7)
+ NOP(J,7) = 0
+ NOP(J,8) = 0
+ ENDIF
+ GO TO 10
+ ENDIF
+ IF (IFLAG .NE. 'r') THEN
+ NOP(J,K) = 0
+ NOP(J,K+1) = 0
+ ENDIF
+!
+! Corner node
+!
+ IF (IFLAG .EQ. 'c') THEN
+ NOP(J,K) = INODE
+!
+! Midside node
+!
+ ELSEIF (IFLAG .EQ. 'm') THEN
+ NOP(J,K-1) = INODE
+ GOTO 7
+!
+! Triangular element
+!
+ ELSEIF (IFLAG .EQ. 't' .AND. K .EQ. 7) THEN
+ NOP(J,7) = 0
+ NOP(J,8) = 0
+ GOTO 20
+!
+! 1-d element
+!
+ ELSEIF (IFLAG .EQ. 'l' .AND. K .EQ. 5) THEN
+ NOP(J,4) = 0
+ NOP(J,5) = 0
+ NOP(J,6) = 0
+ NOP(J,7) = 0
+ NOP(J,8) = 0
+ GOTO 20
+!
+! Junction element
+!
+ ELSEIF (IFLAG .EQ. 'j' .AND. K .EQ. 3) THEN
+ INODE= NOP(J,1)
+ NOP(J,1)=0
+ CALL JUNGEN(J,INODE,IER)
+ IF(IER .EQ. 1) THEN
+!
+! Redo if error
+!
+!ipk jan98 WRITE(*,*) CHAR(7),CHAR(7)
+ GOTO 7
+ ENDIF
+ GO TO 20
+!
+! Exit input
+!
+ ELSEIF(IFLAG .EQ. 'q') THEN
+ NE=NE-1
+!ipkfeb94 CALL WRTOUT(0)
+ IRDONE=0
+ RETURN
+!
+! Redo if error
+!
+ ELSE
+!ipk jan98 WRITE(*,*) CHAR(7),CHAR(7)
+ GOTO 6
+ ENDIF
+ 10 END DO
+!
+ 20 IF (IMAT(J) .EQ. 0) IMAT(J) = 1
+!
+! rearrange if nop(j,4) .ne. 0 separate it from
+! a transition element
+!
+ IF(NOP(J,4) .NE. 0 .AND. NOP(J,6) .EQ. 0) THEN
+ IF(IFLAG .NE. 'f' .AND. IMAT(J) .LT. 901) THEN
+
+ ITMP1 = NOP(J,1)
+ ITMP2 = NOP(J,2)
+ DO 30 KK=1,6
+ NOP(J,KK) = NOP(J,KK+2)
+ 30 CONTINUE
+ IF(NOP(J,5) .EQ. 0) THEN
+ NOP(J,5)=ITMP1
+ NOP(J,6)=ITMP2
+ ELSE
+ NOP(J,7)=ITMP1
+ NOP(J,8)=ITMP2
+ ENDIF
+ ENDIF
+ ENDIF
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+!
+! Check to see if duplicate node numbers have been defined
+!
+ DO 40 KK=1,NCN-1
+ IF(NOP(J,KK) .EQ. 0) GO TO 40
+ DO 37 LL=KK+1,NCN
+ IF(NOP(J,KK) .EQ. NOP(J,LL)) THEN
+ WRITE(MESSAGE,6000) J
+ 6000 FORMAT(' **ERROR** NODES AT ELEMENT NUMBER',I5,' ARE DUPLICATED RE&
+ &TRY')
+ WRITE(MESSAG1,6001) (NOP(J,II),II=1,8)
+ 6001 FORMAT(' NODE LIST FOLLOWS ',8I5)
+ CALL CLRBOX
+ CALL SYMBL(0.,7.75,0.18,MESSAGE,0.,60)
+ CALL SYMBL(0.,7.55,0.18,MESSAG1,0.,60)
+!IPK JUN96
+ CALL SYMBL(0.,7.35,0.18,MESSAG2,0.,25)
+ call keybrd(k)
+!cc read(*,'(A)') ijnk
+!ipk jun96 change transfer location
+! GO TO 6
+ go to 5
+ ENDIF
+ 37 CONTINUE
+ 40 END DO
+ NCORN(J) = NCN
+ IESKP(J) = 0
+ NE = MAX(J,NE)
+!IPK JAN98
+ IERC=0
+ CALL PLTELM(J,IERC)
+!
+! WRITE(IOT,'(10I5)') J, (NOP(J,K),K=1,8), IMAT(J)
+!
+! Return if dimensions exceeded
+!
+!ipk jul94 IF (J .GE. MAXE) THEN
+ IF (J .GE. MEL) THEN
+ CALL WRTOUT(0)
+ CALL CLSCRN
+!ipk jan98 CALL SETD(24)
+!ipk jan98 WRITE(*,*) ' Element number exceeds MAXE. Press retur
+ WRITE(lind,*) &
+ & ' Element number exceeds MAXE. Press return to exit'
+ call symbl &
+ & (1.1,4.0,0.20,LIND,0.0,80)
+!ipk jan98 READ(*,'(A)') IJNK
+ ndig=1
+ CALL GTCHARX(IJNK,NDIG,5.0,4.0)
+ RETURN
+ ENDIF
+!
+! Go do another element
+!
+ GOTO 3
+
+!
+ END
diff --git a/src/src83e/ELVSET.F90 b/src/src83e/ELVSET.F90
new file mode 100644
index 0000000..5dd39c6
--- /dev/null
+++ b/src/src83e/ELVSET.F90
@@ -0,0 +1,425 @@
+ SUBROUTINE SETRNG(XNEARS,NMAP)
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+! Establish size for range
+!
+ JS=1
+ K=0
+ KPT=0
+ VDX=-1.E9
+ write(90,*) 'maxpts', maxpts
+ DO 120 J=1,MAXPTS+1
+!
+! Determine how long each line is
+!
+ MLEN=J-JS
+! write(90,*) 'mlen',j,js,mlen,xmap(j),nmap,vdx
+! write(90,*) j,js,mlen,cmap(j,1),xmap(j),vdx,maxpts
+ IF(XMAP(J) .LT. VDX) THEN
+!IPK NOV05 IF(CMAP(J,1) .LT. VDX) THEN
+!
+! Now check it.
+!
+ K=K+1
+ IF(MLEN .GT. 1) THEN
+! LTP=LINTYP(K)
+ DO 110 M=1,MLEN
+! write(191,*) j,m,js+m-1,nmap
+ IF(VAL(JS+M-1) .GT. -9000.) THEN
+ KPT=KPT+1
+ ENDIF
+ 110 CONTINUE
+ ENDIF
+ NMAP=J
+ IF(MLEN .EQ. 0) GO TO 130
+ JS=J+1
+ go to 120
+ ENDIF
+ cxcur=xmap(j)
+ cycur=ymap(j)
+ 120 END DO
+ 130 CONTINUE
+ write(90,*) 'number of points forming map',nmap
+ write(90,*) 'last map coordinates',cxcur,cycur
+!
+! Estimate areal density to get 100 points
+!
+ ADEN=AMAP*40./(FLOAT(KPT)*TXSCAL**2)
+!
+! Find square coverage
+!
+ XNEARS=SQRT(ADEN)
+ xnearo=xnears
+ xnearf=xnears
+!ipk sep97 xnearo forms the current value xnearp is limiting plus side
+ XNEARP=XNEARS
+! xnears=2.0
+ WRITE(90,*) 'Radius for nearby points',XNEARS
+ RETURN
+ END
+
+ SUBROUTINE SETELV(XNEARS,NMAP,M,ISWT)
+
+ USE WINTERACTER
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+! common /mapc/imap(maxpl),NCRS(MAXPL)
+! dimension ccmap(maxpl)
+
+ DIMENSION LISTM(1000),listt(1600,4),nlf(4),icomp(4),xnear(4)
+ dimension xnearkp(4)
+
+
+ DATA ITIME/0/
+
+ IF(.NOT. ALLOCATED(CCMAP)) THEN
+ ALLOCATE (CCMAP(MAXPL))
+ ENDIF
+ call WcursorShape(CurHourGlass)
+
+
+!ipk feb94 change logic to allow 4 passes and check angles
+!
+! initialize range
+!
+ ict=0
+!ipk sep97 xnears=xnearo
+ xnearo=xnears
+ xnearp=xnears
+ xnearf=xnears
+ write(90,*) 'working node',m
+ do nang=1,4
+ XNEAR(nang)=XNEARS
+ xnearkp(nang)=0.
+ icomp(nang)=0
+ enddo
+!
+! set imap to zero to start or -1 if no value
+!
+!IPK MAY97 INITIALIZE COUNTER
+ ntime=0
+ 220 continue
+
+ do n=1,nmap
+ if(cmap(n,1) .lt. vdx) then
+ imap(n)=-1
+ elseif(val(n) .lt. -9000.) then
+ imap(n)=-1
+ else
+ imap(n)=0
+ endif
+ enddo
+!
+!ipk sep97 Sortlist of map points in increasing x except for single poin
+!
+ IF(ielvsw .EQ. 0 .AND. ISWT .NE. 1) THEN
+!ipk mar99
+ do n=1,nmap
+ ccmap(n)=cmap(n,1)
+ enddo
+ CALL SORTMAP(CCMAP,NCRS,NMAP,IMAP)
+ ielvsw=1
+! DO N=1,NMAP
+! WRITE(90,*) N,CMAP(NCRS(N),1),IMAP(NCRS(N))
+! ENDDO
+ ENDIF
+!ipk sep97 end addition
+!
+! initialize list and completeness test
+!
+ do nang=1,4
+ icomp(nang)=0
+ do n=1,1600
+ listt(n,nang)=0
+ enddo
+ enddo
+!
+! start processing
+!
+ 280 continue
+!
+! check for completeness intialize counter
+!
+ ict=0
+ do nang=1,4
+ if(icomp(nang) .eq. 0) then
+ nlf(nang)=0
+ else
+ ict=ict+1
+ endif
+ enddo
+!
+! if ict = 4 we are done
+!
+ if(ict .lt. 4) then
+!
+! loop through map points
+!
+!ipk sep97 change loop
+ do nang=1,4
+ nlf(nang)=0
+ icomp(nang)=0
+ enddo
+ IFND=0
+ NN=0
+ 285 NN=NN+1
+ IF(NN .GT. NMAP) GO TO 305
+! DO 300 NNN=1,NMAP
+ N=NN
+ if(val(n) .lt. -9990.) go to 285
+ IF(ISWT .EQ. 1) GO TO 297
+ IF(IFND .EQ. 1) GO TO 295
+ IF(XNEARO .LT. XNEARF) THEN
+ IFND=1
+ GO TO 294
+ ENDIF
+
+!IPK SEP97 START SEARCH
+ NLOCA=NMAP/2
+ NSTEPS=NMAP/2
+290 CONTINUE
+
+! WRITE(90,*) 'elvset-164',NLOCA
+! write(90,*) NSTEPS,NCRS(NLOCA)
+! WRITE(90,*) CMAP(NCRS(NLOCA),1),CORD(M,1),XNEAR(1)
+ NCUR=NCRS(NLOCA)
+! IF(CMAP(NCUR,1) .GT. 1.E34) THEN
+! WE ARE AOUT OF RANGE
+! GO TO
+! ENDIF
+ IF(CMAP(NCUR,1)+XNEARO .LT. CORD(M,1).and. val(ncur) .gt. -9000.) THEN
+! still below increase nloca
+ NSTEPS=NSTEPS/2
+ IF(NSTEPS .EQ. 0) THEN
+! we are there
+ NLOCA=NLOCA-1
+ IFND=1
+ GO TO 293
+ ENDIF
+ NLOCA=NLOCA+NSTEPS
+ GO TO 290
+ ELSE
+! too great decrease nloca
+ NSTEPS=(NSTEPS+1)/2
+ NLOCA=NLOCA-NSTEPS
+ IF(NLOCA .LE. 0) THEN
+ NLOCA=0
+ IFND=1
+ GO TO 293
+ ENDIF
+ GO TO 290
+ ENDIF
+ 293 NLOCS=NLOCA
+! WRITE(90,*) 'elvset-201',NLOCA,NSTEPS,NCRS(NLOCA)
+! WRITE(90,*) CMAP(NCRS(NLOCA),1),CORD(M,1),XNEAR(1)
+ GO TO 295
+ 294 NLOCA=NLOCS
+ 295 CONTINUE
+ NLOCA=NLOCA+1
+ if(nloca .gt. nmap) go to 305
+ NCUR=NCRS(NLOCA)
+!
+! test to see if we are past area
+!
+ if(ncur .eq. 0) go to 305
+ IF(CMAP(NCUR,1)-XNEARP .GT. CORD(M,1)) GO TO 305
+ if(val(ncur) .lt. -9000.) go to 295
+ N=NCUR
+ 297 CONTINUE
+ d1=cmap(n,1)-cord(m,1)
+ d2=cmap(n,2)-cord(m,2)
+!ipk may97 IF(ABS(D1) .LT. XNEAR(1)) THEN
+!ipk may97 IF(ABS(D2) .LT. XNEAR(1)) THEN
+ IF(ABS(D1) .LT. max(XNEARO,xnearp)) THEN
+ IF(ABS(D2) .LT. max(XNEARO,xnearp)) THEN
+ if(d1 .lt. 0) then
+ if(d2 .lt. 0) then
+ nang=3
+ if(abs(d1) .lt. xnear(NANG) .and. &
+ & abs(d2) .lt. xnear(NANG)) then
+ imap(n)=3
+ else
+ imap(n)=-1
+ go to 300
+ endif
+ else
+ nang=2
+ if(abs(d1) .lt. xnear(NANG) .and. &
+ & abs(d2) .lt. xnear(NANG)) then
+ imap(n)=2
+ else
+ imap(n)=-1
+ go to 300
+ endif
+ endif
+ elseif(d2 .lt. 0) then
+ nang=4
+ if(abs(d1) .lt. xnear(NANG) .and. &
+ & abs(d2) .lt. xnear(NANG)) then
+ imap(n)=4
+ else
+ imap(n)=-1
+ go to 300
+ endif
+ else
+ nang=1
+ if(abs(d1) .lt. xnear(NANG) .and. &
+ & abs(d2) .lt. xnear(NANG)) then
+ imap(n)=1
+ else
+ imap(n)=-1
+ go to 300
+ endif
+ endif
+!
+! set to skip out if out of range
+!
+ else
+ imap(n)=-1
+ go to 300
+ endif
+ else
+ imap(n)=-1
+ go to 300
+ endif
+!
+!IPK SEP97 END MAJOR REWRITE
+!
+! save value if total less then 50
+!
+ NLF(NANG)=NLF(NANG)+1
+ IF(NLF(NANG) .LT. 101) THEN
+ LISTT(NLF(NANG),NANG)=N
+ ENDIF
+ 300 CONTINUE
+ GO TO 285
+ 305 CONTINUE
+!
+! now reset range if we need to
+!
+ ictz=0
+! write(90,*) ' '
+! write(90,*) ntime
+! write(90,*) 'nlf',nlf
+! write(90,*) 'xnear',xnear
+ do nang=1,4
+ if(nlf(nang) .gt. 150) then
+! rat=sqrt((45.+ntime*3.)/nlf(nang))
+! if(rat .lt. 0.2) rat=0.2
+ rat=sqrt(0.1+0.06*ntime)
+ xnearkp(nang)=xnear(nang)
+ xnear(nang)=xnear(nang)*rat
+!ipk may97 elseif(nlf(nang) .eq. 0) then
+ elseif(nlf(nang) .lt. 2) then
+!ipk may97 if(xnear(nang) .eq. xnears) then
+ ictz=ictz+1
+!ipk may97 else
+!ipk may97 icomp(nang)=1
+!ipk may97 endif
+ else
+ icomp(nang)=1
+ endif
+ enddo
+ xnearf=xnearo
+! write(90,*) 'ntime,ictz,xnear',ntime,ictz
+! write(90,*) 'icomp',icomp
+! write(90,*) 'xneara',xnear
+ if(ictz .gt. 0) then
+ do nang=1,4
+ if(nlf(nang) .lt. 2) then
+ if(xnearkp(nang) .gt. 0.) then
+ xnear(nang)=xnearkp(nang)
+ else
+ xnear(nang)=xnear(nang)*1.5
+ endif
+ if(nang .eq. 2 .or. nang .eq. 3) then
+ if(xnear(nang) .gt. xnearo) xnearo=xnear(nang)
+ endif
+ if(nang .eq. 1 .or. nang .eq. 4) then
+ if(xnear(nang) .gt. xnearp) xnearp=xnear(nang)
+ endif
+ endif
+!ipk may97 xnears=xnears*2.
+! write(90,*) 'nang,xnear',nang,xnear(nang)
+! write(90,*) 'xnearo,xnearp',xnearo,xnearp
+
+ enddo
+!ipk sep97 xnears=xnears*2.
+ ntime=ntime+1
+ if(ntime .lt. 12) go to 220
+! go to 220
+! endif
+ endif
+!
+! go back and try again
+!
+!ipk may97 go to 280
+ ntime=ntime+1
+ if(ntime .lt. 16) go to 280
+ endif
+!
+! finished now compact list
+!
+ do nang=1,4
+! write(90,*)'nang',nang,nlf(nang),xnear(nang)
+ enddo
+ nlg=0
+ do nang=1,4
+ nlim=nlf(nang)
+!ipksep97 if(nlim .eq. 0) then
+!ipksep97 nlim=50
+!ipk sep97 endif
+!ipk sep97 chnage limit and act only if nlim > 0
+! write(90,*) 'nlim',nlim
+ if(nlim .gt. 1600) nlim=1600
+ if(nlim .gt. 0) then
+ do nlgg=1,nlim
+ if(listt(nlgg,nang) .gt. 0) then
+ if(nlg .eq. 1000) nlg=999
+ nlg=nlg+1
+ listm(nlg)=listt(nlgg,nang)
+ endif
+ enddo
+ endif
+ enddo
+! write(90,*) nlg
+! write(90,*) m,(listm(n),n=1,nlg),xnear
+!ipk feb94 end changes
+! do n=1,nmap
+! write(90,*) n,cmap(n,1),cmap(n,2),val(n)
+! enddo
+! write(90,*) 'LIST MAP POINTS NEAR ',M,CORD(M,1),CORD(M,2)
+! DO N=1,NLG
+! WRITE(90,*) listm(n),CMAP(LISTM(N),1),CMAP(LISTM(N),2),val(listm(n))
+! ENDDO
+! read(*,*) n234
+
+!IPK JUL98 CALL GRIDIN(M,SOLN,LISTM,NLG)
+ XXX=CORD(M,1)
+ YYY=CORD(M,2)
+ CALL GRIDIN(XXX,YYY,SOLN,LISTM,NLG)
+ IF(IRMAIN .EQ. 1) then
+ call WcursorShape(CurArrow)
+ RETURN
+ endif
+ WD(M)=SOLN
+ FPN = WD(M)*10.
+ X = CORD(M,1)
+ Y = CORD(M,2) - .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.1,FPN,0.0,-1)
+ ENDIF
+! call WcursorShape(0)
+ call WcursorShape(CurArrow)
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/EVENT.F90 b/src/src83e/EVENT.F90
new file mode 100644
index 0000000..2eda33a
--- /dev/null
+++ b/src/src83e/EVENT.F90
@@ -0,0 +1,2085 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR status
+ SUBROUTINE gim_an_event(ix,iy,iflag)
+
+ USE WINTERACTER
+
+ include 'd.inc'
+
+ COMMON /TMPLIST/ ilisttmp(100),INREORD
+
+! THIS BLOCK IS IN BLK1.F90
+
+ COMMON /VIEWS/ HANG,VANG,VRTSCAL,HANGOLD,VANGOLD,VRTORIG,IASPCT
+
+
+ INTEGER :: NP,NE,NHTP,NMESS,NBRR,IPSW,IRMAIN,ISCRN,icolon,nhtpsv,nmessv,nbrrsv,ntempin,IPW2
+
+
+!ipk jan01 Expand IPSW to 10
+ CHARACTER*6 DESCR
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+ COMMON /HEDS1/ NWINDWS,IWNDWS(10),ISCRNS(10),DESCR(10),ICRSR(10)
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ REAL :: RSCLX,RSCLY,HRAD,VRAD
+
+ real*8 xms,yms
+ INTEGER :: MOUSEX, MOUSEY, MBUTTON, ITIME, IWINDOW,MENUS
+ INTEGER :: IMP,IIN,IOT,IOT1,impf,IBAKON,N,NDM,IDRAG,IYES,ITRIAN,INFO(3)
+
+ LOGICAL :: OPENED,EXISTS
+ CHARACTER(LEN=255) :: FNAME,FNAMGE,FNAMRM,FNAMEB
+ CHARACTER(LEN=3) :: SUB,SUB1
+ CHARACTER(LEN=4) :: SUB2
+ character(len=43) :: zoomh
+ CHARACTER(LEN=50) :: STBAR
+ character(len=1000) :: header
+ CHARACTER(len=10) :: DATEC,TIMEC,ZONEC
+ INTEGER :: DTI(8)
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER(LEN=72) :: CRSTIT
+ REAL :: XX1,XX2,XX3,XX4,XX5,XX6
+
+ COMMON /UNITS/IOT,IOT1
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ TYPE (WIN_FONT) :: FONT
+
+! Define a common block with background file names
+
+ INCLUDE 'BFILES.I90'
+
+ DATA IBAKON/1/
+ DATA rsclx,rscly/100.0,100./,IDOWN/0/
+
+!
+! Interacter graphics input routine
+! Shows the mouse, collects mouse location and character
+! on the mouse-click or on a keystroke
+
+
+ character*1 iflag
+
+ CALL WMenuSetState(ID_ITEM11,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM12,ItemEnabled,0)
+
+ nhtpsv=nhtp
+ nmessv=nmess
+ nbrrsv=nbrr
+ 100 continue
+ DO I=1,255
+ FNAME(I:I)=' '
+ ENDDO
+ MENUS=0
+ idrag=0
+ 101 continue
+ CALL WMessage(ITYPE, MESSAGE)
+ SELECT CASE (ITYPE)
+ CASE (KeyDown) ! Key pressed
+ KEY = MESSAGE%VALUE1
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ XM=MESSAGE%GX
+ YM=MESSAGE%GY
+ IFLAG=CHAR(KEY)
+! WRITE(90,*) 'KEY PRESSED',KEY
+! WRITE(90,'(A)') 'KEY PRESSED',IFLAG,menus
+ CASE (MenuSelect) ! Menu item selected
+ INREORD=0
+ DO J=1,100
+ ilisttmp (j)=0
+ ENDDO
+ SELECT CASE (MESSAGE%VALUE1)
+ CASE (ID_ITEM11) ! New option
+ IMP=0
+ IIN=0
+ CASE (ID_ITEM12) ! Open option
+ IMP=0
+ IIN=0
+ CALL IgrUnits(0.,0.,HSIZE,8.0)
+
+ CALL WSelectFile(ID_STRING1,PromptOn+DirChange,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ENDIF
+ ENDIF
+
+ FILTER ="Network Files|*.rm1;*.geo;*.gfg;*.bin;*.ele|Rm1 file -- *.rm1|*.rm1|Geo file -- *.geo|*.geo|GFGEN file -- *.gfg|*.gfg|GFGEN bin file -- *.bin|*.bin|Rst file -- *.rst|*.rst|TRIANG file -- *.ele|*.ele|MESH2D file -- *.2dm|*.2dm|All files|*.*|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+
+ ITRIAN=0
+ IF(SUB .EQ. 'rm1') then
+ IIN = 10
+ OPEN(10,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'ele') then
+ IIN=10
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=1
+ IGFG=0
+ FNAMKEP=FNAME
+ ELSEIF(SUB .EQ. 'rst') then
+ IIN=11
+! OPEN(IIN ,FILE=FNAME,STATUS='OLD',access='transparent')
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+! OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='BINARY')
+ ELSE
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary')
+ ENDIF
+ ENDIF
+
+ CASE (ID_NMAP)
+ CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'shp') then
+ IMP=113
+ OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ SUB='DBF'
+ CALL ADDSUB(FNAME,SUB)
+ OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ENDIF
+ ENDIF
+ CALL RDMAP(2,IMP,0,0)
+ CALL PLOTOT(0)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ GO TO 100
+
+!IPK MAY03 LOAD ADDITIONAL FILES
+
+ CASE (ID_LOADRM1)
+
+! Load additional RM1 files
+
+ FILTER ="Network Files|*.rm1;*.geo;*.gfg;*.bin;*.ele|Rm1 file -- *.rm1|*.rm1|Geo file -- *.geo|*.geo|Gfgen file -- *.gfg|*.gfg|GFGEN bin file -- *.bin|*.bin|Rst file -- *.rst|*.rst|TRIANG file -- *.ele|*.ele|All files|*.*|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 200
+ ELSE
+ GO TO 250
+ ENDIF
+ 200 CONTINUE
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+
+ ITRIAN=0
+ IF(SUB .EQ. 'geo') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary',ACTION='READ')
+ FNAMKEP=FNAME
+ IGFG=0
+ ELSEIF(SUB .EQ. 'gfg') then
+ IIN = 10
+ IGFG=1
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ELSEIF(SUB .EQ. '2dm') then
+ IIN = 10
+ IGFG=3
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ELSEIF(SUB .EQ. 'bin') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+ IGFG=2
+ ELSEIF(SUB .EQ. 'rst') then
+ IIN=11
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+ IGFG=0
+ ELSEIF(SUB .EQ. 'ele') then
+ IIN=10
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=1
+ IGFG=0
+ FNAMKEP=FNAME
+ ELSE
+ IIN = 10
+ IGFG=0
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ENDIF
+ ITOTFIL=ITOTFIL+1
+ FNAMEOUT(ITOTFIL)=FNAME
+ CALL GETNEWFIL(IIN,IGFG,ITRIAN,0)
+
+ fname=' '
+ GO TO 100
+
+ CASE (ID_CRSF)
+
+! Load cross-section files
+
+ ICRIN=0
+ FILTER ="Cross-Section files -- *.crs|*.crs|All files -- |*.*|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Cross-Section File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 210
+ ELSE
+ GO TO 250
+ ENDIF
+ 210 CONTINUE
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ ICRIN = 23
+ OPEN(ICRIN,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ CALL GETCRS(CRSTIT)
+
+ fname=' '
+ GO TO 100
+
+
+! Load group number files
+
+ IGRPIN=0
+ FILTER ="Group number files -- *.txt|*.txt|All files -- |*.*|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Group Number File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 215
+ ELSE
+ GO TO 250
+ ENDIF
+ 215 CONTINUE
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ IGRP = 28
+ OPEN(IGRP,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ CALL GETGRP
+
+ fname=' '
+ GO TO 100
+
+ CASE (ID_SAVCRS)
+ ICROUT=24
+ INQUIRE(24, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='CRS file -- *.crs|*.crs|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Cross Section File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(ICROUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ ELSE
+ GO TO 250
+ ENDIF
+ ENDIF
+ REWIND ICROUT
+ CALL WRTCRS(ICROUT,CRSTIT)
+ fname=' '
+ GO TO 100
+
+ CASE (ID_SAVGP)
+ IGRPOUT=29
+ INQUIRE(29, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='TXT file -- *.txt|*.txt|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Group Number File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IGRPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ ELSE
+ GO TO 250
+ ENDIF
+ ENDIF
+ REWIND IGRP
+ CALL WRTGP
+ fname=' '
+ GO TO 100
+
+ CASE (ID_ITEM13) ! Save option
+! WRITE(90,*) 'WINTER AT ITEM13'
+ INQUIRE(20, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='Network Files|*.rm1;*.gfg;*.ele|Rm1 file -- *.rm1|*.rm1|gfg file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+! SUB='rm1'
+! CALL ADDSUB(FNAME,SUB)
+
+! WRITE(90,*) 'IN ITEM13',IOT
+! WRITE(90,'(A)') FNAME,SUB
+ IOT = 20
+ FNAMRM=FNAME
+ ITRIANOUT=0
+ if(sub .eq. 'rm1') then
+ igfgsw=0
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+!
+! Check if file cords format to be short or long
+!
+!
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
+ CHAR(13)//'coordinates in long format?' ,&
+ 'Coordinate save format')
+!
+! If answer 'No', use short format
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ ntempin=0
+ else
+ ntempin=2
+ END IF
+!
+ call wrtout(1)
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+ elseif(sub .eq. 'ele') then
+ igfgsw=0
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ itrianout=1
+ call wrtout(1)
+ DO L=255,1,-1
+ IF(FNAME(L:L) .EQ. '.') THEN
+ FNAME(L+1:L+1)='n'
+ FNAME(L+2:L+2)='o'
+ FNAME(L+3:L+3)='d'
+ FNAME(L+4:L+4)='e'
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ itrianout=2
+ call wrtout(1)
+ GO TO 220
+ ENDIF
+ ENDDO
+ 220 continue
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+ else
+ igfgsw=1
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ call wrtout(1)
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+ endif
+ ENDIF
+ if(iactvfil .le. 0) iactvfil=1
+ FNAMEOUT(IACTVFIL)=FNAMRM
+
+ else
+
+ CALL GETSUB(FNAMRM,SUB)
+
+ if(sub .eq. 'ele') then
+ FNAME=FNAMRM
+ igfgsw=0
+ itrianout=1
+ call wrtout(1)
+ DO L=255,1,-1
+ IF(FNAME(L:L) .EQ. '.') THEN
+ FNAME(L+1:L+1)='n'
+ FNAME(L+2:L+2)='o'
+ FNAME(L+3:L+3)='d'
+ FNAME(L+4:L+4)='e'
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ itrianout=2
+ call wrtout(1)
+ GO TO 221
+ ENDIF
+ ENDDO
+ 221 continue
+ ELSE
+ call wrtout(1)
+ ENDIF
+ CLOSE (IOT)
+ fnamrm=FNAMEOUT(IACTVFIL)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+ endif
+ GO TO 100
+
+ CASE (ID_ITEM14) ! Save option for binary
+
+! WRITE(90,*) 'WINTER AT ITEM14'
+ INQUIRE(22, OPENED=OPENED)
+! WRITE(90,'(L2)') OPENED
+ if(.not. opened) then
+ Filter='Geo file -- *.geo|*.geo|GFGEN file -- *.bin|*.bin|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
+! WRITE(90,'(A)') FNAME
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+! SUB='geo'
+! CALL ADDSUB(FNAME,SUB)
+
+! WRITE(90,*) 'IN ITEM14',IOT1
+! WRITE(90,'(A)') FNAME,SUB
+ IOT1=22
+ FNAMGE=FNAME
+ if(sub .eq. 'geo') then
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary')
+ igfgswb=0
+
+! add header to binary file
+
+ DO J=11,1000
+ HEADER(J:J)=' '
+ ENDDO
+ HEADER(1:10)='RMAGEN '
+ CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
+ HEADER(11:20)=DATEC
+ HEADER(21:30)=TIMEC
+ HEADER(31:40)=ZONEC
+ WRITE(IOT1) HEADER
+ call wrtout(2)
+
+ CLOSE (IOT1)
+ OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
+ else
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
+ igfgswb=1
+ call wrtout(2)
+ CLOSE (IOT1)
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
+ endif
+ ENDIF
+ else
+
+! add header to binary file
+
+ DO J=11,1000
+ HEADER(J:J)=' '
+ ENDDO
+ HEADER(1:10)='RMAGEN '
+ CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
+ HEADER(11:20)=DATEC
+ HEADER(21:30)=TIMEC
+ HEADER(31:40)=ZONEC
+ WRITE(IOT1) HEADER
+ call wrtout(2)
+ CLOSE (IOT1)
+ OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
+ endif
+ FNAMEOUT(IACTVFIL)=FNAMRM
+ GO TO 100
+
+ CASE (ID_ITEM18) ! Save As option
+ FILTER ="Bin Map file -- *.mpb|*.mpb|Bin Map file (no head) -- *.mbb|*.mbb|"
+ CALL WSelectFile(filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ if(SUB .eq. 'mpb') then
+ CALL ADDSUB(FNAME,SUB)
+ impf=93
+ OPEN(IMPF ,FILE=fname,STATUS='unknown',form='unformatted')
+
+ call wrtmap(1)
+ elseif(Sub .eq. 'map') then
+ impf=94
+ OPEN(IMPF ,FILE=fname,STATUS='unknown',form='formatted')
+ call wrtmap(2)
+ endif
+ ENDIF
+
+ go to 100
+
+ CASE (ID_LAYFL) ! input layer data
+
+ CALL WSelectFile(ID_STRING9,PromptOn+DirChange,FNAME,'Load Layer File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='lay'
+ CALL ADDSUB(FNAME,SUB)
+ impf=103
+ OPEN(103,FILE=FNAME,STATUS='OLD')
+ call rdlayer
+ ENDIF
+
+ go to 100
+
+ CASE (ID_OUTLAY) ! Save layer data
+
+ call wrtlayer
+ GO TO 100
+
+ CASE (ID_ITEM15) ! Save As option
+
+ Filter='Network Files|*.rm1;*.gfg;*.ele|Rm1 file -- *.rm1|*.rm1|GFGEN file -- *.gfg|*.gfg|TRIANG file -- *.ele|*.ele|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+! SUB='rm1'
+! CALL ADDSUB(FNAME,SUB)
+ FNAMRM=FNAME
+ IOT = 20
+
+ if(sub .eq. 'rm1') then
+ igfgsw=0
+ itrianout=0
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+
+!
+! Check if file cords format to be short or long
+!
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
+ CHAR(13)//'coordinates in long format?' ,&
+ 'Coordinate save format')
+
+! If answer 'No', use short format
+
+ IF (WInfoDialog(4).EQ.2) then
+ ntempin=0
+ else
+ ntempin=2
+ END IF
+!
+ call wrtout(1)
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+
+ elseif(sub .eq. 'ele') then
+ igfgsw=0
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ itrianout=1
+ call wrtout(1)
+ DO L=255,1,-1
+ IF(FNAME(L:L) .EQ. '.') THEN
+ FNAME(L+1:L+1)='n'
+ FNAME(L+2:L+2)='o'
+ FNAME(L+3:L+3)='d'
+ FNAME(L+4:L+4)='e'
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ itrianout=2
+ call wrtout(1)
+ GO TO 225
+ ENDIF
+ ENDDO
+ 225 continue
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+
+ elseif(sub .eq. 'gfg') then
+ igfgsw=1
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ call wrtout(1)
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+ endif
+ IF(IACTVFIL .LE. 0) IACTVFIL=1
+ FNAMEOUT(IACTVFIL)=FNAMRM
+ ENDIF
+
+ go to 100
+
+ CASE (ID_ITEM16) ! Save As option
+
+ Filter='Geo file -- *.geo|*.geo|GFGEN file -- *.bin|*.bin|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+! SUB='geo'
+! CALL ADDSUB(FNAME,SUB)
+ FNAMGE=FNAME
+ IOT1 = 22
+ if(SUB .EQ. 'geo') then
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary')
+ igfgswb=0
+! add header to binary file
+
+ DO J=11,1000
+ HEADER(J:J)=' '
+ ENDDO
+ HEADER(1:10)='RMAGEN '
+ CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
+ HEADER(11:20)=DATEC
+ HEADER(21:30)=TIMEC
+ HEADER(31:40)=ZONEC
+ WRITE(IOT1) HEADER
+ call wrtout(2)
+ CLOSE (IOT1)
+ OPEN(IOT1 ,FILE=FNAMGE,STATUS='UNKNOWN',form='binary')
+ else
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
+ igfgswb=1
+ call wrtout(2)
+ CLOSE (IOT1)
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='unformatted')
+ endif
+ FNAMEOUT(IACTVFIL)=FNAMRM
+ ENDIF
+
+ go to 100
+
+ CASE (ID_SBIN) ! Save As special binary format
+
+ CALL GETHDRTYP(IHDSWT)
+
+ Filter='Geo file -- *.geo|*.geo|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+! SUB='geo'
+! CALL ADDSUB(FNAME,SUB)
+ FNAMGE=FNAME
+ IOT1 = 22
+ if(SUB .EQ. 'geo') then
+ if(ihdswt .eq. 1) then
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='LITTLE_ENDIAN')
+ else
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='BIG_ENDIAN')
+ endif
+ igfgswb=0
+! add header to binary file
+
+ DO J=11,1000
+ HEADER(J:J)=' '
+ ENDDO
+ HEADER(1:10)='RMAGEN '
+ CALL DATE_AND_TIME(DATEC,TIMEC,ZONEC,DTI)
+ HEADER(11:20)=DATEC
+ HEADER(21:30)=TIMEC
+ HEADER(31:40)=ZONEC
+ WRITE(IOT1) HEADER
+ call wrtout(2)
+ CLOSE (IOT1)
+ if(ihdswt .eq. 1) then
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='LITTLE_ENDIAN')
+ else
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='UNFORMATTED', CONVERT='BIG_ENDIAN')
+ endif
+ endif
+ ENDIF
+
+ go to 100
+ CASE (ID_BKF) ! Read background option
+
+ fname=' '
+!!! CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Background file')
+ FILTER ="Background Files|*.wmf;*.bmp;*.pcx;*.png;*.cgm;*.pic;*.jpg|wmf file -- *.wmf|*.wmf|bmp file -- *.bmp|*.bmp|pcx file -- *.pcx|*.pcx|png file -- *.png|*.png|jpeg file -- *.jpg|*.jpg|cgm file -- *.cgm|*.cgm|pic file -- *.pic|*.pic|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange+Appendext,FNAME,'Load Background file')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ NBKFL=NBKFL+1
+ BFNAME(NBKFL)=FNAME
+ IF(SUB .EQ. 'bmp') then
+ ISWBKFL(NBKFL) = 2
+ ELSEIF(SUB .EQ. 'pcx') then
+ ISWBKFL(NBKFL) = 2
+ ELSEIF(SUB .EQ. 'png' .or. sub .eq. 'jpg') then
+ ISWBKFL(NBKFL) = 2
+ ELSE
+ ISWBKFL(NBKFL)=1
+ ENDIF
+ write(90,*) 'nbkfl in winnew',nbkfl
+ write(90,*) ' iswbkfl',iswbkfl(nbkfl)
+ SUB1=SUB
+ SUB='ORG'
+ CALL ADDSUB(FNAME,SUB)
+ BFNAMR(NBKFL)=FNAME
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+ IF(SUB1 .EQ. 'PNG' .or. SUB1 .EQ. 'png') SUB2='PNGW'
+ IF(SUB1 .EQ. 'JPG' .or. SUB1 .EQ. 'jpg') SUB2='JPGW'
+ CALL ADDSUB(FNAME,SUB2)
+ BFNAMR(NBKFL)=FNAME
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+ IF(SUB2 .EQ. 'JPGW') THEN
+ SUB1='JGW'
+ CALL ADDSUB(FNAME,SUB1)
+ BFNAMR(NBKFL)=FNAME
+ ENDIF
+ ENDIF
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'ORG file does not exist!!'//CHAR(13)// &
+ 'Do you wish to create file and view image','Looking for ORG file')
+! If answer 'Yes' set ifrmel to 0
+!
+ IF (WInfoDialog(4) .ne. 2) then
+ OPEN(104,FILE=FNAME,STATUS ='NEW', FORM ='FORMATTED')
+ BFNAMR(NBKFL)=FNAME
+ BFMINMAX(NBKFL,1) = - XS
+ BFMINMAX(NBKFL,2) = - YS
+ BFMINMAX(NBKFL,3) = HSIZE*TXSCAL - XS
+ BFMINMAX(NBKFL,4) = 7.50*TXSCAL - YS
+ WRITE(104,'(4G16.8)') (BFMINMAX(NBKFL,I),I=1,4)
+ CLOSE(104)
+ GO TO 100
+ ELSE
+ NBKFL=NBKFL-1
+ GO TO 100
+ ENDIF
+ ENDIF
+ OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
+ READ(104,'(G16.8)') XX1
+ READ(104,'(G16.8)') XX2
+ READ(104,'(G16.8)') XX3
+ READ(104,'(G16.8)') XX4
+ READ(104,'(G16.8)') XX5
+ READ(104,'(G16.8)') XX6
+ call IGrFileInfo(BFNAME(NBKFL),INFO,3)
+
+ BFMINMAX(NBKFL,1) = XX5
+ BFMINMAX(NBKFL,2) = XX6+INFO(3)*XX4
+ BFMINMAX(NBKFL,3) = XX5+INFO(2)*XX1
+ BFMINMAX(NBKFL,4) = XX6
+
+ CLOSE(104)
+ GO TO 100
+! yes
+
+ ENDIF
+
+ OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
+ READ(104,'(4G16.8)') (BFMINMAX(NBKFL,J),J=1,4)
+ CLOSE(104)
+
+ ENDIF
+
+! ipk jan10
+ go to 100
+
+ CASE (ID_ICOPY)
+ CALL WSelectFile(ID_STRING6,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Copy File Name')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ FNAMEB=FNAME
+ SUB1='ORG'
+ CALL ADDSUB(FNAMEB,SUB1)
+ CALL OUTORG(FNAMEB)
+ if(sub .eq. 'jpg' .or. sub .eq. 'png' .or. sub .eq. 'pcx' .or. sub .eq. 'bmp') then
+! call doplot(0)
+ CALL WGrSaveImageOptions(31,100)
+ CALL WGrSaveImageOptions(32,150)
+ call igrsaveimage(fname)
+ call doplot(0)
+ call IGrFileInfo(FNAME,INFO,3)
+ IF(SUB .EQ. 'jpg') THEN
+ SUB2='jpgw'
+ CALL ADDSUB(FNAMEB,SUB2)
+ CALL OUTJPGW(FNAMEB,INFO)
+ ENDIF
+ CALL HEDR
+ go to 100
+ endif
+
+ CALL IGrInit('HP') ! hardcopy only output
+!ipk may10
+ IYPIX=HSIZE/7.5*540
+ IXPIX=540
+
+ IF(SUB .EQ. 'wmf') then
+ CALL IGrHardCopySelect(1,11)
+ CALL IGrHardCopyOptions(27,1)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+
+ ELSEIF(SUB .EQ. 'emf') then
+ CALL IGrHardCopySelect(1,11)
+ CALL IGrHardCopyOptions(27,2)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ ELSEIF(SUB .EQ. 'dxf') then
+ CALL IGrHardCopySelect(1,8)
+ ELSEIF(SUB .EQ. 'pcx') then
+ CALL IGrHardCopySelect(1,6)
+ CALL IGrHardCopyOptions(26,0)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ CALL IGrHardCopyOptions(2,540)
+ ELSEIF(SUB .EQ. 'bmp') then
+ CALL IGrHardCopySelect(1,6)
+ CALL IGrHardCopyOptions(26,1)
+!ipk may10
+ IYPIX=IYPIX*1.5
+ IXPIX=810
+ CALL IGrHardCopyOptions(1,IYPIX)
+!IPK MAY10 CALL IGrHardCopyOptions(2,540)
+ CALL IGrHardCopyOptions(2,IXPIX)
+ ELSEIF(SUB .EQ. 'png') then
+ CALL IGrHardCopySelect(1,6)
+ CALL IGrHardCopyOptions(26,3)
+ CALL IGrHardCopyOptions(23,24)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ CALL IGrHardCopyOptions(2,540)
+ ELSEIF(SUB .EQ. 'jpg') then
+ CALL IGrHardCopySelect(1,6)
+ CALL IGrHardCopyOptions(23,24)
+ CALL IGrHardCopyOptions(26,4)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ CALL IGrHardCopyOptions(2,540)
+ ELSEIF(SUB .EQ. 'cgm') then
+ CALL IGrHardCopySelect(1,9)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ ELSEIF(SUB .EQ. 'pic') then
+ CALL IGrHardCopySelect(1,7)
+!ipk may10
+ CALL IGrHardCopyOptions(1,IYPIX)
+ CALL IGrHardCopyOptions(2,540)
+ ENDIF
+ CALL IGrHardcopy(fname) ! Start print manager
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,7.5)
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ CALL CLSCRN
+ CALL PLOTOT(-1) ! plot graph
+ endif
+ call rblack
+ call frame(0.,0.,HSIZE,7.5)
+ CALL IGrHardcopy('S') ! Send data to the printer
+ CALL IGrInit('P') ! Turn graphics back on
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,8.0)
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ CALL CLSCRN
+ CALL PLOTOT(0) ! plot graph
+ endif
+ CALL HEDR
+ call rblack
+ CALL IGrHardCopySelect(1,10)
+ GO TO 100
+ ENDIF
+
+! ipk jan10
+ go to 100
+
+ CASE (ID_CLIP)
+
+ call igrsaveimage( )
+ call doplot(0)
+ CALL HEDR
+ go to 100
+
+! Clipboard save
+!ipk may10
+! IYPIX=HSIZE/7.5*540
+! IXPIX=540
+! CALL IGrHardCopySelect(1,11)
+! CALL IGrHardCopyOptions(27,2)
+!ipk may10
+! CALL IGrHardCopyOptions(1,IYPIX)
+! CALL IGrHardcopy() ! Start print manager
+! CALL IGrFillPattern(Solid)
+
+! CALL IgrUnits(0.,0.,HSIZE,7.5)
+! if(menus .eq. 12 .or. menus .eq. 13) then
+! call conout(menus)
+! else
+! CALL CLSCRN
+! CALL PLOTOT(-1) ! plot graph
+! endif
+! call rblack
+! CALL IGrHardcopy('S') ! Send data to the printer
+! CALL IGrInit('P') ! Turn graphics back on
+! CALL IGrFillPattern(Solid)
+!
+! CALL IgrUnits(0.,0.,HSIZE,8.0)
+! if(menus .eq. 12 .or. menus .eq. 13) then
+! call conout(menus)
+! else
+! CALL CLSCRN
+! CALL PLOTOT(0) ! plot graph
+! endif
+! CALL HEDR
+! call rblack
+! CALL IGrHardCopySelect(1,10)
+! GO TO 100
+
+ CASE (ID_SAVSHP) ! Copy to shape file selected is selected
+ call saveshp
+ go to 100
+
+ CASE (ID_ITEM24) ! Print option is selected
+ CALL WHardcopyOptions(3)
+!
+! If the user clicked OK on page setup dialog then output the contents
+! to the selected printer
+!
+ IF (WinfoDialog(ExitButtonCommon).EQ.CommonOK) THEN
+ CALL IGrInit('HP') ! hardcopy only output
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,7.5)
+ CALL IGrHardcopy(' ') ! Start print manager
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ CALL CLSCRN
+ CALL PLOTOT(-1) ! plot graph
+ endif
+ call rblack
+ CALL IGrFillPattern(0,0,0)
+ CALL IGrRectangle(0.,0.,HSIZE,7.5)
+ CALL IGrHardcopy('S') ! Send data to the printer
+ CALL IGrInit('P') ! Turn graphics back on
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,8.0)
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ CALL CLSCRN
+ CALL PLOTOT(0) ! plot graph
+ endif
+ CALL HEDR
+ call rblack
+ CALL IGrFillPattern(0,0,0)
+ CALL IGrRectangle(0.,0.,HSIZE,7.5)
+ GO TO 100
+ END IF
+
+! ipk jan10
+ go to 100
+
+ CASE (ID_ITEM19) ! Demo option
+ SUB='DEM'
+ CALL RBLUE
+ CALL SYMBL(1.,5.,0.25,SUB,0.0,3)
+ CALL DEMOS
+
+! ipk jan10
+ go to 100
+
+ CASE (ID_MMAP)
+ call mmap
+ go to 100
+
+!IPK MAY03
+ CASE (ID_SELRM1) ! Select different mesh file
+ IOLDACT=IACTVFIL
+ CALL PANELFIL
+ IF (IOLDACT .NE. IACTVFIL) THEN
+! Resave current file
+
+ IFILOUT=IOLDACT+50
+ CALL WRTFIL(IFILOUT)
+ CALL LOADFIL
+ ENDIF
+ GO TO 100
+!IPK MAY03
+ CASE (ID_ADDMESH) ! Select file FOR MESH ADDITION
+ IOLDACT=IACTVFIL
+ CALL PANELFIL
+ IF( IOLDACT .EQ. IACTVFIL) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Same file selected for addition'//&
+ CHAR(13)//'Process ended','SAME FILE')
+ GO TO 100
+ ENDIF
+ IFILADD=IACTVFIL
+ IACTVFIL=IOLDACT
+ CALL ADDTOMESH(IFILADD,0)
+ GO TO 100
+!IPK MAY03
+ CASE (ID_MRGMESH) ! Select file FOR MESH MERGING
+ IOLDACT=IACTVFIL
+ CALL PANELFIL
+ IF( IOLDACT .EQ. IACTVFIL) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Same file selected for merging'//&
+ CHAR(13)//'Process ended','SAME FILE')
+ GO TO 100
+ ENDIF
+ IFILADD=IACTVFIL
+ IACTVFIL=IOLDACT
+ CALL ADDTOMESH(IFILADD,1)
+ GO TO 100
+!ipk sep16 ADD MESH FROM POINTS
+ CASE (ID_ADDMESHTR)
+ CALL ADDMESHT
+ GO TO 100
+!ipk may03
+ CASE (ID_TRIANG) ! add a triangle of elements
+ CALL ADDTRIANG
+ GO TO 100
+
+ CASE (ID_ADDMAP) ! add a triangle of elements
+ CALL ADDMAP
+ GO TO 100
+
+ CASE (ID_3DVIEW)
+ CALL SETANGLE
+ I3DVIEW=1
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ CALL CLSCRN
+ call conout(menus)
+ else
+ call plotot(0)
+ endif
+ call hedr
+ GO TO 100
+
+ CASE (ID_VIEWANGLE)
+
+ I3DVIEW=1
+ CALL SETANGLE
+ CALL PLOTOT(0)
+ call hedr
+ GO TO 100
+
+
+
+!ipk may03
+ CASE (ID_QUAD) ! add a quad of elements
+ CALL ADDQUAD
+ GO TO 100
+
+!ipk may03
+ CASE (ID_SETUPLEV) ! setup levees
+ CALL RESETWHGT
+ GO TO 100
+
+ CASE (ID_SETTYPLEV) ! setup levees
+ CALL LEVSETTYP
+ GO TO 100
+
+
+ CASE (ID_G1D)
+ CALL FORM1DEL
+ GO TO 100
+!ipk apr04
+ CASE (ID_CREATM) ! create mesh from contours
+ CALL CREATM
+ GO TO 100
+
+ CASE (ID_OUTLINFL) ! read outline file
+ CALL RDOUTLIN
+ GO TO 100
+
+ CASE (ID_TESTOUT) ! read outline file
+ CALL CHECKPOLY
+ GO TO 100
+
+ CASE (ID_CGEN) ! generate contours
+ CALL CGEN
+ GO TO 100
+
+ CASE (ID_SPLITN)
+ CALL SPLITN
+ GO TO 100
+
+ CASE (ID_FORM999)
+ CALL FORM999(0,0,1)
+ GO TO 100
+
+ CASE (ID_FORM2D)
+ CALL FORM999(1,0,1)
+ GO TO 100
+!IPK FEB03
+
+ CASE (ID_TRIAN)
+ CALL TRIANG
+ GO TO 100
+
+ CASE (ID_SWMAP)
+ CALL SWMAP
+ GO TO 100
+
+ CASE (ID_SWRM1)
+ CALL SWRM1
+ GO TO 100
+
+ CASE (ID_MAP)
+ CALL GRELV
+ GO TO 100
+
+ CASE (ID_SELPR)
+ CALL GETALLANGS
+ GO TO 100
+
+ CASE (ID_RVSDIAG)
+ CALL RVSDIAG
+ GO TO 100
+
+ CASE (ID_LOADELTLD)
+ CALL GETEQ
+ GO TO 100
+
+ CASE (ID_SHOWELTLD)
+ CALL SHOWEQ(0)
+ GO TO 100
+
+ CASE (ID_RESHOWELTLD)
+ CALL SHOWEQ(1)
+ GO TO 100
+
+ CASE (ID_ASSIGNELTLD)
+ CALL ASSIGNEQ
+ GO TO 100
+
+ CASE (ID_SAVELTLD)
+ CALL SAVEEQ
+ GO TO 100
+
+ CASE (ID_ITEM17) ! Exit option
+!IPK SEP02
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ MENUS=0
+ CALL QUIT_PGM
+ CASE (ID_EXIT) ! Exit program (menu option)
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ MENUS=0
+ CALL QUIT_PGM
+
+ CASE (ID_NODEDATA)
+ CALL NODEDISP(0)
+ GO TO 101
+
+ CASE (ID_ELTDATA)
+ CALL ELTDISP(0)
+ GO TO 101
+
+ CASE (ID_EDLAY)
+ CALL LAYDISP
+ GO TO 101
+
+ CASE (ID_RESETRG)
+ CALL RESETREG
+ GO TO 101
+
+ CASE (ID_MOVMESH)
+ CALL MOVMESH
+ GO TO 101
+
+ CASE (ID_TRANSFORM)
+ CALL TRANSMESH
+ GO TO 101
+
+!IPK SEP02
+ CASE (ID_GETELM)
+ CALL GETELMNO
+ GO TO 101
+
+ CASE (ID_ATTACH)
+ CALL REATTACH
+ GO TO 101
+
+ CASE (ID_DDRAW)
+ IDDSW=MOD(IDDSW+1,2)
+ IF(IDDSW .EQ. 1) CALL WMenuSetState(ID_DDRAW,ItemChecked,1)
+
+ GO TO 101
+
+ CASE (ID_COMPLEX)
+ CALL GNODE(2)
+ GO TO 101
+
+ CASE (ID_fillagap)
+ CALL JOINEL
+ GO TO 101
+
+ CASE (ID_GETSTRESSFIL)
+ CALL GETSTRESSFIL
+ GO TO 101
+
+ CASE (ID_NODE)
+ MENUS=2
+ CASE (ID_DELM)
+ CALL DELETM(0)
+ go to 100
+ CASE (ID_DELETELM)
+ CALL DELETEM
+ go to 100
+ CASE (ID_ELTS)
+ MENUS=1
+ CASE (ID_FILL)
+ CALL FILM(1)
+ call hedr
+ go to 100
+ CASE (ID_FILLTR)
+ CALL FILLTR
+ call hedr
+ go to 100
+ CASE (ID_JOIN)
+ CALL JOIN(1)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ go to 100
+ CASE (ID_JOINALL)
+ CALL JOINALL
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ go to 100
+ CASE (ID_CRGRID)
+ CALL CRGRID
+ GO TO 100
+ CASE (ID_CRSECT)
+ CALL CRSECT
+ GO TO 101
+ CASE (ID_CRSCAL)
+ CALL COMPWGT
+ GO TO 101
+ CASE (ID_CSLOC)
+ CALL GETCSLOC
+ GO TO 101
+ CASE (ID_ORDR)
+ MENUS=3
+ CASE (ID_ORDR1)
+ CALL ORDALL
+ GO TO 101
+ CASE (ID_DCONTR)
+ MENUS=12
+ CALL CONOUT(MENUS)
+ GO TO 101
+ CASE (ID_CONTOPT)
+ MENUS=13
+ CALL CONOUT(MENUS)
+ GO TO 101
+!ipk feb02
+ CASE (ID_cdata)
+!
+! Create data for message file and display
+!
+ CALL ELDAT
+ go to 101
+ CASE (ID_CCLN)
+ MENUS=6
+ CASE (ID_CHKCCLN)
+ CALL CHKLIN
+ GO TO 101
+ CASE (ID_CSEC)
+ MENUS=7
+ CASE (ID_ZIN)
+ MENUS=8
+ iflag='z'
+ zoomh=' Zooming, click and drag to form rectangle'
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,43)
+ go to 101
+ CASE (ID_OUT2)
+ MENUS=8
+ iflag='y'
+ CASE (ID_OUT4)
+ MENUS=8
+ iflag='x'
+ CASE (ID_CHCK)
+ CALL CHKAREA
+ GO TO 101
+ CASE (ID_FINDNODE)
+ CALL FINDNOD
+ GO TO 101
+ CASE (ID_FINDELEM)
+ CALL FINDEL
+ GO TO 101
+ CASE (ID_MCHCK)
+ CALL CHKAREA
+ GO TO 101
+ CASE (ID_SMOOTHMAP)
+ CALL SMOOTHMP
+ GO TO 101
+
+ CASE (ID_DRAG)
+ MENUS=8
+ iflag='d'
+ idrag=1
+ zoomh=' drag/pan , click right to end'
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,30)
+ call WCursorShape(CurCrossHair)
+ go to 101
+ CASE (ID_ROTATE)
+ MENUS=8
+ iflag='d'
+ idrag=2
+ zoomh=' rotate view , click right to end'
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,30)
+ call WCursorShape(CurCrossHair)
+ go to 101
+ CASE (ID_VROTATE)
+ MENUS=8
+ iflag='d'
+ idrag=2
+ zoomh=' rotate view , click right to end'
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,30)
+ call WCursorShape(CurCrossHair)
+ go to 101
+ CASE (ID_RSET)
+ MENUS=8
+ iflag='w'
+ CASE (ID_PLEFT)
+ MENUS=8
+ iflag='v'
+ CASE (ID_PRIGHT)
+ MENUS=8
+ iflag='u'
+ CASE (ID_PUP)
+ MENUS=8
+ iflag='t'
+ CASE (ID_PDOWN)
+ MENUS=8
+ iflag='s'
+ CASE (ID_IDRWT)
+
+ DO
+ call wdialogload(IDD_DIALOG06)
+
+ call wdialogputcheckbox(IDF_RADIO1,IPSW(1))
+ call wdialogputcheckbox(IDF_RADIO2,IPSW(2))
+ call wdialogputcheckbox(IDF_RADIO3,IPSW(4))
+! call wdialogputcheckbox(IDF_RADIO4,IPSW(3))
+! call wdialogputcheckbox(IDF_RADIO5,IPSW(9))
+ call wdialogputcheckbox(IDF_RADIO6,IPSW(5))
+ call wdialogputcheckbox(IDF_RADIO7,IPSW(7))
+ call wdialogputcheckbox(IDF_RADIO8,IPSW(6))
+ call wdialogputcheckbox(IDF_RADIO19,IPSW(15))
+ call wdialogputcheckbox(IDF_RADIO9,IPSW(8))
+!ipk jan01
+ call wdialogputcheckbox(IDF_RADIO10,IPSW(10))
+!ipk oct02
+ call wdialogputcheckbox(IDF_RADIO11,IPSW(11))
+ call wdialogputcheckbox(IDF_RADIO12,IPSW(12))
+ call wdialogputcheckbox(IDF_RADIO13,IPSW(13))
+! call wdialogputcheckbox(IDF_RADIO17,IPSW(14))
+ IF(IPSW(3) .EQ. 1) THEN
+ call wdialogputradiobutton(IDF_RADIO4)
+ ELSEIF(IPSW(9) .EQ. 1) THEN
+ call wdialogputradiobutton(IDF_RADIO5)
+ ELSEIF(IPSW(14).EQ. 1) THEN
+ call wdialogputradiobutton(IDF_RADIO17)
+ ELSE
+ call wdialogputradiobutton(IDF_RADIO18)
+ ENDIF
+ IF(IPW1 .EQ. 1) THEN
+ call wdialogputradiobutton(IDF_RADIO14)
+ ELSEIF(IPW1 .EQ. 2) THEN
+ call wdialogputradiobutton(IDF_RADIO15)
+ ELSEIF(IPW1 .EQ. 3) THEN
+ call wdialogputradiobutton(IDF_RADIO16)
+ ENDIF
+ call wdialogputreal(IDF_REAL1,WIDEL)
+ call wdialogputreal(IDF_REAL2,WIDSCL)
+
+ CALL WDialogSelect(IDD_DIALOG06)
+ CALL WDialogShow(-1,-1,0,Modal)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ call wdialoggetcheckbox(IDF_RADIO1,IPSW(1))
+ call wdialoggetcheckbox(IDF_RADIO2,IPSW(2))
+ call wdialoggetcheckbox(IDF_RADIO3,IPSW(4))
+ call wdialoggetcheckbox(IDF_RADIO4,IPSW(3))
+ call wdialoggetcheckbox(IDF_RADIO5,IPSW(9))
+ call wdialoggetcheckbox(IDF_RADIO6,IPSW(5))
+ call wdialoggetcheckbox(IDF_RADIO7,IPSW(7))
+ call wdialoggetcheckbox(IDF_RADIO8,IPSW(6))
+ call wdialoggetcheckbox(IDF_RADIO8,IPSW(15))
+ call wdialoggetcheckbox(IDF_RADIO9,IPSW(8))
+!ipk jan01
+ call wdialoggetcheckbox(IDF_RADIO10,IPSW(10))
+!ipk oct02
+ call wdialoggetcheckbox(IDF_RADIO11,IPSW(11))
+ call wdialogGetcheckbox(IDF_RADIO12,IPSW(12))
+ call wdialogGetcheckbox(IDF_RADIO13,IPSW(13))
+! call wdialoggetcheckbox(IDF_RADIO4,IPSW(3))
+! call wdialoggetcheckbox(IDF_RADIO5,IPSW(9))
+! call wdialogGetcheckbox(IDF_RADIO17,IPSW(14))
+ call wdialoggetradiobutton(IDF_RADIO4,ipw2)
+ IPSW(3)=0
+ IPSW(9)=0
+ IPSW(14)=0
+ IF(IPW2 .EQ. 1) THEN
+ IPSW(3)=1
+ ELSEIF(IPW2 .EQ. 2) THEN
+ IPSW(9)=1
+ ELSEIF(IPW2 .EQ. 3) THEN
+ IPSW(14)=1
+ ENDIF
+! IF(IPSW(3) .EQ. 1) THEN
+! IPSW(9)=0
+! call wdialogputcheckbox(IDF_RADIO5,0)
+! IPSW(14)=0
+! call wdialogputcheckbox(IDF_RADIO17,0)
+! ENDIF
+! IF(IPSW(9) .EQ. 1) THEN
+! IPSW(3)=0
+! call wdialogputcheckbox(IDF_RADIO4,0)
+! IPSW(14)=0
+! call wdialogputcheckbox(IDF_RADIO17,0)
+! ENDIF
+! IF(IPSW(14) .EQ. 1) THEN
+! IPSW(9)=0
+! call wdialogputcheckbox(IDF_RADIO5,0)
+! IPSW(3)=0
+! call wdialogputcheckbox(IDF_RADIO4,0)
+! ENDIF
+
+ IF(IPSW(5) .EQ. 1) THEN
+ IPSW(7)=0
+ call wdialogputcheckbox(IDF_RADIO7,0)
+ ENDIF
+ call wdialoggetradiobutton(IDF_RADIO14,ipw1)
+ call wdialoggetreal(IDF_REAL1,WIDEL)
+ call wdialoggetreal(IDF_REAL2,WIDSCL)
+ MENUS=9
+ endif
+ CALL PLOTOT(0)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+
+ GO TO 100
+ ENDDO
+ GO TO 100
+
+ CASE (ID_ITYPN)
+ MENUS=9
+! IQSW(1)=1-IQSW(1)
+! IF(IQSW(1) .EQ. 1) THEN
+! IQSW(2)=0
+! ENDIF
+ IQSW(1)=1
+ IQSW(2)=0
+ CALL WMenuSetState(ID_ITYPN,ItemChecked,1)
+ CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPC,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPN,ItemChecked,0)
+ go to 100
+ CASE (ID_ITYPC)
+ MENUS=9
+! IQSW(2)=1-IQSW(2)
+! IF(IQSW(2) .EQ. 1) THEN
+! IQSW(1)=0
+! ENDIF
+ IQSW(2)=1
+ IQSW(1)=0
+ CALL WMenuSetState(ID_ITYPC,ItemChecked,1)
+ CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPC,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPN,ItemChecked,0)
+ go to 100
+ CASE (ID_IGPN)
+ MENUS=9
+ IQSW(1)=2
+ IQSW(2)=0
+ CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
+ CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPN,ItemChecked,1)
+ CALL WMenuSetState(ID_IGPC,ItemChecked,0)
+ go to 100
+ CASE (ID_IGPC)
+ MENUS=9
+ IQSW(1)=0
+ IQSW(2)=2
+ CALL WMenuSetState(ID_ITYPC,ItemChecked,0)
+ CALL WMenuSetState(ID_ITYPN,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPN,ItemChecked,0)
+ CALL WMenuSetState(ID_IGPC,ItemChecked,1)
+ go to 100
+ CASE (ID_MAPOPD)
+ DO
+ call wdialogload(IDD_DIALOG05)
+
+ call wdialogputcheckbox(IDF_CMAP0,ICOLON(1))
+ call wdialogputcheckbox(IDF_CMAP1,ICOLON(2))
+ call wdialogputcheckbox(IDF_CMAP2,ICOLON(3))
+ call wdialogputcheckbox(IDF_CMAP3,ICOLON(4))
+ call wdialogputcheckbox(IDF_CMAP4,ICOLON(5))
+ call wdialogputcheckbox(IDF_CMAP5,ICOLON(6))
+ call wdialogputcheckbox(IDF_CMAP6,ICOLON(7))
+ call wdialogputcheckbox(IDF_CMAP7,ICOLON(8))
+ call wdialogputcheckbox(IDF_CMAP8,ICOLON(9))
+ call wdialogputcheckbox(IDF_CMAP9,ICOLON(10))
+ call wdialogputcheckbox(IDF_CMAP10,ICOLON(11))
+ call wdialogputcheckbox(IDF_CMAP11,ICOLON(12))
+
+ CALL WDialogSelect(IDD_DIALOG05)
+ CALL WDialogShow(-1,-1,0,Modal)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetcheckbox(IDF_CMAP0,ICOLON(1))
+ call wdialoggetcheckbox(IDF_CMAP1,ICOLON(2))
+ call wdialoggetcheckbox(IDF_CMAP2,ICOLON(3))
+ call wdialoggetcheckbox(IDF_CMAP3,ICOLON(4))
+ call wdialoggetcheckbox(IDF_CMAP4,ICOLON(5))
+ call wdialoggetcheckbox(IDF_CMAP5,ICOLON(6))
+ call wdialoggetcheckbox(IDF_CMAP6,ICOLON(7))
+ call wdialoggetcheckbox(IDF_CMAP7,ICOLON(8))
+ call wdialoggetcheckbox(IDF_CMAP8,ICOLON(9))
+ call wdialoggetcheckbox(IDF_CMAP9,ICOLON(10))
+ call wdialoggetcheckbox(IDF_CMAP10,ICOLON(11))
+ call wdialoggetcheckbox(IDF_CMAP11,ICOLON(12))
+
+ ENDIF
+ CALL PLOTOT(0)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ GO TO 100
+
+ ENDDO
+ GO TO 100
+
+ CASE (ID_DRAWD)
+ CALL PLOTOT(0)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+
+ GO TO 100
+
+ CASE (ID_BSEL)
+ CALL PANEL012(IBAKON)
+ IF(IBAKON .EQ. 1) THEN
+! FONT%IBCOL = TextWhite
+! call WindowFontColour(0,7)
+ IRGB = WRGB(220,220,220)
+
+ ELSE
+! FONT%IBCOL = TextWhiteBold
+! call WindowFontColour(0,15)
+ IRGB = WRGB(255,255,255)
+ ENDIF
+! CALL WindowFont(FONT)
+ call clear_screen
+ call plotot(0)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+
+ GO TO 100
+
+ CASE (ID_REGST)
+ DO N=1,NBKFL
+ IF(ISWBKFL(N) .NE. 0) THEN
+ CALL REGISTR(N)
+ ENDIF
+ ENDDO
+ GO TO 100
+
+! CASE (ID_BACGDG)
+! call clear_screen
+! call plotot(0)
+! nhtp=nhtpsv
+! nmess=nmessv
+! nbrr=nbrrsv
+! call hedr
+
+! GO TO 100
+
+
+ CASE (ID_HELP1)
+ call helps(0)
+! call WHelpfile('rmagenv5.htm')
+ go to 100
+! MENUS=4
+ CASE (ID_HELP2)
+ call RMINFO
+ go to 100
+
+ CASE (ID_ITEM20)
+ CALL GDIST
+ GO TO 100
+
+ CASE (ID_ITEM22)
+ CALL SELNODE(0)
+ menus=2
+ GO TO 100
+
+ CASE (ID_ALLNODES)
+ CALL SELNODE(1)
+ menus=2
+ GO TO 100
+
+ CASE (ID_UNUSNODES)
+ CALL SELNODE(2)
+ menus=2
+ GO TO 100
+
+ CASE (ID_SELELTYP)
+ CALL SELNODE(3)
+ menus=2
+ GO TO 100
+
+ CASE (ID_MOVGRP)
+ CALL SELNODE(4)
+ menus=2
+ GO TO 100
+
+ CASE (ID_ITEM23)
+ CALL SELELT(0)
+ menus=0
+ GO TO 100
+ CASE (ID_SECGRP)
+ CALL SELELT(2)
+ menus=0
+ GO TO 100
+! CALL HEDR
+ CASE (ID_SELAREA)
+ CALL SELELT(1)
+ menus=2
+ GO TO 100
+ CASE (ID_DISPTYP)
+ CALL FINDTYP
+ menus=2
+ GO TO 100
+
+ CASE (ID_UNDO)
+ CALL UNDOACT
+ GO TO 100
+ CASE (ID_UNDOS)
+ IFLAG='U'
+ CASE (ID_UNDOGEN)
+! IF(ITOTFIL .EQ. 1) THEN
+! CALL ZEROOUT
+! IACTVFIL=0
+! CALL PLOTOT(0)
+! ELSE
+ CALL UNDOGEN
+! ENDIF
+ GO TO 100
+ CASE (ID_GOUTLIN)
+ CALL GOUTLIN
+ GO TO 100
+ CASE (ID_XOUTLIN)
+ CALL OUTLINES(0)
+ GO TO 100
+
+ END SELECT
+
+!
+! Mouse button down - only process mouse button 1 events
+!
+ CASE (MouseButDown)
+ if(menus .eq. 8) then
+ call rred
+ IF (MESSAGE%VALUE1.EQ.1) THEN
+!
+! Enable button up and mouse movement events
+!
+ CALL WMessageEnable(MouseButUp, Enabled)
+! CALL WMessageEnable(MouseMove , Enabled)
+ IDOWN = 1
+!
+! Save the current cursor position
+!
+ XPOS = MESSAGE%GX
+ YPOS = MESSAGE%GY
+! For box plotting we must initialise Exclusive-OR plotting,
+! set the fill type, draw the initial box and save the corner
+! co-ordinates
+!
+ CALL IGrPlotMode('E')
+!DEC09 CALL IGrPlotMode(0)
+ if(idrag .eq. 0) then
+ CALL IGrFillPattern(0,0,0)
+ CALL IGrRectangle(XPOS, YPOS, MESSAGE%GX, MESSAGE%GY)
+ else
+ call Rgreen
+ CALL IGrJoin(XPOS, YPOS, MESSAGE%GX, MESSAGE%GY)
+ iflag='d'
+ endif
+ XOLD = MESSAGE%GX
+ YOLD = MESSAGE%GY
+ ELSE
+ call WCursorShape(CurArrow)
+ idrag=0
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ menus=0
+ ENDIF
+ GO TO 101
+ ELSE
+ MBUTTON = MESSAGE%VALUE1
+ ITIME = MESSAGE%VALUE2
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ XM=MESSAGE%GX
+ YM=MESSAGE%GY
+ IF(MBUTTON .EQ. 1) THEN
+ IFLAG='c'
+ ELSE
+ if(idrag .eq. 0) then
+ IFLAG='r'
+ else
+ idrag=0
+ menus=0
+ go to 101
+ endif
+ ENDIF
+ ENDIF
+!
+! Mouse Movement
+!
+ CASE (MouseMove)
+ IF (IDOWN.EQ.1) THEN
+!
+! For rectangle plotting we must redraw the last box to erase it from the
+! screen. We then update the co-ordinates and draw the new rectangle
+!
+ IF(IDRAG .EQ. 0) THEN
+ CALL IGrRectangle(XPOS, YPOS, XOLD, YOLD)
+ XOLD = MESSAGE%GX
+ YOLD = MESSAGE%GY
+ XSCRN= XOLD
+ YSCRN= YOLD
+ XMS = XSCRN*TXSCAL - XS
+ YMS = YSCRN*TXSCAL - YS
+ WRITE(STBAR,'(2g19.10)') XMS,YMS
+ CALL WindowOutStatusBar(2,STBAR)
+ WRITE(STBAR,'('' NP = ''i6,'' NE = ''i6)') NP,NE
+ CALL WindowOutStatusBar(3,STBAR)
+ WRITE(STBAR,'(2x,A48)') FNAMEDISP
+ CALL WindowOutStatusBar(5,STBAR)
+ xsiz=abs(xold-xpos)
+ ysiz=abs(yold-ypos)
+ slen=sqrt(xsiz**2+ysiz**2)
+
+ shapef=hsize/8.
+
+!jan09 if(xsiz .lt. 1.25*ysiz) then
+!jan09 xsiz=1.25*ysiz
+ if(xsiz .lt. shapef*ysiz) then
+ xsiz=shapef*ysiz
+! xsiz=16./25.*slen
+ if(xold .lt. xpos) then
+ xold=xpos-xsiz
+ else
+ xold=xpos+xsiz
+ endif
+!jan09 elseif(ysiz .lt. 0.80*xsiz) then
+!jan09 ysiz=0.80*xsiz
+ elseif(ysiz .lt. xsiz/shapef) then
+ ysiz=xsiz/shapef
+! ysiz=9./25.*slen
+ if(yold .lt. ypos) then
+ yold=ypos-ysiz
+ else
+ yold=ypos+ysiz
+ endif
+ endif
+ CALL IGrRectangle(XPOS, YPOS, xold,yold)
+ go to 101
+ ELSE
+ CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
+ XOLD = MESSAGE%GX
+ YOLD = MESSAGE%GY
+ XSCRN= XOLD
+ YSCRN= YOLD
+ XMS = XSCRN*TXSCAL - XS
+ YMS = YSCRN*TXSCAL - YS
+ WRITE(STBAR,'(2g19.10)') XMS,YMS
+ CALL WindowOutStatusBar(2,STBAR)
+ WRITE(STBAR,'('' NP = ''i6,'' NE = ''i6)') NP,NE
+ CALL WindowOutStatusBar(3,STBAR)
+ WRITE(STBAR,'(2x,A48)') FNAMEDISP
+ CALL WindowOutStatusBar(5,STBAR)
+ CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
+ go to 101
+ ENDIF
+ ELSE
+ XOLD = MESSAGE%GX
+ YOLD = MESSAGE%GY
+ XSCRN= XOLD
+ YSCRN= YOLD
+ XMS = XSCRN*TXSCAL - XS
+ YMS = YSCRN*TXSCAL - YS
+ WRITE(STBAR,'(2g19.10)') XMS,YMS
+ CALL WindowOutStatusBar(2,STBAR)
+ WRITE(STBAR,'('' NP = ''i6,'' NE = ''i6)') NP,NE
+ CALL WindowOutStatusBar(3,STBAR)
+ WRITE(STBAR,'(2x,A48)') FNAMEDISP
+ CALL WindowOutStatusBar(5,STBAR)
+ GO TO 101
+ ENDIF
+
+! CASE (PushButton) ! Dialog button pressed
+! IDBUTN = MESSAGE%VALUE1
+! IDFIELD = MESSAGE%VALUE2
+
+ CASE (MouseButUp) ! Mouse button up
+ IF(MENUS .NE. 8) THEN
+ MBUTTON = MESSAGE%VALUE1
+ ITIME = MESSAGE%VALUE2
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ XM=MESSAGE%GX
+ YM=MESSAGE%GY
+ IF(MBUTTON .EQ. 1) THEN
+ IFLAG='c'
+ ELSE
+ IFLAG='r'
+ ENDIF
+ ELSE
+!
+! We disable movement and button up events
+!
+ IDOWN = 0
+ CALL WMessageEnable(MouseButUp, Disabled)
+! CALL WMessageEnable(MouseMove , Disabled)
+ IF(IDRAG .EQ. 0) THEN
+ CALL IGrRectangle(XPOS, YPOS, XOLD, YOLD)
+ CALL IGrPlotMode('N')
+ CALL IGrRectangle(XPOS, YPOS, xold,yold)
+ XPOS1=MESSAGE%GX
+ YPOS1=MESSAGE%GY
+ menus=-8
+ zoomh=' Click right if size OK'
+!
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,23)
+ GO TO 101
+ ELSEIF(IDRAG .EQ. 1) THEN
+ menus=8
+ CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
+ CALL IGrPlotMode('N')
+ CALL IGrJoin(XPOS, YPOS, xold,yold)
+
+ XPOS1=MESSAGE%GX
+ YPOS1=MESSAGE%GY
+ xpos=xpos1-xpos
+ ypos=ypos1-ypos
+ xpos1=xpos+HSIZE
+ ypos1=ypos+8.
+ iflag='d'
+ call zoomnew(xpos,ypos,xpos1,ypos1,iflag)
+ zoomh=' Click right to end '
+!
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,20)
+ iflag='r'
+ GO TO 101
+ ELSE
+ menus=8
+ CALL IGrJoin(XPOS, YPOS, XOLD, YOLD)
+ CALL IGrPlotMode('N')
+ CALL IGrJoin(XPOS, YPOS, xold,yold)
+
+ XPOS1=MESSAGE%GX
+ YPOS1=MESSAGE%GY
+ xpos=xpos1-xpos
+ ypos=ypos1-ypos
+ zoomh=' Click right to end '
+
+ IF(ABS(XPOS) .GT. ABS(YPOS)) THEN
+ hrad=xpos/(YPOS1-4)
+ VRAD=0.
+ ELSE
+ vrad=-ypos/10.
+ HRAD=0.
+ ENDIF
+ call adjustang(hrad,vrad)
+!
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,20)
+ iflag='r'
+ GO TO 101
+ ENDIF
+ ENDIF
+! WRITE(90,*) 'MOUSE BUT',MOUSEX,MOUSEY,XM,YM
+! WRITE(90,'(A)') 'MOUSE BUT',IFLAG
+ CASE (Expose) ! Window partly/wholly exposed
+ iflag='P'
+ IX = MESSAGE%X
+ IY = MESSAGE%Y
+ IWIDTH = MESSAGE%VALUE1
+ IHEIGHT = MESSAGE%VALUE2
+ call hedr
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ call plotot(0)
+ endif
+ call hedr
+!IPK MAY01
+ IRDISP=1
+ if(nmess .eq. 11) CALL PLTPT
+
+ if(menus .eq. 13) CALL CONOUT(MENUS)
+
+ go to 100
+ CASE (Resize) ! Window resized
+ CALL IGrUnits(0.,0.,HSIZE,8.0)
+ iflag='P'
+ IWIDTH = MESSAGE%VALUE1
+ IHEIGHT = MESSAGE%VALUE2
+ call hedr
+
+ if(menus .eq. 12 .or. menus .eq. 13) then
+ call conout(menus)
+ else
+ call plotot(0)
+ endif
+ call hedr
+!IPK MAY01
+ IRDISP=1
+ if(nmess .eq. 11) CALL PLTPT
+
+ if(menus .eq. 13) CALL CONOUT(MENUS)
+
+ go to 100
+ CASE (CloseRequest) ! Close window (e.g. Alt/F4)
+ IWINDOW = MESSAGE%WIN
+ if(iwindow .eq. 0) then
+!IPK SEP02
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ CALL QUIT_PGM ! Root window : exit program
+ else
+ CALL WindowCloseChild(iwindow)
+ DO I=1,NWINDWS
+ IF(IWINDOW .EQ. IWNDWS(I)) THEN
+ IWNDWS(i)=0
+ ISCRNS(i)=0
+! This call removes the bitmap
+ CALL BACKP(3,I)
+ ENDIF
+ ENDDO
+ go to 100
+ endif
+! CASE (FieldChanged) ! Field change in modeless dialog
+! IDFIELDOLD = MESSAGE%VALUE1
+! IDFIELDNEW = MESSAGE%VALUE2
+ END SELECT
+! WRITE(90,'(A)') 'endselect',IFLAG
+! write(90,*) 'endselect',menus
+ menus =abs(menus)
+ IF(MENUS .GT. 0 .and. menus .lt. 8) THEN
+ CALL RMAGEN(MENUS,IMP,IIN,1,IOT,IOT1,NDM,ITRIAN,N2,M2)
+ ENDIF
+ if(menus .eq. 8) then
+ IF(IFLAG .EQ. 'w') THEN
+ HANG=0.
+ VANG=90
+ VRTSCAL=100.
+ VRTORIG=0.
+ i3dview=0
+ endif
+ if( IFLAG .EQ. 'r' .or.&
+ iflag .eq. 'y' .or.&
+ iflag .eq. 'x' .or.&
+ iflag .eq. 'w' .or.&
+ iflag .eq. 'v' .or.&
+ iflag .eq. 'u' .or.&
+ iflag .eq. 't' .or.&
+ iflag .eq. 's' ) then
+ call zoomnew(xpos,ypos,xpos1,ypos1,iflag)
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+ call hedr
+ endif
+!IPK MAY01
+ IRDISP=1
+ if(nmess .eq. 11) CALL PLTPT
+ go to 100
+ endif
+ IF(MENUS .EQ. 9) GO TO 101
+
+
+ ix=xm*100.
+ iy=ym*100.
+! call IMouseCursorHide()
+ 250 continue
+ nhtp=nhtpsv
+ nmess=nmessv
+ nbrr=nbrrsv
+! WRITE(90,'(A)') 'end',IFLAG
+! write(90,*) 'end',menus,nhtp,nhtpsv
+! call clscrn
+! call hedr
+ END SUBROUTINE
diff --git a/src/src83e/FILE.F90 b/src/src83e/FILE.F90
new file mode 100644
index 0000000..72e835c
--- /dev/null
+++ b/src/src83e/FILE.F90
@@ -0,0 +1,160 @@
+! last update March 6 2000 add default values for CMAP
+ SUBROUTINE FILE(ientry)
+!
+! Define input output units
+!
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+!IPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+ common /cols/ ibakk,icolr,iblkk
+ COMMON /PAGE/ XL,XH,YL,YH
+!
+ CHARACTER*80 LIND
+!IPK APR94 CHARACTER*40 FNAM,FNAMB
+ CHARACTER*40 FNAM,FNAMB,FNAMC
+ CHARACTER*3 SUB
+ CHARACTER*1 ANS
+ LOGICAL*4 EXST,STATM
+ data ihere/0/
+ if(ihere .eq. 1) return
+ mpnam='elt.mpb'
+ ibakk=8
+ icolr=11
+ iblkk= 9
+ xl=0.
+ yl=0.
+ xh=HSIZE
+ yh=8.0
+ ielvsw=0
+ if(ientry .eq. 1) then
+ ihere=1
+! MAXPL=200000
+ MAXELMP=100000
+
+ ALLOCATE (NOPEL(MAXELMP,3),XCEN(MAXELMP),YCEN(MAXELMP)&
+ ,RADS(MAXELMP) ,NKEY(MAXELMP),CMAP(MAXPL,2)&
+ ,XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+ RADS=0.
+ XCEN=0.
+ YCEN=0.
+ endif
+
+!ipk jan98
+ OPEN(UNIT=90,FILE='messgen.out',STATUS='UNKNOWN', IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(UNIT=90,FILE='messgen1.out',STATUS='UNKNOWN', IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(UNIT=90,FILE='messgen2.out',STATUS='UNKNOWN', IOSTAT=iost)
+ if(iost .gt. 0) then
+ write(*,*) 'ERROR UNABLE TO OPEN MESSGEN.OUT FILE'
+ write(*,*) 'PRESS RETURN TO END'
+ read(*,'(I5)') junk
+ STOP
+ endif
+ endif
+ endif
+!ipk jan98
+ write(lind,6010)
+ 6010 format(' Compilation limits are')
+ call symbl(1.1,1.5,0.20,LIND,0.0,80)
+ write(lind,6110) maxe
+ 6110 FORMAT( ' Maximum elements =',i8)
+ call symbl(1.1,1.2,0.20,LIND,0.0,80)
+ write(lind,6111) maxp
+ 6111 FORMAT( ' Maximum nodes =',i8)
+ call symbl(1.1,0.9,0.20,LIND,0.0,80)
+
+!
+! Open files
+!
+ IBAK = 21
+ OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(IBAK,FILE='ELT1.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(IBAK,FILE='ELT2.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ write(*,*) 'ERROR UNABLE TO OPEN ELT.BAK FILE'
+ write(*,*) 'PRESS RETURN TO END'
+ read(*,'(I5)') junk
+ STOP
+ endif
+ ENDIF
+ ENDIF
+! OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='BINARY')
+
+ IS11=94
+ INQUIRE(FILE='startup.dat',EXIST= EXST)
+ IF(EXST) THEN
+ OPEN(IS11 ,FILE='startup.dat',STATUS='OLD',FORM='FORMATTED')
+ ELSE
+ IS11=0
+ ENDIF
+
+! Initialize variables
+ NCLM=0
+
+!ipk may94 add 2 lines below
+ XREF=0.
+ YREF=0.
+ MNP = MAXP
+ MEL = MAXE
+!! uncertain call INITSIZ(0,0,1)
+ nmapf=1
+ NSIGF=1
+ DO I=1,MNP
+ XUSR(I) = -1.D20
+ YUSR(I) = -1.D20
+ CORD(I,1) = -1.D20
+ CORD(I,2) = -1.D20
+ WD(I) = -9999.
+ LAY(I) = -9999
+ WIDTH(I) = 0.0
+ SS1(I) = 0.0
+ SS2(I) = 0.0
+ WIDS(I) = 0.0
+ WIDBS(I)=0.
+ SSO(I)=0.
+ INSKP(I) = 1
+ INEW(I) = 0
+!ipk mar02
+ lock(i)=0
+ bs1(I)=0.
+ ENDDO
+!
+ DO I=1,MEL
+ DO K=1,8
+ NOP(I,K) = 0
+ ENDDO
+!
+ IEM(I) = 0
+ IMAT(I) = 0
+ THTA(I)=0.
+ XC(I) = -1.E20
+ YC(I) = -1.E20
+ IESKP(I) = -1
+ ENDDO
+!
+ MLIN = MAXLIN
+ DO I=1,MLIN
+ LINTYP(I) = -999
+ ENDDO
+!IPK OCT96
+ DO I=1,10
+ ICOLON(I)=1
+ ENDDO
+
+!ipk mar00 define default values for CMAP
+ DO J=1,MAXPTS
+ CMAP(J,1) = -1.e20
+ CMAP(J,2) = -1.e20
+ enddo
+
+
+ RETURN
+ END
diff --git a/src/src83e/FILL.F90 b/src/src83e/FILL.F90
new file mode 100644
index 0000000..67cdfd8
--- /dev/null
+++ b/src/src83e/FILL.F90
@@ -0,0 +1,269 @@
+!IPK LAST UPDATE jAN 25 2001 INCREMENT NP FOR ALREADY EXISTING NODES IN NOP
+!IPK LAST UPDATE APR 6 1998
+ SUBROUTINE FILM(ISWT)
+!june93 SUBROUTINE FILM(IFILL)
+!-
+! ISWT = 0 means read a value for IFILL
+! ISWT = 1 means use a value of 1 for IFILL
+! If IFILL = 1, use all unused node nos. for filling midside nodes
+! If IFILL = 0, start midside node numbering with max node no.
+!-
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'BFILES.I90'
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ INTEGER NUSED(MAXP)
+
+!IPK MAY02
+ REAL*8 XX,YY
+ data itime/0/
+
+ if(itime .eq. 0) then
+ ifill=0
+ itime=1
+ endif
+! call WcursorShape(1)
+ NHTPsv = nhtp
+ NMESSsv = nmess
+ NBRRsv = nbrr
+ NHTP = 0
+ NBRR = 0
+ NMESS=45
+ CALL HEDR
+ NMESS = 19
+ xprt=3.2
+!
+ IF(ISWT .EQ. 0) THEN
+ CALL GETINT(IFILL)
+ ELSE
+ IFILL=1
+ ENDIF
+!
+
+!-
+!-.....FIND MISSING NODE NUMBERS.....
+!-
+ NP0 = 0
+ DO 10 I=1,MAXP
+ 10 NUSED(I) = 0
+ DO 101 J = 1, NE
+ IF( IMAT(J) .EQ. 0 ) GO TO 101
+ DO 100 K = 1, 8
+ IF( NOP(J,K) .LE. 0) GOTO 100
+ NUSED(NOP(J,K))=999
+ 100 END DO
+ 101 END DO
+
+! Form list of elements connected to nodes
+ IERR=0
+ CALL NDNECON(IERR)
+ IF(IERR .GT. 0) THEN
+ LIMIT=MAXECON
+ CALL NODERR(IERR,LIMIT)
+ GO TO 200
+ ENDIF
+!C-
+!C-.....PUT INPUTS INTO PROPER LOCATIONS.....
+!C-
+! DO 140 J = 1, NE
+! IF( IMAT(J) .EQ. 0 ) GO TO 140
+! IF( NOP(J,5) .GT. 0 ) GO TO 140
+! DO 130 K = 1, 4
+! IT(K) = NOP(J,K)
+! NOP(J,K) = 0
+! 130 CONTINUE
+! KK = 0
+! DO 135 K = 1, 8, 2
+! KK = KK + 1
+! NOP(J,K) = IT(KK)
+! 135 CONTINUE
+! 140 CONTINUE
+!-
+!-.....INSERT NEW NUMBERS.....
+!-
+ NP0=0
+ IF(IFILL .EQ. 0) NP0=NP
+ DO 190 J = 1, NE
+!ipk apr98 IF( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) THEN
+ IF(( IMAT(J) .GT. 0 .AND. IMAT(J) .LT.901) .or. &
+ & imat(j) .gt. 903) THEN
+ NCN = NCORN(J)
+ JN = J + 1
+ DO 180 K = 2, NCN, 2
+ if((imat(j) .gt. 995 .and. imat(j) .lt. 1999) .and. (k .eq. 4 .or. k .eq. 8) &
+ & ) go to 180
+ NA = K - 1
+ NB = MOD(K+1,NCN)
+ IF(NB .EQ. 0) NB=NCN
+ NA = NOP(J,NA)
+ NB = NOP(J,NB)
+ AA=(WD(NA)+WD(NB))/2.
+ AB=(WD1(NA)+WD1(NB))/2.
+ IF( NOP(J,K) .EQ. 0 ) THEN
+ IRDONE=0
+99 NP0 = NP0 + 1
+ IF(NP0 .GT. MAXP) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Execution terminated, nodal limits exceeded. Backup written','LIMITS EXCEEDED')
+ CALL WRTOUT(0)
+ STOP
+ ENDIF
+ IF(INEW(NP0) .EQ. 1) GO TO 99
+ IF (NUSED(NP0) .GT. 0) GOTO 99
+ NOP(J,K) = NP0
+ XX=(CORD(NA,1)+CORD(NB,1))/2.
+ YY=(CORD(NA,2)+CORD(NB,2))/2.
+ CORD(NP0,1)=XX
+ CORD(NP0,2)=YY
+ WD(NP0)=AA
+ WD1(NP0)=AB
+ WIDTH(NP0)=(WIDTH(NA)+WIDTH(NB))/2.
+ SS1(NP0)=(SS1(NA)+SS1(NB))/2.
+ SS2(NP0)=(SS2(NA)+SS2(NB))/2.
+ WIDS(NP0)=(WIDS(NA)+WIDS(NB))/2.
+ WIDBS(NP0)=(WIDBS(NA)+WIDBS(NB))/2.
+ BS1(NP0)=(BS1(NA)+BS1(NB))/2.
+
+
+ INEW(NP0) = 1
+ IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NP0)=1
+ XUSR(NP0) = XX*TXSCAL - XS
+
+ YUSR(NP0) = YY*TXSCAL - YS
+ INSKP(NP0) = 0
+!SSO(N),-
+!,BS1(N)-.....SEARCH FOR OTHER ELEMENT.....
+!-
+!ipk dec98 set a counter
+ ielct=0
+
+!ipk0ct93 DO 170 JJ = JN, NE
+
+ DO 170 JJJ=1,NDELM(NA)
+ JJ=NECON(NA,JJJ)
+!IPK SEP02 DO 170 JJ = 1, NE
+!ipkoct93 IF( IMAT(JJ) .GT. 0 .OR. IMAT(JJ) .LT.901) THE
+ if(jj .eq. j) go to 170
+ if(imat(jj) .gt. 0) then
+ NNCN = NCORN(JJ)
+ DO 160 KK = 2, NNCN, 2
+ IF( NOP(JJ,KK-1) .EQ. NB ) THEN
+ KN = MOD(KK+1,NNCN)
+ IF(KN .EQ. 0) KN=NNCN
+ IF( NOP(JJ,KN) .EQ. NA ) THEN
+ NOP(JJ,KK) = NP0
+!ipk dec98
+ ielct=ielct+1
+ if(ielct .eq. 2) then
+ GO TO 180
+ else
+ go to 170
+ endif
+!ipk dec98 end changes
+ ENDIF
+!IPK APR98 ADD
+ ELSEIF( NOP(JJ,KK-1) .EQ. NA ) THEN
+ KN = MOD(KK+1,NNCN)
+ IF(KN .EQ. 0) KN=NNCN
+ IF( NOP(JJ,KN) .EQ. NB ) THEN
+ NOP(JJ,KK) = NP0
+!ipk dec98
+ ielct=ielct+1
+ if(ielct .eq. 2) then
+ GO TO 180
+ else
+ go to 170
+ endif
+!ipk dec98 end changes
+ ENDIF
+!IPK APR98
+ ENDIF
+ 160 CONTINUE
+ ENDIF
+ 170 CONTINUE
+ ELSE
+ NM=NOP(J,K)
+ IF(INEW(NM) .NE. 1) THEN
+ XX=(CORD(NA,1)+CORD(NB,1))/2.
+ YY=(CORD(NA,2)+CORD(NB,2))/2.
+ CORD(NM,1)=XX
+ CORD(NM,2)=YY
+ WD(NM)=AA
+ WD1(NM)=AB
+ WIDTH(NM)=(WIDTH(NA)+WIDTH(NB))/2.
+ SS1(NM)=(SS1(NA)+SS1(NB))/2.
+ SS2(NM)=(SS2(NA)+SS2(NB))/2.
+ WIDS(NM)=(WIDS(NA)+WIDS(NB))/2.
+ WIDBS(NM)=(WIDBS(NA)+WIDBS(NB))/2.
+ BS1(NM)=(BS1(NA)+BS1(NB))/2.
+ INEW(NM) = 1
+ IF(LOCK(NA) .EQ. 1 .AND. LOCK(NB) .EQ. 1) LOCK(NM)=1
+ XUSR(NM) = XX*TXSCAL - XS
+ YUSR(NM) = YY*TXSCAL - YS
+ INSKP(NM) = 0
+!ipk jan01
+ IF(NM .GT. NP) NP=NM
+ ELSE
+ WD(NM)=AA
+ WD1(NM)=AB
+ ENDIF
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 190 CONTINUE
+ IF (NP0 .GT. NP) NP=NP0
+ 200 CONTINUE
+ NHTP = nhtpsv
+ NMESS = nmesssv
+ NBRR = nbrrsv
+! call WcursorShape(0)
+
+!IPK MAY03
+ ICHG=0
+
+ RETURN
+ END
+
+
+ SUBROUTINE NODERR(NODER,LIMIT)
+
+ USE WINTERACTER
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ INTEGER :: IERR,NODER,LIMIT
+
+ call wdialogload(IDD_NODERR)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_NODERR)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER2,LIMIT)
+ CALL WDialogPutInteger(IDF_INTEGER3,NODER)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ RETURN
+ ELSE
+ RETURN
+ ENDIF
+ enddo
+ RETURN
+ END
diff --git a/src/src83e/FILLTR.F90 b/src/src83e/FILLTR.F90
new file mode 100644
index 0000000..dfad3e1
--- /dev/null
+++ b/src/src83e/FILLTR.F90
@@ -0,0 +1,293 @@
+ SUBROUTINE FILLTR
+ USE WINTERACTER
+ USE IFPORT
+ USE BLKMAP
+ CHARACTER(LEN=256) :: FILTER,FNAME
+ CHARACTER(LEN=80) :: DATAIN,OPTIONS
+ CHARACTER(LEN=96) :: LOCDIR
+ CHARACTER(LEN=3) :: SUB
+ INTEGER INOUTL,NOUTL,OUTPOL
+ INTEGER NTRIAN(5000,2),TWO,ZERO,ntrans(5000)
+ INTEGER*2 RESULT
+ LOGICAL EXISTS
+ do k=1,80
+ options(k:k)=' '
+ enddo
+ TWO=2
+ ZERO=0
+ INOUTL=22
+ OUTPOL=23
+ VOID = - 1.0E+10
+ VDX = - 1.0E+9
+
+!
+! get filename
+
+! FILTER ="Data files|*.dat;*.txt;*.map|Map file -- *.map|*.map|"
+! CALL WSelectFile(FILTER,PromptOn+DirChange+Appendext,FNAME,'Load data file')
+
+! IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+! OPEN(INOUTL,FILE=FNAME,STATUS='OLD')
+! CALL IlowerCase(FNAME)
+! CALL GETSUB(FNAME,SUB)
+! IF(SUB .EQ. 'map') then
+! IMAPIN=1
+! ELSE
+! IMAPIN=0
+! ENDIF
+! ELSE
+! WRITE(*,*) 'ERROR NO FILE'
+! ENDIF
+ IMAPIN=1
+! read outline
+!
+ IF(IMAPIN .EQ. 1) THEN
+ OPEN(113,FORM='BINARY',STATUS='SCRATCH')
+ WRITE(113) XMAP,YMAP
+ REWIND (113)
+ DO K=1,5000
+ IF(XMAP(K) .LT. VDX) THEN
+ NOUTL=K-1
+ GO TO 90
+ ENDIF
+ ENDDO
+90 CONTINUE
+ ELSE
+! IF(IMAPIN .EQ. 1) READ(INOUTL,'(A80)') DATAIN
+ DO K=1,5000
+ READ(INOUTL,'(A80)') DATAIN
+ IF(DATAIN(1:3) .EQ. 'END' .OR. DATAIN(1:3) .EQ. 'end') then
+ NOUTL=K-1
+ GO TO 100
+ ELSE
+ READ(DATAIN,*) XMAP(K),YMAP(K)
+ ENDIF
+ ENDDO
+100 CONTINUE
+ ENDIF
+ IF(XMAP(NOUTL) .EQ. XMAP(1) .AND. YMAP(NOUTL) .EQ. YMAP(1)) THEN
+ XMAP(NOUTL)=VOID
+ YMAP(NOUTL)=VOID
+ NOUTL=NOUTL-1
+ LOOPC=1
+ ELSE
+ LOOPC=0
+ ENDIF
+
+ DO J=1, NOUTL
+ NTRIAN(J,1)=J
+ NTRIAN(J,2)=J+1
+ ENDDO
+ NTRIAN(NOUTL,2)=1
+ JC=NOUTL
+! read contours
+ NOUTBE=NOUTL+1
+ NOUTT=NOUTL
+ DO N=1,100
+ if(imapin .eq. 1) then
+ noutb=noutt+2+LOOPC
+ ncnt=0
+ DO K=NOUTB,5000
+ if(k .eq. noutb) then
+ if(xmap(k) .lt. vdx) go to 300
+ endif
+ IF(XMAP(K) .LT. VDX) THEN
+ NOUTT=K-1
+ GO TO 110
+ ENDIF
+ ncnt=ncnt+1
+ ENDDO
+110 CONTINUE
+ else
+ READ(INOUTL,'(A80)', END=300) DATAIN
+ IF(DATAIN(1:3) .EQ. 'END') GO TO 300
+ NOUTB=NOUTT+1
+ NCNT=0
+ DO K=NOUTB,5000
+ READ(INOUTL,'(A80)') DATAIN
+ IF(DATAIN(1:3) .EQ. 'END' .OR. DATAIN(1:3) .EQ. 'end') then
+ NOUTT=K-1
+ GO TO 200
+ ELSE
+ READ(DATAIN,*) XMAP(K),YMAP(K)
+ NCNT=NCNT+1
+ ENDIF
+ ENDDO
+200 CONTINUE
+ endif
+ IF(XMAP(NOUTT) .EQ. XMAP(NOUTB) .AND. YMAP(NOUTT) .EQ. YMAP(NOUTB)) THEN
+ XMAP(NOUTT)=VOID
+ YMAP(NOUTT)=VOID
+ NOUTT=NOUTT-1
+ LOOPC=1
+ ELSE
+ LOOPC=0
+ ENDIF
+ JC=NOUTB-1
+ JCB=JC+1
+ DO J=NOUTBE, NOUTBE+NCNT-2-LOOPC
+ JC=JC+1
+ NTRIAN(J,1)=JC
+ NTRIAN(J,2)=JC+1
+ ENDDO
+ IF(LOOPC .EQ. 1) THEN
+ NTRIAN(NOUTBE+NCNT-2,1)=JC+1
+ NTRIAN(NOUTBE+NCNT-2,2)=JCB
+ NOUTBE=NOUTBE+NCNT-1
+ ELSE
+ NOUTBE=NOUTBE+NCNT-1
+ ENDIF
+ JC=JC+1
+ ENDDO
+! copy to a file
+300 CONTINUE
+ OPEN(OUTPOL,FILE='TEST.POLY', STATUS='UNKNOWN')
+ ncnt=0
+ DO K=1,NOUTT
+ if(xmap(k) .lt. vdx) cycle
+ ncnt=ncnt+1
+ ntrans(k)=ncnt
+ ENDDO
+ WRITE(OUTPOL,*) NCNT,TWO,ZERO,ZERO
+ ncnt=0
+ DO K=1,noutt
+ if(xmap(k) .lt. vdx) cycle
+ ncnt=ncnt+1
+ WRITE(OUTPOL,*) ncnt,XMAP(K),YMAP(K)
+ ENDDO
+ WRITE(OUTPOL,*) NOUTBE-1,ZERO
+ DO J=1, NOUTBE-1
+ WRITE(OUTPOL,*) J,ntrans(NTRIAN(J,1)),ntrans(NTRIAN(J,2))
+ ENDDO
+ WRITE(OUTPOL,*) ZERO
+ FLUSH (OUTPOL)
+ REWIND (OUTPOL)
+ CLOSE (OUTPOL)
+! close (inoutl)
+! setup options
+
+! OPTIONS = ' -pqa5000V TEST'
+ OPTIONS(1:3) = ' -p'
+ nct=3
+ iswq=1
+ iswy=0
+ id1=100
+ CALL PANELFILLT(ISWQ,ISWY,ID1)
+
+ IF(ISWQ .EQ. 1) THEN
+ NCT=NCT+1
+ OPTIONS(NCT:NCT)='q'
+ ENDIF
+ IF(ISWY .EQ. 1) THEN
+ NCT=NCT+1
+ OPTIONS(NCT:NCT)='q'
+ ENDIF
+ ID1=ID1**2/2
+ WRITE(OPTIONS(NCT+1:NCT+12),'(''a'',I6.6,'' TEST'')') ID1
+! go to TRIANGLE
+
+ INQUIRE (FILE = 'test.1.ele', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.ele')
+ close(77,status='DELETE')
+ ENDIF
+
+ INQUIRE (FILE = 'test.1.node', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.node')
+ close(77,status='DELETE')
+ ENDIF
+
+ INQUIRE (FILE = 'test.1.poly', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.poly')
+ close(77,status='DELETE')
+ ENDIF
+ INQUIRE (FILE = "C:\Program Files\RMA\TRIANGLE.EXE", EXIST = exists)
+ if(.not. exists) then
+ INQUIRE (FILE = "TRIANGLE.EXE", EXIST = exists)
+ if(.not. exists) then
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'TRIANGLE is not available in '//CHAR(13)//&
+ 'C:\Program Files\RMA\ directory'//CHAR(13)//'Do you wish to define directory?'&
+ ,'WARNING TRIANGLE IS NOT AVAILABLE')
+
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) return
+ CALL GETDIR(LOCDIR)
+ else
+ LOCDIR(1:8)='TRIANGLE'
+! WRITE(155,*) LOCDIR
+ RESULT= RUNQQ(LOCDIR, OPTIONS)
+ GO TO 600
+ endif
+ endif
+
+ RESULT= RUNQQ("C:\Program Files\RMA\TRIANGLE", OPTIONS)
+! RESULT= RUNQQ("TRIANGLE", OPTIONS)
+600 CONTINUE
+ IF(IMAPIN .EQ. 1) THEN
+ READ(113) XMAP,YMAP
+ CLOSE (113)
+ ENDIF
+ IIN=10
+ OPEN(IIN,FILE='TEST.1.ELE', STATUS='OLD')
+
+ CALL GETNEWFIL(IIN,0,1,1)
+
+
+! finish up
+ RETURN
+ END
+
+ SUBROUTINE PANELFILLT(N1,N2,N3)
+
+ use winteracter
+ implicit none
+ SAVE
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR,ITIME
+! real ::
+! character*3 ::
+ DATA ITIME/0/
+! IF(ITIME .EQ. 0) THEN
+! ITIME=1
+! N1=1
+! N2=0
+! N3=100
+! ENDIF
+
+ call wdialogload(IDD_FTRIAN)
+ ierr=infoerror(1)
+
+ CALL WDialogPutCheckBox(idf_check1,n1)
+ CALL WDialogPutCheckBox(idf_check2,n2)
+ CALL WDialogPutInteger(idf_integer1,n3)
+
+
+ CALL WDialogSelect(IDD_FTRIAN)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetCheckBox(idf_check1,n1)
+ CALL WDialogGetCheckBox(idf_check2,n2)
+ CALL WDialogGetInteger(idf_integer1,n3)
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ N3=-1
+ ENDIF
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/FORMGP.F90 b/src/src83e/FORMGP.F90
new file mode 100644
index 0000000..add79ff
--- /dev/null
+++ b/src/src83e/FORMGP.F90
@@ -0,0 +1,145 @@
+ SUBROUTINE FORMGP
+
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+
+ CHARACTER*47 MESSAGE
+
+ DATA MESSAGE /'Enter Group Number'/
+
+ DATA ITIME/0/
+
+! SWITCH TO GROUP ACTIVITY
+
+ IF(IQSW(1) .EQ. 1) IQSW(1)=2
+ IF(IQSW(2) .EQ. 1) IQSW(2)=2
+
+
+! IF FIRST TIME ASK TO LOAD FILE OR SET GROUPS = 1
+
+ if(ITIME .EQ. 0) THEN
+! ALLOCATE ARRAY SIZES
+
+ IF(.NOT. ALLOCATED(IGRPNUM)) THEN
+ ALLOCATE (IGRPNUM(25,MAXE),MAXENT(25))
+ CALL TOPAR
+ ENDIF
+ ISW=2
+ ITIME=1
+ ELSE
+ CALL TOPAR
+ ENDIF
+
+
+! ASSIGN A NUMBER TO THE NEW GROUP
+
+ call wdialogload(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(IDF_STRING1,MESSAGE)
+ CALL WDialogPutInteger(IDF_INTEGER1,ISW)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetInteger(IDF_INTEGER1,ISW)
+ GO TO 200
+ ENDIF
+ ENDDO
+
+ 200 CONTINUE
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish add these elements to the current group?'//&
+ CHAR(13)//' ','ADD ELEMENTS?')
+
+! If answer 'No', start afresh
+!
+ IF (WInfoDialog(4).EQ.2) then
+
+! STORE GROUP NUMBERS STARTING AT 1
+
+ DO K=1,NEFL
+ IGRPNUM(ISW,K)=NEFLAG(K)
+ ENDDO
+ MAXENT(ISW)=NEFL
+ ELSE
+!
+! FOR EACH ELEMENT SEARCH FIRST IF NOT FOUND ADD TO THE END
+
+ DO K=1,NEFL
+ DO J=1,MAXENT(ISW)
+ IF(NEFLAG(K) .EQ. IGRPNUM(ISW,J)) GO TO 240
+ ENDDO
+ MAXENT(ISW)=MAXENT(ISW)+1
+ IGRPNUM(ISW,MAXENT(ISW))=NEFLAG(K)
+ 240 CONTINUE
+ ENDDO
+ ENDIF
+
+! REMOVE FROM OLD LIST
+ DO I=1,25
+ IF(I .NE. ISW) THEN
+ DO J=1,MAXENT(I)
+ DO K=1,NEFL
+ IF(NEFLAG(K) .EQ. IGRPNUM(I,J)) THEN
+ IGRPNUM(I,J)=0
+ GO TO 260
+ ENDIF
+ ENDDO
+ 260 CONTINUE
+ ENDDO
+ JT=0
+ LIMIT=MAXENT(I)
+ J=0
+ 270 J=J+1
+ 275 IF(J+JT .LE. LIMIT) THEN
+ IF(IGRPNUM(I,J+JT) .EQ. 0) THEN
+ JT=JT+1
+ GO TO 275
+ ENDIF
+ IGRPNUM(I,J)=IGRPNUM(I,J+JT)
+ GO TO 270
+ ENDIF
+ DO J=MAXENT(I),MAXENT(I)+1-JT,-1
+ IGRPNUM(I,J)=0
+ ENDDO
+ MAXENT(I)=MAXENT(I)-JT
+ ENDIF
+ ENDDO
+
+ CALL TOSER
+
+ RETURN
+ END
+
+ SUBROUTINE TOSER
+ USE BLK1MOD
+ DO I=1,25
+ DO J=1,MAXENT(I)
+ IGRPSER(IGRPNUM(I,J))=I
+ ENDDO
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE TOPAR
+ USE BLK1MOD
+
+ MAXENT=0
+ IGRPNUM=0
+
+ DO K=1,NE
+ I=IGRPSER(K)
+ MAXENT(I)=MAXENT(I)+1
+ IGRPNUM(I,MAXENT(I))=K
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/FORMSHP.F90 b/src/src83e/FORMSHP.F90
new file mode 100644
index 0000000..f13c701
--- /dev/null
+++ b/src/src83e/FORMSHP.F90
@@ -0,0 +1,455 @@
+ subroutine formshp2(istyp,ivecact)
+ use winteracter
+
+ include 'D.inc'
+
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ character*1 ai1a,ai1b,ai1c,ai1d,label,ai1f
+ character*3 sub
+ character*4 ai1,ai7,aai7,ai8,ai9,anrs,aii,aioff
+ character*10 as
+ character*11 name
+ character*80 headr
+ character*255 fnamein,filter
+ integer*2 i3s,i4s
+ integer status,i1,i2,i3,i4,i5,i6,i7,i8,i9,ia1,ia7,ia8,ia9,nrs&
+ ,nars,ii,ioff,iaoff,i1a,i1b,i1c,i1d,istyp,nptemp
+ integer*8 i88
+ real*8 fp1,fp2,fp3,fp4,fp5,fp6,fp7,fp8,bx(1000),by(1000),bm(1000)&
+ ,bxmn,bymn,bxmx,bymx,bmmn,bmmx,axmn,aymn,axmx,aymx,fz,ammn,ammx
+ real bed,val
+ integer ityp,icl
+ allocatable bed(:),val(:,:),ityp(:),icl(:)
+
+ LOGICAL OPENED
+ equivalence(ai1,ia1),(ai7,ia7),(aii,ii),(anrs,nrs),(aioff,ioff)
+
+ if(.not. allocated(bed)) then
+ allocate (bed(250000),val(250000,4),ityp(250000),icl(250000))
+ bed=0.
+ val=0.
+ ityp=0
+ icl=0
+ endif
+ filter='Shape file *.shp|*.shp|'
+ INQUIRE(99,opened= OPENED)
+ IF( .NOT. OPENED) THEN
+ CALL WSelectFile(filter,SaveDialog+PromptOn+AppendExt,FNAMEIN,'Shapefile Name')
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ open(99,file=fnamein,form='binary')
+ sub='shx'
+ call ADDSUB(fnamein,sub)
+ open(98,file=fnamein,form='binary')
+ sub='dbf'
+ call ADDSUB(fnamein,sub)
+ open(97,file=fnamein,form='binary')
+ ELSE
+ RETURN
+ ENDIF
+ ENDIF
+! read data file to establish sizes and max/min
+ nfils=50
+ axmn=1.e36
+ aymn=1.e36
+ ammn=1.e36
+ axmx=-1.e36
+ aymx=-1.e36
+ ammx=-1.e36
+! if(ivecact .ne. 1) then
+! read(70,'(a80)') headr
+! read(70,'(a80)') headr
+! read(headr(9:16),'(i8)') istyp
+! endif
+ do i=1,250000
+ if(istyp .eq. 25) then
+ read(113,end=100) iclt,ityp(i),npts,(bx(j),by(j),bm(j),j=1,npts)
+ do j=1,npts
+ write(155,*) bx(j),by(j),bm(j)
+ enddo
+ icl(i)=iclt
+ write(155,*) icl(i),ityp(i),npts
+ do j=1,npts
+ axmn=min(axmn,bx(j))
+ aymn=min(aymn,by(j))
+ ammn=min(ammn,bm(j))
+ axmx=max(axmx,bx(j))
+ aymx=max(aymx,by(j))
+ ammx=max(ammx,bm(j))
+ enddo
+! NEED TO FIX THIS
+ nfils=nfils+36+12*npts
+! NEED TO FIX THIS
+ elseif(istyp .eq. 5) then
+ IF(IVECACT .EQ. 5) THEN
+ read(113,end=100) iclt,ityp(i),npts,(bx(j),by(j),bm(j),j=1,npts)
+ ELSE
+ read(113,end=100) iclt,npts,(bx(j),by(j),j=1,npts)
+ ENDIF
+ icl(i)=iclt
+ do j=1,npts
+ axmn=min(axmn,bx(j))
+ aymn=min(aymn,by(j))
+ axmx=max(axmx,bx(j))
+ aymx=max(aymx,by(j))
+ enddo
+ ammn=0.
+ ammx=0.
+ nfils=nfils+28+8*npts
+ elseif(istyp .eq. 3) then
+ read(113,end=100) npts,(bx(j),by(j),j=1,npts),d1
+ do j=1,npts
+ axmn=min(axmn,bx(j))
+ aymn=min(aymn,by(j))
+ axmx=max(axmx,bx(j))
+ aymx=max(aymx,by(j))
+ enddo
+ ammn=0.
+ ammx=0.
+ nfils=nfils+28+8*npts
+ elseif(istyp .eq. 1 .and. ivecact .eq. 0) then
+ read(70,9875,end=100) bx(1),by(1)
+ 9875 format(10x,2f20.0,f10.0)
+ axmn=min(axmn,bx(1))
+ aymn=min(aymn,by(1))
+ axmx=max(axmx,bx(1))
+ aymx=max(aymx,by(1))
+ ammn=0.
+ ammx=0.
+ nfils=nfils+14
+ elseif(istyp .eq. 1 .and. ivecact .eq. 1) then
+! read(113,end=100) NR,bxt,byt,d1,d2,d3,d4,d5,d6
+ read(113,end=100) NR,bxt,byt,d1,d2,d3,d4
+ 9874 format(9x,8f14.0)
+ axmn=min(axmn,bxt)
+ aymn=min(aymn,byt)
+ axmx=max(axmx,bxt)
+ aymx=max(aymx,byt)
+ ammn=0.
+ ammx=0.
+ nfils=nfils+14
+ elseif(istyp .eq. 1 .and. ivecact .eq. 6) then
+ read(113,end=100) NR,bx(1),by(1),d1
+ axmn=min(axmn,bx(1))
+ aymn=min(aymn,by(1))
+ axmx=max(axmx,bx(1))
+ aymx=max(aymx,by(1))
+ ammn=0.
+ ammx=0.
+ nfils=nfils+14
+ endif
+ numdat=i
+ enddo
+ 100 rewind 113
+
+! read(70,'(a80)') headr
+!c if(ivecact .eq. 1) read(70,'(a80)') headr
+!c setup header
+ ia1=9994
+ call BTOL(ai1,i1)
+ i2=0
+ i3=0
+ i4=0
+ i5=0
+ i6=0
+ ia7=nfils
+ call BTOL(ai7,i7)
+ i8=1000
+ i9=istyp
+ fz=0.
+ write(99) i1,i2,i3,i4,i5,i6,i7,i8,i9,axmn,aymn,axmx,aymx,fz,fz,ammn,ammx
+ ia7=50+4*numdat
+ call BTOL(ai7,i7)
+ write(98) i1,i2,i3,i4,i5,i6,i7,i8,i9,axmn,aymn,axmx,aymx,fz,fz,ammn,ammx
+ ioff=50
+
+! header now complete for shp and shx options
+ do i=1,numdat
+ if(istyp .eq. 25) then
+ read(113,end=100) iclt,ityp(i),npts,(bx(j),by(j),bm(j),j=1,npts)
+ icl(i)=iclt
+ nrs=32+12*npts
+ nrsc=nrs+4
+! write(155,*) 'nrs',nrs
+ call btol(anrs,nars)
+ elseif(istyp .eq. 5) then
+ IF(IVECACT .EQ. 5) THEN
+ read(113,end=100) iclt,ityp(i),npts,(bx(j),by(j),bm(j),j=1,npts)
+ ELSE
+ read(113) iclt,npts,(bx(j),by(j),j=1,npts)
+ ENDIF
+ icl(i)=iclt
+ nrs=24+8*npts
+ nrsc=nrs+4
+! write(155,*) 'nrs',nrs
+ call btol(anrs,nars)
+ elseif(istyp .eq. 3) then
+ read(113) npts,(bx(j),by(j),j=1,npts),val(i,1)
+ icl(i)=iclt
+ nrs=24+8*npts
+ nrsc=nrs+4
+! write(155,*) 'nrs',nrs
+ call btol(anrs,nars)
+ elseif(istyp .eq. 1) then
+ if(ivecact .eq. 0) then
+ read(70,9875) bx(1),by(1),bed(i)
+ elseif(ivecact .eq. 6) then
+ read(113) ityp(i),bx(1),by(1),val(i,1)
+ else
+ read(113) idum,bxt,byt,(val(i,j),j=1,4)
+ bx(1)=bxt
+ by(1)=byt
+ endif
+ nrs=10
+ nrsc=14
+! write(155,*) 'nrs',nrs
+ call btol(anrs,nars)
+ endif
+ ii=i
+ call btol(aii,nrec)
+ write(99) nrec,nars
+ if(istyp .eq. 25) then
+ j1=istyp
+ j2=1
+ bxmn=bx(1)
+ bymn=by(1)
+ bmmn=bm(1)
+ bxmx=bx(1)
+ bymx=by(1)
+ bmmx=bm(1)
+ do k=2,npts
+ bxmn=min(bxmn,bx(k))
+ bymn=min(bymn,by(k))
+ bmmn=min(bmmn,bm(k))
+ bxmx=max(bxmx,bx(k))
+ bymx=max(bymx,by(k))
+ bmmx=max(bmmx,bm(k))
+ enddo
+ j3=npts
+ j4=0
+ write(99) j1,bxmn,bymn,bxmx,bymx,j2,j3,j4
+ do k=1,npts
+ write(99) bx(k),by(k)
+ enddo
+ write(99) bmmn,bmmx
+ do k=1,npts
+ write(99) bm(k)
+ enddo
+
+ elseif(istyp .gt. 2) then
+ j1=istyp
+ j2=1
+ bxmn=bx(1)
+ bymn=by(1)
+ bxmx=bx(1)
+ bymx=by(1)
+ do k=2,npts
+ bxmn=min(bxmn,bx(k))
+ bymn=min(bymn,by(k))
+ bxmx=max(bxmx,bx(k))
+ bymx=max(bymx,by(k))
+ enddo
+ j3=npts
+ j4=0
+ write(99) j1,bxmn,bymn,bxmx,bymx,j2,j3,j4
+! write(155,*) j1,bxmn,bymn,bxmx,bymx,j2,j3,j4
+ do k=1,npts
+ write(99) bx(k),by(k)
+! write(155,*) k,bx(k),by(k)
+ enddo
+ elseif(istyp .eq. 1) then
+ j4=1
+ write(99) j4,bx(1),by(1)
+ endif
+! write(155,*) ioff,nrs
+ call btol(aioff,iaoff)
+ write(98) iaoff,nars
+ ioff=ioff+nrsc
+ enddo
+ i1a=3
+ i1b=115
+ i1c=12
+ i1d=9
+ ai1a=char(i1a)
+ ai1b=char(i1b)
+ ai1c=char(i1c)
+ ai1d=char(i1d)
+ i2=numdat
+ if(ivecact .eq. 0 .or. ivecact .gt. 3) then
+ i4s=18
+ i3s=97
+ elseif(ivecact .eq. 3) then
+ i4s=11
+ i3s=65
+ else
+ i4s=37
+ i3s=161
+ endif
+ i5=0
+ write(97) ai1a,ai1b,ai1c,ai1d,i2,i3s,i4s,i5
+ ai1a=char(0)
+ ai1b='W'
+ write(97) i5,i5,i5,ai1a,ai1a,ai1b,ai1a
+ i2a=0
+ IF(ISTYP .EQ. 25) THEN
+ name='ID '
+ label='N'
+ i2=0
+ ai1a=char(8)
+ ai1b=char(0)
+ ai1c=char(0)
+ ai1f=char(13)
+ ai1d=char(0)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='Type '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(0)
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c,ai1f
+ ELSEIF(ISTYP .EQ. 5) THEN
+ name='ID '
+ label='N'
+ i2=0
+ ai1a=char(8)
+ ai1b=char(0)
+ ai1c=char(0)
+ ai1f=char(13)
+ ai1d=char(0)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='Contour '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(2)
+ IF(IVECACT .EQ. 5) THEN
+ name='TYPE * '
+ label='N'
+ ai1b=char(0)
+ ENDIF
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c,ai1f
+ elseif(istyp .eq. 3) then
+ name='CONTOUR '
+ label='N'
+ i2=0
+ ai1a=char(10)
+ ai1b=char(4)
+ ai1c=char(0)
+ ai1f=char(13)
+ ai1d=char(0)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c,ai1f
+ elseif(istyp .eq. 1) then
+ if(ivecact .eq. 6) then
+ name='NODE '
+ label='N'
+ i2=0
+ ai1a=char(8)
+ ai1b=char(0)
+ ai1c=char(0)
+ ai1f=char(13)
+ ai1d=char(0)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='Bed Elev '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(0)
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c,ai1f
+ else
+ name='VEL '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(4)
+ ai1c=char(0)
+ ai1f=char(13)
+ ai1d=char(0)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='DIR '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(2)
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='DEP '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(3)
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2a,i2a,i2a,ai1d,ai1c
+ name='WS-ELEV '
+ label='N'
+ i2=0
+ ai1a=char(9)
+ ai1b=char(3)
+ ai1c=char(0)
+ ai1f=char(13)
+ write(97)name,label,i2,ai1a,ai1b,i2,i2,i2,ai1d,ai1c
+ write(97)ai1f
+ endif
+ endif
+ ai1a=char(32)
+ ai1f=char(32)
+ do i=1,numdat
+ write(97) ai1a
+ if(istyp .eq. 25) then
+ write(as(1:8),'(i8)') icl(i)
+ write(97) as(1:8)
+ write(as(1:9),'(i9)') ityp(i)
+ write(97) as(1:9)
+ elseif(istyp .eq. 5) then
+ write(as(1:8),'(i8)') icl(i)
+ write(97) as(1:8)
+ if(IVECACT .EQ. 5) then
+ write(as(1:9),'(i9)') ityp(i)
+ write(97) as(1:9)
+ else
+ ficl=contur(icl(i))
+ write(as(1:9),'(f9.2)') ficl
+ write(97) as(1:9)
+ endif
+ elseif(istyp .eq. 3) then
+ write(as(1:10),'(f10.4)') val(i,1)
+ write(97) as(1:10)
+ elseif(istyp .eq. 1) then
+ if(ivecact .eq. 0) then
+ write(as(1:8),'(i8)') i
+ write(97) as(1:8)
+ write(as(1:8),'(f8.2)') bed(i)
+ write(97) as(1:8)
+ elseif(ivecact .eq. 6) then
+ write(as(1:8),'(i8)') ityp(i)
+ write(97) as(1:8)
+ write(as(1:9),'(f9.2)') val(i,1)
+ write(97) as(1:9)
+ else
+ write(as(1:9),'(f9.4)') val(i,1)
+ write(97) as(1:9)
+ write(as(1:9),'(f9.2)') val(i,2)
+ write(97) as(1:9)
+ write(as(1:9),'(f9.3)') val(i,3)
+ write(97) as(1:9)
+ write(as(1:9),'(f9.3)') val(i,4)
+ write(97) as(1:9)
+ endif
+ endif
+ enddo
+ ai1a=char(26)
+ write(97) ai1a
+ close (99)
+ close (98)
+ close (97)
+ return
+ end
+
+
\ No newline at end of file
diff --git a/src/src83e/FRMNODQ.f90 b/src/src83e/FRMNODQ.f90
new file mode 100644
index 0000000..482e145
--- /dev/null
+++ b/src/src83e/FRMNODQ.f90
@@ -0,0 +1,29 @@
+ SUBROUTINE FRMNODQ(X1,Y1,X2,Y2,X3,Y3,X4,Y4,NPTS1,NPTS2)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+! X1,X2,X3,X4 AND Y1,Y2,Y3,Y4 are vertices of quad
+! NPTS1 and NPTS2 are the nominal number of elements on each side
+
+
+! Work along first side AND backwards along second line
+
+ DO N=1,NPTS1-1
+ RATIO=FLOAT(N)/FLOAT(NPTS1)
+ X12=X1+RATIO*(X2-X1)
+ Y12=Y1+RATIO*(Y2-Y1)
+ X43=X4+RATIO*(X3-X4)
+ Y43=Y4+RATIO*(Y3-Y4)
+
+! Now get interior points
+
+ DO M=1,NPTS2-1
+ RATIO=FLOAT(M)/FLOAT(NPTS2)
+ XNEW=X12+RATIO*(X43-X12)
+ YNEW=Y12+RATIO*(Y43-Y12)
+ CALL DEFNOD(XNEW,YNEW)
+ ENDDO
+ ENDDO
+ RETURN
+ END
diff --git a/src/src83e/GETANG.F90 b/src/src83e/GETANG.F90
new file mode 100644
index 0000000..3f2e67d
--- /dev/null
+++ b/src/src83e/GETANG.F90
@@ -0,0 +1,144 @@
+ SUBROUTINE GETALLANGS
+
+ USE BLK1MOD
+ USE BLK2MOD
+ SAVE ICOUNTMX
+
+ DIMENSION ANGA(2),ANGB(2)
+
+ DATA ICOUNTMX/0/
+
+ IF(.NOT. ALLOCATED(NKEY1)) THEN
+ ALLOCATE (NKEY1(MAXE))
+ ENDIF
+ IF(.NOT. ALLOCATED(ANGOP)) THEN
+ ALLOCATE (ANGOP(MAXP))
+ ENDIF
+
+ CALL HEDR
+ ICOUNTMX=50
+ ILMIT=0
+ CALL GEtrev(ICOUNTMX,ILMIT)
+ IF(ICOUNTMX .LT. 0) RETURN
+ NKEY1=0
+! set all the nodal angles negative
+ ANGOP=-1.
+! get elements connected to nodes table
+ IERR=0
+ CALL NDNECON(IERR)
+! loop on the elements to find mid-sides
+ DO N=1,NE
+! work only with triangles
+ IF(NCORN(N) .EQ. 6) THEN
+! go to each mid-side
+ DO K=2,6,2
+ N1=NOP(N,K-1)
+ KN=MOD(K+1,6)
+ N3=NOP(N,KN)
+ KP=MOD(K+3,6)
+ N2=NOP(N,KP)
+ NCUR=NOP(N,K)
+ IF(NCUR .EQ. 0) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
+ 'You have tried to reverse before executing "FILL"'//CHAR(13) &
+ //'Reversing terminated',&
+ 'UNABLE TO REVERSE')
+! CALL SYMBL(0.,7.30,0.20,STRELS,0.,60)
+ RETURN
+ ENDIF
+! call GETANG to get angle opposite N1-N3 line
+ ANGTMP=GETANG(N1,N2,N3)
+ IF(ANGTMP .GT. ANGOP(NCUR)) ANGOP(NCUR)=ANGTMP
+ ENDDO
+ ENDIF
+ ENDDO
+! get the angles in ascending order
+ CALL SORT(ANGOP,ICN,NP)
+
+ ICOUNT=0
+! loop backwards and use the sorrt key ICN
+ DO J=NP,1,-1
+ MIDND=ICN(J)
+! only work when angles greater than 90 deg
+ IF(ANGOP(MIDND) .GT. 1.5708) THEN
+! check if there are two elements connected to this mid side
+ IF(NECON(MIDND,2) .GT. 0) THEN
+! make sure the opposite elements are not quadrilaterals
+ IF(NCORN(NECON(MIDND,1)) .EQ. 6 .AND. NCORN(NECON(MIDND,2)) .EQ. 6) THEN
+! only proceed when the first mid-side has not been processed
+ IF(NKEY1(NECON(MIDND,1)) .EQ. 0) THEN
+ NEL1=NECON(MIDND,1)
+! only proceed when the second mid-side has not been processed
+ IF(NKEY1(NECON(MIDND,2)) .EQ. 0) THEN
+! we really have a candidate lest check if it will make the angles worse
+! first find the locations of the mid sides in the order data to get more angles
+ DO KK=1,2
+ DO K=2,6,2
+! test for a fit
+ IF(NOP(NECON(MIDND,KK),K) .EQ. MIDND) THEN
+! get angles before and after
+! corner before
+ N1=NOP(NECON(MIDND,KK),K-1)
+! corner after
+ N3=MOD(K+1,6)
+ N3=NOP(NECON(MIDND,KK),N3)
+! test for possible equal elev
+ if(ilmit .eq. 1) then
+ if(wd(n1) .gt. -9000.) then
+ if(wd(n1) .eq. wd(n3)) go to 180
+ endif
+ endif
+! corner opposite
+ N2=MOD(K+3,6)
+ N2=NOP(NECON(MIDND,KK),N2)
+! call GETANG to get angle opposite N2-N3 LINE
+ ANGB(KK)=GETANG(N2,N1,N3)
+! call GETANG to get angle opposite N1-N2 LINE
+ ANGA(KK)=GETANG(N1,N3,N2)
+ ENDIF
+ ENDDO
+ ENDDO
+! test if the side angles are larger, if so skip out
+ IF(ANGOP(MIDND) .LT. ANGB(2)+ANGA(1)) GO TO 180
+ IF(ANGOP(MIDND) .LT. ANGB(1)+ANGA(2)) GO TO 180
+! finally we can proceed
+ ICOUNT=ICOUNT+1
+! NELPR(ICOUNT,2)=NECON(MIDND,2)
+! NELPR(ICOUNT,1)=NEL1
+ NKEY1(NECON(MIDND,1))=1
+ NKEY1(NECON(MIDND,2))=1
+ N1=NEL1
+ N2=NECON(MIDND,2)
+! carry out reversal
+ CALL REVERS(N1,N2)
+! show the elements
+ call fillemc(n1,4)
+ call fillemc(n2,4)
+ IF(ICOUNT .GE. ICOUNTMX) GO TO 200
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ ELSE
+ GO TO 200
+ ENDIF
+ 180 CONTINUE
+ ENDDO
+ 200 CONTINUE
+ RETURN
+ END
+
+ FUNCTION GETANG(N1,N2,N3)
+
+ USE BLK1MOD
+
+ A=SQRT((XUSR(N1)-XUSR(N2))**2+(YUSR(N1)-YUSR(N2))**2)
+ B=SQRT((XUSR(N2)-XUSR(N3))**2+(YUSR(N2)-YUSR(N3))**2)
+ C=SQRT((XUSR(N3)-XUSR(N1))**2+(YUSR(N3)-YUSR(N1))**2)
+ ANG1=(A**2+B**2-C**2)/(2.*A*B)
+ IF(ANG1 .GT. 1.) ANG1=1.
+
+ GETANG=ACOS(ANG1)
+
+ RETURN
+ END
diff --git a/src/src83e/GETCRS.F90 b/src/src83e/GETCRS.F90
new file mode 100644
index 0000000..767afdc
--- /dev/null
+++ b/src/src83e/GETCRS.F90
@@ -0,0 +1,241 @@
+ SUBROUTINE GETCRS(CRSTIT)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ CHARACTER*8 ID1
+ CHARACTER*72 DLIN1,CRSTIT
+
+!IPK JUN06
+ DATA VOIDCR/-1.E15/
+
+ XCRS=VOIDCR
+ YCRS=VOIDCR
+ NRIVCR1=0
+ NRIVCR2=0
+!ipk jun11
+ NOREACH=0
+ NRIVL=0
+
+ call ginpt(icrin,id1,dlin1)
+
+ IF(ID1(1:2) .EQ. 'TC') THEN
+ CRSTIT=DLIN1
+ call ginpt(icrin,id1,dlin1)
+ ELSE
+ CALL WMessageBox(0,3,1,'Cross-section Title not found'//char(13)//&
+ 'Cross-section file input terminated','ERROR')
+ return
+ ENDIF
+ N=0
+
+ 200 N=N+1
+ IF(N .GT. MCRS) THEN
+ CALL WMessageBox(0,3,1,'Allowable number of sections (1000) exceeded'//char(13)//&
+ 'Cross-section file input terminated','ERROR')
+ return
+ ENDIF
+ IF(ID1(1:3) .EQ. 'RCH') THEN
+ READ(DLIN1,'(I8)') NOREACHTMP
+ write(90,'(a)') 'rch',id1,dlin1
+ Call ginpt(icrin,id1,dlin1)
+ ENDIF
+
+ IF(ID1(1:3) .EQ. 'ICS') THEN
+ READ(DLIN1,'(2I8,8x,2f16.0)') IVMIL(N),NRIVL(IVMIL(N)),XCRS(IVMIL(N)),YCRS(IVMIL(N))
+ write(90,'(a)') 'ics',id1,dlin1
+ NOREACH(IVMIL(N))=NOREACHTMP
+ IF(NRIVL(IVMIL(N)) .GT. MPTS) THEN
+ CALL WMessageBox(0,3,1,'Allowable number of points in a cross-section (75) exceeded'//char(13)//&
+ 'Cross-section file input terminated','ERROR')
+ return
+ ENDIF
+! IF(NOREACH(N) .EQ. 0) THEN
+! IF(N .GT. 1) THEN
+! NOREACH(N)=NOREACH(N-1)
+! ELSE
+! NOREACH(N)=1
+! ENDIF
+! ENDIF
+ call ginpt(icrin,id1,dlin1)
+ DO I=1,NRIVL(IVMIL(N))
+ write(90,'(a)') 'crs',id1,dlin1
+ READ(DLIN1,'(3F8.0)') (CRSDAT(IVMIL(N),I,J),J=1,3)
+!IPK JUN04
+ if(i .gt. 1) then
+ CRSDAT(IVMIL(N),I,2)=CRSDAT(IVMIL(N),I-1,2)+&
+ (CRSDAT(IVMIL(N),I,1)-CRSDAT(IVMIL(N),I-1,1))*&
+ (CRSDAT(IVMIL(N),I,3)+CRSDAT(IVMIL(N),I-1,3))/2.
+ endif
+ call ginpt(icrin,id1,dlin1)
+ ENDDO
+ NCRSEC=N
+! TEST NCRSEC=MAX(N,IVMIL(N))
+ GO TO 200
+ ENDIF
+
+!ipk jun06 DO N=1,NCRSEC
+
+ DO N=1,MCRS
+ IF(ID1(1:3) .EQ. 'XYL') THEN
+ READ(DLIN1,'(I8,2F16.0)') NN,XCRS(NN),YCRS(NN)
+!IPK JUN06
+ IF(NN .GT. NCRSEC) NCRSEC=NN
+ call ginpt(icrin,id1,dlin1)
+ ELSE
+ GO TO 400
+ ENDIF
+ ENDDO
+
+ 400 CONTINUE
+ DO N=1,MAXP
+ IF(ID1(1:3) .EQ. 'CRF') THEN
+ READ(DLIN1,'(2I8,F8.0,I8,F8.0)') NODCRS&
+ ,NRIVCR1(NODCRS),WTRIVCR1(NODCRS)&
+ ,NRIVCR2(NODCRS),WTRIVCR2(NODCRS)
+ call ginpt(icrin,id1,dlin1)
+ ELSE
+ GO TO 500
+ ENDIF
+ ENDDO
+ 500 CONTINUE
+
+ CLOSE(ICRIN)
+
+! CHECK THE DATA LOADED
+
+ IERR=0
+ DO N=1,NE
+ IF(IMAT(N) .LT. 900) THEN
+ IF(NCORN(N) .EQ. 3 .OR. NCORN(N) .EQ. 5) THEN
+ DO J=1,3,2
+ IF(NRIVCR1(NOP(N,J)) .NE. 0) THEN
+ WD1(NOP(N,J))=&
+ CRSDAT(NRIVCR1(NOP(N,J)),1,1)*WTRIVCR1(NOP(N,J))+&
+ CRSDAT(NRIVCR2(NOP(N,J)),1,1)*WTRIVCR2(NOP(N,J))
+! ELSE
+! WRITE(75,*) ' NO CROSS-SECTION FILE REFERENCE FOR',NOP(N,J)
+! WRITE(75,*) ' EXECUTION TERMINATED'
+! WRITE(*,*) ' NO CROSS-SECTION FILE REFERENCE FOR',NOP(N,J)
+! WRITE(*,*) ' EXECUTION TERMINATED'
+! IERR=IERR+1
+ ELSE
+ WD1(NOP(N,J))=WD(NOP(N,J))
+ ENDIF
+!
+ ENDDO
+
+ WD1(NOP(N,2))=(WD1(NOP(N,1))+WD1(NOP(N,3)))/2.
+!
+ ELSE
+ DO J=1,NCORN(N)
+ WD1(NOP(N,J))=WD(NOP(N,J))
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+
+ RETURN
+ END
+
+ SUBROUTINE WRTCRS(ICROUT,CRSTIT)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+! COMMON/ICN1/ ICN(MAXP)
+
+
+ CHARACTER*8 ID1,ENDDAT
+ CHARACTER*72 CRSTIT
+
+!IPK JUN06
+ DATA VOIDCRP/-1.E14/
+
+ DO J=1,MAXP
+ ICN(J)=0
+ END DO
+! First sort out the potential midsides
+! Note that transition elements caues a problem
+! Find these first
+ DO 200 N=1,NE
+ if(NCORN(N) .GT. 5) GO TO 200
+ IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
+!
+! We have a transition mark node number as if it were corner
+!
+ ICN(NOP(N,3))=1
+ ICN(NOP(N,1))=2
+ ICN(NOP(N,4))=2
+ ICN(NOP(N,5))=2
+ ELSE
+!
+! Store ICN = 2 for corner nodes
+!
+ NCN=NCORN(N)
+!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ MST=1
+ ELSE
+ MST=2
+ ENDIF
+
+ DO 180 M=1,NCN,MST
+
+ ICN(NOP(N,M))=2
+ 180 CONTINUE
+ ENDIF
+ 200 END DO
+ ID1='TC '
+ WRITE(ICROUT,'(A8,A72)') ID1,CRSTIT
+
+
+ DO N=1,NCRSEC
+!ipk jun06
+!! IF(NRIVL(N) .GT. 0) THEN
+ ID1='RCH '
+ WRITE(ICROUT,'(A8,I8)') ID1,NOREACH(IVMIL(N))
+ ID1='ICS '
+!! write(icrout,'(A8,2I8,8x,2f16.4)') ID1,IVMIL(N),NRIVL(N),XCRS(N),YCRS(N)
+!!jul15 write(icrout,'(A8,2I8,8x,2f16.4)') ID1,N,NRIVL(N),XCRS(N),YCRS(N)
+ write(icrout,'(A8,2I8,8x,2f16.4)') ID1,IVMIL(N),NRIVL(IVMIL(N)),XCRS(IVMIL(N)),YCRS(IVMIL(N))
+ ID1='CRS '
+ DO I=1,NRIVL(IVMIL(N))
+ if(crsdat(IVMIL(N),i,2) .gt. 999999.) then
+ WRITE(ICROUT,'(A8,3F8.0)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
+ elseif(crsdat(IVMIL(N),i,2) .gt. 99999.) then
+ WRITE(ICROUT,'(A8,3F8.1)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
+ else
+ WRITE(ICROUT,'(A8,3F8.2)') ID1,(CRSDAT(IVMIL(N),I,J),J=1,3)
+ endif
+ ENDDO
+!ipk jun06
+!! ENDIF
+ ENDDO
+
+
+ DO N=1,NCRSEC
+!ipk jun06
+ IF(XCRS(N) .GT. VOIDCRP) THEN
+ ID1='XYL '
+ WRITE(ICROUT,'(A8,I8,2F16.4)') ID1,IVMIL(N),XCRS(IVMIL(N)),YCRS(IVMIL(N))
+!ipk jun06
+ ENDIF
+ ENDDO
+
+ ID1='CRF '
+ DO N=1,NP
+ IF(ICN(N) .EQ. 2) THEN
+ IF(NRIVCR1(N) .GT. 0) THEN
+ WRITE(ICROUT,'(A8,2I8,F8.4,I8,F8.4)') ID1,N&
+ ,NRIVCR1(N),WTRIVCR1(N)&
+ ,NRIVCR2(N),WTRIVCR2(N)
+ ENDIF
+ ENDIF
+ ENDDO
+
+ ENDDAT='ENDDATA '
+ WRITE(ICROUT,'(A8)') ENDDAT
+ RETURN
+ END
+
+
diff --git a/src/src83e/GETEQ1.F90 b/src/src83e/GETEQ1.F90
new file mode 100644
index 0000000..461efc4
--- /dev/null
+++ b/src/src83e/GETEQ1.F90
@@ -0,0 +1,485 @@
+!IPK LAST UPDATE OCT 23 2015 ADD DECODAT OPTION FOR INPUT
+!IPK LAST UPDATE nov 20 2014 IMPLEMENT BINARY FILE SAVE FOR ELEMENT INFLOW DATA
+!IPK LAST UPDATE nov 17 2014 initialise TPRVH FOR ALL TYPES
+!IPK last update oct 22 2012 initialize TPRVH
+!IPK LAST UPDATE MAY 04 2011 FIX BUG CAUSED WHEN SPANNING MULTIPLE FILES
+!IPK LAST UPDATE SEPT 3 2007 ADD FULL DATE TO INPUT
+!IPK last update sept 01 2007 permit comma delimited entry of data
+!IPK LAST UPDATE SEP 06 2004 ADD ERROR FILE
+! Last change: IPK 19 Sep 2000 11:44 am
+!IPK LAST UPDATE APR 16 1997
+!IPK last update Jan 23 1996
+!IPK last update jan 9 1996
+ SUBROUTINE GETEQ
+!IPK APR97 SAVE
+
+ use winteracter
+ USE BLKELTLD
+
+ include 'D.inc'
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+!IPK AUG05 SAVE
+ INTEGER JCNV(12)
+ CHARACTER*32 FNAM
+ CHARACTER*8 ID
+ CHARACTER*80 QHTITLE,DLIN
+ CHARACTER*10 DATE
+ character*255 fnamein,filter
+!IPK oct 12 add initial value
+ data tprvh/0./,ITIME/0/
+ DATA JCNV/0,31,59,90,120,151,181,212,243,273,304,334/
+ LOGICAL OPENED
+ IF(ITIME .EQ. 0) THEN
+ DAYOFY=-9999
+ ITIME=1
+ IQEUNIT=0
+ IBINEL=0
+ IRMATYP=10
+ NQHYD=0
+ NQP=0
+ ENDIF
+ call wdialogload(IDD_CHOOSEMODEL)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_CHOOSEMODEL)
+ ierr=infoerror(1)
+
+ call wdialogputRadioButton(idf_radio1)
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ntyp)
+
+ GO TO 50
+ ENDIF
+
+ enddo
+
+50 CONTINUE
+ IF(NTYP .EQ. 1) IRMATYP=2
+ IF(NTYP .EQ. 2) IRMATYP=10
+ IF(NTYP .EQ. 3) THEN
+ IRMATYP=11
+ NQP=1
+ call wdialogload(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(IDF_STRING1,'NUMBER OF WQ GRAPH ENTRIES')
+ CALL WDialogPutInteger(IDF_INTEGER1,NQP)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetInteger(IDF_INTEGER1,NQP)
+
+! TEMPORARY LIMIT
+ IF(NQP .GT. 3) NQP=3
+
+ GO TO 70
+ ELSE
+ RETURN
+ ENDIF
+ ENDDO
+ ENDIF
+
+!IPK NOV14 ADD IBINEL TO TEST
+ 70 CONTINUE
+ IF(IQEUNIT .EQ. 0 .and. ibinel .eq. 0) THEN
+ INQUIRE(201,opened= OPENED)
+ filter='Element Input files|*.elt;*.elf;*.dat;*.txt;*.grh|All files --|*.*|'
+ IF( .NOT. OPENED) THEN
+ CALL WSelectFile(filter,PromptOn+DirChange,FNAMEIN,'Element Load File Name')
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ OPEN(201,FILE=FNAMEIN,STATUS='OLD')
+ ELSE
+ RETURN
+ ENDIF
+ ENDIF
+ IQEUNIT=201
+ ENDIF
+ IF(NQHYD .EQ. 0) THEN
+
+!IPK NOV14 READ AND ALLOCATE DATA FROM BINARY FILE
+ IF(IBINEL .GT. 0) THEN
+ TSTARTS=(DAYOFY-1)*24.+TIME-TETH
+ READ(IBINEL)NEDPTS,NQHYD,TSTARTKP,IYRKP
+ YEARC=0.
+ IF(IYRR .NE. IYRKP) THEN
+ IF(IYRR .GT. IYRKP) THEN
+ 80 CALL HRYRT(IYRKP,HRYR)
+ YEARC=YEARC+HRYR
+ IYRKP=IYRKP+1
+ IF(IYRR .GT. IYRKP) GO TO 80
+ ELSE
+ 90 CALL HRYRT(IYRKP,HRYR)
+ YEARC=YEARC-HRYR
+ IYRKP=IYRKP-1
+ IF(IYRR .LT. IYRKP) GO TO 90
+ ENDIF
+ ENDIF
+ ALLOCATE(DYE(NEDPTS,NQHYD),TAE(NEDPTS,NQHYD),HAE(NEDPTS,NQHYD),HDE(NEDPTS,NQHYD,3),ILAYRE(NEDPTS,NQHYD))
+ do j=1,NQHYD
+ READ(IBINEL) NCLINE(j),NEST(j),IYDATE(j),NHYE(J)
+ READ(IBINEL) (DYE(I,j),TAE(I,j),HAE(I,j),I=1,nedpts)
+ DO I=1,NEDPTS
+ TAE(I,J)=TAE(I,J)+TSTARTKP-TSTARTS-YEARC
+ ENDDO
+ enddo
+ GO TO 199
+ ENDIF
+!IPK NOV14 END UPDATE
+ NEDPTS=0
+ CALL ALLOCFL(NEDPTS,NELDS,IQEUNIT,3)
+!
+! set starting time in hours of the year
+! teth contains the first time step
+
+ 95 READ(IQEUNIT,'(A8,A72)') ID,QHTITLE
+!IPK sep07 CHECK FOR COMMA'S
+ 98 IFREE=0
+ DO K=1,8
+ IF(ID(K:K) .NE. ',') THEN
+ IFREE=0
+ ELSE
+ KFIRST=K+1
+ IFREE=1
+ GO TO 99
+ ENDIF
+ ENDDO
+ 99 IF(IFREE .EQ. 1) THEN
+ QHTITLE=ID(KFIRST:8)//QHTITLE(1:71+KFIRST)
+ ENDIF
+ READ(IQEUNIT,'(A8,A72)') ID,DLIN
+ IF(ID(1:3) .EQ. 'QEI' .OR. ID(1:3) .EQ. 'QT ') THEN
+ 101 NQHYD=NQHYD+1
+!IPK sep07 CHECK FOR COMMA'S
+!IPK nov14 initialise TPRVH
+ tprvh=0
+ IFREE=0
+ DO K=1,8
+ IF(ID(K:K) .NE. ',') THEN
+ IFREE=0
+ ELSE
+ KFIRST=K+1
+ IFREE=1
+ GO TO 102
+ ENDIF
+ ENDDO
+ 102 IF(IFREE .EQ. 1) THEN
+ DLIN=ID(KFIRST:8)//DLIN(1:71+KFIRST)
+ ENDIF
+!IPK APR97 TEST FOR LIMIT
+ IF(NQHYD .GT. NELDS) THEN
+!IPK SEP04
+ CLOSE(75)
+ OPEN(75,file='ERROR.OUT')
+ WRITE(75,*) 'ERROR STOP TOO MANY ELEMENT INFLOWS'
+ WRITE(*,*) 'ERROR STOP TOO MANY ELEMENT INFLOWS'
+ STOP 'ERROR STOP TOO MANY ELEMENT INFLOWS'
+ ENDIF
+ NHYE(NQHYD)=0
+!IPK sep07
+ if(ifree .eq. 0) then
+ READ(DLIN,'(3I8,2F16.2)',ERR=801) NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD),XYCEL(NQHYD,1),XYCEL(NQHYD,2)
+ GO TO 811
+801 READ(DLIN,'(3I8)') NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD)
+811 CONTINUE
+ else
+ READ(DLIN,*) NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD)
+ endif
+ IF(NCLINE(NQHYD) .EQ. 0) NCLINE(NQHYD)=-9999
+!
+ IYD=IYDATE(NQHYD)
+!IPK may11 set IYDOLD
+ IYDOLD=IYD
+ DO 120 I=1,NEDPTS+1
+ READ(IQEUNIT,'(A8,A72)') ID,DLIN
+!IPK sep07 ADD QN
+ IF(ID(1:3) .EQ. 'TI ') GO TO 98
+ IF(ID(1:3) .EQ. 'QEI' .OR. ID(1:3) .EQ. 'QT ') THEN
+! NHYE(NQHYD)=NHYE(NQHYD)+1
+!IPK jan96 add day of year to logic
+! DYE(NHYE(NQHYD),NQHYD)=1.E+6
+! TAE(NHYE(NQHYD),NQHYD)=1.E+8
+! HAE(NHYE(NQHYD),NQHYD)=HAE(NHYE(NQHYD)-1,NQHYD)
+ GO TO 101
+ ELSEIF(ID(1:2) .EQ. 'QE' .OR. ID(1:2) .EQ. 'QN' .OR. ID(1:2) .EQ. 'QD' .or. ID(1:2) .EQ. 'QM') THEN
+!IPK jan96 add day of year to logic
+!IPK sep07 CHECK FOR COMMA'S
+ IFREE=0
+ DO K=1,8
+ IF(ID(K:K) .NE. ',') THEN
+ IFREE=0
+ ELSE
+ KFIRST=K+1
+ IFREE=1
+ GO TO 105
+ ENDIF
+ ENDDO
+ 105 IF(IFREE .EQ. 1) THEN
+ DLIN=ID(KFIRST:8)//DLIN(1:71+KFIRST)
+ ENDIF
+!IPK sep07 ALLOW FOR QN
+ IF(ID(1:2) .EQ. 'QE' .OR. ID(1:2) .EQ. 'QD') THEN
+ IF(IFREE .EQ. 0) THEN
+ READ(ID(5:8),'(F4.0)') DYE(I,NQHYD)
+ IF(IRMATYP .EQ. 2) READ(DLIN,'(2F8.0)') TAE(I,NQHYD),HAE(I,NQHYD)
+ IF(IRMATYP .EQ. 10) READ(DLIN,'(F8.0,I8,4F8.0)') TAE(I,NQHYD),ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3)
+ IF(IRMATYP .EQ. 11) READ(DLIN,'(F8.0,4F8.0)') TAE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP)
+ else
+ IF(IRMATYP .EQ. 2) READ(DLIN,*) TAE(I,NQHYD),HAE(I,NQHYD)
+ IF(IRMATYP .EQ. 10) READ(DLIN,*) DYE(I,NQHYD),TAE(I,NQHYD),ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3)
+ IF(IRMATYP .EQ. 11) READ(DLIN,*) TAE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP)
+ endif
+!IPK SEP07 ADD DATE INPUT
+ ELSE
+!IPK oct15 add decodat option
+ IF(IFREE .EQ. 1) THEN
+ READ(DLIN,'(A10)') DATE
+ READ(DLIN(12:80),*) TAE(I,NQHYD),HAE(I,NQHYD)
+ READ(DATE,'(I2,1X,I2,1X,I4)') IDAYY,IMTHH,IYYR
+ DYE(I,NQHYD)=IDAYY+JCNV(IMTHH)
+ IF(MOD(IYYR,4) .EQ. 0 .AND. IYYR .NE. 2000) THEN
+ IF(IMTHH .GT. 2) DYE(I,NQHYD)=DYE(I,NQHYD)+1
+ ENDIF
+ ELSE
+ CALL DECODDAT(DLIN,DYE(I,NQHYD),TAE(I,NQHYD))
+ IF(IRMATYP .EQ. 2) READ(DLIN(17:24),'(F8.0)') HAE(I,NQHYD)
+ IF(IRMATYP .EQ. 10) READ(DLIN(17:64),'(I8,4F8.0)') ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3)
+ IF(IRMATYP .EQ. 11) READ(DLIN(17:64),'(4F8.0)') HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP)
+ ENDIF
+!IPK oct15 end decodat update
+ ENDIF
+ IF(DAYOFY .LT. 0) THEN
+ DAYOFY=DYE(I,NQHYD)
+ TSTARTS=(DAYOFY-1)*24.
+ IYRR=IYD
+ ENDIF
+ NHYE(NQHYD)=NHYE(NQHYD)+1
+! IF(I .EQ. 1) THEN
+!
+! reduce input time to time since that set to start simulation
+!
+ 110 CONTINUE
+! IF(MOD(IYD,4) .EQ. 0) THEN
+! ILP=1
+! ELSE
+! ILP=0
+! ENDIF
+! IF(IYD .EQ. IYRR) THEN
+!
+! If now for for the same year
+!
+ TCUR1=(DYE(I,NQHYD)-1.)*24.+TAE(I,NQHYD)
+!
+! set time as the difference
+!
+ TAE(I,NQHYD)=TCUR1
+! WRITE(75,*) I,TAE(I,NQHYD),HAE(I,NQHYD)
+! ELSEIF(IYD .LT. IYRR) THEN
+! IF(MOD(IYD,4) .EQ. 0) THEN
+! TPRVH=TPRVH+366.*24.
+! ELSE
+! TPRVH=TPRVH+365.*24.
+! ENDIF
+! IYD=IYD+1
+! GO TO 110
+! ELSE
+!IPK SEP04
+! CLOSE(75)
+! OPEN(75,file='ERROR.OUT')
+!IPK SEP00
+! WRITE(*,*) ' Element inflows for wrong year'
+! WRITE(*,*) ' Execution stopped'
+! WRITE(75,*) ' Element inflows for wrong year'
+! WRITE(75,*) ' Excution stopped'
+! STOP
+! ENDIF
+! ELSE
+!IPK may11 reset IYD
+! IYD=IYDOLD
+! IF(DYE(I,NQHYD) .LT. DYE(I-1,NQHYD)) THEN
+! TCUR1=TCUR1-365.*24.
+!IPK MAY11 IF(ILP .EQ. 1) TCUR1=TCUR1-24.
+!IPK MAY11 IYD=IYD+1
+! IF(MOD(IYD,4) .EQ. 0) THEN
+! ILP=1
+! ELSE
+! ILP=0
+! ENDIF
+!IPK may11
+! IYDOLD=IYDOLD+1
+! IF(ILP .EQ. 1) TCUR1=TCUR1-24.
+! ENDIF
+! TCUR=(DYE(I,NQHYD)-1.)*24.+TAE(I,NQHYD)
+! TAE(I,NQHYD)=TAE(I-1,NQHYD)+TCUR-TCUR1
+! TCUR1=TCUR
+! WRITE(75,*) I,TAE(I,NQHYD),HAE(I,NQHYD)
+! ENDIF
+ ELSE
+! NHYE(NQHYD)=NHYE(NQHYD)+1
+!IPK jan96 add day of year to logic
+! DYE(NHYE(NQHYD),NQHYD)=1.E+6
+! TAE(NHYE(NQHYD),NQHYD)=1.E+8
+! HAE(NHYE(NQHYD),NQHYD)=HAE(NHYE(NQHYD)-1,NQHYD)
+! IF(IRMATYP .EQ. 10) THEN
+! DO K=1,3
+! HDE(NHYE(NQHYD),NQHYD,K)=HDE(NHYE(NQHYD)-1,NQHYD,K)
+! ENDDO
+! ENDIF
+ GO TO 199
+ ENDIF
+ 120 CONTINUE
+!IPK SEP04
+ CLOSE(75)
+ OPEN(75,file='ERROR.OUT')
+!IPK SEP00
+ WRITE(*,*) 'Execution terminated more lines than allowed in element graph'
+ WRITE(75,*)'Execution terminated more lines than allowed in element graph'
+ stop
+ ENDIF
+ 199 continue
+ ENDIF
+200 CONTINUE
+ CLOSE(IQEUNIT)
+ IQEUNIT=0
+
+ DO I=1,NQHYD
+ IF(XYCEL(I,1) .EQ. 0. .AND. XYCEL(I,2) .EQ. 0) THEN
+ JJ=NCLINE(I)
+ CALL GETXCL(JJ,XYCEL(I,1),XYCEL(I,2))
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+!IPK NOV14 ADD LEAP YEAR ROUTINE
+
+ SUBROUTINE HRYRT(IYRKP,HRYR)
+
+ IF(MOD(IYRKP,4) .EQ. 0) THEN
+ ILP=1
+ HRYR=366.*24.
+ ELSE
+ ILP=0
+ HRYR=365.*24.
+ ENDIF
+ RETURN
+ END
+
+!IPK NEW WITH VERSION 9.0H OCT 25 2015
+
+! DECODE JULIAN DAY FROM DAY/MONTH/YEAR DATA
+
+ SUBROUTINE DECODDAT(DATAIN,DAYJUL,TIME)
+ CHARACTER*72 DATAIN
+ REAL DAYJUL,TIME
+ INTEGER IMTS(12,2),IDAY,IMO,IYR,HR,MIN
+ DATA IMTS/0,31,59,90,120,151,181,212,243,273,304,334,0,31,60,91,121,152,182,213,244,274,305,335/
+!
+! LOOP THROUGH COLUMNS ADDING A COMMA
+ IDBLNK=0
+ DO I=1,16
+ IF(DATAIN(I:I) .EQ. ':') THEN
+ IHSW=0
+ DATAIN(I:I)=','
+ ELSEIF(DATAIN(I:I) .EQ. '.') THEN
+ IHSW=1
+ ENDIF
+ IF(DATAIN(I:I) .EQ. '/') DATAIN(I:I)=','
+ IF(I .GT. 8 .AND. DATAIN(I:I) .EQ. ' ') THEN
+ IF(IDBLNK .EQ. 0) THEN
+ DATAIN(I:I)=','
+ IDBLNK=1
+ IHSW=1
+ ELSE
+ DATAIN(I:I)='0'
+ ENDIF
+ ENDIF
+ ENDDO
+! write(155,*) ihsw,datain(1:16)
+ IF(IHSW .EQ. 0) THEN
+ READ(DATAIN(1:16),*) IDAY,IMO,IYR,HR,MIN
+ TIME=HR+MIN/60.
+ ELSE
+ READ(DATAIN(1:16),*) IDAY,IMO,IYR,TIME
+! write(155,*) IDAY,IMO,IYR,TIME
+ ENDIF
+ IF(MOD(IYR,4) .EQ. 0) THEN
+ DAYJUL=IMTS(IMO,2)+IDAY
+ ELSE
+ DAYJUL=IMTS(IMO,1)+IDAY
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE ALLOCFL(MAXPT,MAXTYP,IUNIT,ITYP)
+
+ USE BLKELTLD
+
+ CHARACTER*8 ID
+ NELDS=200
+ MAXPT=0
+!IPK JUN09 RESTORE MAXTYP1
+ MAXTYP1=0
+ NQLM=0
+ 200 CONTINUE
+
+ READ(IUNIT,'(A8)', END=500) ID
+!IPK JUN09 ADD TO IF OPTIONS
+ IF(ID(1:2) .EQ. 'TT' .OR. ID(1:2) .EQ. 'TH' .OR. ID(1:2) .EQ. 'TE' .OR. ID(1:2) .EQ. 'TI' &
+ & .OR. ID(1:3) .eq. 'CLQ' .OR. ID(1:3) .eq. 'CLH' &
+ & .OR. ID(1:3) .eq. 'QEI' .OR. ID(1:3) .eq. 'QT ' &
+ & .OR. ID(1:3) .EQ. 'TIT' .OR. ID(1:3) .EQ. 'CTL') THEN
+!IPK SEP14 ADD TYPE 4 (STAGE FLOW) OPTION
+!IPK JUN09 RESTORE MAXTYP1
+ MAXTYP1=MAXTYP1+1
+! MAXTYP1=MAXTYP1+1
+!IPK JUN09 IF(NQLM .GT. MAXQPT) MAXPT=NQLM
+ IF(NQLM .GE. MAXPT) MAXPT=NQLM+1
+ NQLM=0
+ GO TO 200
+ ELSEIF(ID(1:6) .EQ. 'ENDDAT') THEN
+!IPK JUN09 ADD TO NQLM
+
+ IF(NQLM .GT. MAXPT) MAXPT=NQLM+1
+ GO TO 500
+ ELSE
+ NQLM=NQLM+1
+ GO TO 200
+ ENDIF
+
+500 CONTINUE
+!IPK JUN09
+ write(90,*) maxtyp,maxtyp1,maxpt,nelds
+ IF(MAXTYP1 .GT. MAXTYP) MAXTYP=MAXTYP1
+
+ ALLOCATE (TAE(MAXPT,MAXTYP),HAE(MAXPT,MAXTYP),DYE(MAXPT,MAXTYP),HDE(MAXPT,MAXTYP,3),ILAYRE(MAXPT,MAXTYP))
+ ALLOCATE (NCLINE(NELDS),NHYE(NELDS),IYDATE(NELDS),NEST(NELDS),XYCEL(NELDS,2))
+ TAE=0.
+ HAE=0.
+ HDE=0.
+ DYE=0.
+ XYCEL=0.
+ ILAYRE=0
+ REWIND IUNIT
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/GETNEWFIL.F90 b/src/src83e/GETNEWFIL.F90
new file mode 100644
index 0000000..f94d4af
--- /dev/null
+++ b/src/src83e/GETNEWFIL.F90
@@ -0,0 +1,779 @@
+ SUBROUTINE GETNEWFIL(IIN,IGFG,ITRIAN,ISWT)
+
+ INCLUDE 'BFILES.I90'
+
+! WRITE CURRENT DATA TO A SCRATCH FILE
+
+ IF(IACTVFIL .GT. 0 .AND. ISWT .NE. -1) THEN
+ IFILOUT=IACTVFIL+50
+ WRITE(90,*) 'INGETNEWFIL IFILOUT',IFILOUT
+ CALL WRTFIL(IFILOUT)
+ CALL ZEROOUT
+ IACTVFIL=ITOTFIL
+ ELSEIF(IACTVFIL .EQ. 0) THEN
+ IACTVFIL=1
+ ENDIF
+ IF(ISWT .EQ. 1) THEN
+ ITOTFIL=ITOTFIL+1
+ FNAMKEP='TEST.1.ELE'
+ IACTVFIL=ITOTFIL
+ FNAMEOUT(IACTVFIL)='TEST.1.ELE'
+ WRITE(90,*) 'ITOTFIL,IACTVFIL',ITOTFIL,IACTVFIL
+ WRITE(90,'(A80)') (FNAMEOUT(KKK),KKK=1,3)
+ ELSE
+ FNAMKEP='TEST.1.ELE'
+ ENDIF
+ IF(ABS(ITRIAN) .EQ. 1) THEN
+ CALL READGFG(IIN,ITRIAN)
+
+! TEST FOR GFG FORMAT
+ ELSEIF(IGFG .EQ. 1) THEN
+ CALL READGFG(IIN,0)
+
+! TEST FOR rm1 FORMAT
+
+ ELSEIF(IIN .EQ. 10) THEN
+ CALL READRM1(IIN)
+
+! TEST FOR rm1 FORMAT
+
+!ipk feb08 replace iin of 11 with 12
+ ELSEIF(IIN .EQ. 12 .and. IGFG .EQ. 0) THEN
+ CALL READGEO(IIN)
+
+ ELSEIF(IIN .EQ. 12 .and. IGFG .EQ. 2) THEN
+ CALL RDBIN(IIN)
+
+ ENDIF
+ IF(ITRIAN .EQ. -1) RETURN
+
+ IFILOUT=IACTVFIL+50
+ WRITE(90,*) 'IFILOUT', IFILOUT
+ CALL WRTFIL(IFILOUT)
+ IACTVFIL=1
+ CALL LOADFIL
+
+
+ CALL RESCAL
+ CALL HEDR
+
+
+ RETURN
+ END
+
+! Write data to a file
+ SUBROUTINE WRTFIL(IFILOUT)
+
+ USE BLK1MOD
+ CHARACTER*80 ALINE
+ CHARACTER*10 FMT
+! INCLUDE 'BLK1.COM'
+
+ CLOSE (IFILOUT)
+ FMT(1:8)='TEMPFIL.'
+ WRITE(FMT(9:10),'(I2)') IFILOUT
+! OPEN(IFILOUT,STATUS='scratch',FORM='binary')
+ WRITE(90,*) 'IFILOUT',IFILOUT
+! OPEN(IFILOUT,STATUS='scratch',FORM='unformatted')
+ OPEN(IFILOUT,FILE=FMT,STATUS='UNKNOWN',FORM='BINARY')
+
+ ISLP=0
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0.
+ WRITE(90,*) 'IN WRTFIL', IFILOUT,NP,NE,IPRT
+ WRITE(IFILOUT) TITLE,NP,NE
+ WRITE(IFILOUT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ WRITE(90,*) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ WRITE(IFILOUT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ WRITE(90,*) 'IPP',IPP
+ IF(IPP .GT. 0) WRITE(IFILOUT) ALINE
+
+ WRITE(IFILOUT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE)
+ WRITE(IFILOUT) &
+ (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
+ & WIDBS(J),SSO(J),BS1(J),J=1,NP)
+
+ WRITE(IFILOUT) NLST
+ IF(NLST .GT. 0) THEN
+ WRITE(IFILOUT) (LLIST(J),J=1,NLST), &
+ & ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)
+ ENDIF
+
+ WRITE(IFILOUT) NENTRY,NLAYD,NCLM
+
+ IF(NENTRY .GT. 0) THEN
+ WRITE(IFILOUT) ((NEF(I,J),J=1,3),I=1,NENTRY)
+ ENDIF
+
+ IF(NLAYD .GT. 0) THEN
+ WRITE(IFILOUT) (LAY(I),I=1,NP)
+ ENDIF
+
+ IF(NCLM .GT. 0) THEN
+ WRITE(IFILOUT) ((ICCLN(I,J),J=1,350),I=1,NCLM)
+ ENDIF
+ REWIND IFILOUT
+ RETURN
+ END
+
+ SUBROUTINE READRM1(IIIN)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*48 DLIN
+
+ IIN=IIIN
+! Read in header lines
+
+ ISET=1
+ WRITE(90,*) 'GOING TO HEADIN'
+ CALL HEADIN(IIN,ISET)
+
+! Read in existing elements
+ WRITE(90,*) 'GOING TO RDELEM'
+ CALL RDELEM(IIN)
+
+! Read in nodal coordinates
+
+ WRITE(90,*) 'GOING TO RDCORD'
+ CALL RDCORD(IIN)
+
+! Close input file
+
+ CLOSE(IIN)
+
+! Scale for plotting
+
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ IF (CORD(J,1) .GT. VDX) THEN
+ XMIN=MIN(XMIN,CORD(J,1))
+ XMAX=MAX(XMAX,CORD(J,1))
+ YMIN=MIN(YMIN,CORD(J,2))
+ YMAX=MAX(YMAX,CORD(J,2))
+ ENDIF
+ ENDDO
+ ENDIF
+
+ RETURN
+ END
+
+! Read GEO file
+ SUBROUTINE READGEO(IIIN)
+ USE BLK1MOD
+ CHARACTER*1000 HEADER
+ CHARACTER*8 ID8
+ CHARACTER*32 IJNK
+ CHARACTER*80 ALINE,DLIN
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+
+ INTEGER*2 NOP2(MAXE,8)
+
+
+ IIN=IIIN
+ read(iin,err=100) header
+ if(header(1:6) .eq. 'RMAGEN') then
+ inopt=2
+ else
+ inopt=1
+ rewind iin
+ endif
+ read(iin) n1,m1
+ rewind iin
+ write(90,*) 'Apparent nodes and elements from file are'
+ write(90,'(i15,i10)') n1,m1
+ if(n1 .gt. maxp .or. m1 .gt. maxe) then
+!
+!...... Perhaps the file format is wrong, close and reopen
+!
+ WRITE(DLIN,'(A32)') 'Parameter limits may be violated'
+ call symbl(0.5,4.5,0.20,dlin,0.0,32)
+ WRITE(DLIN,'(A35)') 'Retrying with alternate file format'
+ call symbl(0.5,4.2,0.20,dlin,0.0,35)
+ close (iin)
+ open(iin ,file=fnamkep,status='old',form='unformatted')
+ read(iin) n1,m1
+ write(90,*) 'Revised nodes and elements from file are'
+ write(90,'(i15,i10)') n1,m1
+ if(n1 .gt. maxp .or. m1 .gt. maxe) then
+ WRITE(DLIN,'(A31)') 'Parameter limits still violated'
+ call symbl(0.5,3.9,0.20,dlin,0.0,31)
+ WRITE(DLIN,'(A27)') 'Apparent nodes and elts are'
+ call symbl(0.5,3.6,0.20,dlin,0.0,27)
+ WRITE(DLIN,'(2i10)') n1,m1
+ call symbl(0.5,3.3,0.20,dlin,0.0,20)
+ WRITE(DLIN,'(A24)') 'Press enter to terminate'
+ call symbl(0.5,4.5,0.20,dlin,0.0,24)
+ CALL GTCHARX(ijnk,ndig,5.0,4.0)
+!cipk aug00 read(*,'(i1)') junk
+ call quit_pgm
+ endif
+ endif
+ rewind iin
+!
+!
+ if(inopt .eq. 2) then
+ read(iin,err=100) header
+ READ(IIN,ERR=100) &
+ & N1,M1,((CORD(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP(J,K),K=1,8),IMAT(J),THTA(J),I3,J=1,M1) &
+ & , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
+ DO J=1,N1
+ XUSR(J)=CORD(J,1)
+ YUSR(J)=CORD(J,2)
+ ENDDO
+!
+ else
+ READ(IIN,ERR=100) &
+ & N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1) &
+ & , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
+ DO J=1,N1
+ DO K=1,2
+ CORD(J,K)=CORDSN(J,K)
+ ENDDO
+ XUSR(J)=CORD(J,1)
+ YUSR(J)=CORD(J,2)
+ ENDDO
+ DO J=1,M1
+!ipk feb08
+ ncorn(j)=0
+ DO K=1,8
+ NOP(J,K)=NOP2(J,K)
+!ipk feb08
+ if(nop(j,k) .gt. 0) ncorn(j)=k
+ ENDDO
+ ENDDO
+ endif
+ read(IIN,err=120,end=120) id8
+ if(id8(1:6) .eq. 'part-2') then
+ read(IIN,err=104) (widbs(j),sso(j),j=1,n1)
+ read(IIN,err=120,end=120) id8
+ endif
+
+! Add part 3 write for continuity lines
+ if(id8(1:6) .eq. 'part-3') then
+
+!ipk aug02 IF(NCLM .GT. 0) THEN
+ READ(IIN,ERR=104) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
+!ipk aug02 ENDIF
+ read(IIN,err=120,end=120) id8
+ endif
+!IPK DEB02 Add part 4 write for lock and BS1 lines and reordering
+ if(id8(1:6) .eq. 'part-4') then
+ read(iin,err=104,end=120) (lock(j),bs1(j),j=1,n1)
+ read(iin,err=104,end=120) &
+ nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
+ endif
+ DO J=1,M1
+!ipk feb08
+ ncorn(j)=0
+ DO K=1,8
+!ipk feb08
+ if(nop(j,k) .gt. 0) ncorn(j)=k
+ ENDDO
+ ENDDO
+
+ GO TO 120
+
+ 100 READ(IIN,ERR=104) &
+ & N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1)
+ DO J=1,N1
+ DO K=1,2
+ CORD(J,K)=CORDSN(J,K)
+ ENDDO
+ XUSR(J)=CORD(J,1)
+ YUSR(J)=CORD(J,2)
+ ENDDO
+ DO J=1,M1
+!ipk feb08
+ ncorn(j)=0
+ DO K=1,8
+ NOP(J,K)=NOP2(J,K)
+!ipk feb08
+ if(nop(j,k) .gt. 0) ncorn(j)=k
+ ENDDO
+ ENDDO
+ GO TO 120
+
+ 104 WRITE(90,*) 'Error reading binary geometry file'
+!ipk jan98 CALL SETD(23)
+ call clscrn()
+ WRITE(aline,*) 'Error reading binary geometry file'
+ call symbl &
+ & (1.1,3.3,0.20,aline,0.0,80)
+ WRITE(aline,*) 'Press enter to exit'
+ call symbl &
+ & (1.1,3.0,0.20,aline,0.0,80)
+ ndig=1
+ CALL GTCHARX(IJNK,NDIG,5.0,7.6)
+ CALL Quit_Pgm
+ STOP
+
+ 120 CONTINUE
+ NP=N1
+ NE=M1
+
+! Close input file
+
+ CLOSE(IIN)
+
+! Scale for plotting
+
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ IF (CORD(J,1) .GT. VDX) THEN
+ XMIN=MIN(XMIN,CORD(J,1))
+ XMAX=MAX(XMAX,CORD(J,1))
+ YMIN=MIN(YMIN,CORD(J,2))
+ YMAX=MAX(YMAX,CORD(J,2))
+ ENDIF
+ ENDDO
+ ENDIF
+ RETURN
+
+ END
+
+ SUBROUTINE READGFG(IUNIT,ISW)
+
+ USE BLK1MOD
+ INCLUDE "BFILES.I90"
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+ CHARACTER*1 ANS
+ CHARACTER*32 ANS32
+ CHARACTER*3 ID
+ CHARACTER*77 DLIN
+ CHARACTER*150 DLIN1
+ CHARACTER*80 LIND
+ DIMENSION NTMP(9),NTEMPLIN(200,10),ATT(9)
+
+ REAL*8 CX,CY,VALS(7)
+
+ MEL=MAXE
+ ylv=7.5
+ IIN=IUNIT
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0.
+ KLIN=0
+ IF(ABS(ISW) .EQ. 1) GO TO 500
+ DO I=1,10000
+ READ(IIN,'(A3,A77)') ID,DLIN
+ IF(ID .EQ. 'T1 ') THEN
+ TITLE(1:77)=DLIN
+ GO TO 10
+ ENDIF
+ ENDDO
+ 10 CONTINUE
+ REWIND IIN
+
+! READ ELEMENT AND CCLINE DATA
+
+ 20 CONTINUE
+ DO ICOUNTC=1,200000
+ DO JJ=1,150
+ DLIN1(JJ:JJ)=' '
+ ENDDO
+ READ(IIN,'(A3,A150)', END=175) ID,DLIN1
+ IF(ID .EQ. 'GE ' .or. ID .EQ. 'GO') THEN
+! Count the number of variables
+ I=0
+ ICOUNT=0
+ 25 CONTINUE
+ IF(DLIN1(I+1:I+1) .NE. ' ') THEN
+ GO TO 30
+ ELSE
+ I=I+1
+ GO TO 25
+ ENDIF
+ 30 I=I+1
+ IF(I .EQ. 151) THEN
+ ICOUNT =ICOUNT+1
+ GO TO 40
+ ENDIF
+ IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
+ ICOUNT=ICOUNT+1
+ 35 CONTINUE
+ IF(I+1 .EQ. 151) GO TO 40
+ IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
+ I=I+1
+ GO TO 35
+ ELSE
+ GO TO 30
+ ENDIF
+ ELSE
+ GO TO 30
+ ENDIF
+ ENDIF
+ ENDDO
+ 40 CONTINUE
+ IF(ID .EQ. 'GO') THEN
+ KLIN=KLIN+1
+ READ(DLIN1,*) (NTEMPLIN(KLIN,K),K=1,ICOUNT)
+ GO TO 20
+ ENDIF
+ IF(ICOUNT .GT. 10) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,9),THT
+ ELSE
+ READ(DLIN1,*) J, (NTMP(K),K=1,9)
+ ENDIF
+
+
+ IF (J .GE. MEL) THEN
+ CALL SETD(23)
+!cipk aug00
+ WRITE(lind,*) ' Element number exceeds MAXE in RDELEM'
+ call symbl (1.1,ylv-0.3,0.20,lind,0.0,80)
+ ndig=1
+ WRITE(90,*) ' Element number exceeds MAXE in RDELEM'
+ WRITE(lind,6000)
+ CALL GTCHARX(ANS32,IJNK,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+ ENDIF
+!
+! Check to ensure there are no duplicate numbers in input stream
+! of element connections
+!
+ DO K=1,7
+ IF(NTMP(K) .NE. 0) THEN
+ DO L=K+1,8
+ IF(NTMP(K) .EQ. NTMP(L)) THEN
+ CALL SETD(23)
+ DO KK=1,8
+ NOP(J,KK) = NTMP(KK)
+ ENDDO
+ IMAT(J)=NTMP(9)
+ call eltdisp(j)
+ DO KK=1,8
+ NTMP(KK) = NOP(J,KK)
+ ENDDO
+ NTMP(9)=IMAT(J)
+ GO TO 45
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ 45 CONTINUE
+ DO K=1,8
+ NOP(J,K) = NTMP(K)
+ ND = NTMP(K)
+ IF (ND .GT. 0) THEN
+ INEW(ND) = 2
+ NP = MAX(NP,ND)
+ ENDIF
+ ENDDO
+!
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ NCORN(J) = NCN
+ IESKP(J) = 0
+ IMAT(J) = NTMP(9)
+ THTA(J)=THT
+ IEM(J) = J
+ DO 50 K=2,NCN,2
+ ND = NTMP(K)
+ IF (ND .GT. 0) THEN
+ IF(NCN .EQ. 5 .AND. K .EQ. 4) GO TO 50
+ WD(ND)=0.
+ ENDIF
+ 50 CONTINUE
+ NE = MAX(J,NE)
+!
+ GOTO 20
+!
+ 175 CONTINUE
+
+ REWIND IIN
+ 70 CONTINUE
+ DO ICOUNTC=1,100000
+ DO JJ=1,150
+ DLIN1(JJ:JJ)=' '
+ ENDDO
+ READ(IIN,'(A3,A150)', END=400) ID,DLIN1
+ IF(ID .EQ. 'GNN' .OR. ID .EQ. 'GWN') THEN
+! Count the number of variables
+ I=0
+ ICOUNT=0
+ 75 CONTINUE
+ IF(DLIN1(I+1:I+1) .NE. ' ') THEN
+ GO TO 80
+ ELSE
+ I=I+1
+ GO TO 75
+ ENDIF
+ 80 I=I+1
+ IF(I .EQ. 151) THEN
+ ICOUNT =ICOUNT+1
+ GO TO 90
+ ENDIF
+ IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
+ ICOUNT=ICOUNT+1
+ 85 CONTINUE
+ IF(I+1 .EQ. 151) GO TO 90
+ IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
+ I=I+1
+ GO TO 85
+ ELSE
+ GO TO 80
+ ENDIF
+ ELSE
+ GO TO 80
+ ENDIF
+ ENDIF
+ ENDDO
+ 90 CONTINUE
+ DO K=1,7
+ VALS(K)=0.
+ ENDDO
+ READ(DLIN1,*) J,(VALS(K),K=1,ICOUNT-1)
+ IF(ID .EQ. 'GNN') THEN
+ CX=VALS(1)
+ CY=VALS(2)
+ BELEV=VALS(3)
+ NP = MAX(NP,J)
+ CORD(J,1) = CX
+ CORD(J,2) = CY
+ XUSR(J) = CX
+ YUSR(J) = CY
+ WD(J) = BELEV
+ INSKP(J)=0
+ INEW(J) = 1
+ GO TO 70
+ ELSE
+ WDTHX=VALS(1)
+ SS1X=VALS(2)
+ SS2X=VALS(3)
+ WDSX=VALS(4)
+ WIDTH(J)=WDTHX
+ SS1(J)=SS1X
+ SS2(J)=SS2X
+ WIDS(J)=WDSX
+ GO TO 70
+ ENDIF
+
+ 400 CONTINUE
+
+! CHECKOUT THE CCLINE DATA
+
+ KK=0
+ IF(KLIN .GT. 0) THEN
+ NCLM=1
+ IF(NTEMPLIN(1,1) .EQ. 1) THEN
+ DO K=1,KLIN
+ DO J=1,10
+ IF(K .EQ. 1 .AND. J .EQ. 1) GO TO 410
+ IF(NTEMPLIN(K,J) .LT. 0) THEN
+ NCLM=NCLM+1
+ KK=0
+ GO TO 420
+ ELSEIF(NTEMPLIN(K,J) .EQ. 0) THEN
+ GO TO 420
+ ELSE
+ KK=KK+1
+ ICCLN(NCLM,KK)=NTEMPLIN(K,J)
+ ENDIF
+ 410 CONTINUE
+ ENDDO
+ 420 CONTINUE
+ ENDDO
+ NCLM=NCLM-1
+ ENDIF
+ ENDIF
+ RETURN
+
+500 CONTINUE
+ IF(ISW .EQ. -1) THEN
+ NESV=NE
+ NPSV=NP
+ ENDIF
+ READ(IUNIT,*) NE,NCNTR,NATTR
+ IMIDS=0
+ DO JJ=1,NE
+ READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
+ IF(ISW .EQ. -1) J=J+NESV
+ IF (J .GE. MEL) THEN
+ CALL SETD(23)
+ WRITE(lind,*) ' Element number exceeds MAXE in RDELEM'
+ call symbl &
+ & (1.1,ylv-0.3,0.20,lind,0.0,80)
+ ndig=1
+ WRITE(90,*) ' Element number exceeds MAXE in RDELEM'
+ WRITE(lind,6000)
+ CALL GTCHARX(ANS32,IJNK,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+ ENDIF
+ DO KK=1,3
+ IF(ISW .EQ. -1) THEN
+ NOP(J,2*KK-1) = NTMP(KK)+NPSV
+ ELSE
+ NOP(J,2*KK-1) = NTMP(KK)
+ ENDIF
+ NOP(J,2*KK)=0
+ ENDDO
+ IF(NATTR .GT. 0) THEN
+ IMAT(J)=ATT(1)
+ ELSE
+ IMAT(J)=1
+ ENDIF
+ NCORN(J)=6
+ IESKP(J)=0
+ ENDDO
+ NE=J
+ CLOSE(IUNIT)
+ DO L=255,1,-1
+ IF(FNAMKEP(L:L) .EQ. '.') THEN
+ FNAMKEP(L+1:L+4)='node'
+ OPEN(IUNIT,FILE=FNAMKEP,STATUS='OLD',ACTION='READ')
+ GO TO 510
+ ENDIF
+ ENDDO
+510 CONTINUE
+
+ READ(IUNIT,*) NPPP,NDUM,NATTR
+ DO KK=1,NPPP
+ READ(IUNIT,*) J,CX,CY,(VALS(K),K=1,NATTR)
+ IF(ISW .EQ. -1) J=J+NPSV
+ IF(J .EQ. 0) THEN
+ J=NPPP
+ JZ=1
+ ENDIF
+ BELEV=-9999.
+ WEL=0.
+ LOCK1=0
+ IF(NATTR .GT. 0) BELEV=VALS(1)
+ IF (J .GE. MAXP) THEN
+ call clscrn()
+ WRITE(dlin,*) ' Node number exceeds MAXP in RDCORD',j
+ call symbl &
+ & (1.1,3.3,0.20,dlin,0.0,80)
+ WRITE(90,*) ' Node number exceeds MAXP in RDCORD'
+ WRITE(DLIN,*) ' Press enter to exit'
+ call symbl &
+ & (1.1,3.0,0.20,dlin,0.0,80)
+ ndig=1
+ CALL GTCHARX(ANS32,ndig,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+ ENDIF
+ NP = MAX(NP,J)
+ XUSR(J) = CX
+ YUSR(J) = CY
+ CORD(J,1) = (XUSR(J)+XS)/TXSCAL
+ CORD(J,2) = (YUSR(J)+YS)/TXSCAL
+ WD(J) = BELEV
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ WIDBS(J)=0.
+ SSO(J)=0.
+ INSKP(J)=0
+ INEW(J) = 1
+ LOCK(J)=LOCK1
+ BS1(J)=0.
+ ENDDO
+
+ CLOSE(IUNIT)
+ 6000 FORMAT(' Press enter to exit')
+ END
+
+
+ SUBROUTINE ZEROOUT
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ MNP = MAXP
+ MEL = MAXE
+ DO I=1,MEL
+ DO M=1,8
+ NOP(I,M)=0
+ ENDDO
+ IESKP(I)=-1
+ IEM(I) = 0
+ IMAT(I) = 0
+ THTA(I)=0.
+ XC(I) = -1.E20
+ YC(I) = -1.E20
+ ENDDO
+ DO I=1,MNP
+ XUSR(I) = -1.D20
+ YUSR(I) = -1.D20
+ CORD(I,1) = -1.D20
+ CORD(I,2) = -1.D20
+ WD(I) = -9999.
+ LAY(I) = -9999
+ WIDTH(I) = 0.0
+ SS1(I) = 0.0
+ SS2(I) = 0.0
+ WIDS(I) = 0.0
+ WIDBS(I)=0.
+ SSO(I)=0.
+ INSKP(I) = 1
+ INEW(I) = 0
+!ipk mar02
+ lock(i)=0
+ bs1(I)=0.
+ ENDDO
+ NP=0
+ NE=0
+ RETURN
+ END
+
diff --git a/src/src83e/GETPGRP.F90 b/src/src83e/GETPGRP.F90
new file mode 100644
index 0000000..bda8585
--- /dev/null
+++ b/src/src83e/GETPGRP.F90
@@ -0,0 +1,109 @@
+ SUBROUTINE GETGRP
+
+ USE BLK1MOD
+
+ CHARACTER*8 IDSAV,ID
+ CHARACTER*72 DLINSAV,DLIN
+
+ IDSAV=ID
+ DLINSAV=DLIN
+
+! ALLOCATE ARRAY SIZES
+
+ IF(.NOT. ALLOCATED(IGRPNUM)) THEN
+ ALLOCATE (IGRPNUM(25,MAXE),MAXENT(25))
+ IGRPNUM=0
+ ENDIF
+!
+! NOW READ DATA TO FILE
+
+ CALL GINPT(IGRP,ID,DLIN)
+ IF(ID(1:3) .EQ. 'TIT') THEN
+
+! READ TITLE
+
+ READ(DLIN,'(A72)') HEDR
+ CALL GINPT(IGRP,ID,DLIN)
+ ENDIF
+ MAXIGRP=0
+
+ 301 READ(DLIN,'(I8)') IGRPA
+ CALL GINPT(IGRP,ID,DLIN)
+ NL=1
+ NH=9
+
+ 401 CONTINUE
+ IF(ID(1:3) .EQ. 'NGP') THEN
+ READ(DLIN,'(9I8)') (IGRPNUM(IGRPA,I),I=NL,NH)
+ CALL GINPT(IGRP,ID,DLIN)
+ IF(IGRPNUM(IGRPA,NH) .NE. 0) THEN
+ NL=NL+9
+ NH=NH+9
+ GO TO 401
+ ENDIF
+ ENDIF
+
+! SET MAXIMA FROM INPUT FILE
+
+ IF(MAXIGRP .LT. IGRPA) MAXIGRP=IGRPA
+ MAXENT(IGRPA)=NH
+
+ IF(ID(1:3) .EQ. 'GRP') GO TO 301
+ CALL TOSER
+ ID=IDSAV
+ DLIN=DLINSAV
+ CALL PLOTOT(1)
+ RETURN
+ END
+
+ SUBROUTINE WRTGP
+
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER(LEN=96) :: FNAME
+ LOGICAL :: OPENED
+
+ IGRPOUT=29
+ INQUIRE(29, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='TXT file -- *.txt|*.txt|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Group File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ OPEN(IGRPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ ELSE
+ RETURN
+ ENDIF
+ ENDIF
+ CALL TOPAR
+ REWIND IGRPOUT
+ WRITE(IGRPOUT,'(a)') 'TIT GROUP FILE'
+
+ DO K=1,25
+ IF(MAXENT(K) .GT. 0) THEN
+ WRITE(IGRPOUT,6001) K
+ LROWS=MAXENT(K)/9+1
+ LASTCOL=MOD(MAXENT(K),9)
+ IF(LASTCOL .EQ. 0) THEN
+ IF(IGRPNUM(K,MAXENT(K)) .EQ. 0) THEN
+ LROWS=LROWS-1
+ ENDIF
+ ENDIF
+ NL=-8
+ DO LL=1,LROWS
+ NL=NL+9
+ NH=NL+8
+ WRITE(IGRPOUT,6002) (IGRPNUM(K,L),L=NL,NH)
+ ENDDO
+ ENDIF
+ ENDDO
+ 6001 FORMAT('NGP ',I8)
+ 6002 FORMAT('GRP ',9I8)
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/GETSTRESSFIL.F90 b/src/src83e/GETSTRESSFIL.F90
new file mode 100644
index 0000000..57e2f70
--- /dev/null
+++ b/src/src83e/GETSTRESSFIL.F90
@@ -0,0 +1,175 @@
+ SUBROUTINE GETSTRESSFIL
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+
+ ALLOCATABLE WDTEMP(:)
+ CHARACTER*256 FILTER,FNAME
+ INTEGER IYRR,IMON,IDAY
+ REAL HOUR
+ LOGICAL OPENED
+ DATA IYRR/2015/,IMON/1/,IDAY/1/
+ DATA HOUR/0.0/
+
+ IF(.NOT. ALLOCATED(WDTEMP)) THEN
+
+ ALLOCATE (WDTEMP(NP))
+ ENDIF
+ DO N=1,NP
+ WDTEMP(N)=WD(N)
+ ENDDO
+
+100 CONTINUE
+
+ ISWT=-1
+
+ IWRTMP=0
+ IF(IMP .GT. 0) THEN
+! FIRST WRITE EXISTING MAP TO SCRATCH
+ OPEN(98,FORM='BINARY',STATUS='SCRATCH')
+
+ CALL WRTMAP(98)
+ REWIND 98
+ IWRTMP=1
+ ENDIF
+ CALL GMAP
+
+ CALL GRIDSB(ISWT)
+
+ INQUIRE(104, OPENED=OPENED)
+ IF(OPENED) GO TO 200
+ Filter='Output file -- *.dat|*.dat|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Stress File')
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ IOT=104
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+ ELSE
+ GO TO 500
+ ENDIF
+200 CONTINUE
+ CALL SETDT(IYRR,IMON,IDAY,HOUR)
+ WRITE(IOT,'(''DATE '',3I8,F8.3)') IYRR,IMON,IDAY,HOUR
+ DO J=1,NP
+ IF (INEW(J) .EQ. 1) THEN
+ WRITE(IOT,'(''WAVESS '',I8,F8.4)') J,WD(J)
+ ENDIF
+ ENDDO
+ WRITE(IOT,'(''ENDBLOCK'')')
+ FLUSH(IOT)
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to process another map file?'//&
+ CHAR(13)//' ','PROCESS ANOTHER?')
+!
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) THEN
+ WRITE(IOT,'(''ENDDATA'')')
+ FLUSH(IOT)
+ GO TO 500
+ ENDIF
+ GO TO 100
+!
+! Delete all unused nodes
+!
+ CALL DELETM(2)
+
+500 DO N=1,NP
+ WD(N)=WDTEMP(N)
+ ENDDO
+ DEALLOCATE (WDTEMP)
+ IF(IWRTMP .GT. 0) THEN
+
+ CALL RDMAP(2,98,0,0)
+ CLOSE (98)
+ ENDIF
+
+ RETURN
+ END
+
+ SUBROUTINE SETDT(N1,N2,N3,R1)
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+ real :: R1
+ character*3 :: sub
+
+ call wdialogload(IDD_SETYRDT)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,n1)
+ CALL WDialogPutInteger(idf_integer2,n2)
+ CALL WDialogPutInteger(idf_integer3,n3)
+ CALL WDialogPutReal(idf_real1,r1)
+
+ CALL WDialogSelect(IDD_setyrdt)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(idf_integer1,n1)
+ CALL WDialogGetInteger(idf_integer2,n2)
+ CALL WDialogGetInteger(idf_integer3,n3)
+ CALL WDialogGetReal(idf_real1,r1)
+ RETURN
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE GMAP
+ USE WINTERACTER
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB,SUB1
+ INTEGER IMP
+
+ CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ELSEIF(SUB .EQ. 'rm1') then
+ imp=13
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'shp') then
+ IMP=113
+ OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ SUB='DBF'
+ CALL ADDSUB(FNAME,SUB)
+ OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ ENDIF
+ ENDIF
+ CALL RDMAP(2,IMP,0,0)
+ CLOSE (IMP)
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/GETTRIANG.F90 b/src/src83e/GETTRIANG.F90
new file mode 100644
index 0000000..06f8e7a
--- /dev/null
+++ b/src/src83e/GETTRIANG.F90
@@ -0,0 +1,139 @@
+! Last change: IPK 2 Feb 2003 6:25 pm
+ SUBROUTINE DELAUNAY1(XMAP1,YMAP1,NVERT)
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*80 LIND
+ CHARACTER*1 ANS
+ REAL*8 XMAP1(*),YMAP1(*)
+ DATA VDX9/-9.E9/,NEDGE/0/
+
+! Get location of supertriangle
+
+ iprt=0
+ ngap=0
+
+
+
+ call supert(XMAP1,YMAP1,NVERT)
+
+ NELTS=1
+
+ NVERTM=NVERT-3
+
+! Sort points into ascending x order
+
+ CALL SORTDB(XMAP1,NKEY,NVERTM)
+
+! Loop on the vertices
+
+ YLV=7.5
+ DO NN=1,NVERT-3
+
+
+ if(mod(NN,2500) .eq. 0) then
+ ylv=ylv-0.3
+ if(ylv .lt. 0.1) then
+ ylv=7.9
+ call clscrn
+ endif
+ write(lind,6010) NN
+ 6010 format(i8,' points processed')
+ call symbl &
+ & (1.1,ylv,0.20,LIND,0.0,80)
+ endif
+
+! process next point
+
+ N=NKEY(NN)
+
+! Skip out if inactive point
+ IF(N .EQ. 0) GO TO 500
+ IF(XMAP1(N) .LT. VDX9) GO TO 500
+
+ IF(NN .LT. NVERTM) THEN
+ DO KK=NN+1,NVERTM
+ K=NKEY(KK)
+ IF(K .NE. 0) THEN
+ IF(XMAP1(N) .EQ. XMAP1(K)) THEN
+ IF(YMAP1(N) .EQ. YMAP1(K)) THEN
+ WRITE(45,*) 'IDENT',N,K
+ NKEY(KK)=0
+ ENDIF
+ ELSE
+ GO TO 200
+ ENDIF
+ ENDIF
+ 200 CONTINUE
+ ENDDO
+ ENDIF
+
+! Set edge buffers to zero
+
+ IF(NEDGE .GT. 0) THEN
+ DO J=1,NEDGE
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ELSE
+ DO J=1,100
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ENDIF
+ NEDGE=0
+
+! test for point in circumcircle
+
+ DO J=1,NELTS
+ CALL INSIDCIRC(XMAP1,YMAP1,J,N,ISWT)
+
+! If inside process edges
+
+ IF(ISWT .EQ. 1) THEN
+ CALL PROCESS(J,NEDGE,NGAP)
+ ENDIF
+ END DO
+
+! Setup to form new triangles
+
+ CALL SETEDG(NEDGE)
+
+! Now form triangles as needed
+
+ DO J=1,NEDGE
+ IF(IEDGE(J,1) .NE. 0) THEN
+ CALL FORMT(XMAP1,YMAP1,J,N,NGAP,KK)
+ ENDIF
+ END DO
+
+ NEDGE=0
+ if(iprt .eq. 0) go to 500
+ DO J=1,NELTS
+ IF(NOPEL(J,1) .GT. 0) THEN
+ WRITE(3,'(2i5,2i10,19x,''1'')') J,(NOPEL(J,K),K=1,3)
+ ENDIF
+ END DO
+
+
+ IF(NN .EQ. 1) THEN
+ write(41,'('' 9999'')')
+ do j=1,nvert
+ write(41,'(i10,2f20.4,F10.3)') j,XMAP1(j),YMAP1(j),VAL(J)
+ enddo
+ write(41,'('' 9999'')')
+ write(41,'('' 9999'')')
+ write(41,'('' 0 NENTRY'')')
+ write(41,'('' 0 NCLM'')')
+ WRITE(41,'(''ENDDATA'')')
+ ENDIF
+ 500 continue
+ END DO
+
+! Get rid of elements from super point
+
+ CALL RIDPOINT(NVERT)
+
+ RETURN
+ END SUBROUTINE
diff --git a/src/src83e/GETWT.F90 b/src/src83e/GETWT.F90
new file mode 100644
index 0000000..1d21ee1
--- /dev/null
+++ b/src/src83e/GETWT.F90
@@ -0,0 +1,238 @@
+ SUBROUTINE TRIANINT(NMAP,M,ISWT,ITIME)
+
+ USE BLKMAP
+ USE BLK1MOD
+ SAVE
+! INCLUDE 'BLK1.COM'
+
+ DIMENSION WGT(8)
+ REAL*8 XMINL,YMINL,XMAXL,YMAXL
+! data itime/0/
+
+! LOOK FOR MATCHING POINTS
+
+ DO K=1,MAXPTS
+ DISQ=(XUSR(M)-XMAP(K))**2+(YUSR(M)-YMAP(K))**2
+ IF(DISQ .LT. 1.) THEN
+ WD(M)=VAL(K)
+ FPN = WD(M)*10.
+ X = CORD(M,1)
+ Y = CORD(M,2) - .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.1,FPN,0.0,-1)
+ endif
+ GO TO 300
+ ENDIF
+ ENDDO
+
+! Search for element that has circumcircle around the node
+
+ IF(ISWT .NE. 0) THEN
+ IF(ITIME .EQ. 0) NSTART=1
+ ELSE
+ NSTART=1
+ ENDIF
+ DO N=NSTART,NELTS
+ IF(NOPEL(N,1) .EQ. 0) GO TO 200
+ if(RADS(N) .eq. 0.) then
+ CALL CCENTRE(XMAP(NOPEL(N,1)),XMAP(NOPEL(N,2)),XMAP(NOPEL(N,3)) &
+ &,YMAP(NOPEL(N,1)),YMAP(NOPEL(N,2)),YMAP(NOPEL(N,3)) &
+ &,XCEN(N),YCEN(N),RADS(N))
+ endif
+
+ IF(RADS(N)+XCEN(N) .GE. XUSR(M)) THEN
+ NSTART=N
+ GO TO 210
+ ENDIF
+ 200 CONTINUE
+ ENDDO
+ 210 CONTINUE
+ WRITE(155,*) M,NSTART
+ DO N=NSTART,NELTS
+ IF(NOPEL(N,1) .EQ. 0) GO TO 250
+ if(RADS(N) .eq. 0.) then
+ CALL CCENTRE(XMAP(NOPEL(N,1)),XMAP(NOPEL(N,2)),XMAP(NOPEL(N,3)) &
+ &,YMAP(NOPEL(N,1)),YMAP(NOPEL(N,2)),YMAP(NOPEL(N,3)) &
+ &,XCEN(N),YCEN(N),RADS(N))
+ endif
+ xminl=min(XMAP(NOPEL(N,1)),XMAP(NOPEL(N,2)),XMAP(NOPEL(N,3)))
+ xmaxl=max(XMAP(NOPEL(N,1)),XMAP(NOPEL(N,2)),XMAP(NOPEL(N,3)))
+ yminl=min(YMAP(NOPEL(N,1)),YMAP(NOPEL(N,2)),YMAP(NOPEL(N,3)))
+ ymaxl=max(YMAP(NOPEL(N,1)),YMAP(NOPEL(N,2)),YMAP(NOPEL(N,3)))
+! IF(M .EQ. 6316) THEN
+! WRITE(156,'(2I6,6F15.2)') M,N,XUSR(M),XMINL,XMAXL,YUSR(M),YMINL,YMAXL
+! ENDIF
+ if(xusr(m) .lt. xminl-0.01 .or. xusr(m) .gt. xmaxl+0.01) then
+ go to 250
+ elseif(yusr(m) .lt. yminl-0.01 .or. yusr(m) .gt. ymaxl+0.01) then
+ go to 250
+ endif
+! IF(M .EQ. 6316) WRITE(156,*) 'PASSED X AND Y TEST',N
+
+ DISQ=(XUSR(M)-XCEN(N))**2+(YUSR(M)-YCEN(N))**2
+
+ IF(DISQ .LE. RADS(N)**2*1.0001) THEN
+
+! IF(M .EQ. 6316) write(156,*) m,n,disq,rads(n)**2,xusr(m),xcen(n)
+
+! We have a candidate
+
+ CALL GETWT(N,XUSR(M),YUSR(M),WGT,1)
+ DO K=1,3
+ IF(WGT(K) .LT. -1E-4 .OR. WGT(K) .GT. 1.0001) THEN
+ WRITE(142,*) 'REJECT',m,n,disq,rads(n)**2,wgt(1),wgt(2),wgt(3)
+ GO TO 250
+ ENDIF
+ ENDDO
+ WD(M)=WGT(1)*VAL(NOPEL(N,1))+WGT(2)*VAL(NOPEL(N,2))+WGT(3)*VAL(NOPEL(N,3))
+ FPN = WD(M)*10.
+ X = CORD(M,1)
+ Y = CORD(M,2) - .11
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL RRED
+ CALL NUMBR(X,Y,0.1,FPN,0.0,-1)
+ endif
+ GO TO 300
+ ENDIF
+ 250 CONTINUE
+ ENDDO
+ 300 CONTINUE
+ ITIME=1
+
+ RETURN
+ END
+
+
+ SUBROUTINE GETWT(N,XSW,YSW,WGT,ISWT)
+
+!-
+!......SUBROUTINE TO EVALUATE FUNCTION AT GRID POINTS
+!-
+!- N = ELEMENT NUMBER
+!_ XSW = X COORDINATE OF DESIRED POINT
+!_ YSW = Y COORDINATE OF DESIRED POINT
+! WGT(8) = ARRAY OF WEIGHTING FUNCTIONS
+! ISWT = SWITCH FOR CHOICE BETWEEN LINEAR AND QUADRATIC WEIGHTING
+! = 1 FOR LINEAR
+! = 2 FOR QUADRATIC
+! FROM COMMON
+! NOP = LIST OF NODAL CONNECTIONS AROUND AN ELEMET
+! CORD = REAL*8 ARRAY OF NODAL COORDINATES
+!
+ USE BLKMAP
+ USE BLK1MOD
+ REAL*8 XN,DNX,DNY,XSW,YSW
+ DOUBLE PRECISION XG,YG,XK,YK,XP,YP
+! INCLUDE 'BLK1.COM'
+!-
+ DIMENSION X(9),Y(9),WGT(8)
+!-
+ DATA TOL/0.01/
+!-
+
+!-
+!......DETERMINE ELEMENT TYPE
+!-
+!IPKOCT93 ADD
+ if(n .eq. 1910) then
+ aaa=0
+ endif
+ NCN=6
+ IT=2
+!-
+!......ESTABLISH LOCAL COORDINATES FOR EACH NODE POINT OF ELEMENT
+!-
+ K1=NOPEL(N,1)
+ X(1)=0.
+ Y(1)=0.
+ DO 300 K=3,NCN,2
+ K2=NOPEL(N,K/2+1)
+ X(K)=XMAP(K2)-XMAP(K1)
+ Y(K)=YMAP(K2)-YMAP(K1)
+ 300 END DO
+ X(2)=X(3)/2.
+ Y(2)=Y(3)/2.
+ X(4)=(X(3)+X(5))/2.
+ Y(4)=(Y(3)+Y(5))/2.
+ X(6)=X(5)/2.
+ Y(6)=Y(5)/2.
+ xminl=min(x(1),x(3),x(5))
+ yminl=min(y(1),y(3),y(5))
+ xmaxl=max(x(1),x(3),x(5))
+ ymaxl=max(y(1),y(3),y(5))
+
+
+!-
+!......ESTABLISH LOCAL COORDINATES OF DESIRED POINT
+!-
+ XP=XSW-XMAP(K1)
+ YP=YSW-YMAP(K1)
+
+ if(xp .lt. xminl .or. xp .gt. xmaxl) then
+ wgt(1)=2.0
+ return
+ elseif(yp .lt. yminl .or. yp .gt. ymaxl) then
+ wgt(1)=2.0
+ return
+ endif
+ XG=0.
+ YG=0.
+!-
+!......ITERATE TO FIND LOCAL COORDINATE
+!-
+ DO 400 ITER=1,10
+ DXKDX=0.
+ DXKDY=0.
+ DYKDX=0.
+ DYKDY=0.
+ XK=-XP
+ YK=-YP
+ DO 350 K=2,NCN
+ XK=XK+XN(IT,K,XG,YG)*X(K)
+ YK=YK+XN(IT,K,XG,YG)*Y(K)
+ DXKDX=DXKDX+DNX(IT,K,XG,YG)*X(K)
+ DYKDX=DYKDX+DNX(IT,K,XG,YG)*Y(K)
+ DXKDY=DXKDY+DNY(IT,K,XG,YG)*X(K)
+ DYKDY=DYKDY+DNY(IT,K,XG,YG)*Y(K)
+ 350 END DO
+ DET=DXKDX*DYKDY-DXKDY*DYKDX
+ DX=(-DYKDY*XK+DXKDY*YK)/DET
+ DY=( DYKDX*XK-DXKDX*YK)/DET
+ XG=XG+DX
+ YG=YG+DY
+ IF(ABS(DX).LT.TOL .AND. ABS(DY).LT.TOL) GO TO 420
+ 400 END DO
+!-
+!......NOW GET WEIGHTING FUNCTIONS FOR QUAD FUNCTION
+!-
+ 420 CONTINUE
+ DO K=1,NCN
+ WGT(K)=XN(IT,K,XG,YG)
+ END DO
+
+ IF(ISWT .EQ. 1) THEN
+!-
+!- REDUCE TO LINEAR FUNCTION BY ADDING TERMS
+!-
+ DO K=2,NCN,2
+ WGT(K-1)=WGT(K-1)+WGT(K)/2.
+ IF(K .LT. NCN) THEN
+ WGT(K+1)=WGT(K+1)+WGT(K)/2.
+ ELSE
+ WGT(1)=WGT(1)+WGT(K)/2.
+ ENDIF
+ ENDDO
+!-
+!- THEN COMPACT ARRAY
+!-
+ DO K=1,NCN/2
+ WGT(K)=WGT(2*K-1)
+ ENDDO
+
+ ENDIF
+
+ RETURN
+ END
diff --git a/src/src83e/GINPT.F90 b/src/src83e/GINPT.F90
new file mode 100644
index 0000000..9ee5ac7
--- /dev/null
+++ b/src/src83e/GINPT.F90
@@ -0,0 +1,47 @@
+ SUBROUTINE GINPT(irm2,ID,DLIN)
+ CHARACTER ID*8,DLIN*72
+ 100 CONTINUE
+ READ(irm2,7000) ID,DLIN
+ write(90,7000) id,dlin
+!ipk jul03
+ call to_upper(id)
+ 7000 FORMAT(A8,A72)
+ do i=1,8
+ if(id(i:i) .eq. char(9)) go to 200
+ enddo
+ do i=1,72
+ if(dlin(i:i) .eq. char(9)) go to 200
+ enddo
+ IF(ID(1:1) .EQ. ':') GO TO 100
+ IF(ID(1:1) .EQ. ';') GO TO 100
+ IF(ID(1:3) .EQ. 'com') GO TO 100
+ IF(ID(1:3) .EQ. 'COM') GO TO 100
+ IF(ID(1:3) .EQ. 'Com') GO TO 100
+ IF(ID(1:8) .EQ. ' ') GO TO 100
+ RETURN
+ 200 continue
+ write(*,*) 'Error Tab character found in the following line'
+ write(90,*) 'Error Tab character found in the following line'
+ write(90,7000) id,dlin
+ write(*,7000) id,dlin
+ stop
+ END
+
+
+ SUBROUTINE TO_UPPER(STR)
+
+ CHARACTER*(*) STR
+ CHARACTER*1 CH
+
+ L = LEN(STR)
+
+ DO I=1,L
+ CH = STR(I:I)
+ IF ( ICHAR(CH) .GT. 96 .AND. ICHAR(CH) .LE. 122) THEN
+ STR(I:I) = CHAR(ICHAR(CH)-32)
+ ENDIF
+ ENDDO
+
+ END
+
+
diff --git a/src/src83e/GOUTLIN.F90 b/src/src83e/GOUTLIN.F90
new file mode 100644
index 0000000..82de04a
--- /dev/null
+++ b/src/src83e/GOUTLIN.F90
@@ -0,0 +1,127 @@
+ SUBROUTINE GOUTLIN
+
+ USE WINTERACTER
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+
+ CHARACTER(LEN=255) :: FNAME,FILTER
+ CHARACTER(LEN=4) :: SUB
+ LOGICAL OPENED
+ CHARACTER*1 IFLAG,ANS(10)
+! DIMENSION XOUT(1000),YOUT(1000)
+ DATA ANS/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+
+ IF(.NOT. ALLOCATED(XOUT)) THEN
+ ALLOCATE (XOUT(5000,10),YOUT(5000,10))
+ ENDIF
+ N=0
+ IOUTOUT=25
+ INQUIRE(25, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='OUTLINE file -- *.dat|*.dat|POLY file -- *.poly|*.poly|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Outline File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IOUTOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ ELSE
+ GO TO 1
+ ENDIF
+ ENDIF
+
+ 1 CONTINUE
+
+ IF(SUB(1:3) .EQ. 'dat') THEN
+ IOUTSW=0
+ ELSE
+ IOUTSW=1
+ ENDIF
+
+!IPK GET STRING OF MAP COORDINATES
+
+!
+! Draw box around selections
+!
+ 2 CONTINUE
+
+ NHTPSV=NHTP
+ NMESSV=NMESS
+ NBRRSV=NBRR
+
+ NHTP=0
+ NBRR=1
+ NMESS=45
+ CALL HEDR
+!
+! Get answer
+!
+! 3 call xyloc(XPT,YPT,ANS,IBOX)
+ 3 call xyloc(XPT,YPT,IFLAG,IBOX)
+!
+ IF(IRMAIN .NE. 1 .and. ibox .ne. 10) THEN
+
+ N=N+1
+ XTMP = XPT*TXSCAL - XS
+ YTMP = YPT*TXSCAL - YS
+ IF(IOUTSW .EQ. 0) THEN
+ WRITE(IOUTOUT,*) XTMP,YTMP
+ ELSE
+ XOUT(N,1)=XTMP
+ YOUT(N,1)=YTMP
+ ENDIF
+ GO TO 3
+
+ ENDIF
+ IF(IOUTSW .EQ. 1) THEN
+ NDIM=2
+ NZERO=0
+ NONE=1
+ WRITE(IOUTOUT,*)N,NDIM,NZERO,NZERO
+ DO I=1,N
+ WRITE(IOUTOUT,*) I,XOUT(I,1),YOUT(I,1)
+ ENDDO
+ WRITE(IOUTOUT,*) N,NZERO
+ DO I=1,N-1
+ WRITE(IOUTOUT,*) I,I,I+1
+ ENDDO
+ WRITE(IOUTOUT,*) N,N,NONE
+
+ WRITE(IOUTOUT,*) NZERO
+ ENDIF
+ NHTP=NHTPSV
+ NMESS=NMESSV
+ NBRR=NBRRSV
+ CALL HEDR
+
+
+ RETURN
+ END
+
+ SUBROUTINE GETSUB4(FNAME,SUB)
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=4) :: SUB
+ INTEGER ,EXTERNAL :: LENSTR
+ INTEGER :: LNNAM,K
+
+ LNNAM=LENSTR(FNAME)
+ SUB=' '
+ DO K=LNNAM,1,-1
+ IF(FNAME(K:K) .EQ. '.') THEN
+ IF(LNNAM .GT. K+3) THEN
+ SUB=FNAME(K+1:K+4)
+ ELSEIF(LNNAM .GT. K+2) THEN
+ SUB(1:3)=FNAME(K+1:K+3)
+ SUB(4:4)=' '
+ ELSE
+ SUB=' '
+ ENDIF
+ GO TO 110
+ ENDIF
+ ENDDO
+110 CONTINUE
+ RETURN
+ END
diff --git a/src/src83e/GRIDSB.F90 b/src/src83e/GRIDSB.F90
new file mode 100644
index 0000000..fc0f780
--- /dev/null
+++ b/src/src83e/GRIDSB.F90
@@ -0,0 +1,872 @@
+!IPK LAST UPDATE FEB 11 2002 ADD LOCK AS VARIABLE
+!ipk last update Feb 10 1997
+ SUBROUTINE GRIDSB(ISWTIN)
+!
+! Routines to control interpolation of nodal elevations
+!
+ USE WINTERACTER
+ USE BLKMAP
+ USE BLK1MOD
+
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+
+!iPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+
+
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+!IPKJAN94 INTEGER*2 LISTM
+! INTEGER LISTM
+!ipk feb94 add ARF then remove may97
+
+! DIMENSION LISTM(1000),listt(1600,4),nlf(4),icomp(4),xnear(4)
+!ipk feb03 common /mapc/imap(maxpl),NCRS(MAXPL)
+!ipk sep97 add NCRS above
+!
+!ipknov93 CHARACTER*1 ANS,ANSW(10)
+ CHARACTER*1 ANS,ANSW(10),IFLAG
+ CHARACTER*63 STRELS
+ DATA STRELS/' You have tried set to set elevation with no mapfile"'/
+!
+ DATA ANSW/'m','a','f','s','k','u','t','w','h','q'/
+!JUN08 DATA ISWTAGN/0/
+!ipk feb94 add DATA and FUNCTION below
+! DATA ARF/-180.,-90.,0.,90.,180./
+! ANGN(K,L)=
+! + ATAN2((CMAP(K,2)-CORD(L,2)),(CMAP(K,1)-CORD(L,1)))*57.296
+!
+! Draw box around selections
+!
+!IPK SEP97
+100 CONTINUE
+ IDONET=0
+ NHTP = 9
+ NMESS = 0
+ NBRR = 0
+ IF(ISWTIN .EQ. -1) GO TO 190
+ CALL HEDR
+!
+! Get answer
+!
+ 110 call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 110
+ ANS=ANSW(IBOX)
+ ENDIF
+ IF(ANS .EQ. 'm') THEN
+!
+! This option allows changes to bottom elevations
+!
+ CALL ADDPTH
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 100
+
+ ELSEIF (ANS .EQ. 'a') THEN
+!
+! All nodes
+!
+ ISWT = -1
+ DO N=1,NP
+ IF(INEW(N) .EQ. 1) WD(N)=-9999.
+ ENDDO
+ ELSEIF(ANS .EQ. 'f') THEN
+!
+! Fill nodes
+!
+ ISWT = 0
+ ELSEIF(ANS .EQ. 's') THEN
+!
+! Single node at a time
+!
+ ISWT = 1
+
+!ipk feb02 add lock/unlock and remove cdata
+
+ ELSEIF(ANS .EQ. 'k') THEN
+!
+! lock node
+!
+! Get M from mouse
+!
+ 115 CONTINUE
+ NHTP=0
+ NMESS=21
+ NBRR=3
+ CALL HEDR
+ IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,M,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .eq. 'q') go to 100
+ lock(m)=1
+ go to 115
+ ELSEIF(ANS .EQ. 'u') THEN
+!
+! unlock node
+!
+! Get M from mouse
+!
+ 120 CONTINUE
+ NHTP=0
+ NMESS=21
+ NBRR=3
+ CALL HEDR
+ IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,M,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .eq. 'q') go to 100
+ lock(m)=0
+ go to 120
+ ELSEIF(ANS .EQ. 't') THEN
+!
+! Create data for layers
+!
+ CALL ADDLAY
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 100
+ ELSEIF(ANS .EQ. 'w') THEN
+!
+! This option allows changes to nodal widths
+!
+ CALL ADDWID
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 100
+!
+! Call to help screen
+!
+ ELSEIF(ANS .EQ. 'h') THEN
+ CALL HELPS(4)
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 100
+!
+ ELSEIF(ANS .EQ. 'q') THEN
+!
+! Writeout and return
+!
+ CALL WRTOUT(0)
+ RETURN
+ ENDIF
+
+190 CONTINUE
+
+ IF(IMP .EQ. 0) THEN
+ CALL SYMBL(0.,7.25,0.20,STRELS,0.,63)
+ go to 100
+ endif
+!
+! Establish size for range
+!
+ call setrng(xnears,nmap)
+
+ ITIME=0
+ ICOUNTF=0
+ MM=0
+ 200 MM=MM+1
+! write(90,*) 'gridsb-111',mm,np,iswt,inew(mm)
+ IF(MM .LE. NP) THEN
+!
+! Decode which alternative we are processing
+! ipk feb 03 determine interpolation method
+!
+ IF(MM .EQ. 1 .AND. ISWTAGN .EQ. 0) THEN
+
+ IF(IRECD .EQ. 2) THEN
+ iswtintp=0
+ iswtagn=0
+ go to 210
+ ENDIF
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to interpolate '//&
+ CHAR(13)//'from the triangulated map file?' ,&
+ 'Select Interpolation method?')
+! If answer 'Yes' set interpolate switch to 1
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ iswtintp=0
+ ELSE
+ iswtintp=1
+ ENDIF
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Ask this question again?'//&
+ CHAR(13)//' ' ,&
+ 'Ask again?')
+! If answer 'Yes' set again switch to 0
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ iswtagn=1
+ ELSE
+ iswtagn=0
+ ENDIF
+ ENDIF
+
+ 210 CONTINUE
+
+ IF(iswtintp .eq. 1) then
+ if(iswt .ne. 1) then
+
+! Sort the x-coordinates
+
+ call sortdb(xusr,ncrs,np)
+ else
+ ncrs(mm)=mm
+ endif
+ m=ncrs(mm)
+ else
+ m=mm
+ endif
+! IPK OCT 2 1991
+ IF(ISWT .EQ. 1) THEN
+! Single node at a time ISWT = 1
+!
+! Get M from mouse and set MM to NP
+!
+ NHTP=0
+ NMESS=21
+!ipk jun08 NBRR=0
+ NBRR=1
+ CALL HEDR
+ IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .eq. 'q') go to 100
+ M=INODE
+ MM=NP
+ endif
+ IF(INEW(M) .EQ. 0) GO TO 200
+! IPK END OCT 2 1991
+
+ IF(ISWT .EQ. -1) THEN
+! All nodes ISWT = -1
+!ipk feb02
+ if(lock(m) .eq. 1) go to 200
+
+ ELSEIF(ISWT .EQ. 0) THEN
+! Fill nodes ISWT = 0
+!ipk feb02
+ IF(WD(M) .GT. -9000. .or. lock(m) .eq. 1) go to 200
+
+ ENDIF
+! write(90,*) 'gridsb-138', m,mm,iswt,wd(m),xnears
+
+ IF(ISWTINTP .EQ. 0) THEN
+ if(lock(m) .eq. 0) CALL SETELV(XNEARS,NMAP,M,ISWT)
+ ELSE
+ if(nelts .eq. 0) then
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'No triangulated exists'//&
+ CHAR(13)//'Do you wish to triangulate now?' ,&
+ 'NO TRIANGULATION AVAILABLE?')
+! If answer 'Yes' set triangulate now
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ return
+ ELSE
+ call triang
+ IDONET=1
+ ENDIF
+
+ endif
+ if(lock(m) .eq. 0) CALL TRIANINT(NMAP,M,ISWT,ITIME)
+ ENDIF
+
+! write(90,*) 'gridsb-141', m,iswt,wd(m)
+ if(wd(m) .lt. -9997.) THEN
+ icountf=icountf+1
+ WD(M)=-9998.
+ ENDIF
+ GO TO 200
+ ENDIF
+ IF(IDONET .EQ. 1) THEN
+ CALL RDMAP(2,99,0,0) ! XXXXX
+ CLOSE(99)
+ ENDIF
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to plot contours?'//&
+ CHAR(13)//' ','PLOT CONTOURS?')
+!
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) THEN
+ go to 220
+ ENDIF
+215 menus=13
+ call conout(menus)
+ MENUS=12
+ CALL CONOUT(MENUS)
+
+!ipkjan94 IF(ISWT .EQ. -1) GO TO 210
+220 if(icountf .gt. 0) then
+
+ CALL FMESS(ICOUNTF,ISWTT)
+!
+! If answer 'Yes', use search for adjacent nodes
+!
+ IF(ISWTT .EQ. 1) then
+ call fillin(icountf)
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to plot contours again?'//&
+ CHAR(13)//' ','PLOT CONTOURS?')
+!
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) THEN
+ IF(ICOUNTF .GT. 0) GO TO 220
+ ELSE
+ GO TO 215
+ ENDIF
+ END IF
+ endif
+ IF(ISWTIN .EQ. -1) RETURN
+ IF(ISWT .EQ. 1) THEN
+!ipk jun08 CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .eq. 'q') go to 100
+ M=INODE
+ MM=NP-1
+ GO TO 200
+ ELSEIF(ISWT .EQ. -1) THEN
+ GO TO 100
+ ENDIF
+!ipk jun08 IF(ABS(ISWT) .EQ. 1) GO TO 100
+ RETURN
+ END
+!ipk jul98 revise call
+!IPK SUBROUTINE GRIDIN(I,SOLN,LISTM,NLG)
+ SUBROUTINE GRIDIN(XZ,YZ,SOLN,LISTM,NLG)
+!
+! Routine to interpolate values from map to node points
+!
+! I is the location in the CORD array to be interpolated
+! SOLN is the interpolated value developed
+! NLG is the number of entries in the map array
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+!IPK JAN94 INTEGER*2 LISTM,NLIST,NKEY
+!IPK DEC09 INTEGER LISTM,NLIST,NKEY
+ INTEGER LISTM,NLIST
+ DIMENSION LISTM(*)
+ DIMENSION NLIST(1000),ADIST(1000),WT(1000)
+!
+! Function statements
+!
+ DIST(K,X,Y)=SQRT((CMAP(K,1)-X)**2+(CMAP(K,2)-Y)**2)
+!IPK FEB97 ANG(K,X,Y)=ATAN2((CMAP(K,2)-Y),(CMAP(K,1)-X))*57.296
+ ANG(K,X,Y)=ATAN2((CMAP(K,1)-X),(CMAP(K,2)-Y))*57.296
+!
+! Initialize
+!
+ TOL=120.
+! DO KK=1,NLG
+! WRITE(90,*) 'LISTM',KK,LISTM(KK)
+! ENDDO
+!
+! Form list of distances from I to data locations
+!
+ NTMP=0
+ IPAS=1
+!IPK JUL98 X=CORD(I,1)
+!PK JUL98 Y=CORD(I,2)
+ X=XZ
+ Y=YZ
+ 140 CONTINUE
+ DO 150 KK=1,NLG
+ K=LISTM(KK)
+ IF(K .EQ. NTMP) THEN
+ ADIST(KK)=-VOID
+ ELSE
+ ADIST(KK)=DIST(K,X,Y)
+ ENDIF
+ 150 END DO
+!
+! Sort order for nearest points
+!
+ CALL SORT(ADIST,NKEY,NLG)
+ do nnnn=1,nlg
+ nn=nkey(nnnn)
+ nzz=listm(nn)
+! WRITE(90,*) NZZ,X,Y,cmap(nzz,1),cmap(nzz,2)
+! ATMP=ANG(NZZ,X,Y)
+! write(90,*) nnnn,adist(nnnn),val(nzz),ATMP
+ enddo
+! read(*,*) aaa
+ KK=1
+!
+! Search through sorted list
+!
+ INIT=1
+ 180 DO 260 K=1,NLG
+ NN=NKEY(K)
+ IF(NN .EQ. 0) GO TO 260
+ N=LISTM(NN)
+!
+! Initialize
+!
+ IF(N .EQ. NTMP) GO TO 260
+ IF(INIT .EQ. 1) THEN
+ NLIST(1)=N
+ YY=(CMAP(N,2)-Y)
+ XX=(CMAP(N,1)-X)
+ IF(YY .EQ. 0. .AND. XX .EQ. 0.) THEN
+ RANGEF=0.
+ RANGEB=360.
+ ELSE
+ RANGEF=ANG(N,X,Y)
+ RANGEB=ANG(N,X,Y)+360.
+ ENDIF
+ INIT=2
+ GO TO 260
+ ENDIF
+!
+! Skip out if already processed
+!
+ YY=(CMAP(N,2)-Y)
+ XX=(CMAP(N,1)-X)
+ IF(YY .EQ. 0. .AND. XX .EQ. 0.) THEN
+ ANGLE=0.
+ ELSE
+ ANGLE=ANG(N,X,Y)
+ ENDIF
+ 200 CONTINUE
+! write(90,*) 'angls',n,angle,rangef,rangeb,val(n)
+!
+! Test if angle greater than high value
+!
+ IF(ANGLE .GT. RANGEF) THEN
+!
+! Test if the new point is within the allowable range
+!
+ IF(ANGLE .LT. RANGEF+TOL) THEN
+!
+! Process this point
+!
+ RANGEF=ANGLE
+ KK=KK+1
+ NLIST(KK)=N
+ NKEY(K)=0
+!
+! Test if we now have enough points to exit
+!
+ IF(RANGEF+TOL .GT. RANGEB) THEN
+ GO TO 300
+ ELSE
+ GO TO 180
+ ENDIF
+!
+! Test if angle lies inside the already spanned area
+! If so it cannot be used
+!
+ ELSEIF(ANGLE .GT. RANGEB) THEN
+ NKEY(K)=0
+!
+! Test if it close enough to the low value
+!
+ ELSEIF(ANGLE .GT. RANGEB-TOL) THEN
+!
+! Process this point
+!
+ RANGEB=ANGLE
+ KK=KK+1
+ NLIST(KK)=N
+ NKEY(K)=0
+!
+! Test if we have enough points to exit
+!
+ IF(RANGEF+TOL .GT. RANGEB) THEN
+ GO TO 300
+ ELSE
+ GO TO 180
+ ENDIF
+!
+! Not a usable point at this time, move on to next point
+!
+ ELSE
+ GO TO 260
+!
+! Increase angle by 360 and test again
+!
+ ENDIF
+ ELSE
+ ANGLE=ANGLE+360.
+ GO TO 200
+ ENDIF
+ 260 END DO
+!
+! We have finished loop without completing polygon
+!
+ GO TO 500
+!
+! Process least squares fit on this list
+!
+ 300 CONTINUE
+! WRITE(90,*) 'least squares list',KK,x,y
+! WRITE(90,*) (NLIST(N),N=1,KK)
+! do n=1,kk
+! write(90,*) nlist(n),cmap(nlist(n),1),cmap(nlist(n),2)
+! + ,val(nlist(n)),dist(nlist(n),x,y)
+! enddo
+!ipk feb97 changes to refine processing
+!
+! Check if points are close together relative to the centre point
+!
+! write(90,*) kk,x,y,nlg
+ do n=1,kk
+ l=nlist(n)
+ dc=dist(l,x,y)
+ xx=cmap(l,1)
+ yy=cmap(l,2)
+ if(n .lt. kk) then
+ do m=n+1,kk
+ ll=nlist(m)
+ dr=dist(ll,xx,yy)
+ if(dr .lt. 0.1*dc) then
+ if(kk .gt. 3) then
+ ds=dist(ll,x,y)
+ if(ds .lt. dc) then
+ ndrp=n
+ else
+ ndrp=m
+ endif
+!
+! drop this point
+!
+ do mm=ndrp,kk-1
+ nlist(mm)=nlist(mm+1)
+ enddo
+ kk=kk-1
+ go to 300
+ else
+ go to 310
+ endif
+ endif
+ enddo
+ endif
+ enddo
+ 310 continue
+!ipk feb97 end changes for processing
+! WRITE(90,*) '310',kk
+! WRITE(90,*) (NLIST(N),N=1,KK)
+!ipk feb97 chnage to add weighting
+ do n=1,kk
+!ipk jul98 if(dist(nlist(n),CORD(I,1),CORD(I,2)) .gt. 0.) then
+!ipk jul98 wt(n)=1./dist(nlist(n),CORD(I,1),CORD(I,2))
+ if(dist(nlist(n),XZ,YZ) .gt. 0.) then
+ wt(n)=1./dist(nlist(n),XZ,YZ)
+ else
+ soln=val(nlist(n))
+ return
+ endif
+ enddo
+!IPK JUL98 CALL ALSQ(KK,NLIST,I,SOLN,WT)
+ CALL ALSQ(KK,NLIST,XZ,YZ,SOLN,WT)
+!ipk feb97 end changes
+!
+! final value is SOLN
+!
+ RETURN
+ 500 TOL=TOL+25.
+ IF(TOL .GT. 180.) GO TO 550
+ IF(RANGEF+TOL .GT. RANGEB) THEN
+ GO TO 300
+ ENDIF
+ GO TO 180
+ 550 CONTINUE
+!c write(90,*) ' in trouble split',rangef,rangeb
+ SPLIT=(RANGEF+RANGEB)/2.-180.
+ AMIN=180.
+ DO 600 N=1,KK
+ IF(NLIST(N) .EQ. NTMP) GO TO 600
+ YY=(CMAP(NLIST(N),2)-Y)
+ XX=(CMAP(NLIST(N),1)-X)
+ IF(YY .EQ. 0. .AND. XX .EQ. 0.) THEN
+ ANGL=0.
+ ELSE
+ ANGL=ANG(NLIST(N),X,Y)
+ ENDIF
+ IF(IPAS .EQ. 2) GO TO 600
+!
+! Find line closest to split
+!
+ IF(ABS(SPLIT-ANGL) .LT. AMIN) THEN
+ AMIN=ABS(SPLIT-ANGL)
+! write(90,*) 'ntmp reset',ntmp,nlist(n),amin,split
+ NTMP=NLIST(N)
+ ENDIF
+ ANGLP=ANGL-360.
+ IF(ABS(SPLIT-ANGLP) .LT. AMIN) THEN
+ AMIN=ABS(SPLIT-ANGLP)
+ NTMP=NLIST(N)
+ ENDIF
+! 580 WRITE(90,*) NLIST(N),ANGL
+ 600 END DO
+ IF(IPAS .EQ. 1) THEN
+ IPAS=2
+ X=CMAP(NTMP,1)
+ Y=CMAP(NTMP,2)
+ TOL=120.
+ write(90,*) 'INTERP FOR ',xz,yz,' MOVED TO',x,y,ntmp
+ GO TO 140
+ ENDIF
+ WRITE(90,*) 'ERROR NO POLYGON RANGEF,RANGEB',RANGEF,RANGEB,SPLIT
+ WRITE(90,*) 'OPPOSITE NODE AND ANGULAR DIFF',NTMP,AMIN
+ SOLN=-9998.
+ RETURN
+ END
+!
+! FUNCTION ANG(K,X,Y)
+!
+! INCLUDE 'BLK1.COM'
+!
+! YY=(CMAP(K,2)-Y)
+! XX=(CMAP(K,1)-X)
+! IF(YY .EQ. 0. .AND. XX .EQ. 0.) THEN
+! ANG=0.
+! ELSE
+! ANG=ATAN2(YY,XX)*57.296
+! ENDIF
+! RETURN
+! END
+
+ SUBROUTINE SORT(A,NKEY,N)
+!*********************************** .....SORT.....
+!-
+!......SORT IS A SIMPLE SHELL SORT ROUTINE
+!-
+! SHELL SORT
+ SAVE
+!
+!IPK JAN94 INTEGER*2 NKEY
+ DIMENSION A(*),NKEY(1)
+ IF(N.LT.2) RETURN
+ DO 90 J=1,N
+ NKEY(J)=J
+ 90 END DO
+ ID = N
+ 100 ID = ID / 2
+ 110 IB = 1
+ 120 GO TO 200
+ 130 IB = IB + 1
+ IF( IB .LE. ID ) GO TO 200
+ IF( ID .GT. 1 ) GO TO 100
+ RETURN
+ 200 I = IB
+ 210 K = I + ID
+ 220 IF( A(NKEY(I)) .LE. A(NKEY(K)) ) GO TO 250
+ NKT = NKEY(K)
+ NKEY(K) = NKEY(I)
+ J = I
+ 230 K = J - ID
+ IF( K .LT. 1 ) GO TO 240
+ IF( A(NKT) .GT. A(NKEY(K)) ) GO TO 240
+ NKEY(J) = NKEY(K)
+ J = K
+ GO TO 230
+ 240 NKEY(J) = NKT
+ 250 I = I + ID
+ IF( I + ID .LE. N ) GO TO 210
+ GO TO 130
+ END
+!ipk feb97 add weighting
+!iok jul98 SUBROUTINE ALSQ(NPTS,NLIST,I,SOLN,WT)
+ SUBROUTINE ALSQ(NPTS,NLIST,xx,yy,SOLN,WT)
+!
+! Least squares routine
+!
+! INCLUDE 'PARAM.COM'
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!IPK JAN94 INTEGER*2 NLIST
+ REAL*8 A,R,B,S,X,Y,ATR,ATR2,BTR,C,T,X3,X2,X1
+ DIMENSION A(3,3),R(3),B(2,2),S(2),wt(*)
+ DIMENSION NLIST(*)
+!
+! Initialize matrices
+!
+!ipk jul98 X=CORD(I,1)
+!ipk jul98 Y=CORD(I,2)
+ X=XX
+ Y=YY
+! write(*,*) (nnn,cmap(nnn,1),cmap(nnn,2),nnn=1,16)
+! write(*,*) (nlist(n),n=1,npts)
+ DO 160 K=1,3
+ R(K)=0.
+ DO 150 J=1,3
+ A(J,K)=0.
+ 150 CONTINUE
+ 160 END DO
+!
+! Form A and R matrices
+!
+ DO 200 N=1,NPTS
+ KK=NLIST(N)
+! write(*,*) cmap(kk,1),cmap(kk,2),val(kk)
+!ipk feb97 add weighting
+ A(1,1)=A(1,1)+1.0*wt(n)
+ A(1,2)=A(1,2)+CMAP(KK,1)*wt(n)
+ A(1,3)=A(1,3)+CMAP(KK,2)*wt(n)
+ A(2,2)=A(2,2)+CMAP(KK,1)**2*wt(n)
+ A(2,3)=A(2,3)+CMAP(KK,1)*CMAP(KK,2)*wt(n)
+ A(3,3)=A(3,3)+CMAP(KK,2)**2*wt(n)
+ R(1)=R(1)+VAL(KK)*wt(n)
+ R(2)=R(2)+CMAP(KK,1)*VAL(KK)*wt(n)
+ R(3)=R(3)+CMAP(KK,2)*VAL(KK)*wt(n)
+!ipk feb97 end addition of weighting
+ 200 END DO
+! read(*,*) al
+!
+! Solve equations
+!
+ ATR=A(1,2)/A(1,1)
+ ATR2=A(1,3)/A(1,1)
+ B(1,1)=A(2,2)-ATR*A(1,2)
+ B(1,2)=A(2,3)-ATR*A(1,3)
+ S(1)=R(2)-ATR*R(1)
+ B(2,2)=A(3,3)-ATR2*A(1,3)
+ S(2)=R(3)-ATR2*R(1)
+ BTR=B(1,2)/B(1,1)
+ C=B(2,2)-BTR*B(1,2)
+ T=S(2)-BTR*S(1)
+ X3=T/C
+ X2=S(1)/B(1,1)-BTR*X3
+ X1=R(1)/A(1,1)-ATR*X2-ATR2*X3
+!
+! Substitute to get interpolated value
+!
+ SOLN=X1+X2*X+X3*Y
+ RETURN
+ END
+!
+!ipksep97 new routine for soring map lines
+!
+ SUBROUTINE SORTMAP(A,NKEY,N,IMAP)
+!*********************************** .....SORT.....
+!-
+!......SORT IS A SIMPLE SHELL SORT ROUTINE
+!-
+! SHELL SORT
+ SAVE
+!
+!IPK JAN94 INTEGER*2 NKEY
+ DIMENSION A(*),NKEY(1),IMAP(*)
+ DATA VOID/1.E35/
+ IF(N.LT.2) RETURN
+ DO 90 J=1,N
+ NKEY(J)=J
+ IF(IMAP(J) .LT. 0) A(J)=VOID
+ 90 END DO
+ ID = N
+ 100 ID = ID / 2
+ 110 IB = 1
+ 120 GO TO 200
+ 130 IB = IB + 1
+ IF( IB .LE. ID ) GO TO 200
+ IF( ID .GT. 1 ) GO TO 100
+ RETURN
+ 200 I = IB
+ 210 K = I + ID
+ 220 IF( A(NKEY(I)) .LE. A(NKEY(K)) ) GO TO 250
+ NKT = NKEY(K)
+ NKEY(K) = NKEY(I)
+ J = I
+ 230 K = J - ID
+ IF( K .LT. 1 ) GO TO 240
+ IF( A(NKT) .GT. A(NKEY(K)) ) GO TO 240
+ NKEY(J) = NKEY(K)
+ J = K
+ GO TO 230
+ 240 NKEY(J) = NKT
+ 250 I = I + ID
+ IF( I + ID .LE. N ) GO TO 210
+ GO TO 130
+ END
+ subroutine fillin(icountf)
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+ DIST(N,M)=(cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2
+ CALL KCON(0)
+ MCOUNT=0
+ MCOUNTF=0
+ DO N=1,NP
+ IF(WD(N) .LT. -9997. .and. WD(N) .GT. -9998.5) THEN
+ MCOUNT=MCOUNT+1
+ DISTCUR=1.E20
+ NADJCT=0
+ DO K=1,NDELM(N)
+ J=NECON(N,K)
+ DO I=1,NCORN(J)
+ NC=NOP(J,I)
+ IF(NC .NE. 0 .AND. NC .NE. N) THEN
+ IF(WD(NC) .GT. -9997.) THEN
+ distance=dist(n,nc)
+ if(distance .lt. distcur) then
+ distcur=distance
+ nadjct=nc
+ endif
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ if(nadjct .gt. 0) then
+ wd(n)=wd(nadjct)
+ else
+ mcounfT=mcountf+1
+ ENDIF
+ if(mcount .eq. icountf) THEN
+ ICOUNTF=MCOUNTF
+ return
+ ENDIF
+ endif
+ enddo
+ ICOUNTF=MCOUNTF
+ return
+ end
+
+ SUBROUTINE FMESS(N1,N2)
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,IERR
+! real ::
+ character*3 :: sub
+
+ call wdialogload(IDD_FBED)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,n1)
+
+
+ CALL WDialogSelect(IDD_FBED)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ N2=1
+ RETURN
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ N2=0
+ RETURN
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/HEDR.F90 b/src/src83e/HEDR.F90
new file mode 100644
index 0000000..f74ad71
--- /dev/null
+++ b/src/src83e/HEDR.F90
@@ -0,0 +1,334 @@
+!IPk last updated July 15 1998
+!IPk last updated Nov 18 1997
+!IPk last updated Oct 31 1996 fix bug in map option
+!IPK LAST UPDATED OCT 16 1996
+!IPk last updated Oct 14 1996
+!IPk last updated Oct 25 1995
+ SUBROUTINE HEDR
+ SAVE
+
+! Routine to draw NSIZ header boxes at top of page with the HEAD label
+
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ CHARACTER*1 ALABL(10)
+ CHARACTER*40 MPDUM
+
+ COMMON /SSIZE/ HSIZE
+
+ COMMON /BLKA1/ TITLE,HLABL,ALABL,MPDUM
+
+!IPk oct 95 lines defining MPDUM added
+!ipk jan01 Expand IPSW to 10
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!IPk feb94 HEAD array and NHEDL enlarged
+!IPk oct96 HEAD AND NHEDL MESS, ENLARGED
+
+ common /cols/ ibakk,icolr,iblkk
+
+ CHARACTER*8 HED(10),HEAD(10,16)
+ CHARACTER*47 MESOUT,MESS(48)
+!ipk lan01 add to MESS
+!ipk jan99 add to MESS
+!ycw mar97 change HEADR(5,5) to HEADR(6,7)
+!ipk add extra headr
+ CHARACTER*8 HEADR(6,10)
+ DIMENSION NHEDL(16)
+ DIMENSION X(5),Y(5),IRV(10)
+!IPk feb 94 this statement reconstructed
+!IPK OCT 96 THIS STATMENT DONE AGAIN
+ DATA HEAD/ ' (e)lts ','(n)odes ','(o)rder ',' (h)elp ',' ',&
+'cc(l)ine',' csec(t)',' (z)oom ',' (r)draw',' (q)uit ','(n)od bk',& !1/2
+' (e)l bk',&
+'re(f)ine','spli(t) ','c(l)ean ',5*' ','pr(l)st ','get(g)rp'& ! 2/3
+,'(p)rgrp ','c(o)ptnd','cop(t)el',' (h)elp ',' ',' (z)oom ',' (r)draw',' (q)uit'& !3
+,' (a)dd ',' (m)ove ',' (d)el ',' (f)ind ',' (g)line',' (e)lev '& !4
+,' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' (m)ap ',' (o)utln'& !4/5
+,' (e)lts ','(n)odes ',' ne(t)w ',' t(y)pe ','cc(l)ine',' (d)ata '& !5
+,'(b)elev ',' d(r)aw ',' (s)el ',' (j)oin ',' (f)ind ',' (g)blok'& !5/6
+,' (t)ype ',' f(i)ll ',' (h)elp ',' (z)oom ',' (r)draw',' (q)uit '& !6
+,' (d)el ','r(e)fin ',' (n)umb ',' (a)ll ','rectn(g)','(t)riang'& !7
+,' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' (f)our ','two(l)g '& !7/8
+,'two(s)h ','spli(t) ','re(v)rs ','clea(n) ',' ','s(m)plfy',' ',' (q)uit '& !8
+,'(m)an/el','(a)ll/el','(f)il/el','(s)in/el',' loc(k) ','(u)nlock'& !9
+,'(t)hree ','man/(w)d',' (h)elp ','(q)uit ','al(l)mid','cen(m)id'& !9/10
+,'sin(g)le','un(u)sed',' (f)ill ',' (j)oin ',' (h)elp ',' (z)oom '& !0
+,' (r)draw',' (q)uit ','a(s)ave ','(b)save ','(m)save ',' (p)save'& !10/11
+,2*' ',' (h)elp ',' (z)oom ',' (r)draw',' (q)uit ',' z(e)ro '& !11/12
+,' (o)ne ',' (t)wo ','t(h)ree ',' (f)our ',' f(i)ve ',' (s)ix '& !12
+,' se(v)en',' ei(g)ht',' (q)uit ',' (w)idth',' ss(1) ',' ss(2) '& !12/13
+,'strw(d) ','str(e)lv','str(s)lp',' (b)s1 ',' (z)oom ',' (r)draw'& !13
+,' (q)uit ','(d)elete','s(e)t999','se(t)elv','set(l)ay',' loc(k) ','(u)nlock','(f)orm-t',' (z)oom ',' (r)draw'& !13/14
+,' (q)uit ','(d)elete','r(e)fin ','se(t)yp ','s(m)plfy','form(g)p','elev und',' ',' (z)oom ',' (r)draw'& !14/15
+,' (q)uit ','(m)an/el','(a)ll/el','(f)il/el',' ',' ',' '& !15/16
+,' ',' ',' (h)elp ','(q)uit '/
+
+
+!IPk apr95 changed structure of messages added 3 more entries
+
+
+ DATA MESS /'Enter node to search for',' Enter material type',& ! 1,2
+ 'Enter element to search for ',& ! 3
+ 'Enter numbr of layers ',& ! 4
+ 'Enter width ',& ! 5
+ 'Click mouse at end of line ',& ! 6
+ 'Enter nmbr of nodes in line ',& ! 7
+ 'Click at corners of block ',& ! 8
+ 'Enter nmbr of elts in x-dir ',& ! 9
+ 'Enter nmbr of elts in y-dir ',& ! 10
+ 'Click to move boundaries or (q)uit to save ',& ! 11
+ 'Click on elements', 'Enter starting list number ',& ! 12,13
+ 'Enter bottom elevation', 'Click on node ',& ! 14,15
+ 'Click location of new node', 'Click at node to move ',&! 16,17
+ 'Click at node to delete ',& ! 18
+ 'Type 1 to use all nodes else type 0 ',& ! 19
+ 'Enter element to select','Click location of node',& ! 20,21
+ 'Enter ss1','Enter ss2','Enter strwid','Enter storage elevation',& ! 22,23,24,25
+ 'Click mouse on node','click mouse on next node',& ! 26,27
+ 'ERROR - Midside node selected - Select node again',& ! 28
+ 'Plotting a selected cross section',& ! 29
+ 'Click two locations to form a cross section',&! 30
+ 'Click to adjust the cross section',& ! 31
+ 'Compute cross section parameters',& ! 32
+ 'Click a node for the cross section',& ! 33
+
+ 'Click two locations to form the width','Click to adjust the line','Click two locations to form left slope',& ! 34 35 36
+ 'Click two locations to form right slope','Click a location'& ! 37 38
+ ,'Enter storage elevation','Enter storage slope',& ! 39 40
+ 'Click at two locations to determine distance'& ! 41
+ ,'Enter continuity line number use 0 to end','Click at location on image to define register point'& ! 42 43
+ ,'Enter 1-d cross-section bed slope','Click at location to define outline point'& ! 44 45
+ ,' ','Click two locations to define move'& ! 46 47
+ ,'Click locations to form outline'/ ! 48
+ ! last line Jan 2001
+! line above added Jan 1999
+ DATA HEADR /&
+ ' (q)uit ',5*' ',&
+ ' (r)draw',' (q)uit ',4*' ',&
+ ' (z)oom ',' (r)draw', ' (q)uit ',3*' ',&
+ ' (n)ext ',' (z)oom ', ' (r)draw',' (q)uit ',2*' ',&
+ ' (b)ack ',' cn(n)ect', ' (z)oom ',' (r)draw',' (q)uit ',' ',&
+ ' (l)ine ',' (d)rawcs', ' (z)oom ',' (r)draw',' (q)uit ',' ',&
+ ' (d)ist ',' (w)idth', ' (1)slop',' (2)slop',' b(e)lev',' (q)uit',&
+ ' (d)el ',' (z)oom ', ' (r)draw',' (q)uit ',2*' ',&
+ ' s(a)ve ',' (z)oom ', ' (r)draw',' (q)uit ',2*' ',&
+ ' u(n)do ',' (c)ancl', ' (z)oom ',' (r)draw',' (q)uit ',1*' '/
+ DATA IRV/1 , 2 , 5 , 3 , 4 , 7 , 10 , 6 , 9, 5/
+ DATA NHEDL/10,5,10,10,10,10,10,10,10,10,10,10,10,10,10,10/
+! DATA IBAKK/12/,ICOLR/11/
+ IF(NHTP .NE. 0) THEN
+
+! Clear upper box area
+
+ CALL CLRBOX
+
+! Copy appropriate heading for output
+
+ NSIZ=NHEDL(NHTP)
+ DO 120 N=1,NSIZ
+ HED(N)=HEAD(N,NHTP)
+ 120 CONTINUE
+
+! Draw box around selections with colour
+!
+ Y(1)=7.5
+ Y(2)=7.5
+ Y(3)=7.995
+ Y(4)=7.995
+ Y(5)=7.5
+ XPT=0.
+ DO 150 I=1,NSIZ
+ X(1)=XPT
+ X(4)=XPT
+ X(5)=XPT
+! XPT=XPT+1.0
+ XPT=XPT+HSIZE/10.
+ X(2)=XPT
+ X(3)=XPT
+ IF(I .EQ. 10) THEN
+ IBLK=IBAKK
+!IPK OCT96 ADD COLOR OPTIONS
+ ELSEIF((NHTP .EQ. 5 .AND. IPSW(IRV(I)) .EQ. 1) .OR. &
+ (NHTP .EQ. 12 .AND. ICOLON(I) .EQ. 1)) THEN
+ IBLK=iblkk
+ ELSE
+ IBLK=IBAKK
+ ENDIF
+ CALL POLYFL(X,Y,5,IBLK)
+ CALL RBLACK
+ CALL PLOTT(X(1),Y(1),3)
+ CALL PLOTT(X(2),Y(2),2)
+ CALL PLOTT(X(3),Y(3),2)
+ CALL PLOTT(X(4),Y(4),2)
+ CALL PLOTT(X(1),Y(1),2)
+ 150 CONTINUE
+ XSY=0.
+ YSY=7.65
+ DO 200 N=1,NSIZ
+!ipk mar01
+ CALL SYMBL(XSY,YSY,0.20,HED(N),0.0, 8)
+! XSY=XSY+1.0
+ XSY=XSY+HSIZE/10.
+ 200 CONTINUE
+ ENDIF
+ IF(NMESS .GT. 0) THEN
+
+! Clear upper box area
+
+ CALL CLRBOX
+
+! Write out message
+
+ MESOUT=MESS(NMESS)
+!ipk mar01
+ CALL SYMBL(0.,7.65,0.20,MESOUT,0.,47)
+
+ ENDIF
+ IF(NBRR .NE. 0) THEN
+
+! Put box on right
+
+! Draw box around selections
+
+ NBX=NBRR
+ if(NBX.gt.5) NBX=NBRR-1 !ycw mar97
+ IF(NBX .GT. 6) NBX=4
+ if(nbrr .eq. 10) NBX=5
+! XLEFT=10-NBX
+ XLEFT=(10-NBX)*HSIZE/10.
+ DO 250 K=1,NBX
+ X(1)=XLEFT
+ X(4)=XLEFT
+ X(5)=XLEFT
+! XLEFT=XLEFT+1.0
+ XLEFT=XLEFT+HSIZE/10.
+ X(2)=XLEFT
+ X(3)=XLEFT
+ IBLK=IBAKK
+ CALL POLYFL(X,Y,5,IBLK)
+ CALL RBLACK
+ CALL PLOTT(X(1),Y(1),3)
+ CALL PLOTT(X(2),Y(2),2)
+ CALL PLOTT(X(3),Y(3),2)
+ CALL PLOTT(X(4),Y(4),2)
+ CALL PLOTT(X(1),Y(1),2)
+!ipk mar01
+ CALL SYMBL(XLEFT-1.,7.65,0.20,HEADR(K,NBRR),0.0,8)
+ 250 CONTINUE
+! ENDIF
+ ENDIF
+ RETURN
+ END
+
+
+
+! Get xy location of cursor in screen coordinates (inches)
+
+
+ subroutine xyloc(xscrn,yscrn,iflag,ibox)
+ save
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ CHARACTER*1 ALABL(10)
+ CHARACTER*40 MPDUM
+
+ COMMON /SSIZE/ HSIZE
+
+ COMMON /BLKA1/ TITLE,HLABL,ALABL,MPDUM
+!IPk oct 95 lines defining MPDUM added
+
+!ipk jan01 Expand IPSW to 10
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+
+ character*1 iflag
+ common /blktek/ xmin, xmax, ymin, ymax,&
+ xpiv, ypiv, cthet, sthet,&
+ xscal, yscal, theta, thetdg,&
+ pgscl,scrnx,scrny,ix,iy
+
+! IRDISP= 0 means no redisplay
+
+ irdisp=0
+ 100 continue
+! iy=ymax
+! write(90,*) 'to tekgin nhtp',nhtp
+ call tekgin(xscrn,yscrn,iflag)
+! write(90,*) 'back tekgin nhtp',nhtp,xscrn,yscrn,IRDISP
+! write(90,'(a)') 'iflag',iflag
+
+ if(iflag .eq. 'P') then
+ call hedr
+!IPk nov97 add (0)
+ call plotot(0)
+ call hedr
+!ipk may01
+ irdisp=1
+ go to 100
+ endif
+
+
+!IPk mar94 if(yscrn .gt. 7.0 .and. iflag .eq. 'c') then
+ if(yscrn .gt. 7.5 .and. iflag .eq. 'c') then
+! ibox=ifix(xscrn+0.9999)
+ ibox=ifix(xscrn*10./HSIZE+0.9999)
+ iflag='c'
+ elseif(iflag .eq. 'M') then
+ irmain = 1
+ elseif(iflag .ne. 'c') then
+ ibox=1
+ else
+ ibox=0
+ endif
+ if(irmain .eq. 1) return
+
+! Check for zoom command
+
+ if(nhtp .eq. 2 .or. nhtp .eq. 5 .or. nhtp .eq. 12 .or.&
+ nhtp .eq. 8 .or. nhtp .eq. 9) then
+ return
+ elseif(nhtp .eq. 0 .and. (nbrr .eq. 0 .or. nbrr .eq. 2&
+ .or. nbrr .eq. 7)) then
+ return
+ elseif(ibox .eq. 8 .or. iflag .eq. 'z') then
+ n1=nhtp
+ n2=nbrr
+ nhtp=0
+ nbrr=0
+ CALL ZOOM
+ nhtp=n1
+ nbrr=n2
+!ipk may01
+ irdisp=1
+ if(irmain .eq. 1) return
+ call hedr
+ IF(N2 .EQ. 10) CALL PLTPT
+ go to 100
+ elseif(ibox .eq. 9 .or. iflag .eq. 'r') then
+
+! Save display parameters
+
+ n1=nhtp
+ n2=nmess
+ n3=nbrr
+ CALL RDRW(0)
+ if(n2 .eq. 11) call pltpt
+!ipk may01
+ irdisp=1
+ if(irmain .eq. 1) return
+
+! Restore display parameters
+
+ nhtp=n1
+ nmess=n2
+ nbrr=n3
+ call hedr
+ go to 100
+ endif
+
+ return
+
+ end
diff --git a/src/src83e/HELPS.F90 b/src/src83e/HELPS.F90
new file mode 100644
index 0000000..3d45694
--- /dev/null
+++ b/src/src83e/HELPS.F90
@@ -0,0 +1,99 @@
+!ipk last update Nov 18 1997
+!
+ SUBROUTINE HELPS(NTPIN)
+ USE WINTERACTER
+!
+! Master routine controlling the help facility
+!
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+!
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER*32 ANS
+ CHARACTER*78 AHP
+ character*55 strels
+! INTEGER*2 IPAG
+! INTEGER*2 NT
+ DIMENSION NPOS(11),NFIN(10)
+ LOGICAL*4 EXST
+
+ INQUIRE(FILE=DIRECT,EXIST=EXST)
+ IF(.not. EXST) THEN
+ CALL CLSCRN
+! WRITE(strels,6000)
+! 6000 format( 'Help files not available, press enter to return to menu')
+! CALL SYMBL(0.2,7.0,0.25,STRELS,0.0,55)
+! NDIG=1
+! call gtcharx(ans,ndig,6.0,7.0)
+
+ Filter='HTM file -- *.htm|*.htm|'
+
+! CALL WSelectFile(FILTER,PromptOn,DIRECT,'Help files not available - BROWSE')
+
+ CALL WSelectFile(FILTER,LoadDialog+MustExist,DIRECT,'Help files not available - BROWSE')
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 200
+ ELSE
+ CALL PLOTOT(1)
+ RETURN
+ ENDIF
+ ENDIF
+!
+! Write list of options and request choice
+!
+ 200 CONTINUE
+!
+! Decode choice and open appropriate file
+!
+ IF(NTPIN .EQ. 0) THEN
+ if(nhtp .lt. 3) then
+ call WHelpfile(DIRECT)
+ elseif(nhtp .eq. 3) then
+ call WHelpfile(DIRECT,'REORDER')
+ elseif(nhtp .eq. 4) then
+ call WHelpfile(DIRECT,'NODE')
+ elseif(nhtp .eq. 5) then
+ call WHelpfile(DIRECT,'REDRAW')
+ elseif(nhtp .eq. 6) then
+ call WHelpfile(DIRECT,'ELEMENT')
+ elseif(nhtp .eq. 7) then
+ call WHelpfile(DIRECT,'SELECT')
+ elseif(nhtp .eq. 8) then
+ call WHelpfile(DIRECT,'REFINE')
+ elseif(nhtp .eq. 9) then
+ call WHelpfile(DIRECT,'ELEVATION')
+ elseif(nhtp .eq. 10) then
+ call WHelpfile(DIRECT,'DELETE')
+ elseif(nhtp .eq. 11) then
+ call WHelpfile(DIRECT,'SAVE')
+ elseif(nhtp .eq. 12) then
+ call WHelpfile(DIRECT,'MAP')
+ elseif(nhtp .eq. 13) then
+ call WHelpfile(DIRECT,'WIDTH')
+ elseif(nhtp .eq. 14) then
+ call WHelpfile(DIRECT,'POLNODE')
+ elseif(nhtp .eq. 15) then
+ call WHelpfile(DIRECT,'POLELEM')
+ endif
+ ELSEIF(NTPIN .EQ. 1) THEN
+ call WHelpfile(DIRECT,'FILE')
+ ELSEIF(NTPIN .EQ. 2) THEN
+ call WHelpfile(DIRECT,'ELEMENT')
+ ELSEIF(NTPIN .EQ. 3) THEN
+ call WHelpfile(DIRECT,'NODE')
+ ELSEIF(NTPIN .EQ. 4) THEN
+ call WHelpfile(DIRECT,'ELEVATION')
+ ELSEIF(NTPIN .EQ. 5) THEN
+ call WHelpfile(DIRECT,'REORDER')
+ ELSEIF(NTPIN .EQ. 6) THEN
+ call WHelpfile(DIRECT,'SELECT')
+ ELSEIF(NTPIN .EQ. 7) THEN
+ call WHelpfile(DIRECT,'DELETE')
+ ELSEIF(NTPIN .EQ. 8) THEN
+ call WHelpfile(DIRECT,'SAVE')
+
+ ENDIF
+ RETURN
+ END
diff --git a/src/src83e/INITSIZ.f90 b/src/src83e/INITSIZ.f90
new file mode 100644
index 0000000..8aef61d
--- /dev/null
+++ b/src/src83e/INITSIZ.f90
@@ -0,0 +1,162 @@
+ SUBROUTINE INITSIZ(IIN1,N1,M1,K1)
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+ USE BLKMAP
+
+ INCLUDE 'D.INC'
+
+ IF(K1 .EQ. 0) THEN
+ MAXPL=200000
+ MAXP=200000
+ MAXE=120000
+ MAXSTO=2
+ MAXLIN=3000
+ MAXECON=60
+ MAXECON1=30
+ MAXLN=20
+ MAELN=300
+ RETURN
+ ENDIF
+ IMIDS=0
+ IF(IIN1 .EQ. 10. .AND. IGFG .EQ. 0 .AND. ITRIAN .EQ. 0) THEN
+ CALL RDRM1(IIN1,N1,M1,IMIDS)
+ ENDIF
+ IF(ITRIAN .EQ. 0) NMIDS=1
+ iqsw(1)=1
+ iqsw(2)=0
+ CALL WMenuSetState(ID_ITYPN,ItemChecked,1)
+
+ IF(N1 .GT. MAXP .OR. M1 .GT. MAXE .AND. IMIDS .EQ. 0) then
+
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Do you wish to add 20,000 nodes and elements to the limit (YES) or reset sizes (NO)','LIMITS EXCEEDED')
+
+ IF (WInfoDialog(4) .ne. 2) then
+! yes
+ MAXP=N1+20000
+ MAXE=M1+20000
+ ELSE
+ CALL RESETSIZ
+ ENDIF
+ ELSEIF((N1 .GT. MAXP/3 .OR. M1 .GT. MAXE) .AND. IMIDS .EQ. 1) then
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'This is a large unfilled network, do you wish to reset sizes?','LIMITS EXCEEDED')
+ IF (WInfoDialog(4) .ne. 2) then
+! yes
+ CALL RESETSIZ
+ ENDIF
+
+ endif
+
+ ALLOCATE (CORD(MAXP,2),XUSR(MAXP),YUSR(MAXP),XC(MAXE),YC(MAXE)&
+ ,NOP(MAXE,8),IMAT(MAXE),THTA(MAXE),IMATL(MAXE),CORDSN(MAXP,2)&
+ ,WD(MAXP) ,WD1(MAXP),INSKP(MAXP), IESKP(MAXE),NCORN(MAXE)&
+ ,WIDTH(MAXP), SS1(MAXP), SS2(MAXP), WIDS(MAXP)&
+ ,IJUN(MAXP),INEW(MAXP),IEM(MAXE),LINTYP(MAXLIN),NEFLAG(MAXP),NEF(MAXP,3),LAY(0:MAXP+1),WTLAY(0:MAXP+1,9)&
+ ,WIDBS(MAXP),SSO(MAXP),NODDEL(MAXP),IELDEL(MAXE)&
+ ,NOPSV(MAXE,8),nefsv(MAXP,3),IMATSV(MAXE),LOCK(MAXP),BS1(MAXP),EDIF(0:MAXP),IGRPSER(MAXE),IOD(MAXP))
+
+ IJUN=0
+ lay=0
+ IGRPSER=1
+
+ ALLOCATE (NRIVCR1(MAXP),WTRIVCR1(MAXP),NRIVCR2(MAXP),WTRIVCR2(MAXP))
+
+
+ ALLOCATE (xusrsto(MAXP,MAXSTO),yusrsto(MAXP,MAXSTO),wdsto(MAXP,MAXSTO),&
+ WIDTHsto(MAXP,MAXSTO), SS1sto(MAXP,MAXSTO), SS2sto(MAXP,MAXSTO), WIDSsto(MAXP,MAXSTO)&
+ ,WIDBSsto(MAXP,MAXSTO),SSOsto(MAXP,MAXSTO),bs1sto(MAXP,MAXSTO)&
+ ,nopsto(MAXE,8,MAXSTO),imatsto(MAXE,MAXSTO),thtasto(MAXE,MAXSTO))
+
+ ALLOCATE (ICCLNSTO(50,350,MAXSTO)&
+ ,NPSTO(MAXSTO),NESTO(MAXSTO),NLSTSTO(MAXSTO),NCLMSTO(MAXSTO))
+
+ ALLOCATE (ILISTSTO(MAXLN,MAELN,MAXSTO),LLISTSTO(MAXLN,MAXSTO))
+
+
+ ALLOCATE (MLIST(MAXE),ENXT(MAXE),NDELM(MAXP),LIST(MAXP) &
+ ,NINC(MAXP),NELIM(MAXE))
+
+ ALLOCATE (ICON(MAXE,MAXECON))
+
+ ALLOCATE (NECON(MAXP,MAXECON))
+
+ ALLOCATE (MSN(MAXP),ICN(MAXP))
+
+ ALLOCATE (ILIST(MAXLN,MAELN),LLIST(MAXLN))
+
+ RETURN
+ END
+
+ SUBROUTINE RESETSIZ
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLKMAP
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: NTYP,NLOCC
+
+
+ call wdialogload(IDD_MLIMITS)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_MLIMITS)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,MAXP)
+ CALL WDialogPutINTEGER(IDF_INTEGER2,MAXE)
+ CALL WDialogPutINTEGER(IDF_INTEGER3,MAXPL)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,MAXP)
+ CALL WDialogGetINTEGER(IDF_INTEGER2,MAXE)
+ CALL WDialogGetINTEGER(IDF_INTEGER3,MAXPL)
+
+ GO TO 100
+ ENDIF
+
+ enddo
+
+ 100 CONTINUE
+ return
+ end
+
+ SUBROUTINE SETGFGTRIAN(I1,I2,N2,M2)
+ USE BLK1MOD
+! Define a common block with file names etc
+
+ INCLUDE 'BFILES.I90'
+ CHARACTER (LEN=255) :: FNAMTMP
+ IGFG=I1
+ ITRIAN=I2
+ IF(ITRIAN .EQ. 1) THEN
+ READ(10,*) M2
+ REWIND (10)
+ itunit=14
+ FNAMTMP=FNAMKEP
+ DO L=255,1,-1
+ IF(FNAMTMP(L:L) .EQ. '.') THEN
+ FNAMTMP(L+1:L+4)='node'
+ OPEN(ITUNIT,FILE=FNAMTMP,STATUS='OLD',ACTION='READ')
+ READ(ITUNIT,*) N2
+ CLOSE(ITUNIT)
+ RETURN
+ ENDIF
+ ENDDO
+ ENDIF
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/INOUT.F90 b/src/src83e/INOUT.F90
new file mode 100644
index 0000000..0d054db
--- /dev/null
+++ b/src/src83e/INOUT.F90
@@ -0,0 +1,2524 @@
+!IPK LAST UPDATE SEP 23 2015 ADD OPTION FOR SURFER FORMAT MAPS
+!IPK LAST UPDATE FEB 11 2002 ADD LOCK AS VARIABLE AND READ NEW MAP FILE
+!ipk jan99 fix restart file
+!
+!
+!****************************************************************
+!
+ SUBROUTINE WRTOUT(IFOM)
+!ipk oct95 IFO replaced by IFOM because the value changes
+!
+! Write out updated data
+!
+! IFO = 0 write to backup
+! IFO = 1 write to output in ASCII
+!IPK MAR94 add a line
+! IFO = -1 write to ASCII in emergency
+! IFO = 2 write to output as binary
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*55 FMTT
+ CHARACTER*39 FMTU
+!IPK JUL98
+ CHARACTER*8 ID8
+ CHARACTER*60 LIND
+ CHARACTER*32 IJNK
+!
+ DATA ISET /2/,ZERO/0.0/
+!ipk oct95 copy IFO from IFOM
+!ipk feb99 IOT=20
+!ipk feb99 IOT1=22
+
+ IF((IFOM .EQ. 2 .AND. IOT1 .EQ. 0) .OR. &
+ & (IFOM .EQ. 1 .AND. IOT .EQ. 0)) THEN
+ CALL CLRBOX
+ WRITE(LIND,*) 'You have attempted to save without opening save f&
+ &ile'
+ CALL SYMBL(0.2,7.80,0.20,LIND,0.0,60)
+ WRITE(LIND,*) 'Press return to continue'
+ CALL SYMBL(0.2,7.55,0.20,LIND,0.0,60)
+ CALL GTCHARX(IJNK,NDIG,5.0,7.6)
+ CALL CLRBOX
+ RETURN
+ ENDIF
+ IFO=IFOM
+
+ IF(IFO .GT. 0) THEN
+!
+! Check connectivity before saving
+!
+ CALL CHKCON(IREP)
+ IF(IREP .EQ. 0) RETURN
+ ENDIF
+!
+! Setup 1-D
+ IOD=2
+ DO N=1,NE
+ IF(NCORN(N) .LT. 6) THEN
+ IF(NCORN(N) .EQ. 5) THEN
+ NCN=3
+ ELSE
+ NCN=NCORN(N)
+ ENDIF
+ DO K=1,NCN
+ INODE=NOP(N,K)
+ IF(INODE .GT. 0) IOD(INODE)=1
+ ENDDO
+ ELSE
+ DO K=1,8
+ INODE=NOP(N,K)
+ IF(INODE .GT. 0) then
+ IF(IOD(INODE) .EQ. 2) IOD(INODE)=0
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DO J=1,NP
+ IF(IOD(J) .EQ. 0) THEN
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ WIDBS(J)=0.
+ SSO(J)=0.
+ BS1(J)=0.
+ ENDIF
+ ENDDO
+!IPK MAR94 add a line
+ IFO = ABS(IFO)
+ if((ifo .eq. 1 .and. igfgsw .eq. 0) .or. ifo .ne. 1) then
+ if(itrianout .eq. 0) CALL HEADIN(IFO,ISET)
+ endif
+ IF(IFO .EQ. 0 ) THEN
+ WRITE(IBAK) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE)
+ WRITE(IBAK) &
+ & (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
+ & WIDBS(J),SSO(J),BS1(J),J=1,NP)
+!IPK MAR02 add BS1
+!IPK JUL98 + (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J)
+ WRITE(IBAK) NLST
+ IF(NLST .GT. 0) THEN
+ WRITE(IBAK) (LLIST(J),J=1,NLST), &
+ & ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)
+ ENDIF
+!IPK JAN01
+ WRITE(IBAK) NENTRY,NLAYD,NCLM
+ IF(NENTRY .GT. 0) THEN
+ WRITE(IBAK) ((NEF(I,J),J=1,3),I=1,NENTRY)
+ ENDIF
+ IF(NLAYD .GT. 0) THEN
+ WRITE(IBAK) (LAY(I),I=0,NP),((WTLAY(I,J),J=1,9),I=0,NP)
+ ENDIF
+!IPK JAN01
+ IF(NCLM .GT. 0) THEN
+ WRITE(IBAK) ((ICCLN(I,J),J=1,350),I=1,NCLM)
+ ENDIF
+ IF(IBAK .EQ. 21) THEN
+ CLOSE (IBAK)
+ OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(IBAK,FILE='ELT1.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ OPEN(IBAK,FILE='ELT2.BAK',STATUS='UNKNOWN',FORM='UNFORMATTED',IOSTAT=iost)
+ if(iost .gt. 0) then
+ write(*,*) 'ERROR UNABLE TO OPEN ELT.BAK FILE'
+ write(*,*) 'PRESS RETURN TO END'
+ read(*,'(I5)') junk
+ STOP
+ endif
+ ENDIF
+ ENDIF
+! OPEN(IBAK,FILE='ELT.BAK',STATUS='UNKNOWN',FORM='BINARY')
+ ENDIF
+
+ ELSEIF(IFO .EQ. 2) THEN
+ if(igfgswb .eq. 0) then
+!ipk may02 REWIND IOT1
+ WRITE(IOT1) &
+ & NP,NE,(XUSR(J),YUSR(J),ZERO,WD(J),J=1,NP), &
+ & ((NOP(J,K),K=1,8),IMAT(J),THTA(J),IEM(J),J=1,NE), &
+ & (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,NP)
+!IPK JUL98
+ ID8='part-2 '
+ WRITE(IOT1) ID8
+ WRITE(IOT1) (WIDBS(J),SSO(J),J=1,NP)
+
+!IPK JAN01 Add part 3 write for continuity lines
+ IF(NCLM .GT. 0) THEN
+ ID8='part-3 '
+ WRITE(IOT1) ID8
+ WRITE(IOT1) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
+ ENDIF
+!IPK JAN01 Add part 4 write for continuity lines
+ ID8='part-4 '
+ WRITE(IOT1) ID8
+!ipk mar02 add BS1
+ write(iot1) (lock(j),bs1(j),j=1,np),&
+ nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
+ else
+ call wrtbin
+ endif
+ ELSE
+ if(igfgsw .eq. 0 .and. itrianout .eq. 0) then
+ IOF=IOT
+
+ JJ=0
+ DO 10 J=1,NE
+ IF (IMAT(J) .NE. 0) THEN
+ JJ=JJ+1
+ IF(IECHG .EQ. 0) IEM(JJ)=JJ
+
+ if(np .lt. 100000) then
+ WRITE(IOF,'(10I5,F10.3,I5)') &
+ & J, (NOP(J,K),K=1,8), IMAT(J),THTA(J),IEM(JJ)
+ else
+ WRITE(IOF,'(10I6,F10.3,I6)') &
+ & J, (NOP(J,K),K=1,8), IMAT(J),THTA(J),IEM(JJ)
+ endif
+ ENDIF
+ 10 CONTINUE
+!
+!ipk jan98 restore 9999
+ if(np .lt. 100000) then
+ WRITE(IOF,'(I5)') 9999
+ else
+ WRITE(IOF,'(I6)') 9999
+ endif
+!
+! Write out nodal data
+!
+!ipk jun97 find max or min number in x or y
+ cminx=0.
+ cmaxx=0.
+ wdmin=1.e10
+ wdmax=-1.e10
+ do j=1,np
+ if(inew(j) .eq. 1) then
+! write(90,*) j,xusr(j),yusr(j)
+ if(xusr(j) .gt. cmaxx) cmaxx=xusr(j)
+ if(yusr(j) .gt. cmaxx) cmaxx=yusr(j)
+ if(xusr(j) .lt. cminx) cminx=xusr(j)
+ if(yusr(j) .lt. cminx) cminx=yusr(j)
+ wdmin=min(wdmin,wd(j))
+ wdmax=max(wdmax,wd(j))
+ endif
+ enddo
+ if(abs(wdmin) .gt. abs(wdmax)) then
+ temp=log10(abs(wdmin))
+ elseif(wdmax .eq. 0.) then
+ temp=2.5
+ else
+ temp=log10(abs(wdmax))
+ endif
+ if(temp .gt. 2.) then
+ itp=3
+ elseif(temp .gt. 1.) then
+ itp=4
+ else
+ itp=5
+ endif
+ ndigp=1
+ if(cmaxx .gt. 1.) then
+ ndigp=int(log10(cmaxx))+1
+ endif
+ ndigm=2
+ if(abs(cminx) .gt. 1.) then
+ ndigm=int(log10(abs(cminx)))+2
+ endif
+ ndigo=max(ndigp,ndigm)
+ ndec=min(8-ndigo,4)
+! write(90,*) 'ndigp',ndigp,ndigm,cmaxx,cminx,ndigo,ndec
+ if(ntempin .lt. 2) then
+ write(fmtt,6200) NDEC,NDEC,itp
+!IPK JUL98 6200 format('(I10,F10.',i1,',F10.'I1,',F10.3,F10.1,2F10.3,F
+!IPK FEB02 ALLOW FOR LOCK AND BS1
+ 6200 format('(I10,F10.',i1,',F10.'I1,',F10.',I1,',F10.1,2F10.3,3F10.2,I10,F10.4)')
+ WRITE(FMTU,6201) NDEC,NDEC,ITP
+!IPK FEB02 ALLOW FOR LOCK AND BS1
+ 6201 format('(I10,F10.',i1,',F10.'I1,',F10.',I1,',60X,I10,F10.4)')
+ else
+ ndec=min(14-ndigo,4)
+! write(fmtt,6202) NDEC+10,NDEC+10,ITP
+ write(fmtt,6202) NDEC+9,NDEC+9,ITP
+ 6202 format('(I10,g20.',i2,',g20.'I2,',F10.',I1,',F10.1,2F10.3,3F10.2,I10,F10.4)')
+! WRITE(FMTU,6203) NDEC+10,NDEC+10,ITP
+ WRITE(FMTU,6203) NDEC+9,NDEC+9,ITP
+ 6203 format('(I10,g20.',i2,',g20.'I2,',F10.',I1,',60X,I10,F10.4)')
+ endif
+ DO 20 J=1,NP
+ IF (INEW(J) .EQ. 1) THEN
+!ipk oct94 IF(WIDTH(J) .GT. 0.01) THEN
+ IF(WIDTH(J) .GT. 0.001 .or. bs1(j) .gt. 0.) THEN
+!ipk feb97 WRITE(IOF, '(I10,2F10.3,F10.2,F10.1,2F10.3,F10.1
+!IPK JUL97 WRITE(IOF, '(I10,3F10.3,F10.1,2F10.3,F10.1)')
+!IPK FEB02 ADD LOCK AND BS1
+
+ WRITE(IOF, FMTT) &
+ & J,XUSR(J),YUSR(J),WD(J), &
+ & WIDTH(J),SS1(J),SS2(J),WIDS(J) &
+ & ,WIDBS(J),SSO(J),LOCK(J),BS1(J)
+
+ ELSE
+! write(90,7777) fmtu,j,xusr(j),yusr(j),ndec,ndigo
+ 7777 format(3x,a23,i5,2e15.6,2i8)
+
+!ipk feb97 WRITE(IOF, '(I10,2F10.3,F10.2)')
+!IPK JUL97 WRITE(IOF, '(I10,3F10.3)')
+!ipk feb02 add lock AND BS1
+ WRITE(IOF, FMTU) &
+ & J,XUSR(J),YUSR(J),WD(J),lock(j),BS1(J)
+ ENDIF
+ ENDIF
+ 20 CONTINUE
+!ipk jan98 restore 9999
+ WRITE(IOF,'(I10)') 9999
+ IF(NLST .GT. 0) THEN
+ DO 30 J=1,NLST
+ IF(LLIST(J) .GT. 0) THEN
+ if(np .lt. 100000) then
+ WRITE(IOF,'(16I5)') (ILIST(J,I),I=1,LLIST(J))
+ else
+ WRITE(IOF,'(16I6)') (ILIST(J,I),I=1,LLIST(J))
+ endif
+ ENDIF
+ 30 CONTINUE
+ ENDIF
+!ipk jan98 restore 9999
+ WRITE(IOF,'(I5)') 9999
+! IF(NLAYD .GT. 0) THEN
+! WRITE(IOF,'(2I5)') (I,LAY(I),I=1,NP)
+! ENDIF
+ WRITE(IOF,6000) NENTRY
+ 6000 FORMAT(I5,20X,'NENTRY')
+ IF(NENTRY .GT. 0) THEN
+ WRITE(IOF,'(15I5)') (NEF(I,1),NEF(I,2),NEF(I,3),I=1,NENTRY)
+ ENDIF
+ WRITE(IOF,6001) NCLM
+ 6001 FORMAT(I5,20X,'NCLM')
+ IF(NCLM .GT. 0) THEN
+ DO I=1,NCLM
+ DO J=1,350
+ IF(ICCLN(I,J) .EQ. 0) THEN
+ NTRAC=J-1
+ IF(NTRAC .GT. 0) THEN
+ WRITE(IOF,6002) I,(ICCLN(I,KK),KK=1,NTRAC)
+ 6002 FORMAT('CC1',I5,9I8/('CC2',5X,9I8))
+ ELSE
+ WRITE(IOF,6002) I
+ ENDIF
+ GO TO 40
+ ENDIF
+ ENDDO
+ 40 CONTINUE
+ ENDDO
+ ENDIF
+ WRITE(IOF,6003)
+ 6003 FORMAT('ENDDATA')
+ elseif(itrianout .gt. 0) then
+ call wrtele(IOT,itrianout)
+ else
+ call wrtgfg(IOT)
+ endif
+ ENDIF
+ RETURN
+ END
+!****************************************************************
+ SUBROUTINE HEADIN(IUNIT,ISET)
+!
+! Read and write header data
+!
+!****************************************************************
+!
+ USE BLK1MOD
+ INTEGER*2 I32
+ CHARACTER*80 ALINE
+!ipk dec97
+ character*40 dlin
+ CHARACTER*32 IJNK
+!IPK JUL98
+!ipk may02
+ CHARACTER*8 ID8
+ CHARACTER*3 ID
+ CHARACTER*1000 HEADER
+
+ COMMON /RECOD/ IRECD,TSPC
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+ INTEGER*2 NOP2(MAXE,8)
+ DATA ISLP/0/,IPRT/1/,IPO/1/,IRO/1/,IRFN/0/,IGEN/0/,NXZL/0/,NITST/1/,ISCTXT/0/,IFILL/0/,IALTGM/1/
+ DATA HORIZ/10./,VERT/8./,XSALE/1./,YSALE/1./,XFACT/1./,YFACT/1./,AR/0./,ANG/0./
+ ! ELSE
+ !ISLP=0
+ !IPRT=1
+ !IPO=1
+ !IRO=1
+ !IRFN=0
+ !IGEN=0
+ !NXZL=0
+ !NITST=1
+ !ISCTXT=0
+ !IFILL=0
+ !IALTGM=1
+
+
+
+! IF ISET = 1 read file
+! IUNIT = 0 get a title
+! IUNIT ne 0 and IIN = 11 read RST header
+! IUNIT ne 0 and IIN = 12 read GEO data
+! IUNIT ne 0 and IIN = 10 read RM1 header
+! IUNIT ne 0 and IIN = 10 ITRIAN .NE. 0 read ELE header
+! IF ISET = 2 write file
+! IUNIT = 0 write a backup header
+! IUNIT = 0 write RM1 header
+
+!
+ IF(ISET .EQ. 1) THEN
+ IF(IUNIT .EQ. 0) THEN
+!
+! Generate values
+!
+ CALL SETD(23)
+!ipk oct96 WRITE(*,*) 'Enter a title for output file'
+ WRITE(DLIN,'(a29)') 'Enter a title for output file'
+!ipk oct96 change to dlin
+! call symbl(0.5,5.0,0.25,dlin,0.0,29)
+! ndig=29
+! call gtcharx(title,ndig,0.,4.5)
+
+ IF(IRECD .NE. 2) call get_label(dlin,title)
+
+!
+
+!ipk oct96 end changes
+!ipk oct96 READ(*,5000) TITLE
+ CALL SETD(2)
+! ISPL=0
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0.
+ ELSE
+ IF(IIN .EQ. 11) THEN
+!IPK FEB03 READ(IIN) TITLE,NP,NE
+!IPK FEB03 READ(IIN) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+!IPK FEB03 & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+!IPK FEB03 READ(IIN) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+!IPK FEB03 IF(IPP .GT. 0) READ(IIN) ALINE
+ CALL RDRST(1,IIN)
+
+ ELSEIF(IIN .EQ. 12) THEN
+ CALL SETD(23)
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0.
+ !ipk oct96 WRITE(*,*) 'Enter a title for output file'
+ WRITE(dLIN,'(a29)') 'Enter a title for output file'
+
+ call get_label(dlin,title)
+
+! call symbl(0.5,5.0,0.25,dlin,0.0,29)
+! ndig=29
+! call gtcharx(title,ndig,0.,4.5)
+
+!ipk oct96 end changes
+!ipk oct96 READ(*,5000) TITLE
+ CALL SETD(2)
+ IF(IGFG .EQ. 2) THEN
+ CALL RDBIN(IIN)
+ RETURN
+ ENDIF
+!ipk dec97
+ read(iin,err=100) header
+ if(header(1:6) .eq. 'RMAGEN' .or. header(1:6) .eq. 'RMASIM') then
+ inopt=2
+ else
+ inopt=1
+ rewind iin
+ endif
+ read(iin) n1,m1
+ rewind iin
+ write(90,*) 'Apparent nodes and elements from file are'
+ write(90,'(i15,i10)') n1,m1
+ if(n1 .gt. maxp .or. m1 .gt. maxe) then
+!
+!...... Perhaps the file format is wrong, close and reopen
+!
+ WRITE(DLIN,'(A32)') 'Parameter limits may be violated'
+ call symbl(0.5,4.5,0.20,dlin,0.0,32)
+ WRITE(DLIN,'(A35)') 'Retrying with alternate file format'
+ call symbl(0.5,4.2,0.20,dlin,0.0,35)
+ close (iin)
+ open(iin ,file=fnamkep,status='old',form='unformatted')
+ read(iin) n1,m1
+ write(90,*) 'Revised nodes and elements from file are'
+ write(90,'(i15,i10)') n1,m1
+ if(n1 .gt. maxp .or. m1 .gt. maxe) then
+ WRITE(DLIN,'(A31)') 'Parameter limits still violated'
+ call symbl(0.5,3.9,0.20,dlin,0.0,31)
+ WRITE(DLIN,'(A27)') 'Apparent nodes and elts are'
+ call symbl(0.5,3.6,0.20,dlin,0.0,27)
+ WRITE(DLIN,'(2i10)') n1,m1
+ call symbl(0.5,3.3,0.20,dlin,0.0,20)
+ WRITE(DLIN,'(A24)') 'Press enter to terminate'
+ call symbl(0.5,4.5,0.20,dlin,0.0,24)
+ CALL GTCHARX(ijnk,ndig,5.0,4.0)
+!cipk aug00 read(*,'(i1)') junk
+ call quit_pgm
+ endif
+ endif
+ rewind iin
+!ipk dec97 end changes
+!ipk may02
+ if(inopt .eq. 2) then
+ read(iin,err=100) header
+ READ(IIN,ERR=100) &
+ & N1,M1,((CORD(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP(J,K),K=1,8),IMAT(J),THTA(J),I3,J=1,M1) &
+ & , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
+!IPK JUL98
+ else
+ READ(IIN,ERR=100) &
+ & N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1) &
+ & , (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
+ DO J=1,N1
+ DO K=1,2
+ CORD(J,K)=CORDSN(J,K)
+ ENDDO
+ ENDDO
+ DO J=1,M1
+ DO K=1,8
+ NOP(J,K)=NOP2(J,K)
+ ENDDO
+ ENDDO
+ endif
+ read(IIN,err=120,end=120) id8
+ if(id8(1:6) .eq. 'part-2') then
+ read(IIN,err=104) (widbs(j),sso(j),j=1,n1)
+ read(IIN,err=120,end=120) id8
+ endif
+
+!IPK JAN01 Add part 3 write for continuity lines
+ if(id8(1:6) .eq. 'part-3') then
+
+!ipk aug02 IF(NCLM .GT. 0) THEN
+ READ(IIN,ERR=104) NCLM,((ICCLN(I,J),J=1,350),I=1,NCLM)
+!ipk aug02 ENDIF
+ read(IIN,err=120,end=120) id8
+ endif
+!IPK DEB02 Add part 4 write for lock and BS1 lines and reordering
+ if(id8(1:6) .eq. 'part-4') then
+ read(iin,err=104,end=120) (lock(j),bs1(j),j=1,n1)
+ read(iin,err=104,end=90) &
+ nlst,((ilist(j,k),k=1,maeln),llist(j),j=1,maxln)
+ endif
+ GO TO 120
+!IPK MAR04
+ 90 NLST=0
+ DO J=1,MAXLN
+ LLIST(J)=0
+ DO K=1,MAELN
+ ILIST(J,K)=0
+ ENDDO
+ ENDDO
+ GO TO 120
+
+ 100 READ(IIN,ERR=104) &
+ & N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1), &
+ & ((NOP2(J,K),K=1,8),IMAT(J),THTA(J),I32,J=1,M1)
+ DO J=1,N1
+ DO K=1,2
+ CORD(J,K)=CORDSN(J,K)
+ ENDDO
+ ENDDO
+ DO J=1,M1
+ DO K=1,8
+ NOP(J,K)=NOP2(J,K)
+ ENDDO
+ ENDDO
+ GO TO 120
+
+ 104 WRITE(90,*) 'Error reading binary geometry file'
+!ipk jan98 CALL SETD(23)
+ call clscrn()
+ WRITE(aline,*) 'Error reading binary geometry file'
+ call symbl &
+ & (1.1,3.3,0.20,aline,0.0,80)
+ WRITE(aline,*) 'Press enter to exit'
+ call symbl &
+ & (1.1,3.0,0.20,aline,0.0,80)
+ ndig=1
+ CALL GTCHARX(IJNK,NDIG,5.0,7.6)
+ CALL Quit_Pgm
+ STOP
+
+ 120 CONTINUE
+ NP=N1
+ NE=M1
+ ELSE
+ IF(IGFG .EQ. 0 .AND. ITRIAN .EQ. 0) THEN
+ READ(IIN,5000) TITLE
+ write(90,5000) title
+ 5000 FORMAT( A80)
+ READ(IIN,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ write(90,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ 5010 FORMAT( 15I5,2f10.1,i10)
+ READ(IIN,5011) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ 5011 FORMAT( 2F10.0,4F10.4,2F10.0 )
+ IF(IPP .GT. 0) READ(IIN,5012) ALINE
+ 5012 FORMAT(A80)
+ ELSEIF(IGFG .GT. 0 .OR. ITRIAN .EQ. 1) THEN
+ write(90,*) 'reading gfg/TRIAN title'
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0.
+ IF(IGFG .EQ. 1) THEN
+ DO I=1,10000
+ READ(IIN,'(A3,A77)') ID,DLIN
+ IF(ID .EQ. 'T1 ') THEN
+ TITLE(1:77)=DLIN
+ GO TO 140
+ ENDIF
+ ENDDO
+ ELSEIF(IGFG .EQ. 3) THEN
+ DO I=1,10000
+ READ(IIN,'(A8,A77)') ID8,DLIN
+ IF(ID8 .EQ. 'MESHNAME') THEN
+ TITLE(1:77)=DLIN
+ GO TO 140
+ ENDIF
+ ENDDO
+ ENDIF
+ 140 CONTINUE
+ REWIND IIN
+ ENDIF
+ ENDIF
+ ENDIF
+ ELSE
+ IF(IUNIT .EQ. 0 ) THEN
+ IF(IPNN .NE. 1) THEN
+ ISLP=0
+ IPRT=1
+ IPNN=1
+ IPEN=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=10.
+ VERT=8.
+ XSALE=0.
+ YSALE=0.
+ XFACT=0.
+ YFACT=0.
+ AR=0.
+ ANG=0.
+ xadded=0.
+ yadded=0.
+ ntempin=0
+ ENDIF
+ REWIND IBAK
+ WRITE(IBAK) TITLE,NP,NE
+ WRITE(IBAK) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ WRITE(IBAK) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ IF(IPP .GT. 0) WRITE(IBAK) ALINE
+ ELSEIF(IUNIT .EQ. 1) THEN
+ IOF=IOT
+ REWIND IOF
+!ipk nov02
+!IPK MAR04
+! if(ne .gt. 99999) then
+ if(np .gt. 99999) then
+ if(ntempin .eq. 0) then
+ ntempin=1
+ else
+ ntempin=3
+ endif
+ endif
+ ISLP=0
+ IPRT=1
+ IPO=1
+ IRO=1
+ IPP=0
+ IRFN=0
+ IGEN=0
+ NXZL=0
+ NITST=1
+ ISCTXT=0
+ IFILL=0
+ IALTGM=1
+ NLAYD=0
+ HORIZ=0
+ VERT=0
+ XSALE=0
+ YSALE=0
+ XFACT=0
+ YFACT=0
+ AR=0
+ ANG=0
+ WRITE(IOF,5000) TITLE
+ WRITE(IOF,5010) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+ WRITE(IOF,5011) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ IF(IPP .GT. 0) WRITE(IOF,5012) ALINE
+ ENDIF
+ ENDIF
+ RETURN
+ END
+!
+ SUBROUTINE RDCORD(IUNIT)
+!
+! Read in coordinates
+!
+!IPK MAY02
+ USE WINTERACTER
+ USE BLK1MOD
+
+ include 'd.inc'
+
+ REAL*8 CX,CY,VALS(7)
+
+
+ DIMENSION IRLINE(16)
+ CHARACTER*1 IJNK,ans
+ character*30 blank
+ CHARACTER*32 ANS32
+ CHARACTER*77 DLIN2
+ CHARACTER*28 MESG
+ CHARACTER*3 ID
+ character*80 dlin
+!ipk feb02 expand to 110
+ character*150 dlin1
+! INCLUDE 'BLK1.COM'
+ DATA IFIRST / 0 /
+ data blank/' '/
+!
+ IF (IFIRST .EQ. 0) THEN
+ IF(IIN .EQ. 10) THEN
+ NP = 0
+ ENDIF
+ VOID = - 1.0E+10
+ VDX = -1.E+9
+ IFIRST = 1
+ ENDIF
+ ISTART=0
+ JZ=0
+!
+!
+ IF(IUNIT .EQ. 0) RETURN
+ IF(IUNIT .EQ. 10) THEN
+ IF(IGFG .gt. 0) REWIND IUNIT
+!ipk oct96 upgrade to model limits
+ 20 continue
+ IF(IGFG .EQ. 0 .AND. ITRIAN .EQ. 0) THEN
+!IPK JUL98 read(iunit,'(a80)',end=98) dlin
+!ipk feb02 expand to 110
+!ipk may02 expand to 150
+ read(iunit,'(a150)',end=98) dlin1
+ if(dlin1(11:30) .eq. blank) go to 98
+!IPK JUL98 READ(dlin,'(I10,7F10.0)') J, CX, CY, BELEV,
+!ipk feb02 add lock and BS1
+ if(ntempin .lt. 2) then
+ READ(dlin1,'(I10,9F10.0,I10,F10.0)') J, CX, CY, BELEV, &
+ & WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+ else
+ READ(dlin1,'(I10,2f20.0,7F10.0,I10,F10.0)',err=8888) J, CX, CY, BELEV, &
+ & WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+ go to 8889
+ 8888 do kcl=61,140
+ dlin1(kcl:kcl)=' '
+ enddo
+ READ(DLIN1,'(I10,2F20.0,7F10.0,I10,F10.0)') J, CX, CY, BELEV,&
+ WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+8889 continue
+
+
+ endif
+ ELSEIF(ITRIAN .EQ. 1) THEN
+ IF(ISTART .EQ. 0) THEN
+ READ(IUNIT,*) NPPP,NDUM,NATTR
+ ISTART=1
+ ENDIF
+ READ(IUNIT,*) J,CX,CY,(VALS(K),K=1,NATTR)
+ IF(J .EQ. 0) THEN
+ J=NPPP
+ JZ=1
+ ENDIF
+ BELEV=-9999.
+ WDTHX=0.
+ SS1X=0.
+ SS2X=0.
+ WDSX=0.
+ WEL=0.
+ SSSO=0.
+ LOCK1=0
+ BS11=0.
+ IF(NATTR .GT. 0) BELEV=VALS(1)
+ IF(NATTR .GT. 1) WDTHX=VALS(2)
+ IF(NATTR .GT. 2) SS1X=VALS(3)
+ IF(NATTR .GT. 3) SS2X=VALS(4)
+
+ ELSE
+
+!ipk jun02 Allow for GFGEN input
+ DO ICOUNTC=1,1000000
+ DO JJ=1,150
+ DLIN1(JJ:JJ)=' '
+ ENDDO
+ READ(IUNIT,'(A3,A150)', END=400) ID,DLIN1
+ IF(ID .EQ. 'GNN' .OR. ID .EQ. 'GWN') THEN
+! Count the number of variables
+ I=0
+ ICOUNT=0
+ 75 CONTINUE
+ IF(DLIN1(I+1:I+1) .NE. ' ') THEN
+ GO TO 80
+ ELSE
+ I=I+1
+ GO TO 75
+ ENDIF
+ 80 I=I+1
+ IF(I .EQ. 151) THEN
+ ICOUNT =ICOUNT+1
+ GO TO 90
+ ENDIF
+ IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
+ ICOUNT=ICOUNT+1
+ 85 CONTINUE
+ IF(I+1 .EQ. 151) GO TO 90
+ IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
+ I=I+1
+ GO TO 85
+ ELSE
+ GO TO 80
+ ENDIF
+ ELSE
+ GO TO 80
+ ENDIF
+ ELSEIF(ID(1:2) .EQ. 'ND') THEN
+ ICOUNT=4
+ go to 90
+ ENDIF
+ ENDDO
+ 90 CONTINUE
+ DO K=1,7
+ VALS(K)=0.
+ ENDDO
+ READ(DLIN1,*) J,(VALS(K),K=1,ICOUNT-1)
+! WRITE(109,'(A8,I8,10F15.6)') ID,J,(VALS(K),K=1,ICOUNT-1)
+ IF(ID .EQ. 'GNN' .OR. ID .EQ. 'ND ') THEN
+ CX=VALS(1)
+ CY=VALS(2)
+ BELEV=VALS(3)
+ NP = MAX(NP,J)
+ CORD(J,1) = CX
+ CORD(J,2) = CY
+ XUSR(J) = CX
+ YUSR(J) = CY
+ WD(J) = BELEV
+ INSKP(J)=0
+ INEW(J) = 1
+ GO TO 20
+ ELSE
+ WDTHX=VALS(1)
+ SS1X=VALS(2)
+ SS2X=VALS(3)
+ WDSX=VALS(4)
+ WIDTH(J)=WDTHX
+ SS1(J)=SS1X
+ SS2(J)=SS2X
+ WIDS(J)=WDSX
+ GO TO 20
+ ENDIF
+ ENDIF
+!c IF (J .GT. 9000) GOTO 98
+ IF (J .GE. MAXP) THEN
+!ipk jan98 CALL SETD(23)
+ call clscrn()
+ WRITE(dlin,*) ' Node number exceeds MAXP in RDCORD',j
+ call symbl &
+ & (1.1,3.3,0.20,dlin,0.0,80)
+ WRITE(90,*) ' Node number exceeds MAXP in RDCORD'
+ WRITE(DLIN,*) ' Press enter to exit'
+ call symbl &
+ & (1.1,3.0,0.20,dlin,0.0,80)
+ ndig=1
+ CALL GTCHARX(ANS32,ndig,5.0,4.0)
+!ipk jan98 READ(*,'(A)') IJNK
+ CALL Quit_Pgm
+ STOP
+ ENDIF
+ NP = MAX(NP,J)
+ CORD(J,1) = CX
+ CORD(J,2) = CY
+ XUSR(J) = CX
+ YUSR(J) = CY
+ WD(J) = BELEV
+ WIDTH(J)=WDTHX
+ SS1(J)=SS1X
+ SS2(J)=SS2X
+ WIDS(J)=WDSX
+!IPK JUL98
+ WIDBS(J)=WEL
+ SSO(J)=SSSO
+ INSKP(J)=0
+ INEW(J) = 1
+!IPK FEB02 ADD LOCK
+ LOCK(J)=LOCK1
+ BS1(J)=BS11
+ IF(ITRIAN .EQ. 1) THEN
+ IF((JZ .EQ. 0 .AND. J .EQ. NPPP) .OR. (JZ .EQ. 1 .AND. J .EQ. NPPP-1)) GO TO 400
+ ENDIF
+!
+ GOTO 20
+!
+ 98 CONTINUE
+ NLST=0
+ KK=0
+ 102 continue
+ if(np .gt. 99999) then
+ READ(IUNIT,'(16I6)') IRLINE
+ else
+ READ(IUNIT,'(16I5)') IRLINE
+ endif
+ IF(IRLINE(1) .EQ. 9999 .or. IRLINE(1) .EQ. 99999) GO TO 300
+ IF(KK .EQ. 0) NLST=NLST+1
+ 104 DO 105 K=1,16
+ IF(IRLINE(K) .EQ. 0) GO TO 106
+ KK=KK+1
+ ILIST(NLST,KK)=IRLINE(K)
+ 105 CONTINUE
+ GO TO 102
+ 106 CONTINUE
+ LLIST(NLST)=KK
+ KK=0
+ GO TO 102
+ 300 CONTINUE
+! IF(NLAYD .GT. 0) THEN
+! DO 320 L=1,NP
+! READ(IUNIT,'(2I5)') I,LAY(I)
+! IF(I .GT. 9000) GO TO 325
+! 320 CONTINUE
+! 325 CONTINUE
+! ENDIF
+!IPK JAN01
+ READ(IUNIT,'(I5)',end=375) NENTRY
+ IF(NENTRY .GT. 0) THEN
+ READ(IUNIT,'(15I5)') (NEF(I,1),NEF(I,2),NEF(I,3),I=1,NENTRY)
+ ENDIF
+ READ(IUNIT,'(I5)', end=375) NCLM
+ write(90,*) 'INOUT-695 NCLM',nclm
+ IF(NCLM .GT. 0) THEN
+ READ(IUNIT,'(A3,A77)') ID,DLIN2
+ WRITE(90,'(''INOUT-698'',A3,A77)'),ID,DLIN
+ IF(ID .EQ. 'CC1') THEN
+ 330 READ(DLIN2,'(I5,9I8)') I,(ICCLN(I,J),J=1,9)
+ WRITE(90,'(I5,9I8)') I,(ICCLN(I,J),J=1,9)
+ NL=1
+ 340 NL=NL+9
+ READ(IUNIT,'(A3,A77)',end=375) ID,DLIN2
+ WRITE(90,'(''INOUT-705'',A3,A77)'),ID,DLIN
+ IF(ID .EQ. 'CC2') THEN
+ READ(DLIN2,'(5X,9I8)') (ICCLN(I,J),J=NL,NL+8)
+ ELSEIF(ID .EQ. 'CC1') THEN
+ GO TO 330
+ ELSEIF(ID .EQ. 'END') THEN
+ GO TO 375
+ ENDIF
+ GO TO 340
+ ENDIF
+ ENDIF
+
+ 375 CONTINUE
+ WRITE(90,*) 'INOUT-718 NCLM',NCLM
+ ELSE
+ IF(IUNIT .EQ. 11) THEN
+!IPK FEB03 READ(IUNIT) &
+!IPK FEB03 & (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
+!IPK FEB03 & WIDBS(J),SSO(J),BS1(J),J=1,NP)
+!IPK FEB03!ipk jan99 + (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J)
+!IPK FEB03 DO 350 J=1,NP
+!IPK FEB03 CORD(J,1) = XUSR(J)
+!IPK FEB03 CORD(J,2) = YUSR(J)
+!IPK FEB03 INSKP(J)=0
+!IPK FEB03 IF (CORD(J,1) .GT. VDX) THEN
+!IPK FEB03 INEW(J) = 1
+!IPK FEB03 ENDIF
+!IPK FEB03 350 CONTINUE
+!IPK FEB03 READ(IUNIT) NLST
+!IPK FEB03 IF(NLST .GT. 0) THEN
+!IPK FEB03 READ(IUNIT) (LLIST(J),J=1,NLST), &
+!IPK FEB03 ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)
+!IPK FEB03 ENDIF
+
+!IPK FEB03 READ(IUNIT) NENTRY,NLAYD,NCLM
+!IPK FEB03 IF(NENTRY .GT. 0) THEN
+!IPK FEB03 READ(IUNIT) ((NEF(I,J),J=1,3),I=1,NENTRY)
+!IPK FEB03 ENDIF
+!IPK FEB03 IF(NLAYD .GT. 0) THEN
+!IPK FEB03 READ(IUNIT) (LAY(I),I=1,NP)
+!IPK FEB03 ENDIF
+!IPK FEB03 IF(NCLM .GT. 0) THEN
+!IPK FEB03 READ(IUNIT) ((ICCLN(I,J),J=1,350),I=1,NCLM)
+!IPK FEB03 ENDIF
+
+ CALL RDRST(3,IUNIT)
+
+ ELSE
+ DO 360 J=1,NP
+ XUSR(J) = CORD(J,1)
+ YUSR(J) = CORD(J,2)
+!!apr99 INSKP(J)=0
+ IF (CORD(J,1) .GT. VDX) THEN
+ INSKP(J)=0
+ INEW(J) = 1
+ ENDIF
+ 360 CONTINUE
+ ENDIF
+ ENDIF
+ 400 CONTINUE
+ WRITE(90,*) 'INOUT-762 NCLM',NCLM
+
+!
+!ipk jun02 look for nodes that do not have coordinates but are defined in NOP
+
+ do n=1,ne
+ if(imat(n) .gt. 0) then
+ ncn=ncorn(n)
+ if(ncn .eq. 3) then
+ n1=nop(n,2)
+ if(n1 .ne. 0) then
+ if(inew(n1) .ne. 1) then
+ cord(n1,1)=(cord(nop(n,1),1)+cord(nop(n,3),1))/2.
+ cord(n1,2)=(cord(nop(n,1),2)+cord(nop(n,3),2))/2.
+ XUSR(n1) = CORD(n1,1)
+ YUSR(n1) = CORD(n1,2)
+ INSKP(n1)=0
+ INEW(n1) = 1
+ endif
+ endif
+ elseif(ncn .gt. 5) then
+ do k=2,ncn,2
+ n1=nop(n,k)
+ IF(N1 .NE. 0) THEN
+ if(inew(n1) .ne. 1) then
+ kk=mod(k+1,ncn)
+ cord(n1,1)=(cord(nop(n,k-1),1)+cord(nop(n,kk),1))/2.
+ cord(n1,2)=(cord(nop(n,k-1),2)+cord(nop(n,kk),2))/2.
+ XUSR(n1) = CORD(n1,1)
+ YUSR(n1) = CORD(n1,2)
+ INSKP(n1)=0
+ INEW(n1) = 1
+ NP = MAX(NP,n1)
+ endif
+ ENDIF
+ if(inew(nop(n,k-1)) .eq. 0) then
+ CALL EltERRDisp(n,ims)
+ if(ims .eq. 1) CALL DELTEL(n)
+ go to 120
+ endif
+ enddo
+120 continue
+ endif
+ endif
+ enddo
+ WRITE(90,*) 'INOUT-797 NCLM',NCLM
+
+ WRITE(MESG,6010) NE
+ 6010 FORMAT(I7,' Nodes read from file')
+ CALL SYMBL(1.1,3.3,0.25,mesg,0.0,28)
+
+ RETURN
+!
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE RDMAP(IFIRST,IMPP,JSTT,KSTT)
+!
+! Read in coordinates of map lines
+!
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ DIMENSION NTMP(9)
+ DIMENSION VALS(2000)
+ INTEGER*8 II
+!
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ CHARACTER*80 ALIN,lind
+!ipk jan98 CHARACTER*1 IJNK
+ CHARACTER*1 ans
+ CHARACTER*32 ANS32
+ CHARACTER*5 LAB1
+ CHARACTER*9 LAB2
+ CHARACTER*8 LAB3
+ CHARACTER*12 LAB4
+ CHARACTER*4 HEDR
+!
+ 5 continue
+
+
+ ielvsw=0
+! IF (IFIRST .EQ. 0) THEN
+ IF(IFIRST .EQ. 2) IMP=IMPP
+ VOID = - 1.0E+10
+ VDX = -1.0E+9
+ CXO=VDX
+ CYO=VDX
+ DO 10 J=JSTT+1,MAXPL
+ CMAP(J,1) = VOID
+ CMAP(J,2) = VOID
+ XMAP(J) = VOID
+ YMAP(J) = VOID
+ 9 CONTINUE
+ 10 CONTINUE
+ write(90,*) 'maxpl in rdmap - 1 ',maxpl
+!ipk jan98
+ ylv=7.9
+ call clscrn
+! ENDIF
+!
+!ipkfeb94 added logic
+ if(imp .eq. 9) then
+!
+ I=0
+ J=0
+ K=1
+20 READ(IMP,'(A80)') ALIN
+ if(alin(1:5) .eq. 'NCOLS') THEN
+ CALL RDESRI(alin,j,k)
+ GO TO 98
+ ENDIF
+!ipk oct96 addition to identify first point
+ KFIRST=0
+ I=I+1
+ IF(MOD(I,25) .EQ. 0) REWIND 90
+ WRITE(90,'(2i5,A65)') I,K,ALIN
+!ipk oct94 3 lines added
+ if(mod(i,2000) .eq. 0) then
+!ipk jan98 write(*,*) i,' map lines now processed'
+ ylv=ylv-0.3
+ if(ylv .lt. 0.1) then
+ ylv=7.9
+ call clscrn
+ endif
+ write(lind,6010) i
+ call symbl &
+ & (1.1,ylv,0.20,LIND,0.0,80)
+ endif
+ DO KC=1,5
+ IF(ALIN(KC:KC) .EQ. 'E' .OR. ALIN(KC:KC) .EQ. 'e') THEN
+ GO TO 98
+ ENDIF
+ ENDDO
+ READ(ALIN,*) LINTYP(K),VALL
+ valkp=vall
+ IF(K .GT. MAXLIN) THEN
+!ipk dec09 CALL SETD(23)
+!ipk jan98
+!ipk dec09 WRITE(lind,*) 'Too many map lines. increase maxlin in common'
+!ipk dec09 ylv=ylv-0.6
+!ipk dec09 if(ylv .lt. 0.1) then
+!ipk dec09 ylv=7.9
+!ipk dec09 call clscrn
+!ipk dec09 endif
+!ipk dec09 call symbl &
+!ipk dec09 & (1.1,ylv,0.20,LIND,0.0,80)
+!ipk dec09 WRITE(90,*) 'Too many map lines. increase maxlin in common'
+!ipk jan98 WRITE(*,*) ' Press enter to exit'
+!ipk jan98 READ(*,'(A)') IJNK
+!ipk dec09 WRITE(LIND,*) ' Press enter to exit'
+!ipk dec09 call symbl &
+!ipk dec09 & (1.1,ylv-0.3,0.20,lind,0.0,80)
+!ipk dec09 ndig=1
+!ipk dec09 CALL GTCHARX(ANS,IJNK,5.0,4.0)
+!ipk dec09 CALL Quit_Pgm
+
+ MAXPLL=MAXPL
+ call ADJUSTMAP(MAXPLL)
+ MAXPL=MAXPLL
+ deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)
+
+ allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+
+ maxpts=maxpl
+ ifirst=0
+ rewind imp
+ go to 5
+
+ ENDIF
+ 21 CONTINUE
+ READ(IMP,'(A80)') ALIN
+
+!ipk sep05
+
+ do i=1,80
+ if(alin(i:i) .eq. char(9)) then
+ alin(i:i)=','
+ endif
+ enddo
+
+ I=I+1
+ IF(MOD(I,25) .EQ. 0) REWIND 90
+ WRITE(90,'(2i5,A65)') I,K,ALIN
+!ipk oct94 3 lines added
+ if(mod(i,10000) .eq. 0) then
+!ipk jan98 write(*,*) i,' map lines now processed'
+ ylv=ylv-0.3
+ if(ylv .lt. 0.1) then
+ ylv=7.9
+ call clscrn
+ endif
+ write(lind,6010) i
+ 6010 format(i8,' map points processed')
+ call symbl &
+ & (1.1,ylv,0.20,LIND,0.0,80)
+ endif
+ DO KC=1,5
+ IF(ALIN(KC:KC) .EQ. 'E' .OR. ALIN(KC:KC) .EQ. 'e') THEN
+ GO TO 97
+ ENDIF
+ ENDDO
+!ipk oct96 change to permit more line types
+!ipk jan01 IF(LINTYP(K) .NE. 2 .and. valkp .lt. -9998.) THEN
+!IPK APR03 IF(LINTYP(K) .NE. 2 .and. valkp .ne. 0.) THEN
+!IPK APR03 READ(ALIN,*) CX, CY
+!IPK APR03 vall=valkp
+!IPK APR03 ELSE
+!IPK APR03 READ(ALIN,*) CX, CY, VALL
+!IPK APR03 ENDIF
+ IF(LINTYP(K) .EQ. 2) THEN
+ READ(ALIN,*) CX, CY, VALL
+ ELSEIF(VALKP .LT. 9999.) THEN
+ READ(ALIN,*) CX, CY
+ vall=valkp
+ ELSEIF(VALKP .EQ. 9999.) THEN
+ READ(ALIN,*) CX, CY, VALL
+ ENDIF
+!ipk oct96 addition to prevent test on first point
+ if(kfirst .ne. 0) then
+ IF(CX .EQ. CXO .AND. CY .EQ. CYO) GO TO 21
+ else
+ kfirst=1
+ endif
+ IF(J .EQ. MAXPL) THEN
+ CALL SETD(23)
+!ipk jan98 WRITE(*,*) 'Too many map points. increase maxpl in co
+!ipk jan98 WRITE(90,*) 'Too many map points. increase maxpl in c
+!ipk jan98 WRITE(*,*) ' Press enter to exit'
+!ipk jan98 READ(*,'(A)') IJNK
+!ipk jan98
+!ipk dec09 WRITE(lind,6030) maxpl
+!ipk dec09 6030 format ('Map point exceed',i10,' increase maxpl in common' )
+!ipk dec09 ylv=ylv-0.6
+!ipk dec09 if(ylv .lt. 0.1) then
+!ipk dec09 ylv=7.9
+!ipk dec09 call clscrn
+!ipk dec09 endif
+!ipk dec09 call symbl &
+!ipk dec09 & (1.1,ylv,0.20,LIND,0.0,80)
+!ipk dec09 WRITE(90,6030) maxpl
+!ipk jan98 WRITE(*,*) ' Press enter to exit'
+!ipk jan98 READ(*,'(A)') IJNK
+!ipk dec09 WRITE(LIND,*) ' Press enter to exit'
+!ipk dec09 call symbl &
+!ipk dec09 & (1.1,ylv-0.3,0.20,lind,0.0,80)
+!ipk dec09 ndig=1
+!ipk dec09 CALL GTCHARX(ANS,IJNK,5.0,4.0)
+!ipk dec09 CALL Quit_Pgm
+
+ call ADJUSTMAP(MAXPL)
+ deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)
+
+ allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+
+ maxpts=maxpl
+
+ rewind imp
+ go to 5
+
+
+
+
+ ENDIF
+ J=J+1
+ CMAP(J,1) = CX
+ CMAP(J,2) = CY
+ XMAP(J) = CX
+ YMAP(J) = CY
+ VAL(J) = VALL
+ CXO=CX
+ CYO=CY
+!
+ GOTO 21
+!
+ 97 CONTINUE
+ J=J+1
+ K=K+1
+ GO TO 20
+ 98 CONTINUE
+!ipk feb94
+ klint=k-1
+ jlint=j
+!ipk feb94 end change
+ J=J+1
+
+!IPK FEB03
+
+ MAXPTS=J-2
+
+ write(90,*) 'maxpts in rdmap - 2 ',maxpts,xmap(908)
+
+!IPK FEB02 SCLAE NEW VALUES
+
+ IF(IFIRST .EQ. 2) THEN
+ IF(CMAP(MAXPTS,1) .GE. VDX) MAXPTS=MAXPTS+1
+ DO K=1,MAXPTS
+ IF (CMAP(K,1) .GT. VDX) THEN
+ CMAP(K,1) = (CMAP(K,1)+XS)/TXSCAL
+ CMAP(K,2) = (CMAP(K,2)+YS)/TXSCAL
+ ENDIF
+ END DO
+ ENDIF
+ write(90,*) 'maxpts',maxpts
+ CLOSE(IMP)
+! do k=1,maxpts
+! write(90,*) cmap(k,1),cmap(k,2),xmap(k),ymap(k),val(k)
+! enddo
+ RETURN
+ ELSEIF(IMP .EQ. 113) THEN
+ CALL READSHP
+!
+!
+!ipkfeb94 logic to add binary read of map
+!
+ elseif(imp .eq. 92 .OR. IMP .GT. 94) then
+
+
+!ipk jan98 test for max lines
+ read(imp) klint,jlint
+ rewind imp
+ if(klint+KSTT .gt. maxlin .or. jlint +JSTT .gt. maxpl) then
+ call clscrn
+ write(lind,6310)
+ 6310 format(' Compilation limits exceeded')
+ call symbl &
+ & (0.5,3.5,0.20,LIND,0.0,80)
+ write(lind,6311) maxpl,jlint
+ 6311 FORMAT(' Maximum map points =',2i8,' points requested')
+ call symbl &
+ & (0.5,3.2,0.20,LIND,0.0,80)
+ write(lind,6312) maxlin,klint
+ 6312 FORMAT( ' Maximum lines =',2i8,' lines requested')
+ call symbl &
+ & (0.5,2.9,0.20,LIND,0.0,80)
+ WRITE(LIND,*) ' Press enter to exit'
+ call symbl &
+ & (0.5,2.0,0.20,lind,0.0,80)
+ ndig=1
+ CALL GTCHARX(ANS32,IJNK,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+ endif
+ read(imp) klint,jlint,(xmap(j),ymap(j),val(j),j=JSTT+1,JSTT+jlint) &
+ & ,(lintyp(k),k=KSTT+1,KSTT+klint)
+ read(imp,end=200) nelts ,((nopel(j,k),k=1,3),j=1,nelts)
+ maxpts=jlint+JSTT
+ go to 220
+ 200 continue
+ MAXPTS=JLINT+JSTT
+ nelts=0
+ 220 continue
+ do j=JSTT+1,JSTT+jlint
+ cmap(j,1)=xmap(j)
+ cmap(j,2)=ymap(j)
+ enddo
+ JLINT=MAXPTS
+ KLINT=KSTT+klint
+ ELSEIF(IMP .EQ. 94) THEN
+ READ(IMP,'(A4)') HEDR
+ IF(HEDR .EQ. 'DSAA') THEN
+ READ(IMP,*) NCOLS1,NROWS1
+ maxpts=ncols1*nrows1
+ if(maxpts .gt. maxpl) then
+ maxpl=maxpts+1
+ deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)
+
+ allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+
+ endif
+ READ(IMP,*) XXORG,XXTOP,YYORG,YYTOP
+ READ(IMP,*) DD1,DD2
+ DXINT=(XXTOP-XXORG)/(NCOLS1-1)
+ DYINT=(YYTOP-YYORG)/(NROWS1-1)
+ JJ=0
+ II=0
+ ANODAT=1.E36
+ READ(IMP,*) (VAL(I),I=1,MAXPTS)
+ DO J=NROWS1,1,-1
+ DO I=1,NCOLS1
+ II=II+1
+ IF(VAL(II) .GT. ANODAT) CYCLE
+ JJ=JJ+1
+ XMAP(JJ)=DXINT*(I-1)+XXORG
+ YMAP(JJ)=DYINT*(NROWS1+1-J)+YYORG
+ CMAP(JJ,1)=XMAP(JJ)
+ CMAP(JJ,2)=YMAP(JJ)
+ VAL(JJ)=VAL(II)
+ ENDDO
+ ENDDO
+
+ ELSE
+ REWIND IMP
+ READ(IMP,*) LAB1,NCOLS1
+ READ(IMP,*) LAB1,NROWS1
+ maxpts=ncols1*nrows1
+ if(maxpts .gt. maxpl) then
+ maxpl=maxpts+1
+ deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)
+
+ allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+
+ endif
+ READ(IMP,*) LAB2,XXORG
+ READ(IMP,*) LAB2,YYORG
+ READ(IMP,*) LAB3,CELLSIZ
+ READ(IMP,*) LAB4,ANODAT
+ JJ=0
+ II=0
+ READ(IMP,*) (VAL(I),I=1,MAXPTS)
+ DO J=1,NROWS1
+! READ(IMP,*) (VALS(I),I=1,NCOLS1)
+ DO I=1,NCOLS1
+ II=II+1
+ IF(VAL(II) .EQ. ANODAT) CYCLE
+ JJ=JJ+1
+ XMAP(JJ)=CELLSIZ*(I-1)+XXORG
+ YMAP(JJ)=CELLSIZ*(NROWS1+1-J)+YYORG
+ CMAP(JJ,1)=XMAP(JJ)
+ CMAP(JJ,2)=YMAP(JJ)
+ VAL(JJ)=VAL(II)
+ ENDDO
+ ENDDO
+ ENDIF
+ MAXPTS=JJ
+ XMAP(MAXPTS+1)= VOID
+
+ KLINT=1
+ LINTYP(1)=2
+ else
+
+! READ AN RM1 FILE AS A MAP FILE
+
+! first headers
+ jlint=0
+ READ(IMP,'(a80)') alin
+ READ(IMP,5010) IPP,nnrl8
+ 5010 FORMAT( 30x,i5,60x,i10)
+ READ(IMP,'(a80)') alin
+ IF(IPP .GT. 0) READ(IMP,'(a80)') ALIN
+
+! next elements
+
+ 230 CONTINUE
+ read(imp,'(a80)',end=300) ALIN
+
+ IF(ALIN(6:20) .EQ. ' ') GO TO 250
+ if(mod(nnrl8,2) .eq. 0) then
+ READ(ALIN,'(10I5)',END=250) J, (NTMP(K),K=1,9)
+ else
+ READ(ALIN,'(10I6)',END=250) J, (NTMP(K),K=1,9)
+ endif
+ NOPEL(J,1)=NTMP(1)
+ NOPEL(J,2)=NTMP(3)
+ NOPEL(J,3)=NTMP(5)
+ NELTS=MAX(J,NELTS)
+ GO TO 230
+
+! finally nodes
+ 250 CONTINUE
+ read(imp,'(a80)',end=300) ALIN
+ if(ALIN(11:30) .eq. ' ') go to 300
+ if(nnrl8 .lt. 2) then
+ READ(alin,'(I10,3F10.0)') J, CX, CY,BELEV
+
+ else
+ READ(alin,'(I10,2f20.0,F10.0)') J, CX, CY, BELEV
+
+ endif
+ xmap(j)=cx
+ CMAP(J,1)=CX
+ ymap(j)=cy
+ CMAP(J,2)=CY
+ val(j)=belev
+ jlint=max(j,jlint)
+
+ GO TO 250
+
+ 300 maxpts=jlint
+ klint=1
+ lintyp(1)=2
+ ENDIF
+
+!IPK FEB02 SCALE NEW VALUES
+
+ IF(IFIRST .EQ. 2) THEN
+ DO K=JSTT+1,MAXPTS
+ IF (CMAP(K,1) .GT. VDX) THEN
+ CMAP(K,1) = (CMAP(K,1)+XS)/TXSCAL
+ CMAP(K,2) = (CMAP(K,2)+YS)/TXSCAL
+ ENDIF
+ END DO
+ ENDIF
+ CLOSE(IMP)
+ return
+ END
+!
+!***********************************************************************
+!
+ SUBROUTINE RDELEM(IUNIT)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+ CHARACTER*1 AA,ANS
+ CHARACTER*32 ANS32
+ CHARACTER*81 DLIN
+ CHARACTER*150 DLIN1
+ CHARACTER*3 ID
+!cipk aug00
+ CHARACTER*80 LIND
+ CHARACTER*25 BLANK
+ CHARACTER*31 MESG
+ DIMENSION NTMP(9),ATT(9)
+!
+ DATA IFIRST / 0 /
+ DATA IERRL /0/
+ DATA BLANK /' '/
+!ipk jul94 add a line
+ MEL=MAXE
+!cipk aug00
+ ylv=7.5
+!
+! Read in existing elements
+!
+ IF (IFIRST .EQ. 0) THEN
+!
+! Initialize arrays
+!
+ VOID = - 1.0E+10
+ VDX = -1.E+9
+ IF(IIN .EQ. 10) NE = 0
+ IFIRST = 1
+ ENDIF
+ ISTART=0
+ NTMP=0
+ ATT=0.
+!
+ IF(IUNIT .EQ. 0) RETURN
+ IF(IUNIT .EQ. 10) THEN
+
+ IF(IGFG .GT. 0) REWIND IUNIT
+ JZ=0
+!ipk oct96 move around login to allow long length files
+ 10 CONTINUE
+ IF(IGFG .EQ. 0 .AND. ITRIAN .EQ. 0) THEN
+ READ(IUNIT,'(A81)',END=98) DLIN
+!ipk mar04 IF(DLIN(6:20) .EQ. BLANK .AND. IERRL .EQ. 0) THEN
+ IF(DLIN(7:20) .EQ. BLANK .AND. IERRL .EQ. 0) THEN
+ GO TO 175
+!ipk dec97 generalize to allow multiple errors
+!ipk dec97 ELSEIF(IERRL .EQ. 1) THEN
+ ELSEIF(IERRL .EQ. 1 .and. dlin(6:20) .eq. blank) THEN
+ CALL SETD(23)
+!cipk aug00
+ WRITE(lind,6000)
+ 6000 FORMAT(' Press enter to exit')
+ call symbl &
+ & (1.1,ylv-0.3,0.20,lind,0.0,80)
+ ndig=1
+ CALL GTCHARX(ANS32,IJNK,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+
+ ENDIF
+ ifree=1
+ do j=1,10
+ if(dlin(j:j) .eq. ',') then
+ ifree=0
+ endif
+ enddo
+ if(ifree .eq. 1) then
+ if(mod(ntempin,2) .eq. 0) then
+ READ(DLIN,'(10I5,F10.3,I5)',END=98) J, (NTMP(K),K=1,9),THT &
+ & ,NTEMP
+ else
+ READ(DLIN,'(10I6,F10.3,I6)',END=98) J, (NTMP(K),K=1,9),THT &
+ & ,NTEMP
+ endif
+ else
+ READ(DLIN,*,END=98) J, (NTMP(K),K=1,9),THT &
+ & ,NTEMP
+ endif
+ ELSEIF(ITRIAN .EQ. 1) THEN
+ IF(ISTART .EQ. 0) THEN
+ REWIND(IUNIT)
+ READ(IUNIT,*) NE,NCNTR,NATTR
+ ISTART=1
+ ENDIF
+ READ(IUNIT,*) J,(NTMP(K),K=1,NCNTR),(ATT(K),K=1,NATTR)
+ IF(J .EQ. 0) THEN
+ JZ=1
+ J=NE
+ ENDIF
+ ELSE
+!ipk jun02 Allow for GFGEN input
+ DO ICOUNTC=1,700000
+ DO JJ=1,150
+ DLIN1(JJ:JJ)=' '
+ ENDDO
+ READ(IUNIT,'(A3,A150)', END=175) ID,DLIN1
+ IF(ID .EQ. 'GE ') THEN
+! Count the number of variables
+ I=0
+ ICOUNT=0
+ 75 CONTINUE
+ IF(DLIN1(I+1:I+1) .NE. ' ') THEN
+ GO TO 80
+ ELSE
+ I=I+1
+ GO TO 75
+ ENDIF
+ 80 I=I+1
+ IF(I .EQ. 151) THEN
+ ICOUNT =ICOUNT+1
+ GO TO 90
+ ENDIF
+ IF(DLIN1(I:I) .EQ. ' ' .OR. DLIN1(I:I) .EQ. ',') THEN
+ ICOUNT=ICOUNT+1
+ 85 CONTINUE
+ IF(I+1 .EQ. 151) GO TO 90
+ IF(DLIN1(I+1:I+1) .EQ. ' ') THEN
+ I=I+1
+ GO TO 85
+ ELSE
+ GO TO 80
+ ENDIF
+ ELSE
+ GO TO 80
+ ENDIF
+ ELSEIF(ID .EQ. 'E3T') THEN
+ ICOUNT=4
+ GO TO 90
+ ELSEIF(ID .EQ. 'E4Q') THEN
+ ICOUNT=5
+ GO TO 90
+ ENDIF
+ ENDDO
+ 90 CONTINUE
+ IF(ICOUNT .GT. 10) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,9),THT
+ ELSEIF(IGFG .EQ. 3) THEN
+ IF(ICOUNT .EQ. 4) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,7,2)
+ IF(NTMP(7) .EQ. 0) NTMP(9)=1
+ NTMP(2)=0
+ NTMP(4)=0
+ NTMP(6)=0
+ NTMP(7)=0
+ NTMP(8)=0
+ ELSEIF(ICOUNT .EQ. 5) THEN
+ READ(DLIN1,*) J, (NTMP(K),K=1,9,2)
+ IF(NTMP(9) .EQ. 0) NTMP(9)=1
+ NTMP(2)=0
+ NTMP(4)=0
+ NTMP(6)=0
+ NTMP(8)=0
+ ENDIF
+ ELSE
+ READ(DLIN1,*) J, (NTMP(K),K=1,9)
+ ENDIF
+ ENDIF
+
+!c IF (J .GT. 9000 .AND. IERRL .EQ. 0) THEN
+!c GO TO 175
+!IPK OCT96 END CHANGES
+ IF (J .GE. MEL) THEN
+ CALL SETD(23)
+!cipk aug00
+ WRITE(lind,*) ' Element number exceeds MAXE in RDELEM'
+ call symbl &
+ & (1.1,ylv-0.3,0.20,lind,0.0,80)
+ ndig=1
+ WRITE(90,*) ' Element number exceeds MAXE in RDELEM'
+ WRITE(lind,6000)
+ CALL GTCHARX(ANS32,IJNK,5.0,4.0)
+ CALL Quit_Pgm
+ STOP
+ ENDIF
+!
+! Check to ensure there are no duplicate numbers in input stream
+! of element connections
+!
+ DO 12 K=1,7
+ IF(NTMP(K) .EQ. 0) GO TO 12
+ DO 11 L=K+1,8
+ IF(NTMP(K) .EQ. NTMP(L)) THEN
+ CALL SETD(23)
+!cipk aug00
+! WRITE(90,5000) J
+! write(90,5001) (NTMP(MM),MM=1,8)
+! WRITE(lind,5000) J
+! call symbl &
+! & (1.1,ylv-0.3,0.25,lind,0.0,80)
+! ylv=ylv-0.3
+! if(ylv .lt. 0.4) then
+! call clscrn
+! ylv=7.5
+! endif
+! write(lind,5001) (NTMP(MM),MM=1,8)
+! call symbl &
+! & (1.1,ylv-0.3,0.25,lind,0.0,80)
+! ylv=ylv-0.3
+! if(ylv .lt. 0.4) then
+! call clscrn
+! ylv=7.5
+! endif
+ 5000 FORMAT(' **ERROR** Nodes at element number',i5,' are duplicated')
+ 5001 FORMAT(' node list as follows ',8i5)
+! IERRL=1
+ DO KK=1,8
+ NOP(J,KK) = NTMP(KK)
+ ENDDO
+ IMAT(J)=NTMP(9)
+ call eltdisp(j)
+ DO KK=1,8
+ NTMP(KK) = NOP(J,KK)
+ ENDDO
+ NTMP(9)=IMAT(J)
+ GO TO 13
+ ENDIF
+ 11 CONTINUE
+ 12 CONTINUE
+ 13 CONTINUE
+ IF(ITRIAN .EQ. 0) THEN
+ DO 15 K=1,8
+ NOP(J,K) = NTMP(K)
+ ND = NTMP(K)
+ IF (ND .GT. 0) THEN
+ INEW(ND) = 2
+ NP = MAX(NP,ND)
+ ENDIF
+ 15 CONTINUE
+ IMAT(J) = NTMP(9)
+ THTA(J)=0
+ IEM(J) = j
+ ELSE
+ DO K=1,3
+ NOP(J,2*K-1)=NTMP(K)
+ IF(NCNTR .EQ. 3) THEN
+ NOP(J,2*K)=0
+ ELSEIF(NCNTR .EQ. 6) THEN
+ NOP(J,2*K)=NTMP(K+3)
+ ENDIF
+ ND = NTMP(K)
+ IF (ND .GT. 0) THEN
+ INEW(ND) = 2
+ NP = MAX(NP,ND)
+ ENDIF
+ ENDDO
+ NOP(J,7)=0
+ NOP(J,8)=0
+ IF(NATTR .GT. 0) THEN
+ IMAT(J)=ATT(1)+0.5
+ IF(NATTR .GT. 1) THEN
+ THTA(J)=ATT(2)
+ IF(NATTR .GT. 2) THEN
+ IEM(J)=ATT(3)
+ ELSE
+ IEM(J)=0
+ ENDIF
+ ELSE
+ THTA(J)=0.
+ IEM(J)=0
+ ENDIF
+ ELSE
+ IMAT(J)=1
+ THTA(J)=0.
+ IEM(J)=0
+ ENDIF
+ ENDIF
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ NCORN(J) = NCN
+ IESKP(J) = 0
+ DO 25 K=2,NCN,2
+ ND = NTMP(K)
+ IF (ND .GT. 0) THEN
+ IF(NCN .EQ. 5 .AND. K .EQ. 4) GO TO 25
+ WD(ND)=0.
+ ENDIF
+ 25 CONTINUE
+ IF(ITRIAN .EQ. 1) THEN
+ IF((JZ .EQ. 0 .AND. J .EQ. NE) .OR. (JZ .EQ. 1 .AND. J .EQ. NE-1)) THEN
+ CLOSE(IUNIT)
+ DO L=255,1,-1
+ IF(FNAMKEP(L:L) .EQ. '.') THEN
+ FNAMKEP(L+1:L+1)='n'
+ FNAMKEP(L+2:L+2)='o'
+ FNAMKEP(L+3:L+3)='d'
+ FNAMKEP(L+4:L+4)='e'
+ OPEN(IUNIT,FILE=FNAMKEP,STATUS='OLD',ACTION='READ')
+ IF(JZ .EQ. 1) THEN
+ READ(IUNIT,*) NPPP,NDUM,NATTR
+ REWIND(IUNIT)
+ DO J=1,NE
+ DO K=1,5,2
+ IF(NOP(J,K) .EQ. 0) NOP(J,K)=NPPP
+ ENDDO
+ ENDDO
+ ENDIF
+ GO TO 175
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ NE = MAX(J,NE)
+!
+ GOTO 10
+!
+ 98 CONTINUE
+ ELSE
+ IF(IUNIT .EQ. 11) THEN
+!IPK FEB03 READ(IUNIT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE)
+
+ CALL RDRST(2,IUNIT)
+ ENDIF
+ DO 140 J=1,NE
+ IF(IMAT(J) .EQ. 0) GO TO 140
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ NCORN(J) = NCN
+ IESKP(J) = 0
+! DO 125 K=2,NCN,2
+! ND = NOP(J,K)
+! IF (ND .GT. 0) THEN
+! IF(NCN .EQ. 5 .AND. K .EQ. 4) GO TO 125
+! WD(ND)=0.
+! ENDIF
+! 125 CONTINUE
+ 140 CONTINUE
+ ENDIF
+!
+! Set up junction counter array
+!
+ 175 CONTINUE
+ DO 180 N=1,NP
+ IJUN(N)=0
+ 180 END DO
+ DO 200 N=1,NE
+!ipkoct93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ DO 190 K=1,NCORN(N)
+ IF(NOP(N,K) .GT. 0) THEN
+ IJUN(NOP(N,K))=K
+ ENDIF
+ 190 CONTINUE
+ ENDIF
+ 200 END DO
+ WRITE(MESG,6010) NE
+ 6010 FORMAT(I7,' Elements read from file')
+ CALL SYMBL(1.1,4.3,0.25,mesg,0.0,31)
+ RETURN
+ END
+ SUBROUTINE CHKCON(IREP)
+ USE WINTERACTER
+!
+! Check connectivity of grid
+!
+!-
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ CHARACTER*80 LIND
+!
+ CHARACTER*1 ANS
+! CHARACTER*60 STRELS
+! DATA STRELS/' You have tried to save before executing "FILL"'/
+!
+! Test to make sure fill has been executed.
+!
+ IF(IREP .EQ. 1) GO TO 100
+ ylv=7.5
+ IREP = 1
+ DO 70 N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ DO 60 M=2,NCORN(N),2
+ IF(NOP(N,M) .EQ. 0 .AND. IMAT(N) .NE. 999) THEN
+ CALL GETSVPN(ANS)
+ IF(ANS .EQ. 'T' .OR. ANS .EQ. 't') THEN
+ IREP = 0
+!ipk nov97 add 0
+ CALL PLOTOT(0)
+ CALL HEDR
+ RETURN
+ ELSEIF(ANS .EQ. 'S' .OR. ANS .EQ. 's') THEN
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ CALL HEDR
+ IREP = 1
+ return
+! go to 100
+!ipk jun04 RETURN
+ ELSEIF(ANS .EQ. 'F' .OR. ANS .EQ. 'f') THEN
+!ipk aug02
+ CALL FILM(0)
+ IREP = 1
+ ELSE
+ IREP = 2
+ ENDIF
+ ENDIF
+ 60 CONTINUE
+ ENDIF
+ 70 END DO
+ 100 CONTINUE
+
+
+ IDUP=0
+ call kcon(1)
+ do n=1,ne
+ if(imat(n) .lt. 900 .and. imat(n) .gt. 0) then
+ ndup=0
+ do j=2,ncorn(n),2
+ if(nop(n,j) .eq. 0) go to 120
+ if(ndelm(nop(n,j)) .gt. 2) then
+ ndup=ndup+1
+ endif
+ enddo
+ if(ndup .eq. ncorn(n)/2) then
+ IDUP=1
+ write(90,*) ' DUPLICATE ELEMENT',n
+ endif
+ endif
+ enddo
+
+ 120 continue
+
+ IF(IDUP .EQ. 1) THEN
+!cipk aug00
+
+ Call WMessageBox(1,3,0,'Duplicate elements have been found'//Char(13)//&
+ 'See file MESSGEN.OUT for details'//'Press OK to continue save',&
+ 'ERROR IN NETWORK!!')
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ CALL HEDR
+ CALL PLOTOT(0)
+ IREP = 1
+ ELSE
+ IREP = 0
+ CALL HEDR
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ RETURN
+ ENDIF
+ endif
+
+!
+! Test for areas of each element
+!
+ INEG = 0
+ DO 250 N=1,NE
+ IF(IMAT(N) .GT. 0 .AND. NCORN(N) .GT. 5) THEN
+ J1=NOP(N,1)
+ J2=NOP(N,3)
+ J3=NOP(N,5)
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+! IF(INEG .EQ. 0) CALL CLSCRN
+! CALL SETD(23)
+!cipk aug00
+! WRITE(lind,*) 'Negative area for element number',N
+ WRITE(90,*) ' NEGATIVE AREA FOR ELEMENT NUMBER',N
+! if(ylv .lt. 0.4) then
+! ylv=7.5
+! call clscrn
+! endif
+! call symbl &
+! & (1.1,ylv-0.3,0.20,lind,0.0,80)
+! ylv=ylv-0.3
+! ndig=1
+ INEG = 1
+ GO TO 250
+ ENDIF
+ IF(NCORN(N) .EQ. 8) THEN
+ J1=NOP(N,3)
+ J2=NOP(N,5)
+ J3=NOP(N,7)
+ AREA=(CORD(J2,1)-CORD(J1,1))*(CORD(J3,2)-CORD(J1,2))- &
+ & (CORD(J3,1)-CORD(J1,1))*(CORD(J2,2)-CORD(J1,2))
+ IF(AREA .LT. 0.) THEN
+! IF(INEG .EQ. 0) CALL CLSCRN
+! CALL SETD(23)
+!cipk aug00
+! WRITE(lind,*) 'Negative area for element number',N
+ WRITE(90,*) 'Negative area for element number',N
+! if(ylv .lt. 0.4) then
+! ylv=7.5
+! call clscrn
+! endif
+! call symbl &
+! & (1.1,ylv-0.3,0.20,lind,0.0,80)
+! ylv=ylv-0.3
+! ndig=1
+ INEG = 1
+ ENDIF
+ ENDIF
+ ENDIF
+ 250 END DO
+
+ IF(INEG .EQ. 1) THEN
+!cipk aug00
+
+ Call WMessageBox(1,3,0,'Negative Areas have been found'//Char(13)//&
+ 'See file MESSGEN.OUT for details'//'Press OK to continue save',&
+ 'ERROR IN NETWORK!!')
+
+! WRITE(lind,*) 'If you wish to terminate save enter (t)'
+! if(ylv .lt. 0.7) then
+! ylv=7.5
+! call clscrn
+! endif
+! call symbl &
+! & (1.1,ylv-0.3,0.20,lind,0.0,80)
+! ylv=ylv-0.3
+! WRITE(lind,*) 'If you still wish to save enter (s)'
+! call symbl &
+! & (1.1,ylv-0.3,0.20,lind,0.0,80)
+
+!ipk jun96 change * to (a)
+
+!cipkaug00 READ(*,'(A)') ANS
+! READ(*,*) ANS
+! CALL GTCHARX(ANS,IJNK,5.0,4.0)
+
+! CALL SETD(2)
+! IF(ANS .EQ. 'T' .OR. ANS .EQ. 't') THEN
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ CALL HEDR
+ CALL PLOTOT(0)
+ IREP = 1
+ RETURN
+ ELSE
+ IREP = 0
+ CALL HEDR
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ RETURN
+ ENDIF
+! ELSEIF(ANS .EQ. 'S' .OR. ANS .EQ. 's') THEN
+! CALL HEDR
+!ipknov97 add (0)
+! CALL PLOTOT(0)
+! IREP = 1
+! RETURN
+! ENDIF
+ ENDIF
+
+ RETURN
+ END
+!ipk oct98 update call
+ SUBROUTINE WRTMAP(isw)
+!
+! Write map file in binary format
+!
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ character*3 ends
+!
+!
+! Open binary map file
+!
+ IF(ISW .GT. 90) THEN
+ IMPF=ISW
+ ELSE
+ impf=93
+ ENDIF
+
+!ipk oct98
+ if(isw .eq. 0) then
+ OPEN(IMPF ,FILE=mpnam,STATUS='unknown',form='unformatted')
+!IPK FRB03
+ else
+ rewind impf
+ endif
+
+ if(isw .eq. 2) then
+ impf=94
+ aninin=-9999.
+ zero=0.
+ ends='END'
+ if(lintyp(1) .eq. 0 .or. lintyp(1) .eq. 1) then
+ write(impf,*) lintyp(1),aninin
+ ifm=1
+ elseif(lintyp(1) .eq. 2) then
+ write(impf,*) lintyp(1),zero
+ ifm=2
+ else
+ write(impf,*) lintyp(1),val(1)
+ ifm=1
+ endif
+ ilin=1
+ do J=1,maxpts
+ if(xmap(J) .gt. vdx) then
+ if(ifm .eq. 1) then
+ write(impf,*) xmap(j),ymap(j)
+ else
+ write(impf,*) xmap(j),ymap(j),val(j)
+ endif
+ if(j .eq. maxpts) write(impf,'(a3)') ends
+ else
+ write(impf,'(a3)') ends
+ ilin=ilin+1
+ if(j .eq. maxpts) go to 200
+ if(lintyp(ilin) .eq. 0 .or. lintyp(ilin) .eq. 1) then
+ write(impf,*) lintyp(ilin),aninin
+ ifm=1
+ elseif(lintyp(ilin) .eq. 2) then
+ write(impf,*) lintyp(ilin),zero
+ ifm=2
+ else
+ write(impf,*) lintyp(ilin),val(j+1)
+ ifm=1
+ endif
+ endif
+
+ enddo
+ 200 continue
+ write(impf,'(a3)') ends
+ return
+ endif
+ jlint=maxpts
+ write(impf) klint,jlint,(xmap(j),ymap(j),val(j),j=1,jlint) &
+ & ,(lintyp(k),k=1,klint)
+
+ if(nelts .gt. 0) then
+ write(impf) nelts,((nopel(j,k),k=1,3),j=1,nelts)
+ endif
+ return
+ END
+
+ SUBROUTINE GETSVPN(ANS)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IPOS
+ INTEGER :: JNK,ierr
+ CHARACTER*1 :: ANS,CDAT(4)
+ DATA CDAT/'s','t','f','c'/
+ call wdialogload(IDD_DIALOG07)
+ ierr=infoerror(1)
+
+
+ call wdialogputRadioButton(idf_radio1)
+
+
+ CALL WDialogSelect(IDD_DIALOG07)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ipos)
+ ans=cdat(ipos)
+ return
+ endif
+!IPK SEP02
+ ans=cdat(1)
+ return
+ enddo
+ RETURN
+ END
+
+!***************************************************************************************
+
+ subroutine wrtgfg(IOF)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ IOF=IOT
+ WRITE(IOF,5000) TITLE
+ 5000 format('T1'/'T2'/'T3 ',A80)
+ WRITE(IOF,5001)
+ 5001 FORMAT('SI 1')
+ WRITE(IOF,5002)
+ 5002 FORMAT('$L 3 0 6 0')
+!
+! CURRENTLY DISABLED
+!
+! IF(NLST .GT. 0) THEN
+! DO J=1,NLST
+! IF(LLIST(J) .GT. 0) THEN
+! IF(J .EQ. 1) THEN
+! ILIST(J,LLIST(J))=-ABS(ILIST(J,LLIST(J)))
+! ENDIF
+! WRITE(IOF,5003) (ILIST(J,I),I=1,LLIST(J))
+! 5003 FORMAT('GO 2',11I6/('GO',12I6))
+! ENDIF
+! ENDDO
+! ENDIF
+ DO J=1,NE
+ IF (IMAT(J) .NE. 0) THEN
+ IF(IECHG .EQ. 0) IEM(J)=J
+ WRITE(IOF,5004) &
+ & J, (NOP(J,K),K=1,8), IMAT(J),THTA(J)
+ 5004 FORMAT('GE',10(1X,I6),F17.4)
+ ENDIF
+ ENDDO
+ DO J=1,NP
+ IF (INEW(J) .EQ. 1) THEN
+ WRITE(IOF, 5005) &
+ & J,XUSR(J),YUSR(J),WD(J)
+ 5005 FORMAT('GNN',I6,2F14.3,F10.3)
+ ENDIF
+ ENDDO
+ DO J=1,NP
+ IF (INEW(J) .EQ. 1) THEN
+ IF(WIDTH(J) .GT. 0.) THEN
+ WRITE(IOF, 5006) &
+ & J, &
+ & WIDTH(J),SS1(J),SS2(J),WIDS(J)
+ 5006 FORMAT('GWN',I6,1X,F9.1,1X,2F6.2,1X,F9.1)
+ ENDIF
+ ENDIF
+ ENDDO
+
+
+ return
+ end
+
+ subroutine wrtele(IOF,itr)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ IOF=IOT
+ NVRT=2
+ if(itr .eq. 1) then
+ NEL=NE
+ NATT=2
+ IF(NOP(1,2) .EQ. 0) THEN
+ NVRT=3
+ ELSE
+ NVRT=6
+ ENDIF
+ write(IOF,6001) NEL,NVRT,NATT
+ DO N=1,NE
+ IF(NVRT .EQ. 3) THEN
+ WRITE(IOF,6002) N,(NOP(N,J),J=1,5,2),IMAT(N),THTA(N)
+ ELSE
+ WRITE(IOF,6003) N,(NOP(N,J),J=1,5,2),(NOP(N,J),J=2,6,2),IMAT(N),THTA(N)
+ ENDIF
+ ENDDO
+ else
+ NPL=NP
+ NATT=1
+ write(IOF,6001) NPL,NVRT,NATT
+ DO N=1,NPL
+ WRITE(IOF,6004) N,XUSR(N),YUSR(N),WD(N)
+ ENDDO
+
+ endif
+ 6001 FORMAT(I6,I2,I2,I2)
+ 6002 FORMAT(I6,3(' ',I6),I5,' ',F6.2)
+ 6003 FORMAT(I6,6(' ',I6),I5,' ',F6.2)
+ 6004 FORMAT(I6,2F16.6,F11.4)
+ return
+ end
+
+
+ SUBROUTINE RDRST(IENT,IUNIT)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*80 ALINE
+
+ IF(IENT .EQ. 1) THEN
+! READ(IUNIT) IDUMMY1
+ READ(IUNIT) TITLE,NP,NE
+! READ(IUNIT) IDUMMY1,IDUMMY2
+ READ(IUNIT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
+! READ(IUNIT) ,IDUMMY2,IDUMMY3
+ READ(IUNIT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ IPP=0
+ NTEMPIN=2
+ IF(IPP .GT. 0) THEN
+! READ(IIN) IDUMMY3,IDUMMY4
+ READ(IIN) ALINE
+ ENDIF
+
+ ELSEIF(IENT .EQ. 2) THEN
+! READ(IUNIT) IDUMMY4,IDUMMY5
+ READ(IUNIT) ((NOP(J,K),K=1,8),IMAT(J),THTA(J),J=1,NE)
+ DO J=1,NE
+ IF(IMAT(J) .NE. 0) THEN
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ NCORN(J) = NCN
+ IESKP(J) = 0
+ ENDIF
+ ENDDO
+ ELSE
+
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) &
+ & (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
+ & WIDBS(J),SSO(J),BS1(J),J=1,NP)
+ DO J=1,NP
+ CORD(J,1) = XUSR(J)
+ CORD(J,2) = YUSR(J)
+ INSKP(J)=0
+ INEW(J)=0
+ IF (CORD(J,1) .GT. VDX) THEN
+ INEW(J) = 1
+ ENDIF
+ ENDDO
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) NLST
+ IF(NLST .GT. 0) THEN
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) (LLIST(J),J=1,NLST), &
+ ((ILIST(J,I),I=1,LLIST(J)),J=1,NLST)
+ ENDIF
+
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) NENTRY,NLAYD,NCLM
+ if(nentry .eq. 0 .and. nlayd .eq. 0 .and. nclm .eq. 0) return
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ IF(NENTRY .GT. 0) THEN
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) ((NEF(I,J),J=1,3),I=1,NENTRY)
+ ENDIF
+ IF(NLAYD .GT. 0) THEN
+! READ(IUNIT) IDUMMY5,IDUMMY6
+ READ(IUNIT) (LAY(I),I=1,NP),((WTLAY(I,J),J=1,9),I=0,NP)
+ ENDIF
+ IF(NCLM .GT. 0) THEN
+! READ(IUNIT) IDUMMY5,IDUMMY6
+! NCLM=11
+ READ(IUNIT) ((ICCLN(I,J),J=1,350),I=1,NCLM)
+ ENDIF
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE ADJUSTMAP(MAXPLL)
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ USE BLKMAP
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: NTYP,NLOCC
+
+
+ call wdialogload(IDD_SETMAXMAP)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_SETMAXMAP)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,MAXPLL)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,MAXPLL)
+
+ GO TO 100
+ ENDIF
+
+ enddo
+
+ 100 CONTINUE
+ return
+ end
+
+ SUBROUTINE RDESRI(alin,k,j)
+ use blkmap
+ use blk1mod
+ real*8 xorig,yorig,cellsize
+ character*80 alin
+! READ HEADERS
+ read(alin(6:80),*) ncols
+ READ(IMP,'(A80)') ALIN
+ read(alin(6:80),*) nrows
+ READ(IMP,'(A80)') ALIN
+ read(alin(10:80),*) xorig
+ READ(IMP,'(A80)') ALIN
+ read(alin(10:80),*) yorig
+ READ(IMP,'(A80)') ALIN
+ read(alin(9:80),*) cellsize
+ READ(IMP,'(A80)') ALIN
+ read(alin(13:80),*) xnodat
+ ntot=ncols*nrows
+ read(imp,'(10f12.0)') (val(i),i=1,ntot)
+ ict=0
+ ikp=0
+ do n=1,nrows
+ ytemp=cellsize*(n-1)+yorig
+ do m=1,ncols
+ ict=ict+1
+ if(val(ict) .ne. xnodat) then
+ xtemp=cellsize*(m-1)+xorig
+ ikp=ikp+1
+ xmap(ikp)=xtemp
+ ymap(ikp)=ytemp
+ cmap(ikp,1)=xtemp
+ cmap(ikp,2)=ytemp
+ val(ikp)=val(ict)
+ endif
+ enddo
+ LINTYP(1)=2
+ k=2
+ j=ikp
+ enddo
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/INTEL.F90 b/src/src83e/INTEL.F90
new file mode 100644
index 0000000..9fb6fe0
--- /dev/null
+++ b/src/src83e/INTEL.F90
@@ -0,0 +1,438 @@
+ SUBROUTINE GRELV
+!
+! THIS ROUTINE COMPUTES THE GRIDDED ELEVATION
+!
+ use winteracter
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+!-
+
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IERR,ISET
+ REAL :: ASET
+ DATA NXP,NYP/30,20/
+ DATA ITIM/0/
+
+ IF(ITIM .EQ. 0) THEN
+ NX=NXP+2
+ NY=NYP+2
+ ITIM=0
+ ENDIF
+
+ call wdialogload(IDD_GETINTP)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINTP)
+ ierr=infoerror(1)
+
+ 100 continue
+ NXP=NX-2
+ NYP=NY-2
+ XGR=XGRID*TXSCAL
+ YGR=YGRID*TXSCAL
+ CALL WDialogPutINTEGER(IDF_INTEGER1,NXP)
+ CALL WDialogPutINTEGER(IDF_INTEGER2,NYP)
+ CALL WDialogPutREAL(IDF_REAL1,XGR)
+ CALL WDialogPutREAL(IDF_REAL2,YGR)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,NXP)
+ CALL WDialogGetINTEGER(IDF_INTEGER2,NYP)
+ CALL WDialogGetREAL(IDF_REAL1,XGR)
+ CALL WDialogGetREAL(IDF_REAL2,YGR)
+ GO TO 200
+ else
+ NRECC=0
+ endif
+
+ enddo
+
+ 200 CONTINUE
+ NX=NXP+2
+ NY=NYP+2
+ XGRID=XGR/TXSCAL
+ YGRID=YGR/TXSCAL
+!-
+ AXMAX = HSIZE
+ AYMAX = 7.0
+ if(xgrid .eq. 0.) then
+ XGRID = AXMAX/FLOAT(NX-3)
+ ELSE
+ NX=(AXMAX/XGRID+0.5)+3
+ ENDIF
+ IF(YGRID .EQ. 0.) THEN
+ YGRID = AYMAX/FLOAT(NY-3)
+ ELSE
+ NY=(AYMAX/YGRID+0.5)+3
+ ENDIF
+
+ IF(NX .GT. MAXGRD .OR. NY .GT. MAXGRD) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
+ 'Maximum number of interpolation points exceeded '//CHAR(13) &
+ //'Choose a lower resolution.', &
+ 'Warning')
+ go to 100
+ endif
+
+ CALL LOCATE
+!
+ CALL POINTEL
+
+ RETURN
+ END
+
+ SUBROUTINE POINTEL
+!*********************************** .....POINTS.....
+!-
+!......SUBROUTINE TO EVALUATE FUNCTION AT GRID POINTS
+!-
+!-
+ USE WINTERACTER
+ USE BLK1MOD
+
+ include 'd.inc'
+
+ INCLUDE 'TXFRM.COM'
+!
+ REAL*8 XN,DNX,DNY
+ DOUBLE PRECISION XG,YG,XK,YK,XP,YP
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLKV1.COM'
+! INCLUDE 'BLKV2.COM'
+ INCLUDE 'BFILES.I90'
+!-
+!ipk jul94 DIMENSION X(8),Y(8)
+ DIMENSION X(9),Y(9)
+ CHARACTER(LEN=255) :: FNAME,FNAMR
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER(LEN=3) :: SUB,SUB1
+!-
+ DATA TOL/0.01/
+!-
+
+!-
+!......LOOP ON ALL GRID POINTS
+!-
+ FILTER = 'Map file *.map|*.map|'
+ CALL WSelectFile(FILTER,SaveDialog+PromptOn,FNAME,'Save Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(199,FILE=FNAME,STATUS='UNKNOWN')
+ WRITE(199,8000)
+ 8000 FORMAT('2,0.')
+ ELSE
+ RETURN
+ ENDIF
+
+ DO 1000 NN=1,NX
+ DO 950 MM=1,NY
+ N=IGRID(NN,MM)
+ IF(N.EQ.0) GO TO 950
+ HGN=0.
+ 250 CONTINUE
+!-
+!......DETERMINE ELEMENT TYPE
+!-
+!IPKOCT93 ADD
+ NCN=8
+ IT=1
+
+ IF(NOP(N,7).NE.0) GO TO 275
+ NCN=6
+ IT=2
+ 275 CONTINUE
+!-
+!......ESTABLISH LOCAL COORDINATES FOR EACH NODE POINT
+!-
+ K1=NOP(N,1)
+ X(1)=0.
+ Y(1)=0.
+ DO 300 K=2,NCN
+ K2=NOP(N,K)
+ X(K)=CORD(K2,1)-CORD(K1,1)
+ Y(K)=CORD(K2,2)-CORD(K1,2)
+ 300 END DO
+!-
+!......ESTABLISH LOCAL COORDINATES OF DESIRED POINT
+!-
+ XP=FLOAT(NN-2)*XGRID
+ XRL=XP*TXSCAL-XS
+ XP=XP-CORD(K1,1)
+ YP=FLOAT(MM-2)*YGRID
+ YRL=YP*TXSCAL-YS
+ YP=YP-CORD(K1,2)
+ XG=0.
+ YG=0.
+!-
+!......ITERATE TO FIND LOCAL COORDINATE
+!-
+ DO 400 ITER=1,10
+ DXKDX=0.
+ DXKDY=0.
+ DYKDX=0.
+ DYKDY=0.
+ XK=-XP
+ YK=-YP
+ DO 350 K=2,NCN
+ XK=XK+XN(IT,K,XG,YG)*X(K)
+ YK=YK+XN(IT,K,XG,YG)*Y(K)
+ DXKDX=DXKDX+DNX(IT,K,XG,YG)*X(K)
+ DYKDX=DYKDX+DNX(IT,K,XG,YG)*Y(K)
+ DXKDY=DXKDY+DNY(IT,K,XG,YG)*X(K)
+ DYKDY=DYKDY+DNY(IT,K,XG,YG)*Y(K)
+ 350 END DO
+ DET=DXKDX*DYKDY-DXKDY*DYKDX
+ DX=(-DYKDY*XK+DXKDY*YK)/DET
+ DY=( DYKDX*XK-DXKDX*YK)/DET
+ XG=XG+DX
+ YG=YG+DY
+ IF(ABS(DX).LT.TOL .AND. ABS(DY).LT.TOL) GO TO 420
+ 400 END DO
+!-
+!......NOW EVALUATE GRID POINT
+!-
+ 420 CONTINUE
+ DO 450 K=1,NCN
+ J=NOP(N,K)
+ HGN=HGN+XN(IT,K,XG,YG)*WD(J)
+ 450 END DO
+ WRITE(199,9800) XRL,YRL,HGN
+ 9800 FORMAT(F14.2',',F14.2,',',F14.3)
+ 950 END DO
+ 1000 END DO
+! IF(NVEL .EQ. 1) WRITE(6,9803) ((UGRID(NN,MM),MM=1,32),
+! 1NN=1,32)
+! IF(NVEL .EQ. 1) WRITE(6,9803) ((VGRID(NN,MM),MM=1,32),
+! 1NN=1,32)
+ 9803 FORMAT(8E12.4)
+! WRITE(6,9802)((GRID(NN,MM),MM=1,16),NN=1,16)
+!9802 FORMAT(16F8.2)
+ WRITE(199,8001)
+ 8001 FORMAT('END')
+ WRITE(199,8001)
+ RETURN
+ END
+
+!
+ SUBROUTINE LOCATE
+!*********************************** .....LOCATE.....
+!-
+!......LOCATE ESTABLISHES ELEMENT NUMBERS FOR ALL GRID POINTS
+!-
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLKV1.COM'
+! INCLUDE 'BLKV2.COM'
+ INCLUDE 'BFILES.I90'
+!
+ COMMON XS(4,3),YS(4,3),XM(4,3),ROOT(10)
+!
+ VOID=1.E+20
+ NPTS= 7
+ DS=1./(FLOAT(NPTS)-1.)
+ DO 340 N=1,MAXGRD
+ DO 340 M=1,MAXGRD
+ 340 IGRID(N,M)=0
+!-
+!....... PROCESS EACH ELEMENT
+!-
+ DO 900 N=1,NE
+ IF(IESKP(N) .NE. 0) GO TO 900
+ IF(IMAT(N).LE.0) GO TO 900
+ IF(NOP(N,6) .EQ. 0) GO TO 900
+ XMINN=VOID
+ YMINN=VOID
+ XMAXX=-VOID
+ YMAXX=-VOID
+!-
+!...... TRACE AROUND EACH SIDE FOR MAX AND MIN LOCATIONS
+!-
+ NCN=8
+ IF(NOP(N,7).EQ.0) NCN=6
+ NSIDE=NCN/2
+ K=0
+ DO 600 M=1,NCN,2
+ K=K+1
+ M1=NOP(N,M)
+ M2=NOP(N,M+1)
+ M3=MOD(M+2,NCN)
+ M3=NOP(N,M3)
+ XS(K,1)=CORD(M1,1)
+ XS(K,2)=CORD(M2,1)
+ XS(K,3)=CORD(M3,1)
+ YS(K,1)=CORD(M1,2)
+ YS(K,2)=CORD(M2,2)
+ YS(K,3)=CORD(M3,2)
+ XM(K,1)=2.*XS(K,1)-4.*XS(K,2)+2.*XS(K,3)
+ XM(K,2)=-3.*XS(K,1)+4.*XS(K,2)-XS(K,3)
+ XM(K,3)=XS(K,1)
+!-
+!..... WORK ALONG BOUNDARY OF ELEMENT
+!-
+ S=0.
+ DO 550 J=1,NPTS
+ XN1=(1.-S)*(1.-2.*S)
+ XN2=4.*(1.-S)*S
+ XN3=S*(2.*S-1.)
+ X=XN1*XS(K,1)+XN2*XS(K,2)+XN3*XS(K,3)
+ Y=XN1*YS(K,1)+XN2*YS(K,2)+XN3*YS(K,3)
+ IF(X.LT.XMINN) XMINN=X
+ IF(X.GT.XMAXX) XMAXX=X
+ IF(Y.LT.YMINN) YMINN=Y
+ IF(Y.GT.YMAXX) YMAXX=Y
+ S=S+DS
+ 550 END DO
+ 600 END DO
+!-
+!...... ESTABLISH GRID FRAMEWORK
+!-
+ XLH=XMINN/XGRID
+ XRH=XMAXX/XGRID
+ YBT=YMINN/YGRID
+ YTP=YMAXX/YGRID
+ IXL=XLH+2.999
+ IXT=XRH+2.001
+ IYL=YBT+2.999
+ IYT=YTP+2.001
+ IERR=0
+!$$$
+ IF(IXL.LT.0) IERR=1
+ IF (IXL .LT. 1) IXL = 1
+ IF(IYL.LT.0) IERR=1
+ IF (IYL .LT. 1) IYL = 1
+ IF(IXT.GT.NX) IERR=1
+ IF (IXT .GT. NX) IXT = NX
+ IF(IYT.GT.NY) IERR=1
+ IF (IYT .GT. NY) IYT = NY
+!
+ IF(IERR.EQ.0) GO TO 620
+! WRITE(6,9989) N
+! 9989 FORMAT(///' ERROR STOP FOR ELEMENT',I5)
+! WRITE(6,9990) (K,(XS(K,M),YS(K,M),XM(K,M),M=1,3),K=1,NSIDE)
+! 9990 FORMAT(I10,9E13.4)
+! WRITE(6,9992) XLH,XRH,YBT,YTP,IXL,IXT,IYL,IYT
+! 9992 FORMAT(4F20.6,4I8)
+!$$$ STOP
+ 620 CONTINUE
+!-
+!...... FIND INTERSECTIONS FOR HORIZONTAL GRID LINE
+!-
+ DO 800 M=IYL,IYT
+ Y=(M-2)*YGRID
+ IL=0
+ DO 700 K=1,NSIDE
+ A=2.*YS(K,1)-4.*YS(K,2)+2.*YS(K,3)
+ B=-3.*YS(K,1)+4.*YS(K,2)-YS(K,3)
+ C=YS(K,1)-Y
+ SQ=B**2-4.*A*C
+ IF(ABS(A).LT.0.01) GO TO 650
+ IF(SQ.GT..001) GO TO 660
+ IF(SQ.LT.-.001) GO TO 700
+ S=-B/(2.*A)
+ IF(S.LT.0. .OR. S.GT.1.0) GO TO 700
+ IL=IL+1
+ ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3)
+ IL=IL+1
+ ROOT(IL)=ROOT(IL-1)
+ GO TO 700
+ 650 IF(ABS(B).LT. 0.001) GO TO 700
+ S=-C/B
+ GO TO 670
+ 660 CONTINUE
+ S=(-B+SQRT(SQ))/(2.*A)
+ IF(S.LT.0. .OR. S.GT.1.0) GO TO 665
+ IL=IL+1
+ ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3)
+ 665 S=(-B-SQRT(SQ))/(2.*A)
+ 670 CONTINUE
+ IF(S.LT.0. .OR. S.GT.1.0) GO TO 700
+ IL=IL+1
+ ROOT(IL)=XM(K,1)*S**2+XM(K,2)*S+XM(K,3)
+ 700 END DO
+ IF(IL.GT.0) GO TO 705
+ DO 703 K=1,NSIDE
+ IF(ABS(YS(K,3)-Y).LT.0.05) GO TO 704
+ 703 END DO
+ GO TO 800
+ 704 IL=2
+ ROOT(1)=XS(K,3)-0.05
+ ROOT(2)=XS(K,3)+0.05
+ 705 CONTINUE
+ CALL SORTE(ROOT,IL)
+! ISET=0
+ IC=1
+!-
+!....... LOCATE VALUES INTO IGRID
+!-
+ 9908 FORMAT(I10,F20.2)
+ 9997 FORMAT(5F20.4)
+ DO 750 K=IXL,IXT
+ X=(K-2)*XGRID
+ 710 CONTINUE
+ IF(X.LE.ROOT(IC)) GO TO 720
+ IC=IC+1
+ IF(IC.GT.IL) GO TO 800
+ GO TO 710
+ 720 IF(MOD(IC,2).EQ.0) IGRID(K,M)=N
+ 750 END DO
+ 800 END DO
+ 900 END DO
+!CC WRITE(*,9800) ((IGRID(N,M),N=1,20),M=1,20)
+ 9800 FORMAT(20I3)
+ RETURN
+ END
+!
+ SUBROUTINE SORTE(A,N)
+!*********************************** .....SORT.....
+!-
+!......SORT IS A SIMPLE SHELL SORT ROUTINE
+!-
+! SHELL SORT
+ SAVE
+!
+ DIMENSION A(*)
+ IF(N.LT.2) RETURN
+ ID = N
+ 100 ID = ID / 2
+ 110 IB = 1
+ 120 GO TO 200
+ 130 IB = IB + 1
+ IF( IB .LE. ID ) GO TO 200
+ IF( ID .GT. 1 ) GO TO 100
+ RETURN
+ 200 I = IB
+ 210 K = I + ID
+ 220 IF( A(I) .LE. A(K) ) GO TO 250
+ T = A(K)
+ A(K) = A(I)
+ J = I
+ 230 K = J - ID
+ IF( K .LT. 1 ) GO TO 240
+ IF( T .GT. A(K) ) GO TO 240
+ A(J) = A(K)
+ J = K
+ GO TO 230
+ 240 A(J) = T
+ 250 I = I + ID
+ IF( I + ID .LE. N ) GO TO 210
+ GO TO 130
+ END
+!
diff --git a/src/src83e/JLINE.F90 b/src/src83e/JLINE.F90
new file mode 100644
index 0000000..2de216e
--- /dev/null
+++ b/src/src83e/JLINE.F90
@@ -0,0 +1,122 @@
+ SUBROUTINE JLINE(ILIN,CVAL)
+
+! Routine to join up points
+
+ USE BLKMAP
+ USE BLK1MOD
+ ! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+ COMMON /CCGEN/ XCLIN(4000,2),YCLIN(4000,2),ALIN(-4000:4000,2),IUSED(4000)
+
+
+ VOID=-1.0E+10
+
+ DO K=1,MAXLIN
+ IF(LINTYP(K) .EQ. -999) THEN
+ NLIN=K-1
+ GO TO 100
+ ENDIF
+ ENDDO
+ NLIN=MAXLIN
+ 100 CONTINUE
+
+ DO I=1,ILIN
+ IUSED(I)=0
+ ENDDO
+! Loop through remaining poins
+
+ DO I=1,ILIN
+ IF(IUSED(I) .EQ. 0) THEN
+
+! Set first points
+
+ IFW=2
+ IFB=1
+ IUSED(I)=1
+ ALIN(1,1)=XCLIN(I,1)
+ ALIN(1,2)=YCLIN(I,1)
+ ALIN(2,1)=XCLIN(I,2)
+ ALIN(2,2)=YCLIN(I,2)
+
+! Look at remaining points for match
+
+ 200 CONTINUE
+
+ DO J=I,ILIN
+ IF(IUSED(J) .EQ. 0) THEN
+! First for forward points
+
+ IF(XCLIN(J,1) .EQ. ALIN(IFW,1) .AND. YCLIN(J,1) .EQ. ALIN(IFW,2)) THEN
+ IFW=IFW+1
+ ALIN(IFW,1)=XCLIN(J,2)
+ ALIN(IFW,2)=YCLIN(J,2)
+ IUSED(J)=1
+ ELSEIF(XCLIN(J,2) .EQ. ALIN(IFW,1) .AND. YCLIN(J,2) .EQ. ALIN(IFW,2)) THEN
+ IFW=IFW+1
+ ALIN(IFW,1)=XCLIN(J,1)
+ ALIN(IFW,2)=YCLIN(J,1)
+ IUSED(J)=1
+ ELSEIF(XCLIN(J,1) .EQ. ALIN(IFB,1) .AND. YCLIN(J,1) .EQ. ALIN(IFB,2)) THEN
+ IFB=IFB-1
+ ALIN(IFB,1)=XCLIN(J,2)
+ ALIN(IFB,2)=YCLIN(J,2)
+ IUSED(J)=1
+ ELSEIF(XCLIN(J,2) .EQ. ALIN(IFB,1) .AND. YCLIN(J,2) .EQ. ALIN(IFB,2)) THEN
+ IFB=IFB-1
+ ALIN(IFB,1)=XCLIN(J,1)
+ ALIN(IFB,2)=YCLIN(J,1)
+ IUSED(J)=1
+ ENDIF
+ IF(IUSED(J) .EQ. 1) GO TO 200
+ ENDIF
+ ENDDO
+
+! No new points found line must be complete
+! Check for loops
+! First end points
+
+ 250 CONTINUE
+! IF((ALIN(IFB,1) .EQ. ALIN(IFW,1)) .AND. (ALIN(IFB,2) .EQ. ALIN(IFW,2))) THEN
+! IFB=IFB+1
+! IF(IFB .EQ. IFW) GO TO 300
+! GO TO 250
+! ENDIF
+ NLIN=NLIN+1
+ LINTYP(NLIN)=3
+ IF(IMP .EQ. 0) IMP=9
+ N=0
+ IF(MAXPTS .EQ. MAXPL) MAXPTS=0
+ IF(MAXPTS .GT. 0) THEN
+ MAXPTS=MAXPTS+1
+ CMAP(MAXPTS,1) = VOID
+ CMAP(MAXPTS,2) = VOID
+ XMAP(MAXPTS) = VOID
+ YMAP(MAXPTS) = VOID
+! WRITE(198,'(I5,3F15.6)') MAXPTS,XMAP(MAXPTS),YMAP(MAXPTS),VAL(MAXPTS)
+ ENDIF
+ A1= VOID
+ A2= VOID
+ DO J=IFB,IFW
+ IF(ALIN(J,1) .EQ. A1 .AND. ALIN(J,2) .EQ. A2) GO TO 275
+ MAXPTS=MAXPTS+1
+! Check for double points
+ XMAP(MAXPTS) = ALIN(J,1)
+ YMAP(MAXPTS) = ALIN(J,2)
+ VAL(MAXPTS) = CVAL
+ CMAP(MAXPTS,1)=(XMAP(MAXPTS)+XS)/TXSCAL
+ CMAP(MAXPTS,2)=(YMAP(MAXPTS)+YS)/TXSCAL
+
+! WRITE(198,'(I5,3F15.6)') MAXPTS,XMAP(MAXPTS),YMAP(MAXPTS),VAL(MAXPTS)
+ 275 CONTINUE
+ ENDDO
+ 300 CONTINUE
+ ENDIF
+
+! Copy values into contour line array
+
+ ENDDO
+ klint=nlin
+
+ RETURN
+ END
+
diff --git a/src/src83e/JOIN.bmp b/src/src83e/JOIN.bmp
new file mode 100644
index 0000000..60f0ed5
Binary files /dev/null and b/src/src83e/JOIN.bmp differ
diff --git a/src/src83e/JOINEL.F90 b/src/src83e/JOINEL.F90
new file mode 100644
index 0000000..00dcc4e
--- /dev/null
+++ b/src/src83e/JOINEL.F90
@@ -0,0 +1,452 @@
+!IPK LAST UPDATE SEP 23 2015 ADD OPTION FOR JOINING ELEMENTS
+ subroutine joinel
+
+ USE BLK1MOD
+ USE BLK2MOD
+ use blkmap
+ INTEGER LIST1(1000),LIST2(1000),idel(1000)
+ real xmapt(1000),ymapt(1000)
+
+
+ CHARACTER*1 IFLAG,ANSW(10)
+ CHARACTER*60 STRELS
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+
+
+ DATA STRELS/' You have tried to join before executing "FILL"'/
+!
+!
+! Test to make sure fill has been executed.
+!
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ DO M=2,NCORN(N),2
+!ipkoct93
+ if(imat(n) .LT. 900) THEN
+ IF(NOP(N,M) .EQ. 0) THEN
+ CALL SYMBL(0.,7.30,0.20,STRELS,0.,60)
+ RETURN
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+! Initiliaze list etc
+
+ NHTPSV=NHTP
+ NMESSSV=NMESS
+ NBRRSV=NBRR
+
+! get starting elements
+ CALL KCON(0)
+ DO N=1,NE
+ DO M=1,8
+ NOPSV(N,M)=NOP(N,M)
+ ENDDO
+ IMATSV(N)=IMAT(N)
+ ENDDO
+ NESAV=NE
+ NEFSAV=NENTRY
+ NPUNDO=0
+ list1=0
+ list2=0
+! SELECT FIRST ELEMENT
+10 CONTINUE
+ CALL PANELTYP(NMTYP)
+ NHTP=0
+ NMESS=20
+ NBRR=8
+ CALL HEDR
+
+ CALL PROX(XC,YC,NE,XX,YY,NEL1,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ CALL fillem(NEL1)
+!
+ IF(IFLAG .EQ. 'q') THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+
+ CALL PROX(XC,YC,NE,XX,YY,NEL2,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ CALL fillem(NEL1)
+ CALL fillem(NEL2)
+
+ CALL PROX(XC,YC,NE,XX,YY,NEL3,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+
+ CALL fillem(NEL1)
+ CALL fillem(NEL2)
+ CALL fillem(NEL3)
+ CALL PROX(XC,YC,NE,XX,YY,NEL4,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ CALL fillem(NEL1)
+ CALL fillem(NEL2)
+ CALL fillem(NEL3)
+ CALL fillem(NEL4)
+
+! work on first pair
+! get starting mid-side
+ ilc=0
+ call findbcel(nel1,nd1,nd2,nd3,ierr,ilc)
+! save back node
+ list1(1)=nd1
+ write(90,*) '1',nd1
+
+! get adjacent corner save corner
+ m=2
+ list1(m)=nd3
+ write(90,*) m,nd3
+ nelc=nel1
+ nelcsv=nel1
+! start looop
+ do nss=1,1000
+! find next element and get mid side
+ nadj=ndelm(nd3)
+ do kkk=1,nadj
+ nd3=list1(m)
+ nelc=nelcsv
+ if(necon(nd3,kkk) .ne. nelc) then
+ nelc=necon(nd3,kkk)
+ ilc=2
+ call findbcel(nelc,nd1,nd2,nd3,ierr,ilc)
+ if(ierr .eq. 0) go to 200
+ endif
+ enddo
+200 continue
+ nelcsv=nelc
+! get and save next corner
+ m=m+1
+ if(m .gt. 1000) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ RETURN
+ ENDIF
+ list1(m)=nd3
+ write(90,*) m,nd3
+! test for last element
+ if(nelc .eq. nel2) go to 250
+ enddo
+250 continue
+ m1=m
+
+! repeat for second pair
+! get starting mid-side
+ ilc=1
+ call findbcel(nel3,nd1,nd2,nd3,ierr,ilc)
+! save back node
+ list2(1)=nd1
+ write(90,*) m,nd1
+
+! get adjacent corner save corner
+ m=2
+ list2(m)=nd3
+ write(90,*) m,nd3
+ nelc=nel3
+ nelcsv=nel3
+! start looop
+ do nss=1,1000
+! find next element and get mid side
+ nadj=ndelm(nd3)
+ do kkk=1,nadj
+ nd3=list2(m)
+ nelc=nelcsv
+ if(necon(nd3,kkk) .ne. nelc) then
+ nelc=necon(nd3,kkk)
+ ilc=2
+ if(nelc .eq. nel4) ilc=4
+ call findbcel(nelc,nd1,nd2,nd3,ierr,ilc)
+ if(ierr .eq. 0) go to 300
+
+ endif
+ enddo
+300 continue
+ nelcsv=nelc
+! get and save next corner
+ m=m+1
+ if(m .gt. 1000) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ ENDIF
+ list2(m)=nd3
+ write(90,*) m,nd3
+! test for last element
+ if(nelc .eq. nel4) go to 350
+ enddo
+350 continue
+ m2=m
+ ! add points in triangle list
+ do j=1,m2
+ list1(m1+j)=list2(j)
+ enddo
+ nvert=m1+m2
+ do n=1,nvert
+ write(90,*) n,list1(n)
+ enddo
+ do j=1,nvert
+ xmap(j)=xusr(list1(j))
+ ymap(j)=yusr(list1(j))
+ xmapt(j)=xusr(list1(j))
+ ymapt(j)=yusr(list1(j))
+ imap(j)=1
+ val(j)=1.
+ enddo
+! call for triangulation
+
+ CALL DELAUNAY(NVERT)
+
+ do n=1,nelts
+ if(nopel(n,1) .le. m1) then
+ if(nopel(n,2) .le. m1 .and. nopel(n,3) .le. m1) then
+ cycle
+ endif
+ else
+ if(nopel(n,2) .gt. m1 .and. nopel(n,3) .gt. m1) then
+ cycle
+ endif
+500 continue
+ endif
+! FORM A NEW ELEMENT ASSIGN TYPE AS INDICATED
+ CALL GETELM(J)
+ NOP(J,1)=list1(nopel(n,1))
+ NOP(J,3)=list1(nopel(n,2))
+ NOP(J,5)=list1(nopel(n,3))
+ NOP(J,2)=0
+ NOP(J,4)=0
+ NOP(J,6)=0
+ NOP(J,7)=0
+ NOP(J,8)=0
+ IMAT(J)=NMTYP
+ IESKP(J) = 0
+ NCORN(J)=6
+ enddo
+ CALL PLOTOT(1)
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+
+ CALL HEDR
+ return
+ end
+
+ subroutine findbcel(nel,nd1,nd2,nd3,ierr,ilc)
+ use blk1mod
+ USE BLK2MOD
+ integer nel,nd1,nd2,nd3,mlc(5),ndkp
+ ndkp=nd3
+ ierr=0
+ kk=0
+ do k=2,ncorn(nel),2
+ nd2=nop(nel,k)
+ if(ndelm(nd2) .eq. 1) then
+ nd1=nop(nel,k-1)
+ if(nd1 .ne. ndkp .and. ilc .gt. 1) cycle
+ jj=mod(k,ncorn(nel))+1
+ nd3=nop(nel,jj)
+ if(ilc .eq. 4) return
+ if(ilc .gt. 0) then
+ kk=kk+1
+ mlc(kk)=k
+ cycle
+ else
+! check for more than 1
+ kj=k+2
+ if(kj .gt. ncorn(nel)) kj=2
+ nd2a=nop(nel,kj)
+ if(ndelm(nd2a) .eq. 1) then
+ nd1=nop(nel,kj-1)
+ jj=mod(kj,ncorn(nel))+1
+ nd3=nop(nel,jj)
+ nd2=nd2a
+ endif
+ return
+ endif
+
+ endif
+ enddo
+ if(ilc .gt. 0) then
+ if(kk .eq. 1) then
+ if(nd1 .eq. ndkp) then
+ return
+ else
+ ierr=1
+ return
+ endif
+ elseif(kk .eq. 2) then
+ if(abs(mlc(2)-mlc(1)) .eq. 4) then
+ do kk=1,2
+ nd1=nop(nel,mlc(kk)-1)
+ if(nd1 .eq. ndkp) then
+ nd2=nop(nel,mlc(kk))
+ nd3=mod(mlc(kk),ncorn(nel))+1
+ nd3=nop(nel,nd3)
+ return
+ endif
+ enddo
+ endif
+ if(ilc .eq. 1) then
+ if(mlc(kk) .eq. ncorn(nel) .and. mlc(kk-1) .eq. 2) then
+ nd1=nop(nel,1)
+ nd2=nop(nel,2)
+ nd3=nop(nel,3)
+ else
+ return
+ endif
+ else
+ if(mlc(kk) .eq. ncorn(nel) .and. mlc(kk-1) .eq. 2) then
+ return
+ else
+ nd1=nop(nel,mlc(1)-1)
+ nd2=nop(nel,mlc(1))
+ nd3=nop(nel,mlc(1)+1)
+ endif
+ endif
+ elseif(kk .eq. 3) then
+ if(mlc(kk) .eq. ncorn(nel)) then
+ if(mlc(kk-1) .eq. ncorn(nel)-2) then
+ nd1=nop(nel,1)
+ nd2=nop(nel,2)
+ nd3=nop(nel,3)
+ elseif(mlc(kk-1) .eq. ncorn(nel)-4) then
+ nd1=nop(nel,3)
+ nd2=nop(nel,4)
+ nd3=nop(nel,5)
+ else
+ return
+ endif
+ else
+ return
+ endif
+ endif
+! else
+! return
+ endif
+ ierr=1
+ return
+ end
+
+ SUBROUTINE PANELTYP(N1)
+
+! Choose options and intervals
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,itime,IERR
+ data itime/0/
+
+ if(itime .eq. 0) then
+ n1=1
+ itime=1
+ endif
+
+ call wdialogload(IDD_MATTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(idf_integer1,N1)
+
+ CALL WDialogSelect(IDD_MATTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(idf_integer1,N1)
+ ELSE
+ N1=1
+ RETURN
+
+ ENDIF
+
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/LAYDISP.F90 b/src/src83e/LAYDISP.F90
new file mode 100644
index 0000000..1607335
--- /dev/null
+++ b/src/src83e/LAYDISP.F90
@@ -0,0 +1,69 @@
+ Subroutine LayDisp
+
+ USE WINTERACTER
+ USE BLK1MOD
+!
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: INODE,IBOX,NN
+ INTEGER :: IERR
+ CHARACTER*1 :: IFLAG
+
+ DATA INODE/1/
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select node','CHOOSE NODE')
+ IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+
+ 100 continue
+ call wdialogload(IDD_LAY)
+ ierr=infoerror(1)
+
+
+ IF(ILAYTP .EQ. 1) THEN
+ call wdialogputRadioButton(idf_radio1)
+ ELSE
+ call wdialogputRadioButton(idf_radio2)
+ ENDIF
+ lno=lay(INODE)
+ CALL WDialogPutINTEGER(IDF_INTEGER1,lno)
+ do i=1,7
+ CALL WGridPutCellReal(IDF_GRID1,i,1,wtlay(INODE,i))
+ enddo
+
+
+ CALL WDialogSelect(IDD_LAY)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ilaytp)
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,lno)
+ lay(INODE)=lno
+ do i=1,7
+ CALL WGridGetCellReal(IDF_GRID1,i,1,wtlay(INODE,i))
+ enddo
+ return
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ endif
+!IPK SEP02
+ return
+ enddo
+ RETURN
+ END
diff --git a/src/src83e/LEVSETTYP.F90 b/src/src83e/LEVSETTYP.F90
new file mode 100644
index 0000000..60fd971
--- /dev/null
+++ b/src/src83e/LEVSETTYP.F90
@@ -0,0 +1,50 @@
+ SUBROUTINE LEVSETTYP
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+
+ CHARACTER*47 MESSAGE
+
+ DATA ITIME/0/
+ IMATTYP=1
+ BLELVEL=0.
+
+ call wdialogload(IDD_LEVSETTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_LEVSETTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogPutReal(IDF_REAL1,BLEVEL)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,IMATTYP)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetInteger(IDF_INTEGER1,IMATTYP)
+ CALL WDialogGetReal(IDF_REAL1,BLEVEL)
+ GO TO 200
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ ENDIF
+ ENDDO
+
+200 CONTINUE
+
+ DO N=1,NE
+ IF(IMAT(N) .EQ. 99) CYCLE
+ DO K=1,NCORN(N)
+ IF(NOP(N,K) .EQ. 0) CYCLE
+ IF(WD(NOP(N,K)) .LT. BLEVEL) GO TO 300
+ ENDDO
+ IMAT(N)=IMATTYP
+300 CONTINUE
+ ENDDO
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/LOADFIL.F90 b/src/src83e/LOADFIL.F90
new file mode 100644
index 0000000..e7e38f2
--- /dev/null
+++ b/src/src83e/LOADFIL.F90
@@ -0,0 +1,23 @@
+ SUBROUTINE LOADFIL
+
+ INCLUDE 'BFILES.I90'
+
+
+ IFILOUT=IACTVFIL+50
+
+! Zero out current arrays
+
+ CALL ZEROOUT
+
+ IFNUM=IACTVFIL+50
+ WRITE(90,*) 'IN LOADFIL IFNUM',IFNUM
+ CALL RDRST(1,IFNUM)
+ CALL RDRST(2,IFNUM)
+ CALL RDRST(3,IFNUM)
+ REWIND IFNUM
+
+ CALL RESCAL
+ CALL HEDR
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/MMAP.F90 b/src/src83e/MMAP.F90
new file mode 100644
index 0000000..04909ec
--- /dev/null
+++ b/src/src83e/MMAP.F90
@@ -0,0 +1,99 @@
+!IPK LAST UPDATE SEP 23 2015 ADD NEW FORMAT TO 6 DEC
+ Subroutine MMap
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CALL OPENMP
+
+ CALL SVELEM(IYES)
+
+ rewind 99
+
+! if IYES .eq. 1 save as an element format
+
+ valmap=0.
+ mapno=2
+ IF(IYES .EQ. 1) THEN
+ do n=1,ne
+ write(99,6001)
+ 6001 format(' 3,9999.')
+ if(imat(n) .gt. 0) then
+ ncn=ncorn(n)
+ do m=1,ncn
+ j=nop(n,m)
+ if(j .gt. 0) then
+ write(99,'(3f16.3)') xusr(j),yusr(j),wd(j)
+ endif
+ enddo
+ j=nop(n,1)
+ if(j .gt. 0) then
+ write(99,'(3f16.3)') xusr(j),yusr(j),wd(j)
+ endif
+ endif
+ write(99,6000)
+ 6000 format('END')
+ enddo
+
+! if IYES .eq. 0 save as a nodal list
+
+
+ ELSE
+ write(99,6002)
+ 6002 format(' 2,0')
+ do j=1,np
+ if(inew(j) .eq. 1) then
+ write(99,'(3f16.6)') xusr(j),yusr(j),wd(j)
+ endif
+ enddo
+ write(99,6000)
+ ENDIF
+ write(99,6000)
+ close (99)
+ return
+ end
+
+ subroutine openmp
+
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ CALL WSelectFile(ID_STRING7,SaveDialog+PromptOn,FNAME,'Save Network as Mapfile')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='map'
+ CALL ADDSUB(FNAME,SUB)
+ open(99,file=fname, form='formatted', status='unknown')
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE SVELEM(IYES)
+
+ USE WINTERACTER
+
+ INCLUDE 'D.INC'
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save element layout?'//&
+ CHAR(13)//' ','Map option')
+!
+! If answer 'No', return
+!
+ iyes=1
+ IF (WInfoDialog(4).EQ.2) iyes=0
+ return
+ end
+
\ No newline at end of file
diff --git a/src/src83e/MOVMESH.f90 b/src/src83e/MOVMESH.f90
new file mode 100644
index 0000000..ef3e501
--- /dev/null
+++ b/src/src83e/MOVMESH.f90
@@ -0,0 +1,386 @@
+ SUBROUTINE MOVMESH
+
+ USE WINTERACTER
+ USE BLK1MOD
+
+ SAVE
+
+! implicit none
+
+ include 'd.inc'
+
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+
+ CHARACTER*1 IFLAG
+ REAL xlocorg,ylocorg,xlocscl,ylocscl,XREFPT,YREFPT,xlocs,ylocs,xlocf,ylocf,stscalx,stscaly,xtest,ytest
+ INTEGER NTYPR,ITIMETHRU
+
+ allocatable xusrt(:),yusrt(:),xcrst(:),ycrst(:)
+
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ DATA ITIMTHRU/0/,NTYPR/1/,xlocorg/0./,ylocorg/0./,xlocscl/0./,ylocscl/0./
+
+ call wdialogload(IDD_DIALOG048)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG048)
+ ierr=infoerror(1)
+
+ IF(NTYPR .EQ. 1) THEN
+ call wdialogputRadioButton(idf_radio1)
+ ELSE
+ call wdialogputRadioButton(idf_radio2)
+ ENDIF
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ntypr)
+ go to 100
+
+ elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ return
+ ENDIF
+
+ enddo
+
+ 100 continue
+
+ IF(NTYPR .EQ. 1) THEN
+
+ call wdialogload(IDD_DIALOG047)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG047)
+ ierr=infoerror(1)
+
+ CALL WDialogPutReal(IDF_REAL1,xlocorg)
+ CALL WDialogPutReal(IDF_REAL2,ylocorg)
+ CALL WDialogPutReal(IDF_REAL3,xlocscl)
+ CALL WDialogPutReal(IDF_REAL4,ylocscl)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetReal(IDF_REAL1,xlocorg)
+ CALL WDialogGetReal(IDF_REAL2,ylocorg)
+ CALL WDialogGetReal(IDF_REAL3,xlocscl)
+ CALL WDialoggetReal(IDF_REAL4,ylocscl)
+
+ allocate (xusrt(np),yusrt(np))
+
+ if(xlocscl .eq. 0.) then
+ do j=1,np
+ xusrt(j)=xusr(j)
+ yusrt(j)=yusr(j)
+ xusr(j)=xusr(j)+xlocorg
+ yusr(j)=yusr(j)+ylocorg
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ if(ncrsec .gt. 0) then
+ allocate (xcrst(nrsec),ycrst(nrsec))
+ do j=1,ncrsec
+ xcrst(j)=xcrs(j)
+ ycrst(j)=ycrs(j)
+ xcrs(j)=xcrs(j)+xlocorg
+ ycrs(j)=ycrs(j)+ylocorg
+ enddo
+ endif
+ else
+ do j=1,np
+ xusr(j)=(xusr(j)-xlocorg)*xlocscl
+ yusr(j)=(yusr(j)-ylocorg)*ylocscl
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ if(ncrsec .gt. 0) then
+ allocate (xcrst(nrsec),ycrst(nrsec))
+ do j=1,ncrsec
+ xcrst(j)=xcrs(j)
+ ycrst(j)=ycrs(j)
+ xcrs(j)=(xcrs(j)-xlocorg)*xlocscl
+ ycrs(j)=(ycrs(j)-ylocorg)*ylocscl
+ enddo
+ endif
+ endif
+
+ go to 300
+
+ elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ return
+ endif
+ enddo
+
+ else
+
+! get reference point
+! xrefpt
+! yrefpt
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Fixed Reference point','CHOOSE REFERENCE')
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XREFPT = XTEMP*TXSCAL - XS
+ YREFPT = YTEMP*TXSCAL - YS
+
+! get start move point
+! xlocs
+! ylocs
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Starting point','CHOOSE START')
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XLOCS = XTEMP*TXSCAL - XS
+ YLOCS = YTEMP*TXSCAL - YS
+
+! get finish move point
+! xlocf
+! ylocf
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Finishing point','CHOOSE FINISH')
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XLOCF = XTEMP*TXSCAL - XS
+ YLOCF = YTEMP*TXSCAL - YS
+
+! establish x moves
+ stscalx=(xlocf-xrefpt)/(xlocs-xrefpt)
+
+! establish y moves
+ stscaly=(ylocf-yrefpt)/(ylocs-yrefpt)
+
+ allocate (xusrt(np),yusrt(np))
+ do j=1,np
+ xusrt(j)=xusr(j)
+ yusrt(j)=yusr(j)
+ xusr(j)=xrefpt-(xrefpt-xusr(j))*stscalx
+ yusr(j)=yrefpt-(yrefpt-yusr(j))*stscaly
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ if(ncrsec .gt. 0) then
+ allocate (xcrst(nrsec),ycrst(nrsec))
+ do j=1,ncrsec
+ xcrst(j)=xcrs(j)
+ ycrst(j)=ycrs(j)
+ xcrs(j)=xrefpt-(xrefpt-xcrs(j))*stscalx
+ ycrs(j)=yrefpt-(yrefpt-ycrs(j))*stscaly
+ enddo
+ endif
+
+ endif
+
+ 300 continue
+ CALL CLSCRN
+ CALL PLOTOT(1)
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to keep '//&
+ CHAR(13)//' ','new locations?')
+ !
+! If answer 'No', reset
+!
+ IF (WInfoDialog(4).EQ.2) then
+ do j=1,np
+ xusr(j)=xusrt(j)
+ yusr(j)=yusrt(j)
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ if(ncrsec .gt. 0) then
+ do j=1,ncrsec
+ xcrs(j)=xcrst(j)
+ ycrs(j)=ycrst(j)
+ enddo
+ deallocate (xcrst,ycrst)
+ endif
+ CALL CLSCRN
+ CALL PLOTOT(1)
+ endif
+
+ deallocate(xusrt,yusrt)
+
+ RETURN
+ END
+
+ SUBROUTINE TRANSMESH
+
+ USE WINTERACTER
+ USE BLK1MOD
+
+ SAVE
+
+! implicit none
+
+ include 'd.inc'
+
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+
+ CHARACTER*1 IFLAG
+ allocatable xusrt(:),yusrt(:),xcrst(:),ycrst(:)
+ data iopt1/1/
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ call wdialogload(IDD_TRANSFORM)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_TRANSFORM)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,IOPT1)
+
+ CALL WDialogPutReal(IDF_REAL3,COEF1)
+ CALL WDialogPutReal(IDF_REAL4,COEF2)
+ CALL WDialogPutReal(IDF_REAL5,COEF3)
+ CALL WDialogPutReal(IDF_REAL6,COEF4)
+ CALL WDialogPutReal(IDF_REAL7,COEF5)
+ CALL WDialogPutReal(IDF_REAL8,COEF6)
+ CALL WDialogPutINTEGER(IDF_INTEGER2,ICOEF1)
+ CALL WDialogPutINTEGER(IDF_INTEGER3,ICOEF2)
+ CALL WDialogPutINTEGER(IDF_INTEGER4,ICOEF3)
+ CALL WDialogPutINTEGER(IDF_INTEGER5,ICOEF4)
+ CALL WDialogPutINTEGER(IDF_INTEGER9,ICOEF5)
+ CALL WDialogPutINTEGER(IDF_INTEGER10,ICOEF6)
+
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,IOPT1)
+ CALL WDialogGetReal(IDF_REAL3,COEF1)
+ CALL WDialogGetReal(IDF_REAL4,COEF2)
+ CALL WDialogGetReal(IDF_REAL5,COEF3)
+ CALL WDialoggetReal(IDF_REAL6,COEF4)
+ CALL WDialoggetReal(IDF_REAL7,COEF5)
+ CALL WDialoggetReal(IDF_REAL8,COEF6)
+ CALL WDialogGetINTEGER(IDF_INTEGER2,ICOEF1)
+ CALL WDialogGetINTEGER(IDF_INTEGER3,ICOEF2)
+ CALL WDialogGetINTEGER(IDF_INTEGER4,ICOEF3)
+ CALL WDialogGetINTEGER(IDF_INTEGER5,ICOEF4)
+ CALL WDialogGetINTEGER(IDF_INTEGER9,ICOEF5)
+ CALL WDialogGetINTEGER(IDF_INTEGER10,ICOEF6)
+ go to 200
+ elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ return
+ ENDIF
+
+ enddo
+200 continue
+ if(.not. allocated(xusrt)) then
+ allocate (xusrt(np),yusrt(np))
+
+ do j=1,np
+ xusrt(j)=xusr(j)
+ yusrt(j)=yusr(j)
+ enddo
+ if(ncrsec .gt. 0) then
+ allocate (xcrst(nrsec),ycrst(nrsec))
+ do j=1,ncrsec
+ xcrst(j)=xcrs(j)
+ ycrst(j)=ycrs(j)
+ enddo
+ endif
+ endif
+ IF(IOPT1 .EQ. 1) THEN
+ DO J=1,NP
+ XUSR(J)=COEF1*XUSR(J)+COEF2
+ YUSR(J)=COEF3*YUSR(J)+COEF4
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ IF(COEF5 .EQ. 0. .AND. COEF6 .EQ. 0.) CYCLE
+ WD(J)=COEF5*WD(J)+COEF6
+ ENDDO
+ if(ncrsec .gt. 0) then
+ do j=1,ncrsec
+ xcrs(j)=coef1*XCRS(J)+COEF2
+ ycrs(j)=coef3*YCRS(J)+COEF4
+ enddo
+ endif
+ ELSE IF(IOPT1 .EQ. 2) THEN
+ do j=1,np
+ reff=coef3
+ angl=(xusr(j)-coef1)/reff
+ a=cos(angl)
+ a=reff*cos(angl)
+ b=reff*sin(angl)
+ xusr(j)=reff*sin(angl)-(yusr(j)-coef2)*sin(angl)
+ yusr(j)=(yusr(j)-coef2)*cos(angl)+reff*(1.-cos(angl))
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ if(ncrsec .gt. 0) then
+ do j=1,ncrsec
+ reff=coef3+coef2-ycrs(j)
+ ang=(xcrs(j)-coef1)/reff
+ xcrs(j)=coef1+reff*sin(angl)
+ ycrs(j)=coef2+reff*cos(angl)
+ enddo
+ endif
+ ELSEIF(IOPT1 .EQ. 3) THEN
+ DO J=1,NP
+ A=(XUSR(J)-COEF1)*COS(COEF3)-(YUSR(J)-COEF2)*SIN(COEF3)
+ B=(XUSR(J)-COEF1)*SIN(COEF3)+(YUSR(J)-COEF2)*COS(COEF3)
+ XUSR(J)=A
+ YUSR(J)=B
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ ENDDO
+ if(ncrsec .gt. 0) then
+ do j=1,ncrsec
+ A=(XCRS(J)-COEF1)*COS(COEF3)-(YCRS(J)-COEF2)*SIN(COEF3)
+ B=(XCRS(J)-COEF1)*SIN(COEF3)+(YCRS(J)-COEF2)*COS(COEF3)
+ xcrs(j)=A
+ ycrs(j)=B
+ enddo
+ endif
+ ENDIF
+ CALL CLSCRN
+ CALL PLOTOT(1)
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to keep '//&
+ CHAR(13)//' ','new locations?')
+ !
+! If answer 'No', reset
+!
+ IF (WInfoDialog(4).EQ.2) then
+ do j=1,np
+ xusr(j)=xusrt(j)
+ yusr(j)=yusrt(j)
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ enddo
+ deallocate (Xusrt,yusrt)
+ if(ncrsec .gt. 0) then
+ do j=1,ncrsec
+ xcrs(j)=xcrst(j)
+ ycrs(j)=ycrst(j)
+ enddo
+ deallocate (xcrst,ycrst)
+ endif
+ CALL CLSCRN
+ CALL PLOTOT(1)
+ endif
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/NECON.F90 b/src/src83e/NECON.F90
new file mode 100644
index 0000000..c5a88c7
--- /dev/null
+++ b/src/src83e/NECON.F90
@@ -0,0 +1,44 @@
+ SUBROUTINE NDNECON(IERR)
+!
+! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! INITIALIZE
+!
+ ISWT=IERR
+ NCM=MAXECON
+ DO J=1,NCM
+ DO N=1,NP
+ NECON(N,J)=0
+ ENDDO
+ ENDDO
+ DO N=1,NP
+ NDELM(N)=0
+ ENDDO
+!
+! FORM TABLE OF ELEMENTS CONNECTED TO EACH NODE
+!
+! IERR=0
+ DO M=1,NE
+ IF(IMAT(M) .NE. 0) THEN
+ DO K=1,8
+ IF(ISWT .EQ. 1 .AND. MOD(K,2) .EQ. 1) CYCLE
+ N=NOP(M,K)
+ IF (N .GT. 0) THEN
+ NDELM(N)=NDELM(N)+1
+ J=NDELM(N)
+ IF(J .GT. MAXECON) THEN
+ IERR=MAX(IERR,J)
+ ELSE
+ NECON(N,J)=M
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ END DO
+ RETURN
+ END
diff --git a/src/src83e/NEWRMGN.F90 b/src/src83e/NEWRMGN.F90
new file mode 100644
index 0000000..0fabdb2
--- /dev/null
+++ b/src/src83e/NEWRMGN.F90
@@ -0,0 +1,952 @@
+!IPK LAST UPDATE SEP 23 2015 ADD MORE INFO ON FRAME
+!
+ PROGRAM NEWRMAGEN
+!
+! Use of the module is compulsory
+!
+ USE WINTERACTER
+ USE DFLIB
+!
+ IMPLICIT NONE
+!
+! Define some parameters to match those in the resource file
+!
+ include 'd.inc'
+ INCLUDE 'TXFRM.COM'
+
+ REAL HSIZE,scratio
+ COMMON /SSIZE/ HSIZE
+
+!
+ INTEGER :: IBASEV =40042
+ INTEGER :: I,IRES,N2,M2,ID1,ID2
+ INTEGER :: ITYPE, IX, IY, IWIDTH, IHEIGHT, KEY,IYES
+ INTEGER :: MOUSEX, MOUSEY, MBUTTON, ITIME, IWINDOW
+ INTEGER :: IDFIELDOLD, IDFIELDNEW, IDBUTN, IDFIELD,TOOLID(4)
+ INTEGER :: LNNAM,K,LMPNAM,IMP,IIN,MENUS,IOT,IOT1,impf,IGFG,ITRIAN,INFO(3)
+ INTEGER , DIMENSION(5) :: WIDSTAT
+ INTEGER*2 :: N1,STATUS,lnnnam,iswtfl,n
+ CHARACTER(LEN=255) :: FNAME,FNAMD,FILTER
+ CHARACTER(LEN=3) :: SUB,SUB1
+ CHARACTER(LEN=4) :: SUB2
+ CHARACTER(LEN=1000) :: HEADR
+ INTEGER ,EXTERNAL :: LENSTR
+ LOGICAL :: OPENED,exists
+ LOGICAL(4) :: statud
+ REAL :: XX1,XX2,XX3,XX4,XX5,XX6
+ INTEGER :: iw,ih,ihandle,ient,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
+ common /hands/ ihandle,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
+
+
+ INTEGER ISCRWID,ISCRHGT
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ TYPE (WIN_FONT) :: FONT
+
+! Define a common block with background file names
+
+ INCLUDE 'BFILES.I90'
+
+!
+! Get initial directory and add help name
+
+ fname = FILE$CURDRIVE
+ IRES=GETDRIVEDIRQQ (fname)
+! lnnnam=windowstringlength(fname)
+ lnnnam=lenstr(fname)
+ direct=fname(1:lnnnam)//'\doc\rmagen83d.htm'
+
+! write(128,*) fname,lnnnam,direct
+
+!
+!
+! Initialise WiSK
+!
+ CALL WInitialise()
+!
+! Create a root window with :
+! - System menu
+! - Minimise button
+! - Maximise button
+!
+! WINDOW%FLAGS = SysMenuOn + MinButton + MaxButton + StatusBar
+
+ ISCRWID = WInfoScreen(1) ! Get screen width
+ ISCRHGT = WInfoScreen(2) ! Get screen height
+ scratio=float(iscrwid)/float(iscrhgt)
+ HSIZE=scratio*8.
+
+!
+! Centre the window on the screen at 80% of screen size
+!
+ WINDOW%X = -1
+ WINDOW%Y = -1
+ WINDOW%WIDTH = 0
+ WINDOW%HEIGHT = 0
+!
+! Identify the menu to be attached to the window
+! and specify the initial window title
+!
+! WINDOW%MENUID = IDR_MENU1
+! WINDOW%TITLE = 'RMAGEN'
+!
+! Now open the root window
+!
+ CALL WindowOpen(FLAGS =SysMenuOn+MinButton+MaxButton+StatusBar, &
+ MENUID=IDR_MENU1, &
+ TOOLID=(/0,ID_TOOLBAR1,0,0/), &
+ TITLE ='RMAGEN')
+! CALL WindowOpen(WINDOW,TITLE ='RMAGEN') ! Open root window
+
+!
+! Add a toolbar
+!
+! CALL WMenuToolbar(ID_TOOLBAR1)
+!
+! Main message loop
+!
+! initialise palette
+!
+ CALL IGrPaletteInit
+!
+! set fill style to solid
+!
+ CALL IGrFillPattern(Solid)
+
+ FONT%IBCOL = TextWhite
+ CALL WindowFont(FONT)
+! CALL WindowClear(RGB=RGB_yellow) ! clear window to yellow
+! IRGB = WRGB(220,220,220)
+! IRGB = WRGB(191,191,191)
+ IRGB = WRGB(227,227,227)
+ CALL WindowClear(rgb=irgb) ! clear to yellow
+
+ WIDSTAT(1) = 1000
+ WIDSTAT(2) = 2000
+ WIDSTAT(3) = 1500
+ WIDSTAT(4) = 1000
+ WIDSTAT(5) = 2500
+ CALL WindowStatusBarParts(5, WIDSTAT)
+ CALL WindowOutStatusBar(1, ' X and Y location')
+ CALL WindowOutStatusBar(4, ' Active File Name')
+ CALL IgrUnits(0.,0.,HSIZE,8.0)
+
+! IF(ISW .EQ. 1) THEN
+! CALL WMessageEnable(MouseMove , Enabled)
+! MENUS=-3
+! CALL RMAGEN(MENUS,IMP,IIN,1,IOT,IOT1,IGFG)
+! ENDIF
+
+
+! CALL WMenuSetState(ID_NETWD,ItemChecked,1)
+! DO I=1,12
+! CALL WMenuSetState(IBASEV+I,ItemChecked,1)
+! ENDDO
+ IDDSW=-1
+ IHANDLE=0
+ IHAND1=0
+ IHAND2=0
+ N2=0
+ M2=0
+ TXSCAL = 1.
+ XS=0.
+ YS=0.
+ NBKFL=0
+ IRDONE=-1
+ DO I=1,10
+ ISWBKFL(I)=0
+ ENDDO
+ IACTVFIL=0
+ ITOTFIL=0
+ IOT=0
+ IOT1=0
+ IMP=0
+
+ CALL INITSIZ(IIN,N2,M2,0)
+
+ CALL WMenuSetState(ID_loadrm1,ItemEnabled,0)
+ CALL WMenuSetState(ID_sbin,ItemEnabled,0)
+ CALL WMenuSetState(ID_crsf,ItemEnabled,0)
+ CALL WMenuSetState(ID_savcrs,ItemEnabled,0)
+ CALL WMenuSetState(ID_LAYFL,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM13,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM14,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM18,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM15,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM16,ItemEnabled,0)
+ CALL WMenuSetState(ID_ICOPY,ItemEnabled,0)
+ CALL WMenuSetState(ID_Clip,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM24,ItemEnabled,0)
+ CALL WMenuSetState(ID_MMAP,ItemEnabled,0)
+ CALL WMenuSetState(ID_MAPM,ItemEnabled,0)
+ CALL WMenuSetState(ID_NETWORK,ItemEnabled,0)
+ CALL WMenuSetState(ID_NODE,ItemEnabled,0)
+ CALL WMenuSetState(ID_ELTS,ItemEnabled,0)
+ CALL WMenuSetState(ID_ORDR,ItemEnabled,0)
+ CALL WMenuSetState(ID_CCLN,ItemEnabled,0)
+ CALL WMenuSetState(ID_CONTR,ItemEnabled,0)
+ CALL WMenuSetState(ID_CSEC,ItemEnabled,0)
+ CALL WMenuSetState(ID_CSEC1,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM20,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM26,ItemEnabled,0)
+ CALL WMenuSetState(ID_ZOOM,ItemEnabled,0)
+ CALL WMenuSetState(ID_DRAW,ItemEnabled,0)
+ CALL WMenuSetState(ID_UNDOM,ItemEnabled,0)
+ CALL WMenuSetState(ID_NMAP,ItemEnabled,0)
+ CALL WMenuSetState(ID_CDATA,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM56,ItemEnabled,0)
+ CALL WMenuSetState(ID_SECGRP,ItemEnabled,0)
+
+ iswtfl=0
+ N1=1
+ CALL GETARG(N1,FNAME,STATUS)
+ if(status .ne. -1 ) then
+
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+ do n=status,1,-1
+ if(fname(n:n) .eq. '\') then
+ lnnnam=n-1
+ go to 99
+ endif
+ enddo
+ 99 continue
+ if(lnnnam .gt. 0) then
+ fnamd=fname(1:lnnnam)
+ statud = CHANGEDIRQQ(fnamd)
+ endif
+ iswtfl=1
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ ITRIAN=0
+ IF(SUB .EQ. 'geo') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary',ACTION='READ')
+ FNAMKEP=FNAME
+ READ(IIN) HEADR
+ READ(IIN) N2,M2
+ REWIND (IIN)
+
+ ELSEIF(SUB .EQ. 'gfg') then
+ IIN = 10
+ IGFG=1
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ELSEIF(SUB .EQ. '2dm') then
+ IIN = 10
+ IGFG=3
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ELSEIF(SUB .EQ. 'rst') then
+ IIN=11
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+! OPEN(IIN,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ IGFG=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. 'bin') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+ IGFG=2
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. 'ele') then
+ IIN=10
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=1
+ IGFG=0
+ FNAMKEP=FNAME
+ CALL SETGFGTRIAN(IGFG,ITRIAN,N2,M2)
+ ELSEIF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'shp') then
+ IMP=113
+ OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ sub='dbf'
+ call addsub(fname,sub)
+ OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ ELSE
+ IIN = 10
+ IGFG=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ENDIF
+ IF(IMP .EQ. 0) THEN
+ IACTVFIL=1
+ ITOTFIL=1
+ FNAMEOUT(1)=FNAME
+ ENDIF
+ CALL WMenuSetState(ID_loadrm1,ItemEnabled,1)
+ CALL WMenuSetState(ID_sbin,ItemEnabled,1)
+ CALL WMenuSetState(ID_crsf,ItemEnabled,1)
+ CALL WMenuSetState(ID_savcrs,ItemEnabled,1)
+ CALL WMenuSetState(ID_LAYFL,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM13,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM14,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM18,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM15,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM16,ItemEnabled,1)
+ CALL WMenuSetState(ID_ICOPY,ItemEnabled,1)
+ CALL WMenuSetState(ID_Clip,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM24,ItemEnabled,1)
+ CALL WMenuSetState(ID_MMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_MAPM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NETWORK,ItemEnabled,1)
+ CALL WMenuSetState(ID_NODE,ItemEnabled,1)
+ CALL WMenuSetState(ID_ELTS,ItemEnabled,1)
+ CALL WMenuSetState(ID_ORDR,ItemEnabled,1)
+ CALL WMenuSetState(ID_CCLN,ItemEnabled,1)
+ CALL WMenuSetState(ID_CONTR,ItemEnabled,1)
+! CALL WMenuSetState(ID_CSEC,ItemEnabled,0)
+ CALL WMenuSetState(ID_CSEC1,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM20,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM26,ItemEnabled,1)
+ CALL WMenuSetState(ID_ZOOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_DRAW,ItemEnabled,1)
+ CALL WMenuSetState(ID_UNDOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_CDATA,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM56,ItemEnabled,1)
+ CALL WMenuSetState(ID_RESETLIM,ItemEnabled,0)
+ CALL WMessageEnable(MouseMove , Enabled)
+
+ IF(IMP .GT. 0) THEN
+ MENUS=-2
+ CALL INITSIZ(IIN,N2,M2,1)
+ go to 500
+ ENDIF
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to load '//&
+ CHAR(13)//'a map file?' ,&
+ 'Map File Input?')
+!
+! If answer 'No' skip out
+!
+ IMP=0
+ IF (WInfoDialog(4) .NE. 2) then
+
+ fname=' '
+ CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ELSEIF(SUB .EQ. 'rm1') then
+ imp=13
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'shp') then
+ IMP=113
+ OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ SUB='DBF'
+ CALL ADDSUB(FNAME,SUB)
+ OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ ENDIF
+ ENDIF
+ END IF
+ MENUS=-2
+ CALL INITSIZ(IIN,N2,M2,1)
+
+ go to 500
+ endif
+
+
+
+ DO WHILE (.TRUE.) ! Loop until user terminates
+
+ 100 continue
+ CALL WMessage(ITYPE, MESSAGE)
+ SELECT CASE (ITYPE)
+ CASE (KeyDown) ! Key pressed
+ KEY = MESSAGE%VALUE1
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ CASE (MenuSelect) ! Menu item selected
+ SELECT CASE (MESSAGE%VALUE1)
+! CASE (ID_FILE) ! File option selected
+ CASE (ID_RESETLIM)
+ CALL RESETSIZ
+
+ CASE (ID_ITEM11) ! New option
+ IMP=0
+ IIN=0
+ CALL INITSIZ(IIN,N2,M2,1)
+ CALL WMenuSetState(ID_loadrm1,ItemEnabled,1)
+ CALL WMenuSetState(ID_sbin,ItemEnabled,1)
+ CALL WMenuSetState(ID_crsf,ItemEnabled,1)
+ CALL WMenuSetState(ID_savcrs,ItemEnabled,1)
+ CALL WMenuSetState(ID_LAYFL,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM13,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM14,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM18,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM15,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM16,ItemEnabled,1)
+ CALL WMenuSetState(ID_ICOPY,ItemEnabled,1)
+ CALL WMenuSetState(ID_Clip,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM24,ItemEnabled,1)
+ CALL WMenuSetState(ID_MMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_MAPM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NETWORK,ItemEnabled,1)
+ CALL WMenuSetState(ID_NODE,ItemEnabled,1)
+ CALL WMenuSetState(ID_ELTS,ItemEnabled,1)
+ CALL WMenuSetState(ID_ORDR,ItemEnabled,1)
+ CALL WMenuSetState(ID_CCLN,ItemEnabled,1)
+ CALL WMenuSetState(ID_CONTR,ItemEnabled,1)
+! CALL WMenuSetState(ID_CSEC,ItemEnabled,0)
+ CALL WMenuSetState(ID_CSEC1,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM20,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM26,ItemEnabled,1)
+ CALL WMenuSetState(ID_ZOOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_DRAW,ItemEnabled,1)
+ CALL WMenuSetState(ID_UNDOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_CDATA,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM56,ItemEnabled,1)
+ CALL WMenuSetState(ID_RESETLIM,ItemEnabled,0)
+ CALL WMessageEnable(MouseMove , Enabled)
+
+
+ MENUS=-2
+ EXIT
+ CASE (ID_ITEM12) ! Open option
+ IMP=0
+ IIN=0
+ if(iswtfl .eq. 1) go to 200
+ fname=' '
+ FILTER ="Network Files|*.rm1;*.geo;*.gfg;*.bin;*.ele;*.2dm|Rm1 file -- *.rm1|*.rm1|Geo file -- *.geo|*.geo|GFGEN file -- *.gfg|*.gfg|GFGEN bin file -- *.bin|*.bin|Rst file -- *.rst|*.rst|ele file -- *.ele|*.ele|MESH2D file -- *.2dm|*.2dm|All files|All files|*.*|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 200
+ ELSE
+ GO TO 250
+ ENDIF
+ 200 CONTINUE
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'geo') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',form='binary',ACTION='READ')
+ FNAMKEP=FNAME
+ READ(IIN) HEADR
+ READ(IIN) N2,M2
+ REWIND (IIN)
+
+ ITRIAN=0
+ ELSEIF(SUB .EQ. 'gfg') then
+ IIN = 10
+ IGFG=1
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. '2dm') then
+ IIN = 10
+ IGFG=3
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. '2dm') then
+ IIN = 10
+ IGFG=3
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. 'bin') then
+ IIN=12
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+ IGFG=2
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. 'rst') then
+ IIN=11
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',FORM='UNFORMATTED')
+! OPEN(IIN,FILE=FNAME,STATUS='OLD',FORM ='BINARY')
+ IGFG=0
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ELSEIF(SUB .EQ. 'ele') then
+ IIN=10
+ OPEN(IIN ,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=1
+ IGFG=0
+ FNAMKEP=FNAME
+ CALL SETGFGTRIAN(IGFG,ITRIAN,N2,M2)
+ ELSE
+ IIN = 10
+ IGFG=0
+ OPEN(10,FILE=FNAME,STATUS='OLD',ACTION='READ')
+ ITRIAN=0
+ CALL SETGFGTRIAN(IGFG,ITRIAN,ID1,ID2)
+ ENDIF
+ IACTVFIL=1
+ ITOTFIL=1
+ FNAMEOUT(1)=FNAME
+ CALL SHORTNAME(FNAME,FNAMEDISP)
+ 250 CONTINUE
+ fname=' '
+ filter="Map file -- *.map |*.map|Bin Map file -- *.mpb|*.mpb|Bin Map file (no head) -- *.mbb|*.mbb|RM1 file (as map) -- *.rm1|*.rm1|ESRI ASC file -- *.asc|*.asc|SURFER GRD file -- *.grd|*.grd|ESRI SHP file -- *.shp|*.shp|"
+ CALL WSelectFile(filter,PromptOn,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD',action='read')
+ ELSEIF(SUB .EQ. 'shp') then
+ IMP=113
+ OPEN(113,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ SUB='DBF'
+ CALL ADDSUB(FNAME,SUB)
+ OPEN(114,FILE=FNAME,STATUS='OLD',FORM ='BINARY',action='read')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ELSEIF(SUB .EQ. 'rm1') then
+ imp=13
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',action='read')
+ ENDIF
+ ENDIF
+ CALL WMenuSetState(ID_loadrm1,ItemEnabled,1)
+ CALL WMenuSetState(ID_sbin,ItemEnabled,1)
+ CALL WMenuSetState(ID_crsf,ItemEnabled,1)
+ CALL WMenuSetState(ID_savcrs,ItemEnabled,1)
+ CALL WMenuSetState(ID_LAYFL,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM13,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM14,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM18,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM15,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM16,ItemEnabled,1)
+ CALL WMenuSetState(ID_ICOPY,ItemEnabled,1)
+ CALL WMenuSetState(ID_Clip,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM24,ItemEnabled,1)
+ CALL WMenuSetState(ID_MMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_MAPM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NETWORK,ItemEnabled,1)
+ CALL WMenuSetState(ID_NODE,ItemEnabled,1)
+ CALL WMenuSetState(ID_ELTS,ItemEnabled,1)
+ CALL WMenuSetState(ID_ORDR,ItemEnabled,1)
+ CALL WMenuSetState(ID_CCLN,ItemEnabled,1)
+ CALL WMenuSetState(ID_CONTR,ItemEnabled,1)
+ CALL WMenuSetState(ID_CSEC1,ItemEnabled,1)
+! CALL WMenuSetState(ID_CSEC,ItemEnabled,0)
+ CALL WMenuSetState(ID_ITEM20,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM26,ItemEnabled,1)
+ CALL WMenuSetState(ID_ZOOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_DRAW,ItemEnabled,1)
+ CALL WMenuSetState(ID_UNDOM,ItemEnabled,1)
+ CALL WMenuSetState(ID_NMAP,ItemEnabled,1)
+ CALL WMenuSetState(ID_CDATA,ItemEnabled,1)
+ CALL WMenuSetState(ID_ITEM56,ItemEnabled,1)
+ CALL WMenuSetState(ID_RESETLIM,ItemEnabled,0)
+ CALL WMessageEnable(MouseMove , Enabled)
+
+
+ MENUS=-2
+ CALL INITSIZ(IIN,N2,M2,1)
+ EXIT
+ CASE (ID_ITEM13) ! Save option
+ WRITE(90,*) 'NWRM ITEM13'
+ INQUIRE(20, OPENED=OPENED)
+ if(.not. opened) then
+ FILTER ="Network Files|*.rm1;*.gfg;*.ele|Rm1 file -- *.rm1|*.rm1|GFGEN file -- *.gfg|*.gfg|ele file -- *.ele|*.ele|All files|*.*|"
+
+ CALL WSelectFile(FILTER,SaveDialog+PromptOn,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='rm1'
+ CALL ADDSUB(FNAME,SUB)
+
+ WRITE(90,*) 'IN ITEM13-NEW',IOT
+ WRITE(90,'(A)') FNAME,SUB
+ IOT = 20
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN',ACTION='READWRITE')
+
+ call wrtout(1)
+ ENDIF
+ else
+ call wrtout(1)
+ endif
+
+ CASE (ID_ITEM14) ! Save option
+ WRITE(90,*) 'NWRM ITEM14'
+
+ INQUIRE(22, OPENED=OPENED)
+ if(.not. opened) then
+ CALL WSelectFile(ID_STRING4,SaveDialog+PromptOn,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='geo'
+ CALL ADDSUB(FNAME,SUB)
+
+ WRITE(90,*) 'IN ITEM14-NEW',IOT1
+ WRITE(90,'(A)') FNAME,SUB
+ IOT1=22
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary',ACTION='READWRITE')
+ call wrtout(2)
+ ENDIF
+ else
+ call wrtout(2)
+ endif
+
+ CASE (ID_ITEM18) ! Save As option
+
+ CALL WSelectFile(ID_STRING5,SaveDialog+PromptOn,FNAME,'Save Bin Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='mpb'
+ CALL ADDSUB(FNAME,SUB)
+ impf=93
+ OPEN(IMPF ,FILE=fname,STATUS='unknown',form='unformatted',ACTION='READWRITE')
+
+ call wrtmap(1)
+
+ ENDIF
+
+ CASE (ID_ITEM15) ! Save As option
+
+ CALL WSelectFile(ID_STRING3,SaveDialog+PromptOn,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='rm1'
+ CALL ADDSUB(FNAME,SUB)
+
+ IOT = 20
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN',ACTION='READWRITE')
+ call wrtout(1)
+ ENDIF
+
+ CASE (ID_ITEM16) ! Save As option
+
+ CALL WSelectFile(ID_STRING4,SaveDialog+PromptOn,FNAME,'Save Network File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ SUB='geo'
+ CALL ADDSUB(FNAME,SUB)
+
+ IOT1 = 22
+ OPEN(IOT1 ,FILE=FNAME,STATUS='UNKNOWN',form='binary',ACTION='READWRITE')
+ call wrtout(2)
+ ENDIF
+
+ CASE (ID_BKF) ! Read background option
+
+ fname=' '
+ FILTER ="Background File|*.wmf;*.bmp;*.pcx;*.png;*.cgm;*.pic;*.jpg|wmf file -- *.wmf|*.wmf|bmp file -- *.bmp|*.bmp|pcx file -- *.pcx|*.pcx|png file -- *.png|*.png|jpeg file -- *.jpg|*.jpg|cgm file -- *.cgm|*.cgm|pic file -- *.pic|*.pic|"
+ CALL WSelectFile(FILTER,PromptOn+DirChange,FNAME,'Load Background file')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ NBKFL=NBKFL+1
+ BFNAME(NBKFL)=FNAME
+ SUB1=SUB
+ IF(SUB .EQ. 'bmp') then
+ ISWBKFL(NBKFL) = 2
+ ELSEIF(SUB .EQ. 'pcx') then
+ ISWBKFL(NBKFL) = 2
+ ELSEIF(SUB .EQ. 'png' .or. sub .eq. 'jpg') then
+ ISWBKFL(NBKFL) = 2
+ ELSE
+ ISWBKFL(NBKFL)=1
+ ENDIF
+ SUB='ORG'
+ CALL ADDSUB(FNAME,SUB)
+ BFNAMR(NBKFL)=FNAME
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+ IF(SUB1 .EQ. 'PNG' .or. SUB1 .EQ. 'png') SUB2='PNGW'
+ IF(SUB1 .EQ. 'JPG' .or. SUB1 .EQ. 'jpg') SUB2='JPGW'
+ CALL ADDSUB(FNAME,SUB2)
+ BFNAMR(NBKFL)=FNAME
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+ IF(SUB2 .EQ. 'JPGW') THEN
+ SUB1='JGW'
+ CALL ADDSUB(FNAME,SUB1)
+ BFNAMR(NBKFL)=FNAME
+ ENDIF
+ ENDIF
+ INQUIRE (FILE = fname, EXIST = exists)
+ IF (.NOT. exists) THEN
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'ORG file does not exist!!'//CHAR(13)// &
+ 'Do you wish to create file and view image','Looking for ORG file')
+! If answer 'Yes' set ifrmel to 0
+!
+ IF (WInfoDialog(4) .ne. 2) then
+ OPEN(104,FILE=FNAME,STATUS ='NEW', FORM ='FORMATTED')
+ BFMINMAX(NBKFL,1) = - XS
+ BFMINMAX(NBKFL,2) = - YS
+ BFMINMAX(NBKFL,3) = HSIZE*TXSCAL - XS
+ BFMINMAX(NBKFL,4) = 7.50*TXSCAL - YS
+ WRITE(104,'(4G16.8)') (BFMINMAX(NBKFL,I),I=1,4)
+ CLOSE(104)
+
+ EXIT
+ ELSE
+ NBKFL=NBKFL-1
+ EXIT
+ ENDIF
+ ENDIF
+! yes
+ OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
+ READ(104,'(G16.8)') XX1
+ READ(104,'(G16.8)') XX2
+ READ(104,'(G16.8)') XX3
+ READ(104,'(G16.8)') XX4
+ READ(104,'(G16.8)') XX5
+ READ(104,'(G16.8)') XX6
+ CLOSE(104)
+ call IGrFileInfo(BFNAME(NBKFL),INFO,3)
+
+ BFMINMAX(NBKFL,1) = XX5
+ BFMINMAX(NBKFL,2) = XX6+INFO(3)*XX4
+ BFMINMAX(NBKFL,3) = XX5+INFO(2)*XX1
+ BFMINMAX(NBKFL,4) = XX6
+
+ CLOSE(104)
+ GO TO 125
+ ENDIF
+
+ OPEN(104,FILE=FNAME,STATUS ='OLD', FORM ='FORMATTED')
+ READ(104,'(4G16.8)') (BFMINMAX(NBKFL,I),I=1,4)
+ CLOSE(104)
+ 125 CONTINUE
+ ENDIF
+
+ CASE (ID_ITEM24) ! Print option is selected
+ CALL WHardcopyOptions(3)
+!
+! If the user clicked OK on page setup dialog then output the contents
+! of the subroutine DOPLOT to the selected printer
+!
+ IF (WinfoDialog(ExitButtonCommon).EQ.CommonOK) THEN
+ CALL IGrInit('HP') ! hardcopy only output
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,7.5)
+ CALL IGrHardcopy(' ') ! Start print manager
+ call clscrn
+ CALL PLOTOT(0) ! plot graph
+ call rblack
+ CALL IGrRectangle(0.,0.,HSIZE,7.5)
+
+ CALL IGrHardcopy('S') ! Send data to the printer
+ CALL IGrInit('P') ! Turn graphics back on
+ CALL IGrFillPattern(Solid)
+
+ CALL IgrUnits(0.,0.,HSIZE,8.0)
+ CALL PLOTOT(0)
+ CALL HEDR
+ call rblack
+ CALL IGrRectangle(0.,0.,HSIZE,7.5)
+ END IF
+
+ CASE (ID_ITEM19) ! Demo option
+ MENUS=-1
+ IMP=0
+ IIN=0
+ EXIT
+ CASE (ID_ITEM17) ! Exit option
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ MENUS=0
+ EXIT
+ CASE (ID_EXIT) ! Exit program (menu option)
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ MENUS=0
+ EXIT
+ CASE (ID_NODE)
+ MENUS=2
+ EXIT
+ CASE (ID_ELTS)
+ MENUS=1
+ EXIT
+ CASE (ID_ORDR)
+ MENUS=3
+ EXIT
+ CASE (ID_CCLN)
+ MENUS=6
+ EXIT
+ CASE (ID_CSEC)
+ MENUS=7
+ EXIT
+ CASE (ID_ZOOM)
+ MENUS=8
+ EXIT
+ CASE (ID_DRAW)
+ MENUS=9
+ EXIT
+
+ CASE (ID_HELP1)
+ call helps(0)
+ go to 100
+
+ CASE (ID_HELP2)
+ call RMINFO
+ go to 100
+
+ CASE (ID_ITEM20)
+ CALL GDIST
+ CYCLE
+
+ CASE (ID_ITEM22)
+ CALL SELNODE(0)
+ CYCLE
+
+ CASE (ID_ALLNODES)
+ CALL SELNODE(1)
+ CYCLE
+
+ CASE (ID_UNUSNODES)
+ CALL SELNODE(2)
+ CYCLE
+
+ CASE (ID_ITEM23)
+ CALL SELELT(0)
+ CYCLE
+ END SELECT
+ CASE (PushButton) ! Dialog button pressed
+ IDBUTN = MESSAGE%VALUE1
+ IDFIELD = MESSAGE%VALUE2
+ CASE (MouseButDown,MouseButUp) ! Mouse button down/up
+ MBUTTON = MESSAGE%VALUE1
+ ITIME = MESSAGE%VALUE2
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ CASE (MouseMove) ! Mouse moved
+ ITIME = MESSAGE%VALUE2
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+ CASE (Expose) ! Window partly/wholly exposed
+ IX = MESSAGE%X
+ IY = MESSAGE%Y
+ IWIDTH = MESSAGE%VALUE1
+ IHEIGHT = MESSAGE%VALUE2
+ CASE (Resize) ! Window resized
+ IWIDTH = MESSAGE%VALUE1
+ IHEIGHT = MESSAGE%VALUE2
+ CASE (CloseRequest) ! Close window (e.g. Alt/F4)
+ IWINDOW = MESSAGE%WIN
+ call rquit(iyes)
+ if(iyes .ne. 1) go to 100
+ menus=0
+ exit
+! IF (IWINDOW.EQ.0) EXIT ! Root window : exit program
+! CALL WindowCloseChild(IWINDOW)
+ CASE (FieldChanged) ! Field change in modeless dialog
+ IDFIELDOLD = MESSAGE%VALUE1
+ IDFIELDNEW = MESSAGE%VALUE2
+ END SELECT
+ END DO
+
+500 continue
+ IF(MENUS .NE. 0) THEN
+ CALL RMAGEN(MENUS,IMP,IIN,0,IOT,IOT1,IGFG,ITRIAN,N2,M2)
+ ENDIF
+ close(90)
+ CALL WindowClose ! Remove program window
+ stop
+!! CALL WindowClose ! Remove program window
+ END PROGRAM NEWRMAGEN
+
+ SUBROUTINE GETSUB(FNAME,SUB)
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ INTEGER ,EXTERNAL :: LENSTR
+ INTEGER :: LNNAM,K
+
+ LNNAM=LENSTR(FNAME)
+ SUB=' '
+ DO K=LNNAM,1,-1
+ IF(FNAME(K:K) .EQ. '.') THEN
+ IF(LNNAM .GT. K+2) THEN
+ SUB=FNAME(K+1:K+3)
+ ELSE
+ SUB=' '
+ ENDIF
+ GO TO 110
+ ENDIF
+ ENDDO
+110 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE ADDSUB(FNAME,SUB)
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=*) :: SUB
+ INTEGER ,EXTERNAL :: LENSTR
+ INTEGER :: LNNAM,K,LMPNAM
+
+ LNNAM=LENSTR(FNAME)
+ DO K=LNNAM,1,-1
+ IF(FNAME(K:K) .EQ. '.') THEN
+ lmpnam=k
+ FNAME=FNAME(1:LMPNAM)//SUB
+ GO TO 110
+ ENDIF
+ ENDDO
+ FNAME=FNAME(1:LNNAM)//'.'//SUB
+110 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE SHORTNAME(FNAMELL,FNAMES)
+ CHARACTER(LEN=255) :: FNAMELL
+ CHARACTER(LEN=48) :: FNAMES
+ INTEGER ,EXTERNAL :: LENSTR
+ INTEGER :: LNNAM,K,KSTART,KEND
+
+ LNNAM=LENSTR(FNAMELL)
+ DO K=1,48
+ FNAMES(K:K)=' '
+ ENDDO
+ KSTART=1
+ DO K=LNNAM,1,-1
+ IF(FNAMELL(K:K) .EQ. '\') THEN
+ KSTART=K+1
+ GO TO 200
+ ENDIF
+ ENDDO
+200 KEND=LNNAM-KSTART+1
+ IF(KEND .GT. 48) KEND=48
+
+ FNAMES(1:KEND)=FNAMELL(KSTART:KSTART+KEND-1)
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/NODEDISP.F90 b/src/src83e/NODEDISP.F90
new file mode 100644
index 0000000..93582c8
--- /dev/null
+++ b/src/src83e/NODEDISP.F90
@@ -0,0 +1,149 @@
+ Subroutine NodeDisp(nin)
+
+ USE WINTERACTER
+ USE BLK1MOD
+!
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: N,IBOX,NN
+ INTEGER :: IERR
+ CHARACTER*1 :: IFLAG
+
+ if(nin .eq. 0) then
+ n=1
+ else
+ n=nin
+ endif
+ ims=0
+ 100 continue
+ call wdialogload(IDD_NODEDATA)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+ NN=N
+ XTEMP=XUSR(N)
+ YTEMP=YUSR(N)
+ WDTEMP=WIDTH(N)
+ CALL WDialogPutReal(IDF_REAL1,XTEMP,'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL2,YTEMP,'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL3,WD(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL4,WDTEMP,'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL5,SS1(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL6,SS2(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL7,WIDS(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL8,WIDBS(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL9,SSO(N),'(F10.2)')
+ CALL WDialogPutReal(IDF_REAL10,BS1(N),'(F10.4)')
+ IF(LOCK(N) .NE. 0) then
+ CALL WDialogPutCheckBox(IDF_CHECK1,1)
+ ELSE
+ CALL WDialogPutCheckBox(IDF_CHECK1,0)
+ ENDIF
+
+ CALL WDialogSelect(IDD_NODEDATA)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modeless)
+ ierr=infoerror(1)
+
+ if(ims .eq. 1 .or. nin .gt. 0) go to 200
+ 150 CONTINUE
+ call wdialogload(IDD_SELNODE)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,N)
+
+ CALL WDialogSelect(IDD_SELNODE)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ ims=1
+ go to 100
+ endif
+!ipk sep02
+ ims=1
+ go to 100
+ enddo
+
+ 200 continue
+! CALL WDialogSelect(IDD_NODEDATA)
+! ierr=infoerror(1)
+! Branch depending on type of message.
+!
+! CALL WDialogGetInteger(IDF_INTEGER1,N)
+! WRITE(90,*) 'IN NODEDISP N,NN', N,NN
+! IF(N .NE. NN) go to 100
+
+ DO
+!WHILE(.NOT.QUIT)
+ CALL WMessage(ITYPE,MESSAGE)
+ SELECT CASE (ITYPE)
+ CASE (PushButton)
+ IF(MESSAGE%VALUE1.EQ.IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetReal(IDF_REAL1,XTEMP)
+ CALL WDialogGetReal(IDF_REAL2,YTEMP)
+ XUSR(N)=XTEMP
+ YUSR(N)=YTEMP
+ CALL WDialogGetReal(IDF_REAL3,WD(N))
+ CALL WDialogGetReal(IDF_REAL4,WDTEMP)
+ CALL WDialogGetReal(IDF_REAL5,SS1(N))
+ CALL WDialogGetReal(IDF_REAL6,SS2(N))
+ CALL WDialogGetReal(IDF_REAL7,WIDS(N))
+ CALL WDialogGetReal(IDF_REAL8,WIDBS(N))
+ CALL WDialogGetReal(IDF_REAL9,SSO(N))
+ CALL WDialogGetReal(IDF_REAL10,BS1(N))
+ CORD(N,1)=(XUSR(N)+XS)/TXSCAL
+ CORD(N,2)=(YUSR(N)+YS)/TXSCAL
+ call WDialogHide()
+ call wdialogUNload()
+ WIDTH(N)=WDTEMP
+ RETURN
+ ELSEIF(MESSAGE%VALUE1.EQ.IDNEXT) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,N)
+ CALL WDialogGetReal(IDF_REAL1,XTEMP)
+ CALL WDialogGetReal(IDF_REAL2,YTEMP)
+ XUSR(N)=XTEMP
+ YUSR(N)=YTEMP
+ CALL WDialogGetReal(IDF_REAL3,WD(N))
+ CALL WDialogGetReal(IDF_REAL4,WDTEMP)
+ CALL WDialogGetReal(IDF_REAL5,SS1(N))
+ CALL WDialogGetReal(IDF_REAL6,SS2(N))
+ CALL WDialogGetReal(IDF_REAL7,WIDS(N))
+ CALL WDialogGetReal(IDF_REAL8,WIDBS(N))
+ CALL WDialogGetReal(IDF_REAL9,SSO(N))
+ CALL WDialogGetReal(IDF_REAL10,BS1(N))
+ CORD(N,1)=(XUSR(N)+XS)/TXSCAL
+ CORD(N,2)=(YUSR(N)+YS)/TXSCAL
+ WIDTH(N)=WDTEMP
+ GO TO 150
+ ELSEIF(MESSAGE%VALUE1.EQ.IDCANCEL) THEN
+ call WDialogHide()
+ call wdialogUNload()
+ RETURN
+ ENDIF
+ END SELECT
+ END DO
+
+
+
+ RETURN
+ END
+
+
\ No newline at end of file
diff --git a/src/src83e/NODES.F90 b/src/src83e/NODES.F90
new file mode 100644
index 0000000..7335da5
--- /dev/null
+++ b/src/src83e/NODES.F90
@@ -0,0 +1,911 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR CHNAGED ELEMENTS/NODES
+! Last change: IPK 13 Jan 98 10:01 am
+!ipk last update to add deletion opton when moving nodes
+!ipk last update Jan 12 1998
+!ipk last update Nov18 1997
+!
+!****************************************************************
+!
+ SUBROUTINE ADDNOD
+!
+! Input additional node locations from screen
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ INCLUDE 'TXFRM.COM'
+!
+ CHARACTER*1 IFLAG,ANS,ANSW(0:9)
+ CHARACTER*32 JUNK
+ CHARACTER*20 NODH
+!ipk jan98
+ CHARACTER*80 LIND
+ DATA ANSW/'a','m','d','f','g','e','h','z','r','q'/
+ data itime/0/
+
+ if(itime .eq. 0) then
+ nodsh=1
+ itime=1
+ endif
+ ISWT=3
+!
+! Draw box around selections
+!
+ 2 CONTINUE
+ NHTP=4
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+!
+! Get answer
+!
+ 3 call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 3
+ I=IBOX-1
+ ANS=ANSW(I)
+ ENDIF
+!
+ IF(ANS .EQ. 'a') THEN
+ ISWT=1
+ NHTP=0
+ NBRR=0
+ NMESS=16
+ ELSEIF(ANS .EQ. 'm') THEN
+ ISWT=0
+ NHTP=0
+ NBRR=0
+ NMESS=17
+ ELSEIF(ANS .EQ. 'd') THEN
+!
+! Call deleting operations
+!
+ CALL DELOP
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 2
+ ELSEIF(ANS .EQ. 'e') THEN
+ CALL GRIDSB(0)
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 2
+ ELSEIF(ANS .EQ. 'q') THEN
+ RETURN
+ ELSEIF(ANS .EQ. 'f') THEN
+!
+! Search for a plot a grid centered around a node
+!
+ NHTP=0
+ NBRR=0
+ NMESS=1
+ CALL HEDR
+ NMESS=1
+ CALL GETINT(NODSH)
+ IF(INEW(NODSH) .LE. 0) GO TO 2
+ DO 4 I=1,NP
+ IF(CORD(I,1) .GT. VOID) THEN
+ INSKP(I)=0
+ ENDIF
+ 4 CONTINUE
+ DO 5 I=1,NE
+ IF(IMAT(I) .GT. 0) THEN
+ IESKP(I)=0
+ ENDIF
+ 5 CONTINUE
+ XP=CORD(NODSH,1)
+ YP=CORD(NODSH,2)
+ XMIN=XP-5.0*PSCALE
+ YMIN=YP-3.5*PSCALE
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ FPN=NODSH
+ HT=0.15
+ XP=CORD(NODSH,1)
+ YP=CORD(NODSH,2)
+ CALL RCYAN
+ CALL NUMBR(XP,YP+0.07,HT,FPN,0.0,-1)
+ CALL RBLUE
+!
+ GO TO 2
+ ELSEIF(ANS .EQ. 'g') THEN
+!
+! This option generates nodes on a line
+!
+ CALL GNODE(1)
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 2
+ ELSEIF(ANS .EQ. 'h') THEN
+ CALL HELPS(3)
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 2
+ ELSE
+ GO TO 3
+ ENDIF
+ 6 CONTINUE
+!
+! Test for adding operation
+!
+ IF(ISWT .EQ. 1) THEN
+!
+ CALL GETNOD(J)
+ CALL GETNOD(J)
+ CALL GETNOD(J)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! Get number of node nearest cursor (if ISWT = 0)
+!
+ ELSE
+ 61 IBOX=1
+! CALL CLRBOX
+ CALL HEDR
+!ipk jan98
+ call wrtbox(idelv)
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!ipk jan98 add option for deleting elevation on move
+ IF(IBOX .EQ. 7 .or. iflag .eq. 'e') THEN
+ IDELV=MOD(IDELV+1,2)
+ GO TO 61
+ ENDIF
+ J=INODE
+!ipk jan98
+ if(idelv .eq. 1) then
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ WIDBS(J)=0.
+ SSO(J)=0.
+ endif
+!ipk jan98
+!
+ IF(IFLAG .EQ. 'q') THEN
+!ipk feb94 CALL WRTOUT(0)
+ GO TO 2
+ ENDIF
+ CALL PLTNOD(J,1)
+!
+ ENDIF
+!
+! Deleting operation
+!
+ IF(ISWT .EQ. 2) THEN
+ WRITE(NODH,5000) j
+! CALL CLRBOX
+ CALL HEDR
+ CALL SYMBL(0.,7.70,0.20,NODH,0.,20)
+ CALL DELETN(J)
+ GO TO 6
+ ENDIF
+ WRITE(NODH,5000) j
+ 5000 FORMAT('Processing node',i5)
+ 7 CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,NODH,0.,20)
+ NHTP=0
+! NMESS=0
+ NBRR=3
+ IF(ISWT .EQ. 0) then
+ NMESS=16
+ endif
+ CALL HEDR
+!
+ IF (J .GE. MAXP) THEN
+ CALL SETD(23)
+!IPK JAN98 WRITE(*,*) ' Node number exceeds MAXP '
+!IPK JAN98 WRITE(*,*) ' Enter -save- to save the file as is'
+!IPK JAN98 WRITE(*,*) ' Enter -quit- to terminate'
+!IPK JAN98 READ(*,'(A)') JUNK
+ CALL CLSCRN()
+ WRITE(LIND,*) ' Node number exceeds MAXP '
+ call symbl &
+ & (1.1,4.6,0.25,LIND,0.0,80)
+ WRITE(LIND,*) ' Enter -save- to save the file as is'
+ call symbl &
+ & (1.1,4.1,0.25,LIND,0.0,80)
+ WRITE(LIND,*) ' Enter -quit- to terminate'
+ call symbl &
+ & (1.1,3.8,0.25,LIND,0.0,80)
+ ndig=4
+ CALL GTCHARX(JUNK,NDIG,5.0,4.0)
+ IF(JUNK .NE. 'save') THEN
+ CALL WRTOUT(0)
+ CALL Quit_Pgm()
+ stop
+ else
+ call wrtout(1)
+ CALL Quit_Pgm()
+ stop
+ ENDIF
+!ipk an97 RETURN
+ ENDIF
+!
+! Get screen coordinate of node
+!
+ CALL XYLOC(XX,YY,IFLAG,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+!ipk feb94 CALL WRTOUT(0)
+! IF(ISWT .EQ. 2) NP=NP-1
+ if(inew(j) .eq. 0 .and. j .eq. np) np=np-1
+ GO TO 2
+ ENDIF
+!
+ IF (IFLAG .EQ. 'c') THEN
+!
+ IF(YY .GT. 7.5) THEN
+ CALL DELETN(J)
+ GO TO 6
+ ENDIF
+ INSKP(J)=0
+ CORD(J,1) = XX
+ CORD(J,2) = YY
+ INEW(J) = 1
+!
+ XUSR(J) = XX*TXSCAL - XS
+ YUSR(J) = YY*TXSCAL - YS
+ IF (J .GT. NP) NP = J
+! WRITE(IOT,'(I10,2F10.3)') J, XUSR(J),YUSR(J)
+ CALL PLTNOD(J,0)
+ ICHG=0
+!
+ IF(ISWT .EQ. 0) NMESS=17
+ GOTO 6
+ ENDIF
+ RETURN
+!
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE ADDPTH
+!
+! Add nodal bottom elevations
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 IFLAG,ANSW(10)
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+ DATA NTYPP,NLOCC,BELEV/1,0,0./
+!
+ 4 CONTINUE
+ NHTP = 0
+ NMESS = 45
+ NBRR = 0
+ CALL HEDR
+ xprt=3.2
+ NMESS = 14
+!
+ CALL ADJUSTOPT(NTYPP,NLOCC)
+
+ CALL GETFPN(BELEV)
+!
+! Write out current depths
+!
+ 7 HT = .15
+ DO 10 J=1,NP
+ IF(INSKP(J) .EQ. 0) THEN
+ IF (CORD(J,1) .GT. VDX) THEN
+!!SEP02 FPN = WD(J)*10.
+ FPN = WD(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) + .07
+ IF(X .GT. 0. .AND. X .LT. 10.0 .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+!!SEP02 CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ call numbr(x,y,0.12,fpn,0.0,1)
+ ENDIF
+ ENDIF
+ ENDIF
+ 10 END DO
+!
+! Input new depths
+!
+ NMESS = 15
+ NBRR = 4
+ CALL HEDR
+ 5 IBOX=1
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+!ipk feb94 CALL WRTOUT(0)
+ RETURN
+ ELSEIF(IFLAG .EQ. 'e' .OR. IFLAG .EQ. 'n') THEN
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ GO TO 4
+ ENDIF
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. 10.) XPRT=0.
+ FPN= INODE
+ CALL RRED
+ CALL NUMBR(XPRT,7.70,HT,FPN,0.0,-1)
+ IF (IFLAG .EQ. 'c') THEN
+ IF(NTYPP .EQ. 1) THEN
+ WD(INODE) = BELEV
+ ELSE
+ WD(INODE) = WD(INODE)+BELEV
+ ENDIF
+ IF(NLOCC .EQ. 1) THEN
+ LOCK(INODE)=1
+ ENDIF
+ ichg=0
+ FPN = WD(INODE)
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) -0.10
+ call numbr(x,y,0.12,fpn,0.0,1)
+!!SEP02 CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ CALL RBLUE
+!
+ ELSEIF(IFLAG .EQ. 'a') THEN
+ CALL RRED
+ ichg=0
+ DO 100 J=1,NP
+ IF (CORD(J,1) .GE. VDX) THEN
+ WD(J)=BELEV
+ FPN=BELEV
+ X = CORD(J,1)
+ Y = CORD(J,2) + .11
+ CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ ENDIF
+ 100 CONTINUE
+ CALL RBLUE
+ CALL WRTOUT(0)
+ ELSEIF(IFLAG .EQ. 'f') THEN
+ CALL RRED
+ DO 110 J=1,NP
+ IF (CORD(J,1) .GE. VDX .AND. WD(J) .LT. -9000.) THEN
+ WD(J)=BELEV
+ ichg=0
+ FPN=BELEV
+ X = CORD(J,1)
+ Y = CORD(J,2) + .11
+ CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ ENDIF
+ 110 CONTINUE
+ CALL RBLUE
+ CALL WRTOUT(0)
+!
+ ELSE
+!ipk jan98 WRITE(*,*) CHAR(7),CHAR(7)
+ ENDIF
+!
+ GOTO 5
+!
+ END
+!
+ SUBROUTINE JUNGEN(J,I,IERR)
+!
+! Find elements coming into node J, change all but first node
+! Form a new junction element
+!
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ INCLUDE 'TXFRM.COM'
+
+!
+ KOUNT=1
+ DO 200 N=1,NE
+!IPKOCT93 IF(IMAT(N) .GT. 0 .AND. IMAT(N) .LT. 901) THEN
+ IF(IMAT(N) .GT. 0 .AND. (IMAT(N) .LT. 901 .OR. &
+ & IMAT(N) .GT. 903) ) THEN
+ DO 180 K=1,8
+ IF(NOP(N,K) .EQ. I) THEN
+ IF(K .GT. 3) THEN
+ IERR=1
+ RETURN
+ ENDIF
+ IF(KOUNT .EQ. 1) THEN
+ NOP(J,1)=I
+ IJUN(J)=1
+ KOUNT=2
+ ELSE
+ CALL GETNOD(N2)
+ NOP(J,KOUNT)=N2
+ IJUN(N2)=KOUNT
+ KOUNT=KOUNT+1
+ CORD(N2,1) = CORD(I,1)
+ CORD(N2,2) = CORD(I,2)
+ WD(N2)=WD(I)
+ WIDTH(N2) = WIDTH(I)
+ SS1(N2)=SS1(I)
+ SS2(N2)=SS2(I)
+ WIDS(N2)=WIDS(I)
+ INSKP(N2)=0
+ INEW(N2) = 1
+ NOP(N,K) = N2
+!
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ CALL PLTNOD(N2,1)
+ GO TO 200
+ ENDIF
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 200 END DO
+ IF(KOUNT .LT. 9) THEN
+ DO 300 K=KOUNT,8
+ NOP(J,K)=0
+ 300 CONTINUE
+ ENDIF
+ IMAT(J)=901
+ IESKP(J)=1
+ RETURN
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE ELDAT
+!
+! Add bottom elevations to message file and display
+!
+ USE BLKMAP
+ USE BLK1MOD
+ USE WINTERACTER
+
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ INCLUDE 'TXFRM.COM'
+!
+ CHARACTER*1 IFLAG,ANSW(10)
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ LOGICAL :: OPENED
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+!
+!ipk mar00
+ jp=2
+ DO 200 N=1,MAXLIN
+ IF(LINTYP(N) .EQ. -999) THEN
+ NLIN=N
+ GO TO 205
+ ENDIF
+ 200 END DO
+ 205 CONTINUE
+ IF(NLIN .GT. 1) THEN
+ IF(LINTYP(NLIN-1) .NE. 2) THEN
+ LINTYP(NLIN)=2
+ ELSE
+ NLIN=NLIN-1
+ ENDIF
+ ENDIF
+ DO 250 J=MAXPL,1,-1
+ IF(CMAP(J,1) .GE. VDX) THEN
+ JP=J+1
+ GO TO 255
+ ENDIF
+ 250 END DO
+ 255 JP=JP-1
+ IPSW(6)=1
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ write(90,6010)
+ 6010 format(' The lines that follow are locations and new bottom ' &
+ & ,'elevations.'/' Note that a zoom operation may insert'&
+ & ,' other information')
+!
+ 4 CONTINUE
+ NHTP = 0
+ NMESS = 45
+ NBRR = 0
+ CALL HEDR
+!
+ NMESS = 14
+ CALL GETFPN(BELEV)
+!
+! Input new depths
+!
+ 7 CONTINUE
+ NMESS = 15
+ NBRR = 4
+ CALL HEDR
+!
+! Get screen coordinates
+!
+ IBOX = 0
+ CALL XYLOC(XX,YY,IFLAG,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+ IF(IFLAG .EQ. 'q')THEN
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'e') THEN
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'n')THEN
+ GO TO 4
+ ENDIF
+!
+ IF (IFLAG .EQ. 'c') THEN
+!
+ JP=JP+1
+ CMAP(JP,1) = XX
+ CMAP(JP,2) = YY
+ VAL(JP)=BELEV
+!
+ XMAP(JP) = XX*TXSCAL - XS
+ YMAP(JP) = YY*TXSCAL - YS
+ IMAPOUT=27
+ INQUIRE(27, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='MAP file -- *.map|*.map|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Map Data File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IMAPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ WRITE(IMAPOUT,*) '2,0'
+ ELSE
+ GO TO 260
+ ENDIF
+ ENDIF
+ WRITE(IMAPOUT,6000) XMAP(JP),YMAP(JP),VAL(JP)
+ 260 CONTINUE
+ WRITE(90,6000) XMAP(JP),YMAP(JP),VAL(JP)
+ 6000 FORMAT(3F16.4)
+ FPN = BELEV
+ HT=0.15
+ CALL RRED
+ CALL NUMBR(XX,YY,HT,FPN,0.0,-1)
+!
+ GOTO 7
+!
+ ELSE
+!ipk jan98 WRITE(*,*) CHAR(7),CHAR(7)
+ ENDIF
+!
+ GOTO 7
+!
+ END
+!
+ SUBROUTINE DELOP
+!
+! Input additional delete options from screen
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+
+!
+ CHARACTER*1 IFLAG,ANS,ANSW(0:9)
+ CHARACTER*20 NODH
+ DATA ANSW/'l','m','g','u','f','j','h','z','r','q'/
+!
+! Draw box around selections
+!
+ 2 CONTINUE
+ NHTP=10
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+!
+! Get answer
+!
+ 3 call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 3
+ I=IBOX-1
+ ANS=ANSW(I)
+ ENDIF
+ IF(ANS .EQ. 'l') THEN
+!
+! Delete all midside nodes
+!
+ CALL DELETM(0)
+ ELSEIF(ANS .EQ. 'm') THEN
+!
+! Delete all center located midsides
+!
+ CALL DELETM(1)
+ ELSEIF(ANS .EQ. 'g') THEN
+!
+! Deleting operation for nodes
+!
+ NHTP=0
+ NBRR=3
+ NMESS=18
+
+ 6 CONTINUE
+!
+ IBOX=1
+ CALL HEDR
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ J=INODE
+!
+ IF(IFLAG .EQ. 'q') THEN
+!ipk feb94 CALL WRTOUT(0)
+ GO TO 2
+ ENDIF
+ CALL PLTNOD(J,1)
+!
+ WRITE(NODH,5000) j
+ 5000 FORMAT('Processing node',i5)
+ CALL HEDR
+ CALL SYMBL(0.,7.70,0.20,NODH,0.,20)
+ CALL DELETN(J)
+ IRDONE=0
+ GO TO 6
+ ELSEIF(ANS .EQ. 'u') THEN
+!
+! Delete all unused nodes
+!
+ CALL DELETM(2)
+ ELSEIF(ANS .EQ. 'j') THEN
+!
+! Join two nodes together in the element lists
+!
+ CALL JOIN(1)
+ ELSEIF(ANS .EQ. 'f') THEN
+!
+! Fill midside nodes
+!
+!ipk aug02
+ CALL FILM(0)
+ ELSEIF(ANS .EQ. 'h') THEN
+ CALL HELPS(7)
+ ELSEIF(ANS .EQ. 'q') THEN
+ RETURN
+ ENDIF
+ GO TO 2
+ END
+!
+ SUBROUTINE JOIN(ISWTJ)
+!
+! Routine to join references to two nodes
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 IFLAG
+!
+ 61 IBOX=1
+ NHTP=0
+ NBRR=3
+ NMESS=15
+ CALL HEDR
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX)
+ IF(IFLAG .EQ. 'q') THEN
+ RETURN
+ ENDIF
+ FPN= INODE
+ CALL NUMBR(2.0,7.70,0.2,FPN,0.0,-1)
+! CALL PROX(CORD(1,1),CORD(1,2),NP,XX2,YY2,INODE2,IFLAG,INSKP,IBOX)
+! IF(IFLAG .EQ. 'q') THEN
+! RETURN
+! ELSEIF(INODE2 .EQ. INODE) THEN
+!
+! Get second node
+!
+ CALL PROX2(CORD(1,1),CORD(1,2),NP,XX,YY,INODE, &
+ & XX2,YY2,INODE2,IFLAG,INSKP,IBOX)
+ IF(IFLAG .EQ. 'q') THEN
+ RETURN
+ ENDIF
+! ENDIF
+! FPN= INODE2
+! CALL NUMBR(2.5,7.70,0.2,FPN,0.0,-1)
+
+ INODE1=INODE
+ CALL JOINDEL(INODE1,INODE2)
+
+ CALL PLOTOT(1)
+ GO TO 61
+! ENDIF
+ END
+
+ SUBROUTINE JOINDEL(INODE1,INODE2)
+! Routine to join references to two nodes
+!
+ USE BLK1MOD
+!
+! Search for references to INODE2
+!
+ DO N=1,NE
+ NCN=NCORN(N)
+ IF(NCN .GT. 0) THEN
+ DO M=1,NCN
+ IF(NOP(N,M) .EQ. INODE2) THEN
+!
+! Change them to INODE
+!
+ NOP(N,M)=INODE1
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+!
+! Remove node now
+!
+ CORD(INODE2,1)=VOID
+ CORD(INODE2,2)=VOID
+ XUSR(INODE2) = VOID
+ YUSR(INODE2) = VOID
+ INSKP(INODE2)=1
+ INEW(INODE2) = 0
+ WD(INODE2)=-9999.
+ WIDTH(INODE2)=0.
+ SS1(INODE2)=0.
+ SS2(INODE2)=0.
+ WIDS(INODE2)=0.
+!IPK MAY03
+ ICHG=0
+!ipk nov97 add (1)
+ RETURN
+ END
+
+ SUBROUTINE JOINALL
+ USE BLK1MOD
+
+ NMESS = 46
+ TOLER=0.1
+ CALL GETFPN(TOLER)
+
+ DO N=1,NP-1
+ IF(CORD(N,1) .EQ. VOID) CYCLE
+ DO M=N+1,NP
+ IF(CORD(M,1) .EQ. VOID) CYCLE
+ DIST=SQRT((YUSR(M)-YUSR(N))**2+(XUSR(M)-XUSR(N))**2)
+ IF(DIST .LT. TOLER) THEN
+ CALL JOINDEL(N,M)
+ GO TO 100
+ ENDIF
+ ENDDO
+ 100 CONTINUE
+ ENDDO
+
+ CALL PLOTOT(1)
+ RETURN
+ END
+!****************************************************************
+!
+ SUBROUTINE ADDPTH2(nodlist,ndlist)
+!
+! Add nodal bottom elevations
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 IFLAG,ANSW(10)
+
+ dimension nodlist(*)
+
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+ DATA NTYPP,NLOCC/1,0/
+!
+ 4 CONTINUE
+ NHTP = 0
+ NMESS = 45
+ NBRR = 0
+ CALL HEDR
+ xprt=3.2
+ NMESS = 14
+!
+ CALL ADJUSTOPT(NTYPP,NLOCC)
+
+ CALL GETFPN(BELEV)
+!
+! Write out current depths
+!
+ 7 HT = .15
+ DO 10 J=1,NP
+ IF(INSKP(J) .EQ. 0) THEN
+ IF (CORD(J,1) .GT. VDX) THEN
+!!SEP02 FPN = WD(J)*10.
+ FPN = WD(J)
+ X = CORD(J,1)
+ Y = CORD(J,2) + .07
+ IF(X .GT. 0. .AND. X .LT. HSIZE .AND. &
+ & Y .GT. 0. .AND. Y .LT. 7.5) THEN
+!!SEP02 CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ call numbr(x,y,0.12,fpn,0.0,1)
+ ENDIF
+ ENDIF
+ ENDIF
+ 10 END DO
+!
+! Input new depths
+!
+ DO J=1,NDLIST
+ INODE=NODLIST(J)
+ FPN= INODE
+ CALL RRED
+
+ IF(NTYPP .EQ. 1) THEN
+ WD(INODE) = BELEV
+ ELSE
+ WD(INODE) = WD(INODE)+BELEV
+ ENDIF
+ IF(NLOCC .EQ. 1) THEN
+ LOCK(INODE)=1
+ ENDIF
+ ichg=0
+ FPN = WD(INODE)
+ X = CORD(INODE,1)
+ Y = CORD(INODE,2) -0.10
+ call numbr(x,y,0.12,fpn,0.0,1)
+!!SEP02 CALL NUMBR(X,Y,HT,FPN,0.0,-1)
+ CALL RBLUE
+ ENDDO
+!
+!
+ RETURN
+!
+ END
+!
+ SUBROUTINE FINDNOD
+!
+! Search for a plot a grid centered around a node
+!
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+!IPK MAY02
+ INCLUDE 'TXFRM.COM'
+!
+ NHTPSAV=NHTP
+ NMESSAV=NMESS
+ NBRRSAV=NBRR
+ NHTP=0
+ NBRR=0
+ NMESS=1
+ CALL HEDR
+ NMESS=1
+ CALL GETINT(NODSH)
+ IF(INEW(NODSH) .LE. 0) RETURN
+ DO 4 I=1,NP
+ IF(CORD(I,1) .GT. VOID) THEN
+ INSKP(I)=0
+ ENDIF
+ 4 CONTINUE
+ DO 5 I=1,NE
+ IF(IMAT(I) .GT. 0) THEN
+ IESKP(I)=0
+ ENDIF
+ 5 CONTINUE
+ XP=CORD(NODSH,1)
+ YP=CORD(NODSH,2)
+ XMIN=XP-5.0*PSCALE
+ YMIN=YP-3.5*PSCALE
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ FPN=NODSH
+ HT=0.15
+ XP=CORD(NODSH,1)
+ YP=CORD(NODSH,2)
+ CALL RCYAN
+ CALL NUMBR(XP,YP+0.07,HT,FPN,0.0,-1)
+ CALL RBLUE
+ NHTP=NHTPSAV
+ NMESS=NMESSAV
+ NBRR=NBRRSAV
+ CALL HEDR
+!
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/OK.ICO b/src/src83e/OK.ICO
new file mode 100644
index 0000000..e95f890
Binary files /dev/null and b/src/src83e/OK.ICO differ
diff --git a/src/src83e/OUTLINES.F90 b/src/src83e/OUTLINES.F90
new file mode 100644
index 0000000..19c7c1c
--- /dev/null
+++ b/src/src83e/OUTLINES.F90
@@ -0,0 +1,303 @@
+ SUBROUTINE OUTLINES(ISWT)
+
+ USE WINTERACTER
+ USE BLK1MOD
+ include 'd.inc'
+! INCLUDE 'BLK1.COM'
+
+! INTEGER*2 MSN
+! COMMON /MID/ MSN(MAXP)
+
+ CHARACTER(LEN=255) :: FNAME,FILTER
+ CHARACTER(LEN=4) :: SUB
+ REAL XCEN(10),YCEN(10),MTYP(10)
+ LOGICAL OPENED,LSTAT
+ CHARACTER*1 IFLAG,ANS(10)
+ DATA ANS/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+ DATA PI2/1.5708/
+ IF(.NOT. ALLOCATED(ICONNCT)) THEN
+ ALLOCATE (ICONNCT(MAXP,3),IOUTLST(10,5000),NOUTLST(10),NKEP(MAXP))
+ ENDIF
+ IF(.NOT. ALLOCATED(XOUT)) THEN
+ ALLOCATE (XOUT(5000,10),YOUT(5000,10))
+ ENDIF
+ NOUTLST=0
+ IOUTSW=2
+ IPOS=2
+ IF(ISWT .EQ. 1) GO TO 80
+ IOUTOUT=26
+ INQUIRE(26, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='OUTLINE file -- *.dat|*.dat|POLY file -- *.poly|*.poly|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Outline File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IOUTOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ ELSE
+ GO TO 1
+ ENDIF
+ ENDIF
+
+ 1 CONTINUE
+
+ call wdialogload(IDD_DIALOG08)
+ ierr=infoerror(1)
+
+
+ call wdialogputRadioButton(idf_radio1)
+
+
+ CALL WDialogSelect(IDD_DIALOG08)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ipos)
+ ipos=3-ipos
+ go to 50
+ endif
+ ipos= 0
+ go to 50
+ enddo
+ ipos= 2
+ 50 continue
+ IF(SUB(1:3) .EQ. 'dat') THEN
+ IOUTSW=0
+ ELSE
+ IOUTSW=1
+ ENDIF
+!
+! FORM LIST OF ELEMENT SIDES THAT ARE ON THE OUTSIDE
+ 80 CONTINUE
+ DO N=1,NP
+ MSN(N)=0
+ ENDDO
+ ILINEL=0
+ DO N=1,NE
+ IF(IMAT(N) .LE. 0) CYCLE
+ IF(IMAT(N) .NE. 999 .AND. NCORN(N) .GT. 5 .AND. (IMAT(N) .LT. 900 .OR. IMAT(N) .GT. 903)) THEN
+ NCN=NCORN(N)
+ DO K=2,NCN,2
+ J = NOP(N,K)
+ if(J .gt. 0) then
+ MSN(J) = MSN(J) + 1
+ ICONNCT(J,3)=N
+ ICONNCT(J,1)=NOP(N,K-1)
+ IF(K .EQ. NCN) THEN
+ ICONNCT(J,2)=NOP(N,1)
+ ELSE
+ ICONNCT(J,2)=NOP(N,K+1)
+ ENDIF
+ endif
+ ENDDO
+ ELSEIF(IMAT(N) .NE. 999 .AND. NCORN(N) .LE. 5 .AND. (IMAT(N) .LT. 900 .OR. IMAT(N) .GT. 903)) THEN
+ ILINEL=1
+ IF(NCORN(N) .EQ. 5) THEN
+ DO K=1,5,4
+ J=NOP(N,K)
+ MSN(J)=MSN(J)-1
+ ICONNCT(J,-MSN(J))=N
+ ENDDO
+ ELSE
+ DO K=1,3,2
+ J=NOP(N,K)
+ MSN(J)=MSN(J)-1
+ ICONNCT(J,-MSN(J))=N
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+
+! WORK THROUGH OUTSIDE NODES FORMING UP TO 10 CONTIUOUS SEQUENCES
+
+ DO K=1,10
+ JJ=0
+ DO J=1,NP
+ IF(MSN(J) .EQ. 1) THEN
+ MTYP(K)=1
+!
+! THIS IS A STARTING POINT EXTRACT A CORNER NODE
+ IOUTLST(K,1)=ICONNCT(J,1)
+ if(ipos .eq. 1) then
+ IOUTLST(K,2)=ICONNCT(J,2)
+ JJ=2
+ else
+ IOUTLST(K,2)=J
+ IOUTLST(K,3)=ICONNCT(J,2)
+ JJ=3
+ endif
+ N=ICONNCT(J,3)
+ IF(NOP(N,7) .EQ. 0) THEN
+ XCEN(K)=(XUSR(NOP(N,1))+XUSR(NOP(N,3))+XUSR(NOP(N,5)))/3.
+ YCEN(K)=(YUSR(NOP(N,1))+YUSR(NOP(N,3))+YUSR(NOP(N,5)))/3.
+ ELSE
+ XCEN(K)=(XUSR(NOP(N,1))+XUSR(NOP(N,3))+XUSR(NOP(N,5))+XUSR(NOP(N,7)))/4.
+ YCEN(K)=(YUSR(NOP(N,1))+YUSR(NOP(N,3))+YUSR(NOP(N,5))+YUSR(NOP(N,7)))/4.
+ ENDIF
+ MSN(J)=0
+ ICONNCT(J,1)=0
+ ICONNCT(J,2)=0
+
+! NOW LOOK FOR A CONNECTION TO ICONNCT(J,2)
+
+ 100 CONTINUE
+ DO L=1,NP
+ IF(MSN(L) .EQ. 1) THEN
+ IF(ICONNCT(L,1) .EQ. IOUTLST(K,JJ)) THEN
+
+! FOUND ONE
+
+ if(ipos .eq. 2) then
+ IOUTLST(K,JJ+1)=ICONNCT(L,2)
+ JJ=JJ+1
+ else
+ IOUTLST(K,JJ+1)=L
+ IOUTLST(K,JJ+2)=ICONNCT(L,2)
+ JJ=JJ+2
+ endif
+ MSN(L)=0
+ ICONNCT(L,1)=0
+ JTEMP=ICONNCT(L,2)
+ ICONNCT(L,2)=0
+ IF(JTEMP .EQ. IOUTLST(K,1)) GO TO 200
+ GO TO 100
+ ELSEIF(ICONNCT(L,2) .EQ. IOUTLST(K,JJ)) THEN
+
+! FOUND ONE THE OPPOSITE WAY
+
+ IOUTLST(K,JJ+1)=L
+ IOUTLST(K,JJ+2)=ICONNCT(L,1)
+ JJ=JJ+2
+ MSN(L)=0
+ JTEMP=ICONNCT(L,1)
+ ICONNCT(L,1)=0
+ ICONNCT(L,2)=0
+ IF(JTEMP .EQ. IOUTLST(K,1)) GO TO 200
+ GO TO 100
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ELSEIF(MSN(J) .EQ. -1) THEN
+ MTYP(K)=-1
+ JJ=J
+ JO=J
+ LL=1
+ NN=ICONNCT(JJ,LL)
+ IOUTLST(K,LL)=JJ
+ 130 LL=LL+1
+ IF(NCORN(NN) .EQ. 5) THEN
+ NNOP=5
+ ELSE
+ NNOP=3
+ ENDIF
+ IF(NOP(NN,1) .EQ. JJ) THEN
+ JJ=NOP(NN,NNOP)
+ JL=NOP(NN,3)
+ IOUTLST(K,LL)=JL
+ ELSE
+ JJ=NOP(NN,1)
+ JL=JJ
+ IOUTLST(K,LL)=JJ
+ ENDIF
+ CALL GETLINANG(ANGL,JO,JJ)
+ ANGL1=ANGL-PI2
+ IF(LL .EQ. 2) THEN
+ XOUT(1,K)=XUSR(JO)+WIDTH(JO)/2.*COS(ANGL1)
+ YOUT(1,K)=YUSR(JO)+WIDTH(JO)/2.*SIN(ANGL1)
+ XOUT(4999,K)=XUSR(JO)-WIDTH(JO)/2.*COS(ANGL1)
+ YOUT(4999,K)=YUSR(JO)-WIDTH(JO)/2.*SIN(ANGL1)
+ ENDIF
+ XOUT(LL,K)=XUSR(JL)+WIDTH(JL)/2.*COS(ANGL1)
+ YOUT(LL,K)=YUSR(JL)+WIDTH(JL)/2.*SIN(ANGL1)
+ XOUT(5000-LL,K)=XUSR(JL)-WIDTH(JL)/2.*COS(ANGL1)
+ YOUT(5000-LL,K)=YUSR(JL)-WIDTH(JL)/2.*SIN(ANGL1)
+
+ IF(MSN(JJ) .EQ. -1) GO TO 150
+ IF(ICONNCT(JJ,1) .EQ. NN) THEN
+ NN=ICONNCT(JJ,2)
+ ELSE
+ NN=ICONNCT(JJ,1)
+ ENDIF
+ GO TO 130
+150 MSN(JJ)=0
+ JJ=LL
+ DO JJJ=LL,1,-1
+ JJ=JJ+1
+ XOUT(JJ,K)=XOUT(5000-JJJ,K)
+ YOUT(JJ,K)=YOUT(5000-JJJ,K)
+ ENDDO
+ JJ=JJ+1
+ XOUT(JJ,K)=XOUT(1,K)
+ YOUT(JJ,K)=YOUT(1,K)
+ MSN(J)=0
+ GO TO 200
+ ENDIF
+ ENDDO
+ GO TO 300
+ 200 CONTINUE
+ NOUTLST(K)=JJ
+ IF(JJ .GT. 0) THEN
+ IF(IOUTSW .EQ. 1) THEN
+ NDIM=2
+ NZERO=0
+ NONE=1
+ WRITE(IOUTOUT,*)NOUTLST(K)-1,NDIM,NZERO,NZERO
+ DO L=1,NOUTLST(K)-1
+ WRITE(IOUTOUT,*) L,XUSR(IOUTLST(K,L)),YUSR(IOUTLST(K,L))
+ ENDDO
+ WRITE(IOUTOUT,*) NOUTLST(K)-1,NZERO
+ DO I=1,NOUTLST(K)-2
+ WRITE(IOUTOUT,*) I,I,I+1
+ ENDDO
+ WRITE(IOUTOUT,*) NOUTLST(K)-1,NOUTLST(K)-1,NONE
+
+ WRITE(IOUTOUT,*) NZERO
+ ELSE
+ DO L=1,NOUTLST(K)
+ IF(MTYP(K) .EQ. 1) THEN
+ XOUT(L,K)=XUSR(IOUTLST(K,L))
+ YOUT(L,K)=YUSR(IOUTLST(K,L))
+ ENDIF
+ IF(IOUTSW .EQ. 0) THEN
+ WRITE(IOUTOUT,*) XOUT(L,K),YOUT(L,K)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+300 CONTINUE
+ DO K=1,10
+ IF(NOUTLST(K) .EQ. 0) GO TO 400
+ IF(MTYP(K) .EQ. 1) THEN
+ LSTAT=IGrInsidePolygon(XOUT(1,K),YOUT(1,K),NOUTLST(K),XCEN(K),YCEN(K))
+ ELSE
+ LSTAT=.TRUE.
+ ENDIF
+ IF(LSTAT) THEN
+ NOUTLST(K)=ABS(NOUTLST(K))
+ ELSE
+ NOUTLST(K)=-ABS(NOUTLST(K))
+ ENDIF
+ ENDDO
+ 400 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE GETLINANG(angle,n1,n2)
+ USE BLK1MOD
+! use ATAN2 and angle into range 0 to 2*pi
+ ANGLE=ATAN2(YUSR(N2)-YUSR(N1),XUSR(N2)-XUSR(N1))
+ IF(ANGLE .LT. 0.) ANGLE=ANGLE+6.28318515
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/PARAM.COM b/src/src83e/PARAM.COM
new file mode 100644
index 0000000..1374108
--- /dev/null
+++ b/src/src83e/PARAM.COM
@@ -0,0 +1,65 @@
+!IPK LAST UPDATED JULY 17 1998
+!ipk last update Dec 10 1997
+!IPK LAST UPDATED OCT 18 1996
+!
+ SAVE
+!
+! This version is compiled for: LARGE
+! MAXE = maximum number of elements = 200000
+! MAXP = maximum number of nodes =400000
+! MAXPL = maximum number of map data points =1800000
+! MAXLIN = maximum number of map lines = 3000
+! MAXLN = maximum number of reordering lines = 20
+! MAELN = maximum number of elements in a reodering list = 300
+! MAXPGEN= maximum number elements in a genreated block = 2000
+! MAXGRD = maximum number of grid points = 3000
+!
+!
+!
+! PARAMETER (MAXE= 200000,MAXP=400000,MAXLIN=6000,MAXECON=60)
+! PARAMETER (MAXLN=20,MAELN=300,MAXPGEN=2000,MAXGRD=3000,MAXSTO=2)
+! PARAMETER (MAXE8=8*MAXE,MAXP2=2*MAXP)
+
+! This version is compiled for: MEDIUM
+! MAXE = maximum number of elements =130000
+! MAXP = maximum number of nodes =200000
+! MAXPL = maximum number of map data points =1500000
+! MAXLIN = maximum number of map lines = 3000
+! MAXLN = maximum number of reordering lines = 20
+! MAELN = maximum number of elements in a reodering list = 300
+! MAXPGEN= maximum number elements in a genreated block = 2000
+! MAXGRD = maximum number of grid points = 1000
+! MAXSTO = maximum storage locations = 2
+!
+!
+ PARAMETER (MAXPGEN=20000,MAXGRD=1000)
+! PARAMETER (MAXE8=8*MAXE,MAXP2=2*MAXP)
+ PARAMETER (MCRS=1000,MPTS=75)
+
+! This version is compiled for: STANDARD
+! MAXE = maximum number of elements = 40000
+! MAXP = maximum number of nodes = 50000
+! MAXPL = maximum number of map data points = 200000
+! MAXLIN = maximum number of map lines = 3000
+! MAXLN = maximum number of reordering lines = 20
+! MAELN = maximum number of elements in a reodering list = 300
+! MAXPGEN= maximum number elements in a genreated block = 2000
+! MAXGRD = maximum number of grid points = 300
+! MAXSTO = maximum storage locations = 2
+!
+!
+! PARAMETER (MAXE= 40000,MAXP=50000,MAXLIN=6000,MAXECON=60)
+! PARAMETER (MAXLN=20,MAELN=300,MAXPGEN=2000,MAXGRD=3000,MAXSTO=2)
+! PARAMETER (MCRS=600,MPTS=50)
+! PARAMETER (MAXE8=8*MAXE,MAXP2=2*MAXP)
+
+!
+! CORD is the screen scale variable
+! XUSR is the map scale variable
+! To get to CORD from XUSR use
+! CORD(N,1)=(XUSR(N)+XS)/TXSCAL
+! To get to XUSR from CORD use
+! XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+! XS,YS and TXSCAL are kept in TXFRM.COM
+! REAL*8 XS,YS,TXSCAL
+! COMMON /TXFRM/ XS, YS, TXSCAL
\ No newline at end of file
diff --git a/src/src83e/PLOTORDS.F90 b/src/src83e/PLOTORDS.F90
new file mode 100644
index 0000000..049dbd0
--- /dev/null
+++ b/src/src83e/PLOTORDS.F90
@@ -0,0 +1,41 @@
+ SUBROUTINE PLOTORDS
+
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ NLSTP=NLST+1
+ call getxc
+ DO N=1,NLSTP
+ FPN=N
+ DO M=1,NE
+
+! Get element in list
+
+ IF(N .LT. NLSTP) THEN
+ J=ILIST(N,M)
+ ELSE
+ J=ilisttmp(M)
+ ENDIF
+! IF(IMAT(J) .EQ. 0) THEN
+! ENDIF
+
+ IF(J .GT. 0) THEN
+ IF(XC(J) .GT. 0. .AND. XC(J) .LT. HSIZE) THEN
+ IF(YC(J) .GT. 0. .AND. YC(J) .LT. 7.5) THEN
+ xxc=xc(j)
+ yyc=yc(j)
+ CALL NUMBR(XXC,YYC,0.15,FPN,0.0,-1)
+ ENDIF
+ ENDIF
+ ELSE
+ GO TO 300
+ ENDIF
+
+ ENDDO
+ 300 CONTINUE
+ ENDDO
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/PLOTR.F90 b/src/src83e/PLOTR.F90
new file mode 100644
index 0000000..52c5fa5
--- /dev/null
+++ b/src/src83e/PLOTR.F90
@@ -0,0 +1,204 @@
+!ipk last change July 14 updating of cycw changes in 97
+! Last change: IPK 12 Jan 98 1:55 pm
+!ipk last update Nov 18 1997
+!ipk last updated Oct 17 1996
+!ipk last updated Oct 14 1996
+
+ SUBROUTINE RDRW(IS)
+
+! Determine how to draw grid according to switch setting
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 ANS,ANSW(10)
+ character*38 mesg
+
+! Draw box around selections
+
+ DATA ANSW/'m','o','e','n','t','y','l','d','b','r'/
+! m 1 o 2 e 5 n 3 t 4 u 7 g 8 d 6 b 9
+ NHTP=5
+ NMESS=0
+ NBRR=0
+ 100 CONTINUE
+ CALL HEDR
+
+! Get answer
+
+ call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(ibox .le. 0) go to 100
+ IF(ANS .EQ. 'c') THEN
+ ANS=ANSW(IBOX)
+ ENDIF
+ IF(ANS .EQ. 'm') THEN
+!ipk oct96
+ if(ipsw(1) .eq. 0) then
+ call getmpcl
+ NHTP=5
+ endif
+!ipk oc96 end addition
+ IPSW(1)=MOD(IPSW(1)+1,2)
+ GO TO 100
+ ELSEIF(ANS .EQ. 'o') THEN
+ IPSW(2)=MOD(IPSW(2)+1,2)
+ GO TO 100
+ ELSEIF(ANS .EQ. 'n') THEN
+ IPSW(3)=MOD(IPSW(3)+1,2)
+ IF(IPSW(3) .EQ. 1) IPSW(9)=0
+ IF(IPSW(3) .EQ. 1) IPSW(14)=0
+ GO TO 100
+ ELSEIF(ANS .EQ. 't') THEN
+ IPSW(4)=MOD(IPSW(4)+1,2)
+ GO TO 100
+ ELSEIF(ANS .EQ. 'e') THEN
+ IPSW(5)=MOD(IPSW(5)+1,2)
+ if(ipsw(5) .eq. 1) ipsw(7)=0
+ GO TO 100
+ ELSEIF(ANS .EQ. 'd') THEN
+ IPSW(6)=MOD(IPSW(6)+1,2)
+ if(ipsw(6) .eq. 1) then
+!ipk apr02
+ call getmdis(nmapf,nsigf,icolsw,rad,colint)
+! write(mesg,*) 'Enter output frequency for map display'
+! call symbl (1.1,7.3,0.25,mesg,0.0,38)
+! call getint(nmapf)
+ endif
+ GO TO 100
+ ELSEIF(ANS .EQ. 'y') THEN
+ IPSW(7)=MOD(IPSW(7)+1,2)
+ if(ipsw(7) .eq. 1) ipsw(5)=0
+ GO TO 100
+!ipk feb01 drop this option in favour of ccline ELSEIF(ANS .EQ. 'g') THEN
+!ipk feb01 IPSW(8)=MOD(IPSW(8)+1,2)
+!ipk feb01 GO TO 100
+ ELSEIF(ANS .EQ. 'l') THEN
+ IPSW(10)=MOD(IPSW(10)+1,2)
+ GO TO 100
+ ELSEIF(ANS .EQ. 'b') THEN
+ IPSW(9)=MOD(IPSW(9)+1,2)
+ IF(IPSW(9) .EQ. 1) IPSW(3)=0
+ IF(IPSW(9) .EQ. 1) IPSW(14)=0
+ GO TO 100
+ ELSEIF(ANS .EQ. 'r') THEN
+
+! CALL PLOTS(IS)
+!ipk nov97 add (0)
+ CALL PLOTOT(1)
+ RETURN
+ ENDIF
+ GO TO 100
+ END
+
+ SUBROUTINE GETMPCL
+
+! Determine how to draw grid according to switch setting
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 ANS,ANSW(10)
+
+! Draw box around selections
+
+ DATA ANSW/'e','o','t','h','f','i','s','v','g','q'/
+! m 1 o 2 e 5 n 3 t 4 u 7 g 8 d 6 b 9
+ NHTP=12
+ 100 CONTINUE
+ CALL HEDR
+
+! Get answer
+
+ call xyloc(XPT,YPT,ANS,IBOX)
+ IF(ANS .NE. 'c') then
+ DO K=1,10
+ IF(ANS .EQ. ANSW(K)) THEN
+ IBOX=K
+ GO TO 102
+ ENDIF
+ ENDDO
+ 102 CONTINUE
+ ENDIF
+ IF(IBOX .EQ. 10) GO TO 150
+ ICOLON(IBOX)=MOD(ICOLON(IBOX)+1,2)
+ CALL HEDR
+ GO TO 100
+ 150 NHTP=5
+ RETURN
+ END
+
+ SUBROUTINE GDIST
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 ANS,ANSW(10)
+
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ DATA ANSW/6*' ','n','z','r','q'/
+!
+ NHTPSV=NHTP
+ NMESSV=NMESS
+ NBRRSV=NBRR
+ 100 CONTINUE
+ NHTP=0
+ NMESS=41
+ NBRR=4
+ CALL CLRBOX
+ CALL HEDR
+ call xyloc(XPT1,YPT1,ANS,IBOX)
+ call xyloc(XPT2,YPT2,ANS,IBOX)
+ DIST=SQRT((YPT2-YPT1)**2+(XPT2-XPT1)**2)*TXSCAL
+ CALL CLRBOX
+ NMESS=0
+ NBRR=4
+ CALL HEDR
+ CALL NUMBR(0.5,7.55,0.20,DIST,0.0,2)
+ CALL XYLOC(XPT1,YPT1,ANS,IBOX)
+ IF(ANS .NE. 'c') then
+ DO K=1,10
+ IF(ANS .EQ. ANSW(K)) THEN
+ IBOX=K
+ GO TO 102
+ ENDIF
+ ENDDO
+ 102 CONTINUE
+ ENDIF
+ IF(IBOX .EQ. 7) GO TO 100
+ NHTP=NHTPSV
+ NMESS=NMESSV
+ NBRR=NBRRSV
+ CALL CLRBOX
+ CALL HEDR
+
+ RETURN
+ END
+
+
+ SUBROUTINE CHEXIT
+ USE WINTERACTER
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: ITYPE
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+
+ CALL WMessagePeek(ITYPE, MESSAGE)
+
+ SELECT CASE (ITYPE)
+ CASE (-1)
+ RETURN
+ CASE (KeyDown) ! Key pressed
+ IPSW(1)=0
+ IPSW(2)=1
+ IPSW(3)=0
+ IPSW(4)=0
+ IPSW(5)=0
+ IPSW(6)=0
+ IPSW(7)=0
+ IPSW(8)=0
+ IPSW(9)=0
+ IPSW(12)=0
+ RETURN
+ ENDSELECT
+ RETURN
+ END
diff --git a/src/src83e/PLOTR1.F90 b/src/src83e/PLOTR1.F90
new file mode 100644
index 0000000..7911c95
--- /dev/null
+++ b/src/src83e/PLOTR1.F90
@@ -0,0 +1,1647 @@
+!ipk last update March 6 2000 fix IMAT display bug
+!ipk last update Feb 22 1999 add element type option
+!ipk last update Jan 21 1999 add plotting of storage widths
+!ipk lsat update oct 23 1998 change location of label in pgrid
+!
+!****************************************************************
+!
+!ipk nov97 change call
+ SUBROUTINE PLOTOT(imz)
+!
+! Display grid according to switch setting
+!
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+ include 'TXFRM.COM'
+ DIMENSION XLIN(350),YLIN(350)
+ CHARACTER*1 IFLAG
+ CHARACTER*80 LIND
+ !ycw mar97 add for cross section
+ REAL XPL(5),YPL(5)
+ DATA IFIRST/0/
+ IF(IFIRST .EQ. 0) THEN
+ NTTRAC=0
+ IFIRST=1
+ ENDIF
+ HT=0.2
+! CALL CHEXIT
+!
+ if(imz .ne. 2) CALL CLSCRN
+!
+!ipk oct97 output to backup file
+!
+!ipk test for write to backup
+ if(imz .eq. 1) then
+ rewind ibak
+ call wrtout(0)
+ endif
+!
+!ycw mar97 add for cross section
+ if(LCROSS) then
+!! call plotcs
+ return
+ endif
+!ycw
+!
+! Rescale coordinates for plotting
+!
+ CALL SCLMAP
+!rrr
+ IF (IPSW(8) .EQ. 1) CALL PGRID
+!
+ CALL SCLCRD
+!ycw mar97 add for cross section
+ if(ICRS.ne.0) then
+ do i=1,2
+ XPCS(i)=(XPCS(i)-XMIN)/PSCALE
+ YPCS(i)=(YPCS(i)-YMIN)/PSCALE
+ enddo
+ do i=1,NCSNOD
+ XCND(i)=(XCND(i)-XMIN)/PSCALE
+ YCND(i)=(YCND(i)-YMIN)/PSCALE
+ enddo
+ endif
+!ycw
+ PSCALE = 1.
+ XMIN = 0.
+ YMIN = 0.
+! if(np .gt. 100000) call backc(1)
+
+! if(ipsw(4) .eq. 1) then
+! do j=1,ne
+! if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,1)
+! enddo
+! endif
+! write(90,*) 'going to drawbk',nbkfl,iswbkfl(1)
+! IF(NBKFL .GT. 0) THEN
+! DO I=1,NBKFL
+! IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
+! IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
+! ENDDO
+! ENDIF
+ IF(IDDSW .EQ. -1) THEN
+ IF(NP .GT. 100000) THEN
+ IDDSW=0
+ ELSE
+ IDDSW=1
+ ENDIF
+ ENDIF
+ if(IDDSW .EQ. 0) call backc(1)
+
+ if(ipsw(4) .eq. 1) then
+ do j=1,ne
+ if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,1)
+ enddo
+ endif
+
+ IF(NBKFL .GT. 0) THEN
+ DO I=1,NBKFL
+ IF(ISWBKFL(I) .EQ. 1) CALL DRAWBK(I,IMZ)
+ IF(ISWBKFL(I) .EQ. 2) CALL DRAWBKBM(I,IMZ)
+ ENDDO
+ ENDIF
+! write(90,*) 'finished drawbk'
+!
+! Plot map data
+!
+ IF(IMP .NE. 0) THEN
+ IF(IPSW(1) .EQ. 1) THEN
+ CALL PLTMAP
+ ENDIF
+ ENDIF
+!
+! If IPSW(1) = 1 plot map or plot outline if no map
+!
+ IF(IMP .EQ. 0) THEN
+ IF(IPSW(1) .EQ. 1) IPSW(2)=1
+!ipk sep94 allow plotting of outline after map
+! ELSE
+! IF(IPSW(1) .EQ. 1) GO TO 10
+ ENDIF
+!
+! Plot outline of grid only
+!
+ IF(IPSW(2) .EQ. 1) THEN
+ CALL OUTLN
+! GO TO 250
+ ENDIF
+!
+! Plot nodes when IPSW(3) .EQ. 1
+!
+ 10 CONTINUE
+ IF(IPSW(3) .EQ. 1 .OR. IPSW(9) .EQ. 1 .OR. IPSW(14) .EQ. 1) THEN
+ IF(NP .GT. 0) THEN
+ IF(IPSW(3) .EQ. 1) ITP=0
+ IF(IPSW(14) .EQ. 1) ITP=2
+ IF(IPSW(9) .EQ. 1) then
+ ITP=-1
+ wdmin=1.e10
+ wdmax=-1.e10
+ do j=1,np
+ IF(INSKP(J) .EQ. 1) cycle
+ IF(CORD(J,1) .GT. 0. .AND. CORD(J,1) .LT. HSIZE) THEN
+ IF(CORD(J,2) .GT. 0. .AND. CORD(J,2) .LT. 7.5) THEN
+ wdmin=min(wdmin,wd(j))
+ wdmax=max(wdmax,wd(j))
+ else
+ cycle
+ endif
+ else
+ cycle
+ endif
+ enddo
+ if(abs(wdmin) .gt. abs(wdmax)) then
+ temp=log10(abs(wdmin))
+ elseif(wdmin .eq. 0) then
+ temp=2.5
+ else
+ temp=log10(wdmax)
+ endif
+ if(temp .gt. 2.) then
+ itp=-3
+ elseif(temp .gt. 1.) then
+ itp=-4
+ else
+ itp=-5
+ endif
+ endif
+ DO 15 J=1,NP
+! IF(MOD(J,10) .EQ. 0) THEN
+! CALL CHINT(IFLAG)
+! IF(IFLAG .EQ. 'i') GO TO 250
+! ENDIF
+ IF(INSKP(J) .EQ. 1) GO TO 15
+ IF(CORD(J,1) .GT. 0. .AND. CORD(J,1) .LT. HSIZE) THEN
+ IF(CORD(J,2) .GT. 0. .AND. CORD(J,2) .LT. 7.5) THEN
+ CALL PLTNOD(J,ITP)
+ GO TO 15
+ ENDIF
+ ENDIF
+ INSKP(J)=1
+ 15 CONTINUE
+ ENDIF
+ ENDIF
+!
+! Plot data points
+!
+ IF(IPSW(6) .EQ. 1) THEN
+ FCT=10**NSIGF
+ DO 80 J=1,MAXPTS,nmapf
+ IF(VAL(J) .GT. -9000.) THEN
+ X=CMAP(J,1)
+ Y=CMAP(J,2)
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL PLOTT(X,Y,3)
+ if(icolsw .eq. 0) then
+ CALL PLOTT(X,Y,2)
+
+ CALL Rblack
+! ipk mar01
+! ipk jun04 CALL NUMBR(X,Y,0.15,VAL(J)*FCT,0.0,-1)
+ if(nsigf .lt.1) then
+ nsigff=1
+ else
+ nsigff=nsigf
+ endif
+ call numbr(x,y,0.12,val(j),0.0,nsigff)
+ CALL RBlue
+ else
+ if(colint .eq. 0.) colint=1.
+ if(val(j) .ge. 0.) then
+ ncoln=val(j)/colint
+ else
+ ncoln=-val(j)/colint
+ endif
+ ncoln=mod(ncoln,13)+2
+ call change_color(ncoln)
+ raddisp=rad/txscal
+ if(raddisp .lt. 0.01) raddisp=0.01
+ call circle(x,y,raddisp)
+ endif
+ ENDIF
+ ENDIF
+ ENDIF
+ 80 CONTINUE
+ Call RBlue
+! GO TO 250
+ ENDIF
+!
+! Plot existing elements
+!
+!ipk add element type option
+ IF(IPSW(5) .EQ. 1 .OR. IPSW(4) .EQ. 1 .or. ipsw(7) .eq. 1) THEN
+! CALL PLOTT(0.,7.0,3)
+! CALL PLOTT(10.,7.0,2)
+!IPK JAN98
+ IERC=imz
+ if(ne .gt. 0) then
+ DO 20 J=1,NE
+ XC(J)=VOID
+ YC(J)=VOID
+! IF(MOD(J,10) .EQ. 0) THEN
+! CALL CHINT(IFLAG)
+! IF(IFLAG .EQ. 'i') GO TO 250
+! ENDIF
+ IF(IESKP(J) .EQ. 0) THEN
+!IPK JAN98 ADD IERC
+ IF (IMAT(J) .NE. 0) CALL PLTELM(J,IERC)
+ ENDIF
+20 CONTINUE
+ IF(IERC .GT. 0) THEN
+! call clscrn()
+! WRITE(LIND,*) ' Zero node corner nodes'
+! call symbl &
+! & (1.1,5.5,0.25,LIND,0.0,80)
+! WRITE(LIND,*) ' See MESSAGES.OUT file for details'
+! call symbl &
+! & (1.1,5.2,0.25,LIND,0.0,80)
+! WRITE(LIND,*) ' Press enter to terminate'
+! call symbl &
+! & (1.1,4.9,0.25,LIND,0.0,80)
+! ndig=1
+! CALL GTCHARX(IFLAG,NDIG,5.0,5.5)
+! CALL QUIT_PGM()
+! stop
+ CALL WMessageBox(0,0,0,'Error in element connnection'//&
+ CHAR(13)//'Zero corner node found'//&
+ CHAR(13)//'See Mesgen.out for details',&
+ 'ERROR IN ELEMENT CONNECTIONS')
+
+ ENDIF
+ endif
+ ENDIF
+ if(IDDSW .EQ. 0) then
+ call backc(2)
+ endif
+!ycw mar97 add for cross section
+ if(ICRS.ne.0) then
+ call plott(XPCS(1),YPCS(1),3)
+ call RRED
+ call plott(XPCS(2),YPCS(2),2)
+ do i=1,NCSNOD
+ xpl(1)=XCND(i)-0.04
+ ypl(1)=YCND(i)-0.04
+ xpl(2)=XCND(i)+0.04
+ ypl(2)=ypl(1)
+ xpl(3)=xpl(2)
+ ypl(3)=YCND(i)+0.04
+ xpl(4)=xpl(1)
+ ypl(4)=ypl(3)
+ xpl(5)=xpl(1)
+ ypl(5)=ypl(1)
+ call polyfl(xpl,ypl,5,1)
+ enddo
+ call RBLACK
+ endif
+!ycw
+250 continue
+ IF(NTRACT .GT. 0) THEN
+ DO KK=1,NTRACT
+ XLIN(KK)=CORD(ITRAC(KK),1)
+ YLIN(KK)=CORD(ITRAC(KK),2)
+ ENDDO
+ CALL RRED
+!ipk jan01
+ CALL THICKL
+ CALL DASHLN(XLIN,YLIN,NTRAC,0)
+!ipk jan01
+ CALL RBLACK
+ CALL THINL
+ call pltnod(ITRAC(1),0)
+ call pltnod(ITRAC(NTRACT),0)
+ ENDIF
+
+ IF (IPSW(8) .EQ. 1) CALL PGRID
+
+!IPK JAN01
+ IF(IPSW(10) .EQ. 1) CALL PLOTCC
+
+!ipk oct02
+ IF(IPSW(11) .EQ. 1) CALL PLOTCSTR
+
+!ipk oct03
+ IF(IPSW(12) .EQ. 1) CALL PLOTCRSS(0)
+
+ if(ipsw(13) .eq. 1) call plotcrss(1)
+
+ IF(INREORD .EQ. 1) THEN
+ CALL PLOTORDS
+ ENDIF
+
+ IF(IMZ .NE. 1) THEN
+ CALL DOPLOT(IMZ)
+ ENDIF
+ CALL CHEXIT
+ RETURN
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE PLTNOD(J,ICOL)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! Plot nodes on screen
+!
+ HT = .20
+ IF (CORD(J,1) .LT. VDX) RETURN
+ X = CORD(J,1)
+ Y = CORD(J,2)
+ CALL PLOTT(X,Y,3)
+ CALL PLOTT(X,Y,2)
+ IF(ICOL .EQ. 0 .OR. ICOL .EQ. 1) THEN
+ Y = Y+0.07
+ FPN = J
+ ELSEIF(ICOL .EQ. 2) THEN
+ Y = Y+0.07
+ FPN = LAY(J)
+ IF(LAY(J) .EQ. -9999) GO TO 500
+ ELSE
+!ipk jul02 Y = Y-0.11
+ Y = Y+0.10
+!ipk jul02 FPN=WD(J)*10.
+ fpn=wd(j)
+ if(icrin .eq. 23) fpn=wd1(j)
+ ENDIF
+ IF(IJUN(J) .NE. 0) THEN
+ Y=Y-0.17*FLOAT(IJUN(J)-2)
+ ENDIF
+ IF(ICOL .LT. 1) THEN
+ CALL RRed
+ if(lock(j) .eq. 1) call rgreen
+ ELSE
+ CALL RBlack
+ ENDIF
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+! ipk mar01
+! ipk jul02
+ if(icol .lt. 0) then
+ call numbr(x,y,0.12,fpn,0.0,-icol)
+ else
+ CALL NUMBR(X,Y,0.15,FPN,0.0,-1)
+ endif
+ ENDIF
+ ENDIF
+ 500 CONTINUE
+ CALL RBlue
+!
+ END
+!
+!****************************************************************
+!
+!IPK JAN98 SUBROUTINE PLTELM(J)
+ SUBROUTINE PLTELM(J,IERC)
+
+ USE BLK1MOD
+!ipk jan99
+
+ INCLUDE 'TXFRM.COM'
+ INCLUDE 'BFILES.I90'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ DIMENSION XLIN(9),YLIN(9),BLVL(9)
+!
+! INCLUDE 'BLK1.COM'
+ CHARACTER*1 IJNK
+ CHARACTER*80 LIND
+!
+! Plot elements already formed
+!
+ imz=ierc
+ ierc=0
+ call rblue
+ IF (IMAT(J) .EQ. 0 ) RETURN
+ NCN = NCORN(J)
+!
+ XXC = 0.
+ YYC = 0.
+ NLINP=0
+ IESKP(J)=1
+ DO 15 K=1,NCN
+ N = NOP(J,K)
+ IF (N .EQ. 0 .AND. MOD(K,2) .EQ. 1) THEN
+ CALL SETD(23)
+! CALL CLSCRN()
+!IPK JAN98 WRITE(*,*) ' Zero node corner node'
+!IPK JAN98 WRITE(*,*) ' ELEM, NOP(ELEM,K) '
+!IPK JAN98 WRITE(*,'(I5,I10,7I5)') J,(NOP(J,KK),KK=1,NCN)
+ WRITE(90,*) ' ELEM, NOP(ELEM,K) '
+ WRITE(90,'(I5,I10,7I5)') J,(NOP(J,KK),KK=1,NCN)
+!IPK JAN98 WRITE(*,*) 'Press enter to exit'
+!IPK JAN98 READ(*,'(A)') IJNK
+!IPK JAN98 CALL Quit_Pgm
+!IPK JAN98 STOP
+ IERC=IERC+1
+ do kk=1,8
+ nop(j,kk)=0
+ enddo
+ imat(j)=0
+ RETURN
+ ENDIF
+!
+! IF (N .EQ. 0 .OR. CORD(N,1) .LT. VDX) GOTO 15
+ IF (N .EQ. 0) GO TO 15
+ IF(MOD(K,2) .EQ. 1 .AND. CORD(N,1) .LT. VDX) GOTO 15
+ IF(CORD(N,1) .LT. VDX) THEN
+ IF(K .EQ. NCN) THEN
+ X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,1),1))/2.
+ Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,1),1))/2.
+ ELSE
+ X=(CORD(NOP(J,K-1),1)+CORD(NOP(J,K+1),1))/2.
+ Y=(CORD(NOP(J,K-1),2)+CORD(NOP(J,K+1),1))/2.
+ ENDIF
+ ELSE
+!
+ X = CORD(N,1)
+ Y = CORD(N,2)
+ ENDIF
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ IESKP(J)=0
+ GO TO 16
+ ENDIF
+ ENDIF
+ 15 END DO
+ 16 CONTINUE
+!
+ IF(IESKP(J) .EQ. 1) GO TO 26
+
+ if(ipsw(7) .eq. 1 .and. iqsw(2) .GT. 0) then
+ IF(IQSW(2) .EQ. 1) ittmp=imat(j)
+ IF(IQSW(2) .EQ. 2) ittmp=igrpser(j)
+ IF(ITTMP .GT. 900 ) THEN
+ ICCT=MOD(ITTMP+1,10)+4
+ ELSE
+ icct=MOD(ittmp,10)+4
+ ENDIF
+ if(imz .ne. 2) then
+ call fillemc(j,icct)
+ endif
+ endif
+
+ DO 25 K=1,NCN
+ N = NOP(J,K)
+!
+ IF (N .EQ. 0) go to 25
+ IF (CORD(N,1) .LT. VDX) GOTO 25
+!
+ X = CORD(N,1)
+ Y = CORD(N,2)
+!
+ IF (NCN .NE. 5 .OR. K .LT. 5) THEN
+ IF (MOD(K,2) .EQ. 1) THEN
+ XXC = XXC + X
+ YYC = YYC + Y
+ ENDIF
+ ENDIF
+ NLINP=NLINP+1
+!
+ XLIN(NLINP)=X
+ YLIN(NLINP)=Y
+ BLVL(NLINP)=WD(N)
+ IF (K .EQ. 1) THEN
+ X1 = X
+ Y1 = Y
+ ENDIF
+ 25 END DO
+ IF(NCN .GT. 5) THEN
+ NLINP=NLINP+1
+ XLIN(NLINP)=X1
+ YLIN(NLINP)=Y1
+ BLVL(NLINP)=WD(NOP(J,1))
+ ENDIF
+ if(i3dview .eq. 1) then
+ do k=1,nlinp
+ YLIN(K)=YLIN(K)+(BLVL(K)-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
+ enddo
+ endif
+!ipkoct93
+ if(ipsw(4) .eq. 1) then
+ if(ncn .eq. 8 .or. imat(j) .lt. 901) then
+ CALL DASHLN(XLIN,YLIN,NLINP,0)
+ endif
+ endif
+! IF(IMAT(J) .LT. 901 .AND. IPSW(4) .EQ. 1)
+! + CALL DASHLN(XLIN,YLIN,NLINP,0)
+!ipkoct93
+!
+! Plot elem number at center if IPSW(5) = 1
+!
+ CALL RCyan
+ IF (NCN .EQ. 3 .OR. NCN .EQ. 5) NCN = 4
+ XC(J) = 2.*XXC/NCN
+ YC(J) = 2.*YYC/NCN
+! IF(IMAT(J) .GT. 900 ) THEN
+ IF(IMAT(J) .GT. 900 .and. ncorn(j) .ne. 8) THEN
+ CALL RBlue
+ RETURN
+ ENDIF
+!ipk feb99 add element type option
+ IF(IPSW(5) .EQ. 1 .or. ipsw(7) .eq. 1) THEN
+ HT = .20
+ if(ipsw(5) .eq. 1) then
+ FPN = J
+!ipk mar00 fix imat display bug
+ elseif((iqsw(1) .gt. 0) .or. (iqsw(1) .eq. 0 .and. iqsw(2) .eq. 0) ) then
+ CALL RBLACK
+ if(iqsw(1) .eq. 1) fpn=imat(j)
+ if(iqsw(1) .eq. 2) fpn=igrpser(j)
+! elseif(iqsw(2) .eq. 1) then
+! CALL RBLACK
+! fpn=imat(j)
+ else
+ go to 30
+ endif
+ IF(XC(J) .GT. 0. .AND. XC(J) .LT. HSIZE) THEN
+ IF(YC(J) .GT. 0. .AND. YC(J) .LT. 7.5) THEN
+!ipkoct93
+! IF(IMAT(J) .LT. 901) CALL NUMBR(XC(J),YC(J),HT,FPN,0.0,-1)
+! ipk mar01
+!ipk jun02
+ xxc=xc(j)
+ yyc=yc(j)
+ CALL NUMBR(XXC,YYC,0.15,FPN,0.0,-1)
+ ENDIF
+! elseif(iqsw(2) .eq. 1) then
+! CALL RBLACK
+! fpn=imat(j)
+ endif
+ 30 continue
+ ENDIF
+
+!ipk jan99 add plot of 1-d element widths
+ if(ncorn(j) .eq. 3 .or. ncorn(j) .eq. 5) then
+ ncn=3
+ n1=nop(j,1)
+ n2=nop(j,3)
+!
+!...... first for widths
+
+ IF(IPW1 .EQ. 1) THEN
+ wd11=width(n1)/txscal
+ wd2=width(n2)/txscal
+ ELSE
+ IF(NRIVCR1(N1) .EQ. 0 .AND. NRIVCR2(N1) .EQ. 0) RETURN
+ IF(NRIVCR1(N2) .EQ. 0 .AND. NRIVCR2(N2) .EQ. 0) RETURN
+ BT1= &
+ CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
+ CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
+ BT2= &
+ CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
+ CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
+ H1=WIDEL-BT1
+ H2=WIDEL-BT2
+ CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
+ CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
+ WIDTH(N1)=WR1
+ WIDTH(N2)=WR2
+ IF(IPW1 .EQ. 2) THEN
+ WD11=WR1*WIDSCL/TXSCAL
+ WD2=WR2*WIDSCL/TXSCAL
+ ELSE
+ WD11=AR1*WIDSCL/TXSCAL
+ WD2=AR2*WIDSCL/TXSCAL
+ ENDIF
+
+ ENDIF
+ if(wd11 .gt. 0. .and. wd2 .gt. 0.) then
+ x1= cord(n1,1)
+ x2= cord(n2,1)
+ y1= cord(n1,2)
+ y2= cord(n2,2)
+ eldir=atan2(y2-y1,x2-x1)
+ elnorm=eldir-1.5708
+ xlin(1)=x1+cos(elnorm)*wd11/2.
+ xlin(5)=xlin(1)
+ xlin(4)=x1-cos(elnorm)*wd11/2.
+ xlin(2)=x2+cos(elnorm)*wd2/2.
+ xlin(3)=x2-cos(elnorm)*wd2/2.
+ ylin(1)=y1+sin(elnorm)*wd11/2.
+ ylin(5)=ylin(1)
+ ylin(4)=y1-sin(elnorm)*wd11/2.
+ ylin(2)=y2+sin(elnorm)*wd2/2.
+ ylin(3)=y2-sin(elnorm)*wd2/2.
+ call dashln(xlin,ylin,5,0)
+ endif
+
+!...... then for storage widths
+
+ wd11=(wids(n1)+width(n1))/txscal
+ wd2=(wids(n2)+width(n2))/txscal
+ if(wids(n1) .gt. 0. .and. wids(n2) .gt. 0.) then
+ x1= cord(n1,1)
+ x2= cord(n2,1)
+ y1= cord(n1,2)
+ y2= cord(n2,2)
+ eldir=atan2(y2-y1,x2-x1)
+ elnorm=eldir-1.5708
+ xlin(1)=x1+cos(elnorm)*wd11/2.
+ xlin(5)=xlin(1)
+ xlin(4)=x1-cos(elnorm)*wd11/2.
+ xlin(2)=x2+cos(elnorm)*wd2/2.
+ xlin(3)=x2-cos(elnorm)*wd2/2.
+ ylin(1)=y1+sin(elnorm)*wd11/2.
+ ylin(5)=ylin(1)
+ ylin(4)=y1-sin(elnorm)*wd11/2.
+ ylin(2)=y2+sin(elnorm)*wd2/2.
+ ylin(3)=y2-sin(elnorm)*wd2/2.
+ call dashln(xlin,ylin,5,1)
+ endif
+ endif
+
+
+ CALL RBlue
+ 26 CONTINUE
+!
+ RETURN
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE PLTMAP
+!
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! Plot map of input data
+!
+! Determine how long each line is
+!
+ JS=1
+!
+ K=0
+ CALL RCyan
+ DO 20 J=1,MAXPTS
+ MLEN=J-JS
+! write(90,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx
+! write(123,*) 'j,mlen',j,mlen,cmap(j,1),k+1,lintyp(k+1),vdx
+ IF(XMAP(J) .LE. VDX .or. j .eq. maxpts) THEN
+ if(j .eq. maxpts .and. xmap(j) .gt. vdx) mlen=mlen+1
+!
+! Now draw it.
+!
+ K=K+1
+ IF(MLEN .GT. 1) THEN
+ LTP=LINTYP(K)
+!ipk oct96
+ if(icolon(ltp+1) .eq. 1) then
+
+ IF(LTP .NE. 2) THEN
+!ipk oct96 IF(LTP .LT. 2) THEN
+ CALL RRed
+
+! write(90,*) 'at nwpen ltp',ltp
+ IF(LTP .GT. 0) CALL NWPEN(2*LTP+1)
+ IF(LTP .GT. 2) LTP=0
+ CALL DBDASHLN(cmap(js,1),cmap(js,2),MLEN,LTP)
+ ENDIF
+ ENDIF
+ ENDIF
+ IF(MLEN .EQ. 0 .AND. LINTYP(K) .EQ. -999) GO TO 30
+ JS=J+1
+ ENDIF
+ 20 CONTINUE
+ 30 CONTINUE
+ CALL RBlue
+ RETURN
+!
+ END
+!
+!***********************************************************************
+!
+ SUBROUTINE SCLMAP
+!
+! Scale map coordinates for plotting
+! Keep track and update information for mapping
+! screen coordinates back to user coordinates
+!
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+!ipk may94 moved to blk1.com DATA XREF,YREF / 0.0, 0.0 /
+!
+ DO 10 J=1,MAXPTS
+ IF (CMAP(J,1) .LT. VDX) GOTO 10
+ CMAP(J,1) = (CMAP(J,1)-XMIN)/PSCALE
+ CMAP(J,2) = (CMAP(J,2)-YMIN)/PSCALE
+ 10 END DO
+!
+ XREF = (XREF-XMIN)/PSCALE
+ YREF = (YREF-YMIN)/PSCALE
+ IF(IASPCT .EQ. 1) THEN
+ VRTSCAL=VRTSCAL*PSCALE
+ ENDIF
+ TXSCAL = TXSCAL*PSCALE
+ XS = XREF*TXSCAL
+ YS = YREF*TXSCAL
+ write(90,*) ' The line that follows gives the values used for a te&
+ &mporary origin and scale'
+ write(90,6000) xs,ys,txscal
+ 6000 format(3f15.4)
+!
+ RETURN
+ END
+!
+!***********************************************************************
+!
+ SUBROUTINE SCLCRD
+!
+! Scale coordinates for plotting
+! Keep track and update information for mapping
+! screen coordinates back to user coordinates
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ REAL*8 ANGPT,ANGNEW,DRAD,DVANG,DVANGOLD
+
+ DATA PI/3.14159265/,ITIME/0/,DRAD/57.29577957855/
+ IF(ITIME .EQ. 0) THEN
+ VANGOLD=90.
+ VANG=90.
+ HANG=0.
+ HANGOLD=0.
+! DRAD=180./PI
+ ITIME=1
+ ENDIF
+ DVANG=VANG
+ DVANGOLD=VANGOLD
+!
+
+! ROTATE BACK IF NEEDED
+
+
+ IF((HANGOLD .EQ. HANG) .AND. (VANGOLD .EQ. VANG)) GO TO 5
+ IF(HANGOLD .NE. 0. .OR. VANGOLD .NE. 90.) THEN
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ IF (CORD(J,1) .GE. VDX) THEN
+
+ IF(VANGOLD .LT. 90.) THEN
+ CORD(J,2)=4.+(CORD(J,2)-4.)/DSIN(DVANGOLD/DRAD)
+ ENDIF
+
+ ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
+ VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)
+ ANGNEW=ANGPT+HANGOLD
+! IF(J .EQ. 1) THEN
+! WRITE(90,*) 'ROTBACK',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
+! ENDIF
+ CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
+ CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
+! IF(J .EQ. 1) THEN
+! WRITE(90,*) CORD(J,1),CORD(J,2)
+! ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+
+ 5 CONTINUE
+
+ IF(NP .GT. 0) THEN
+ DO 10 J=1,NP
+ IF (CORD(J,1) .LT. VDX) GOTO 10
+ CORD(J,1) = (CORD(J,1)-XMIN)/PSCALE
+ CORD(J,2) = (CORD(J,2)-YMIN)/PSCALE
+ 10 CONTINUE
+ ENDIF
+!
+! ROTATE IF NEEDED
+
+ IF((HANGOLD .EQ. HANG) .AND. (VANGOLD .EQ. VANG)) GO TO 15
+
+ IF(HANG .NE. 0 .OR. VANG .LT. 90.) THEN
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ IF (CORD(J,1) .GE. VDX) THEN
+ ANGPT=DATAN2D(CORD(J,2)-4,CORD(J,1)-5.)
+ VLEN=SQRT((CORD(J,1)-5.)**2+(CORD(J,2)-4.)**2)
+ ANGNEW=ANGPT-HANG
+! IF(J .EQ. 1) THEN
+! WRITE(90,*) 'ROT',ANGPT,VLEN,ANGNEW,CORD(J,1),CORD(J,2)
+! ENDIF
+ CORD(J,1)=5.+VLEN*DCOS(ANGNEW/DRAD)
+ CORD(J,2)=4.+VLEN*DSIN(ANGNEW/DRAD)
+ IF(VANG .LT. 90.) THEN
+ CORD(J,2)=4.+(CORD(J,2)-4.)*DSIN(DVANG/DRAD)
+ ENDIF
+! IF(J .EQ. 1) THEN
+! WRITE(90,*) CORD(J,1),CORD(J,2)
+! ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ HANGOLD=HANG
+ VANGOLD=VANG
+
+ 15 CONTINUE
+
+ RETURN
+!
+ END
+ SUBROUTINE BOX(HEAD,NSIZ)
+!
+! Routine to draw NSIZ header boxes at top of page with the HEAD label
+!
+ CHARACTER*8 HEAD(*)
+ XSY=0.
+ XLMT=FLOAT(NSIZ)
+ DO 200 N=1,NSIZ
+ CALL SYMBL(XSY,7.65,0.20,HEAD(N),0.0, 8)
+ XSY=XSY+1.0
+ 200 CONTINUE
+!
+! Draw box around selections
+!
+ CALL PLOTT(0.0,7.0,3)
+ CALL PLOTT(XLMT,7.0,2)
+ CALL PLOTT(XLMT,7.495,2)
+ CALL PLOTT(0.0,7.495,2)
+ CALL PLOTT(0.0,7.0,2)
+ XPT=0.
+ DO 205 I=1,NSIZ
+ XPT=XPT+1.0
+ CALL PLOTT(XPT,7.0,3)
+ CALL PLOTT(XPT,7.495,2)
+ 205 CONTINUE
+ RETURN
+ END
+ SUBROUTINE BOXR(NBOX)
+ SAVE
+!
+! Routine to draw header box at top right of page with the HEAD label
+!
+ CHARACTER*24 HEAD
+ CHARACTER*16 HEAD1
+ CHARACTER*24 HEAD2
+ DIMENSION X(5),Y(5)
+ DATA HEAD /' (z)oom r(d)raw (q)uit '/
+ DATA HEAD1 /' r(d)raw (q)uit '/
+ DATA HEAD2 /' (n)ext (z)oom (q)uit '/
+!
+! Draw box around selections
+!
+ NBX=IABS(NBOX)
+ XLEFT=10-NBX
+ Y(1)=7.5
+ Y(2)=7.5
+ Y(3)=7.995
+ Y(4)=7.995
+ Y(5)=7.5
+! CALL PLOTT(XLEFT,7.0,3)
+! CALL PLOTT(10.0,7.0,2)
+! CALL PLOTT(10.0,7.495,2)
+! CALL PLOTT(XLEFT,7.495,2)
+! CALL PLOTT(XLEFT,7.0,2)
+! IF(NBOX .GT. 1) THEN
+ DO 200 K=1,NBX
+ X(1)=XLEFT
+ X(4)=XLEFT
+ X(5)=XLEFT
+ XLEFT=XLEFT+1.0
+ X(2)=XLEFT
+ X(3)=XLEFT
+ IBLK=4
+ CALL POLYFL(X,Y,5,IBLK)
+ CALL RBLACK
+ CALL PLOTT(X(1),Y(1),3)
+ CALL PLOTT(X(2),Y(2),2)
+ CALL PLOTT(X(3),Y(3),2)
+ CALL PLOTT(X(4),Y(4),2)
+ CALL PLOTT(X(1),Y(1),2)
+! DO 200 K=1,NBOX-1
+! XLEFT=XLEFT+1.
+! CALL PLOTT(XLEFT,7.0,3)
+! CALL PLOTT(XLEFT,7.495,2)
+ 200 END DO
+! ENDIF
+!
+! Establish label
+!
+ IF(NBOX .EQ. 3) THEN
+ CALL SYMBL(7.0,7.65,0.20,HEAD,0.0,24)
+ ELSEIF(NBOX .EQ. -3) THEN
+ CALL SYMBL(7.0,7.65,0.20,HEAD2,0.0,24)
+ ELSEIF(NBOX .EQ. 2) THEN
+ CALL SYMBL(8.0,7.65,0.20,HEAD1,0.0,16)
+ ENDIF
+ RETURN
+ END
+!
+!
+ SUBROUTINE OUTLN
+!-
+!......OUTLN DRAWS BOUNDARIES FOR THE SYSTEM
+!-
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! INTEGER*2 MSN
+! COMMON /MID/ MSN(MAXP)
+!
+ DATA IFIRST / 1 /
+!-
+!-
+! DATA MAXB/MAXE/
+ YMAXX = 7.50
+!-
+!-.....PLOT BOUNDARY OUTLINE.....
+!-
+! 100 DO 110 J=1,MAXB
+! NBP(J) = 0
+! 110 CONTINUE
+!
+ IF (IFIRST .EQ. 1) GOTO 185
+ IFIRST = 0
+!
+ NPTS=-1
+! READ(5,5020) NPTS
+! 5020 FORMAT( 16I5 )
+ IF( NPTS .EQ. 0 ) RETURN
+ 185 CONTINUE
+ DO 186 I=1,NP
+ 186 MSN(I) = 0
+ DO 187 J=1,NE
+ IF(IESKP(J) .NE. 0) GO TO 187
+ IF (IMAT(J) .LE. 0) GOTO 187
+ IF (IMAT(J) .GT. 900) GO TO 187
+ NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ IF (NOP(J,6) .EQ. 0) NCN=3
+ DO 188 K=2,NCN,2
+ N = NOP(J,K)
+ if(n .gt. 0) then
+ MSN(N) = MSN(N) + 1
+ endif
+ 188 CONTINUE
+ 187 END DO
+ DO 195 J = 1, NE
+ IF(IESKP(J) .NE. 0) GO TO 195
+ IF(IMAT(J) .LE. 0) GO TO 195
+!ipkoct93
+! IF(IMAT(J) .GT. 900) GO TO 195
+ IF(IMAT(J) .GT. 900 .and. nop(j,7) .eq. 0) GO TO 195
+ NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ IF (NOP(J,6) .EQ. 0) NCN=3
+ DO 194 K = 2,NCN , 2
+ L=NOP(J,K)
+ IF(L .EQ. 0) GO TO 194
+ IF(MSN(L) .EQ. 1) THEN
+ N1 = NOP(J,K-1)
+ N2 = NOP(J,K)
+ N3 = MOD(K+1,NCN)
+ IF(N3 .EQ. 0) N3=NCN
+ N3 = NOP(J,N3)
+ X1 = CORD(N1,1)
+ Y1 = CORD(N1,2)
+ X2 = CORD(N2,1)
+ Y2 = CORD(N2,2)
+ X3 = CORD(N3,1)
+ Y3 = CORD(N3,2)
+ CALL FIT(X1,Y1,X2,Y2,X3,Y3)
+ ENDIF
+ 194 CONTINUE
+ 195 END DO
+ RETURN
+ END
+ SUBROUTINE AROHD(XPAGE,YPAGE,XTIP,YTIP,AHLEN,AHWID,ICODE)
+!*********************************** .....AROHD.....
+ SAVE
+!
+ IF(AHWID.LE.0.001) AHWID=AHLEN
+ I1=ICODE/10+3
+ IF(I1.NE.3) I1=2
+ KK=MOD(ICODE,10)
+ I2=2
+ I3=2
+ I4=2
+ IF(KK.EQ.2) GO TO 10
+ IF(KK.NE.4) GO TO 20
+ I3=3
+ GO TO 10
+ 20 IF(KK.NE.5) GO TO 30
+ I2=3
+ I3=3
+ GO TO 10
+ 30 IF(KK.NE.8) GO TO 10
+ I2=3
+ I3=3
+ I4=4
+ 10 CONTINUE
+ CALL PLOTT(XPAGE,YPAGE,3)
+ CALL PLOTT(XTIP,YTIP,I1)
+ TX=XTIP-XPAGE
+ TY=YTIP-YPAGE
+ XLEN=SQRT(TX**2+TY**2)
+ IF(XLEN .GT. 0.001) GO TO 200
+ XLEN=0.001
+ IF(ABS(TX) .LT. 0.001) TX=SIGN(0.001,TX)
+ IF(ABS(TY) .LT. 0.001) TY=SIGN(0.001,TY)
+ 200 CONTINUE
+ TA=AHLEN/XLEN
+ XX=XTIP-TA*TX
+ YY=YTIP-TA*TY
+ AH=(AHWID/2.)**2
+ DY=SQRT(AH*TX**2/(TX**2+TY**2))
+ DY = SIGN(DY,TX)
+ DX=SQRT(AH*TY**2/(TX**2+TY**2))
+ DX = SIGN(DX,TY)
+ X1=XX+DX
+ X2=XX-DX
+ Y1=YY+DY
+ Y2=YY-DY
+ CALL PLOTT(X2,Y1,I2)
+ CALL PLOTT(X1,Y2,I3)
+ CALL PLOTT(XTIP,YTIP,I4)
+ RETURN
+ END
+!
+!$$$ AUG 1987
+! SUBROUTINE TEST(X,Y,IG)
+!
+!...... Routine to that plot is on paper
+!
+! SAVE
+!
+!
+! IG=0
+! IF(X .LT. 0. ) RETURN
+! IF(X .GT. 10.) RETURN
+! IF(Y .LT. 0. ) RETURN
+! IF(Y .GT. 7.0) RETURN
+! IG=1
+! RETURN
+! END
+!
+ SUBROUTINE FIT(X1,Y1,X2,Y2,X3,Y3)
+ SAVE
+!
+ INTEGER I2,I3,IG
+ common /tek/ itek
+
+ DATA I2/2/,I3/3/
+ NPTS = 7
+ DS = 1.0/FLOAT(NPTS)
+ S = 0.0
+! IG=0
+! CALL TEST(X1,Y1,IT)
+! IF(IT .GT. 0) THEN
+ CALL PLOTT(X1,Y1,I3)
+ IG=I3
+! ENDIF
+
+ dx3 = x1-x3
+ dx2 = x1-x2
+ dy3 = y1-y3
+ dy2 = y1-y2
+ if (abs(dx2) .le. 1.E-8) dx2 = 1.E-8
+ if (abs(dx3) .le. 2.E-8) dx3 = 2.E-8
+! call test(x3,y3,itt)
+ if (abs(dy3/dx3 - dy2/dx2) .le. abs(.01*dy2/dx2)) then
+! .and.
+! + itt .gt. 0 .and. it .gt. 0) then
+ call plott(x3,y3,i2)
+ else
+
+ DO 100 J = 1, NPTS
+ S = S + DS
+ XN1 = 1.0-3.0*S+2.0*S**2
+ XN2 = 4.0*S*(1.0-S)
+ XN3 = S*(2.0*S-1.0)
+ X= XN1*X1 + XN2*X2 + XN3*X3
+ Y = XN1*Y1 + XN2*Y2 + XN3*Y3
+! CALL TEST(X,Y,IT)
+! IF(IT .GT. 0) THEN
+! IF(IG .EQ. 0) THEN
+! IG=I3
+! ELSE
+ IG=I2
+! ENDIF
+ CALL PLOTT(X,Y,IG)
+! ELSE
+! IG=0
+! ENDIF
+ 100 END DO
+ endif
+
+ RETURN
+ END
+!
+!****************************************************************
+!
+ SUBROUTINE PGRID
+!
+! Form rectangular grid for guide lines by filling map arrays
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+
+ INCLUDE 'TXFRM.COM'
+
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ DIMENSION XG(2),YG(2)
+!
+ DATA IFIRST / 1 /
+!
+ IF (IFIRST .EQ. 1) THEN
+ DX = 10.
+ DY = 10.
+ X0 = -100.
+!ipk sep94 update to 7.5 size Y0 = -70.
+ Y0 = -75.
+ X9 = HSIZE*10.
+!ipk sep94 update to 7.5 size Y9 = 70.
+ Y9 = 75.
+!
+ IF (XMIN .GT. -VDX) THEN
+ XMIN = -100.
+ XMAX = -XMIN
+ IPSW(8) = 1
+ ENDIF
+ IF (YMIN .GT. -VDX) THEN
+!ipk sep94 update to 7.5 size YMIN = -70.
+ YMIN = -75.
+ YMAX = -YMIN
+ IPSW(8) = 1
+ ENDIF
+!
+ IFIRST = 0
+ RETURN
+!
+ ELSE
+! XDIF = TXSCAL * 10.5
+ XDIF = TXSCAL * HSIZE*1.05
+ IXDIF = IFIX( LOG10(XDIF) )
+ XRANGE = 10**IXDIF
+ XFAC = XDIF/XRANGE
+ DX = XRANGE/10.
+ IF ( XFAC .GE. 5.) THEN
+ DX = 5.*DX
+ ELSEIF (XFAC .GE. 2.) THEN
+ DX = 2.*DX
+ ENDIF
+!
+ X0 = -NINT(XS/DX - .5) * DX - DX
+ X9 = X0 + XDIF
+!
+ DY = DX
+!ipk sep94 update to 7.5 scale YDIF = .70*XDIF
+ YDIF = .75*XDIF
+ Y0 = -NINT(YS/DY -.5) * DY - DY
+ Y9 = Y0 + YDIF
+
+ ENDIF
+!
+! vertical-grid lines
+ LTP = 0
+ MLEN = 2
+ HT = .18
+!
+ DO 10 CX = X0,X9, DX
+ XG(1) = (CX + XS)/TXSCAL
+ YG(1) = (Y0 + YS)/TXSCAL
+ XG(2) = XG(1)
+ YG(2) = (Y9 + YS)/TXSCAL
+ CALL NWPEN(8)
+ CALL DASHLN(XG,YG,MLEN,LTP)
+!
+ FPN = CX
+ IF (AMOD(FPN,1.) .EQ. 0. .OR. ABS(FPN) .LT. 0.01) THEN
+ IPLC = -1
+ ELSE
+ IPLC = 1
+ ENDIF
+ X = XG(1)
+! Y = YG(1) + .02
+!ipk oct98 change y location
+ Y = .20
+ IF ( (X .GT. 0. .AND. X .LT. HSIZE) .AND. &
+ & (Y .GT. 0. .AND. Y .LT. 7.5) ) THEN
+!ipk sep94 change colour CALL NWPEN(12)
+ CALL NWPEN(8)
+! ipk mar01
+ CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC)
+ ENDIF
+ 10 END DO
+!
+! horizontal-grid lines
+ DO 20 CY = Y0,Y9, DY
+ XG(1) = (X0 + XS)/TXSCAL
+ YG(1) = (CY + YS)/TXSCAL
+ XG(2) = (X9 + XS)/TXSCAL
+ YG(2) = YG(1)
+ CALL NWPEN(8)
+ CALL DASHLN(XG,YG,MLEN,LTP)
+!
+ FPN = CY
+ IF (AMOD(FPN,1.) .EQ. 0. .OR. ABS(FPN) .LT. 0.01) THEN
+ IPLC = -1
+ ELSE
+ IPLC = 1
+ ENDIF
+! X = XG(1)
+ X = .02
+ Y = YG(1)
+ IF ( (X .GT. 0. .AND. X .LT. HSIZE) .AND. &
+ & (Y .GT. 0. .AND. Y .LT. 7.5) ) THEN
+!ipk sep94 change color CALL NWPEN(12)
+ CALL NWPEN(8)
+! ipk mar01
+ CALL NUMBR(X,Y,0.15,FPN,0.0,IPLC)
+ ENDIF
+ 20 END DO
+!
+ CALL RBlue
+!
+ END
+
+ SUBROUTINE RESCAL
+!
+! Scale for plotting
+!
+!
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ VDX = - 1.0E+10
+ XREF=0.
+ YREF=0.
+!
+! Reset map coordinates to original scale
+!
+ IF(MAXPTS .GT. 0) THEN
+ DO J=1,MAXPTS
+ IF(CMAP(J,1) .GE. VDX) THEN
+ CMAP(J,1)=TXSCAL*CMAP(J,1) - XS
+ CMAP(J,2)=TXSCAL*CMAP(J,2) - YS
+ ENDIF
+ ENDDO
+ ENDIF
+!
+! Reset nodal coordinates
+!
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ CORD(J,1) = XUSR(J)
+ CORD(J,2) = YUSR(J)
+ ENDDO
+ ENDIF
+!ycw mar97 add for cross section
+ if(ICRS.ne.0) then
+ do i=1,2
+ XPCS(i)=XPCS(i)*TXSCAL - XS
+ YPCS(i)=YPCS(i)*TXSCAL - YS
+ enddo
+ do i=1,NCSNOD
+ XCND(i)=XCND(i)*TXSCAL - XS
+ YCND(i)=YCND(i)*TXSCAL - YS
+ enddo
+ endif
+!ycw
+!
+! Reset controlling scales
+!
+ TXSCAL = 1.
+ XS=0.
+ YS=0.
+ XMIN = 1.E+20
+ XMAX = -XMIN
+ YMIN = 1.E+20
+ YMAX = -YMIN
+ IF(IMP .GT. 0) THEN
+!
+! Find max and min
+!
+!
+ DO J=1,MAXPTS
+ IF (CMAP(J,1) .GT. VDX) THEN
+ IF (CMAP(J,1) .LT. XMIN) XMIN = CMAP(J,1)
+ IF (CMAP(J,1) .GT. XMAX) XMAX = CMAP(J,1)
+ IF (CMAP(J,2) .LT. YMIN) YMIN = CMAP(J,2)
+ IF (CMAP(J,2) .GT. YMAX) YMAX = CMAP(J,2)
+ ENDIF
+ ENDDO
+ ENDIF
+!
+ IF(NP .GT. 0) THEN
+ DO J=1,NP
+ IF (CORD(J,1) .GT. VDX) THEN
+ INSKP(J)=0
+ IF (CORD(J,1) .LT. XMIN) XMIN = CORD(J,1)
+ IF (CORD(J,1) .GT. XMAX) XMAX = CORD(J,1)
+ IF (CORD(J,2) .LT. YMIN) YMIN = CORD(J,2)
+ IF (CORD(J,2) .GT. YMAX) YMAX = CORD(J,2)
+ ENDIF
+ ENDDO
+ ENDIF
+ IF(NE .GT. 0) THEN
+ DO J=1,NE
+ IF(NOP(J,1) .NE. 0) THEN
+ IESKP(J)=0
+ ENDIF
+ ENDDO
+ ENDIF
+!
+!
+ DO J=1,NBKFL
+ XMAX=MAX(XMAX,BFMINMAX(J,1),BFMINMAX(J,3))
+ XMIN=MIN(XMIN,BFMINMAX(J,1),BFMINMAX(J,3))
+ YMAX=MAX(YMAX,BFMINMAX(J,2),BFMINMAX(J,4))
+ YMIN=MIN(YMIN,BFMINMAX(J,2),BFMINMAX(J,4))
+ ENDDO
+ AMAP=(XMAX-XMIN)*(YMAX-YMIN)
+ XSCALE = (XMAX-XMIN)/(hsize-0.5)
+ YSCALE = (YMAX-YMIN)/6.5
+ PSCALE = MAX(XSCALE,YSCALE)
+!
+ XAVE = (XMIN + XMAX) /2.0
+ YAVE = (YMIN + YMAX) /2.0
+ XMIN = XAVE - hsize/2.*PSCALE
+ YMIN = YAVE - 3.5*PSCALE
+ XMAX = XAVE + (hsize-0.5)/2.*PSCALE
+ YMAX = YAVE + 3.25*PSCALE
+!
+! Plot all data
+!
+ CALL PLOTSV(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ RETURN
+ END
+
+!IPK JAN01 NEW ROUTINE
+
+ SUBROUTINE PLOTCC
+
+ USE BLK1MOD
+ use blk2mod
+! INCLUDE 'BLK1.COM'
+ DIMENSION XLIN(350),YLIN(350)
+
+ IF(NCLM .GT. 0) THEN
+
+!Process each line
+ CALL RBLUE
+
+ DO NCLL=1,NCLM
+ WRITE(90,*) 'PLOTR1-1130 NCLL,NCLM',NCLL,NCLM
+ DO KK=1,350
+ IF(ICCLN(NCLL,KK) .NE. 0) THEN
+ IF(KK .EQ. 1) THEN
+ X=CORD(ICCLN(NCLL,KK),1)+0.1
+ Y=CORD(ICCLN(NCLL,KK),2)+0.1
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ FPN=NCLL
+! ipk mar01
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ ENDIF
+ ENDIF
+ ENDIF
+ XLIN(KK)=CORD(ICCLN(NCLL,KK),1)
+ YLIN(KK)=CORD(ICCLN(NCLL,KK),2)
+ ELSE
+ if(kk .eq. 1) GO TO 510
+ NTRAC=KK-1
+ X=CORD(ICCLN(NCLL,KK-1),1)+0.1
+ Y=CORD(ICCLN(NCLL,KK-1),2)+0.1
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ FPN=NCLL
+! ipk mar01
+ CALL NUMBR(X,Y,0.2,FPN,0.0,-1)
+ ENDIF
+ ENDIF
+ if(ntrac .eq. 1) then
+ call IGrCharSize(0.5,0.5)
+ call IGrMarker(x-0.1,y-0.1,14)
+ call IGrCharSize(1.0,1.0)
+ endif
+!
+! Draw along line
+!
+ IF(NTRAC .GT. 1) THEN
+ CALL THICKL
+ CALL DASHLN(XLIN,YLIN,NTRAC,0)
+ CALL THINL
+ ENDIF
+ GO TO 400
+ ENDIF
+ 359 CONTINUE
+ ENDDO
+ 400 CONTINUE
+ IF(NTRAC .EQ. 1) THEN
+ NODL=ICCLN(NCLL,1)
+ DO N=1,NE
+ IF(IMAT(N) .LT. 900 .AND. IMAT(N) .GT. 0) THEN
+ IF(NCORN(N) .EQ. 5 .OR. NCORN(N) .EQ. 3) THEN
+ IF(NOP(N,1) .EQ. NODL) THEN
+ DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
+ DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
+ GO TO 420
+ ELSEIF(NOP(N,3) .EQ. NODL) THEN
+ DIRX=CORD(NOP(N,1),1)-CORD(NOP(N,3),1)
+ DIRY=CORD(NOP(N,1),2)-CORD(NOP(N,3),2)
+ GO TO 420
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ 420 DIR=ATAN2(DIRX,-DIRY)
+ D1=CORD(NODL,1)
+ D2=CORD(NODL,2)
+ ELSE
+
+! Plot arrows on continuity line
+
+ DIRX=CORD(ICCLN(NCLL,1),1)-CORD(ICCLN(NCLL,NTRAC),1)
+ DIRY=CORD(ICCLN(NCLL,1),2)-CORD(ICCLN(NCLL,NTRAC),2)
+ IF(DIRX .EQ. 0. .AND. DIRY .EQ. 0.) THEN
+ DIR=0.
+ ELSE
+ DIR=ATAN2(DIRX,-DIRY)
+ D1=(CORD(ICCLN(NCLL,1),1)+CORD(ICCLN(NCLL,NTRAC),1))/2.
+ D2=(CORD(ICCLN(NCLL,1),2)+CORD(ICCLN(NCLL,NTRAC),2))/2.
+ ENDIF
+ ENDIF
+ DIR1=DIR+2.35619
+ DIR2=DIR-2.35619
+ DE1=D1+0.4*COS(DIR)
+ DE2=D2+0.4*SIN(DIR)
+ DEA1=DE1+0.1*COS(DIR1)
+ DEA2=DE2+0.1*SIN(DIR1)
+ DEB1=DE1+0.1*COS(DIR2)
+ DEB2=DE2+0.1*SIN(DIR2)
+ CALL RBLUE
+ CALL PLOTT(D1,D2,3)
+ CALL PLOTT(DE1,DE2,2)
+ CALL PLOTT(DEA1,DEA2,2)
+ CALL PLOTT(DE1,DE2,3)
+ CALL PLOTT(DEB1,DEB2,2)
+ CALL RBLUE
+510 CONTINUE
+ ENDDO
+ ENDIF
+
+ RETURN
+ END
+
+ SUBROUTINE PLOTCSTR
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+! Plot arrows on control structures
+
+ DO N=1,NE
+ IF(IMAT(N) .GT. 903) THEN
+
+ DIRX=CORD(NOP(N,3),1)-CORD(NOP(N,1),1)
+ DIRY=CORD(NOP(N,3),2)-CORD(NOP(N,1),2)
+ IF(DIRX .EQ. 0. .AND. DIRY .EQ. 0.) THEN
+ DIR=0.
+ ELSEIF(NCORN(N) .LT. 6) THEN
+ DIR=ATAN2(DIRY,DIRX)
+ D1=CORD(NOP(N,1),1)
+ D2=CORD(NOP(N,1),2)
+ ELSE
+ DIR=ATAN2(DIRX,-DIRY)
+ D1=CORD(NOP(N,2),1)
+ D2=CORD(NOP(N,2),2)
+ ENDIF
+ DIR1=DIR+2.35619
+ DIR2=DIR-2.35619
+ IF(IESKP(N) .EQ. 0) THEN
+ D1=CORD(NOP(N,2),1)
+ D2=CORD(NOP(N,2),2)
+ DE1=D1+0.4*COS(DIR)
+ DE2=D2+0.4*SIN(DIR)
+ DEA1=DE1+0.1*COS(DIR1)
+ DEA2=DE2+0.1*SIN(DIR1)
+ DEB1=DE1+0.1*COS(DIR2)
+ DEB2=DE2+0.1*SIN(DIR2)
+ CALL RRED
+ CALL PLOTT(D1,D2,3)
+ CALL PLOTT(DE1,DE2,2)
+ CALL PLOTT(DEA1,DEA2,2)
+ CALL PLOTT(DE1,DE2,3)
+ CALL PLOTT(DEB1,DEB2,2)
+ CALL RBLUE
+ ENDIF
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE PLOTCRSS(isw)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'TXFRM.COM'
+! COMMON/ICN1/ ICN(MAXP)
+
+ CHARACTER*11 PART1,PART2
+
+ if(isw .eq. 0) then
+ CALL RGREEN
+
+ DO NN=1,NCRSEC
+ N=IVMIL(NN)
+ xpt=(xcrs(n)+xs)/txscal
+ ypt=(ycrs(n)+ys)/txscal
+ a=NOREACH(N)/1000.
+ fpn=n+a
+ IF(XPT .GT. 0. .AND. XPT .LT. HSIZE) THEN
+ IF(YPT .GT. 0. .AND. YPT .LT. 7.5) THEN
+ call plotcr(xpt,ypt,0.05)
+ CALL NUMBR(xpt,ypt-0.1,0.13,FPN,0.0,3)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+
+ IF(ISW .EQ. 1) THEN
+
+ DO J=1,MAXP
+ ICN(J)=0
+ END DO
+! First sort out the potential midsides
+! Note that transition elements caues a problem
+! Find these first
+ DO 200 N=1,NE
+ if(NCORN(N) .GT. 5) GO TO 200
+ IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
+!
+! We have a transition mark node number as if it were corner
+!
+ ICN(NOP(N,3))=1
+ ICN(NOP(N,1))=2
+ ICN(NOP(N,4))=2
+ ICN(NOP(N,5))=2
+ ELSE
+!
+! Store ICN = 2 for corner nodes
+!
+ NCN=NCORN(N)
+!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ MST=1
+ ELSE
+ MST=2
+ ENDIF
+ DO 180 M=1,NCN,MST
+ ICN(NOP(N,M))=2
+ 180 CONTINUE
+ ENDIF
+ 200 END DO
+
+ DO J=1,NP
+
+ IF(ICN(J) .EQ. 2) THEN
+ WRITE(PART1,'(I5,F6.3)') &
+ ,NRIVCR1(J),WTRIVCR1(J)
+
+ WRITE(PART2,'(I5,F6.3)') &
+ ,NRIVCR2(J),WTRIVCR2(J)
+
+ IF (CORD(J,1) .LT. VDX) GO TO 300
+ X = CORD(J,1)
+ Y = CORD(J,2)
+
+ CALL RBlack
+ IF(X .GT. 0. .AND. X .LT. HSIZE) THEN
+ IF(Y .GT. 0. .AND. Y .LT. 7.5) THEN
+ CALL SYMBL(X-0.25,Y+.24,0.10,PART1,0.0,11)
+ CALL SYMBL(X-0.25,Y+.12,0.10,PART2,0.0,11)
+ endif
+ ENDIF
+ 300 CONTINUE
+ ENDIF
+ ENDDO
+ ENDIF
+ CALL RBlue
+ RETURN
+ END
diff --git a/src/src83e/RDOUTLIN.F90 b/src/src83e/RDOUTLIN.F90
new file mode 100644
index 0000000..5b30624
--- /dev/null
+++ b/src/src83e/RDOUTLIN.F90
@@ -0,0 +1,46 @@
+ MODULE BLKOUT
+ ALLOCATABLE XOUTL(:),YOUTL(:)
+ INTEGER NOUTLIN
+ ENDMODULE
+
+ SUBROUTINE RDOUTLIN
+!
+! ROUTINE TO READ COORDINATES OF MESH OUTLINE
+
+ USE WINTERACTER
+ USE BLKOUT
+
+ CHARACTER(LEN=255) :: FNAME
+! CHARACTER(LEN=3) :: SUB,SUB1
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER*3 SUB
+
+ FILTER ="Outline files -- *.txt|*.txt|map files -- |*.map|All files -- |*.*|"
+ CALL WSelectFile(FILTER,PromptOn,FNAME,'Load Outline File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ OPEN(99,FILE=FNAME,STATUS='OLD')
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ KTYP=2
+ ELSE
+ KTYP=1
+ ENDIF
+ ELSE
+ RETURN
+ ENDIF
+
+ ALLOCATE (XOUTL(5000),YOUTL(5000))
+ IF(KTYP .EQ. 2) READ(99,*) INDM
+ DO N=1,5000
+ READ(99,*,END=500,ERR=500) XOUTL(N),YOUTL(N)
+ ENDDO
+ close(99)
+500 CONTINUE
+ NOUTLIN=N-1
+ RETURN
+ END
+
diff --git a/src/src83e/RDRM1.F90 b/src/src83e/RDRM1.F90
new file mode 100644
index 0000000..c1968e3
--- /dev/null
+++ b/src/src83e/RDRM1.F90
@@ -0,0 +1,111 @@
+ SUBROUTINE RDRM1(IFILE,NPTEMP,NETEMP,IMIDS)
+
+ SAVE
+
+ REAL*8 CX,CY
+ CHARACTER DLINE*140,ID1*3,BLANK*20
+ DIMENSION ILN(8)
+
+ data blank/' '/
+
+
+ REWIND (IFILE)
+ READ(ifile,'(A80)') TITLE
+ READ(IFILE,'(100X,I5)') IFORM1
+ READ(IFILE,'(A80)') DLINE(1:80)
+
+ IMIDS=0
+ NP=0
+ NE=0
+ NPTEMP=0
+ NETEMP=0
+
+ 100 CALL GINPT1(IFILE,DLINE)
+
+
+!ipk feb12 add format test
+ IF(MOD(IFORM1,2) .EQ. 1) THEN
+ READ(DLINE,'(10I6,F10.3,I6)') J,ILN,IMT,EDIR,INU
+ ELSE
+ READ(DLINE,'(10I5,F10.3,I5)') J,ILN,IMT,EDIR,INU
+ ENDIF
+ IF(ILN(1) .EQ. 0 .AND. (J .EQ. 9999 .OR. J .EQ. 99999)) THEN
+ GO TO 120
+ ELSE
+ IF(ILN(7) .NE. 0) THEN
+ NCN=8
+ ELSEIF(ILN(5) .NE. 0) THEN
+ NCN=6
+ ELSEIF(ILN(3) .NE. 0) THEN
+ NCN=3
+ ENDIF
+
+ DO K=1,NCN
+ NPTEMP=MAX(NPTEMP,ILN(K))
+ NETEMP=MAX(NETEMP,J)
+ IF(MOD(K,2) .EQ. 0 .AND. ILN(K) .EQ. 0) IMIDS=1
+ ENDDO
+ GO TO 100
+ ENDIF
+
+ 120 continue
+
+ CALL GINPT1(IFILE,DLINE)
+
+ IF(IFORM1 .LT. 2) THEN
+ READ(DLINE,'(I10,9F10.0,I10,F10.0)') J, CX, CY, BELEV,&
+ WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+ ELSE
+! do kct=1,140
+! if(dline(kct:kct) .eq. '*') then
+ do kcl=61,140
+ dline(kcl:kcl)=' '
+ enddo
+! go to 8888
+! endif
+! enddo
+!8888 continue
+ READ(DLINE,'(I10,2F20.0,7F10.0,I10,F10.0)',err=8888) J, CX, CY, BELEV,&
+ WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+ go to 8889
+ 8888 do kcl=61,140
+ dline(kcl:kcl)=' '
+ enddo
+ READ(DLINE,'(I10,2F20.0,7F10.0,I10,F10.0)') J, CX, CY, BELEV,&
+ WDTHX,SS1X,SS2X,WDSX,WEL,SSSO,LOCK1,BS11
+8889 continue
+ ENDIF
+
+
+ IF(DLINE(11:30) .eq. blank .AND. (J .EQ. 9999 .OR. J .EQ. 99999)) THEN
+ GO TO 140
+ ELSE
+ NPTEMP=MAX(NPTEMP,J)
+ GO TO 120
+ ENDIF
+140 CONTINUE
+
+ REWIND(IFILE)
+ RETURN
+ END
+
+ SUBROUTINE GINPT1(IIN,DLIN)
+ CHARACTER DLIN*140
+ 100 CONTINUE
+ READ(IIN,7000) DLIN
+!IPK SEP08 write(75,7000) dlin
+ 7000 FORMAT(A140)
+ do i=1,140
+ if(dlin(i:i) .eq. char(9)) go to 200
+ enddo
+ RETURN
+ 200 continue
+!IPK SEP04
+ CLOSE(75)
+ OPEN(75,file='ERROR.OUT')
+ write(*,*) 'Error Tab character found in the following line'
+ write(75,*) 'Error Tab character found in the following line'
+ write(75,7000) dlin
+ write(*,7000) dlin
+ stop
+ END
diff --git a/src/src83e/READSHP.FOR b/src/src83e/READSHP.FOR
new file mode 100644
index 0000000..f3e8262
--- /dev/null
+++ b/src/src83e/READSHP.FOR
@@ -0,0 +1,209 @@
+ SUBROUTINE READSHP
+
+ USE BLKMAP
+ USE BLK1MOD
+ character*4 temp
+ character*100 header,field
+ character*4 ai7,aai7,ai8
+ integer status,i1,i2,i3,i4,i5,i6,i7,i8,i9
+ integer*2 i1s,i2s,i3s
+ integer*1 i1vs(20),i2vs(20)
+ real*8 fp1,fp2,fp3,fp4,fp5,fp6,fp7,fp8,vtemp(20)
+ character*11 label(20),fomat(20)
+ character*1 type(20),a2,a3,a4
+ equivalence (aai7,ia7),(aai8,ia8)
+
+c read header
+
+ read(113) i1,i2,i3,i4,i5,i6,ai7,i8,i9
+ read(113) fp1,fp2,fp3,fp4,fp5,fp6,fp7,fp8
+ CALL BTOL(AI7,IA7)
+ write(90,*) 'file length',ia7
+ write(90,*) 'version',i8
+ write(90,*) 'shapetype',i9
+
+c read data
+
+ read(114) i1,i2,i1s,i2s,i3,i4,i5,i6,i7
+ nrecs=i2
+ nbytesh=i1s
+ nrecsh=nbytesh/32-1
+ ndytesrec=i2s
+ nfl=0
+
+c now process labels
+
+ do k=1,nrecsh
+ read(114) label(k),type(k),i3,i1vs(k),i2vs(k),i3s,i4,i5,i6
+ if(type(k) .eq. 'F' .or. type(k) .eq. 'N') then
+ write(fomat(k),6000) i1vs(k),i2vs(k)
+ 6000 format('(F',i2,'.',i1,')')
+ else
+ if(i1vs (k) .lt. 10) then
+ write(fomat(k),6001) i1vs(k)
+ 6001 format('(A',i1,')')
+ else
+ write(fomat(k),6002) i1vs(k)
+ 6002 format('(A',i2,')')
+ endif
+ endif
+ nfl=nfl+i1vs(k)
+ enddo
+ read(114) a3
+ call choosrec(label,nrecsh,nchs)
+
+
+ 230 continue
+ JK=0
+ JL=0
+ if(i9 .eq. 1) then
+ do JJ=1,100000
+ read(113,end=300) ai7,ai8
+ CALL BTOL(AI7,IA7)
+ CALL BTOL(AI8,IA8)
+ READ(113) I1,FP1,FP2
+ CMAP(JJ,1)=FP1
+ CMAP(JJ,2)=FP2
+ XMAP(JJ)=FP1
+ YMAP(JJ)=FP2
+ MAXPTS=JJ
+c VAL(JJ)=-2.
+ ENDDO
+ 300 CONTINUE
+ XMAP(MAXPTS+1)= VOID
+ LINTYP(1)=2
+
+!
+!c finished shape file now read dbf stat with header
+!
+! read(114) i1,i2,i1s,i2s,i3,i4,i5,i6,i7
+! nrecs=i2
+! nbytesh=i1s
+! nrecsh=nbytesh/32-1
+! ndytesrec=i2s
+! nfl=0
+!
+!c now process labels
+!
+! do k=1,nrecsh
+! read(114) label(k),type(k),i3,i1vs(k),i2vs(k),i3s,i4,i5,i6
+! if(type(k) .eq. 'F' .or. type(k) .eq. 'N') then
+! write(fomat(k),6000) i1vs(k),i2vs(k)
+! 6000 format('(F',i2,'.',i1,')')
+! else
+! if(i1vs (k) .lt. 10) then
+! write(fomat(k),6001) i1vs(k)
+! 6001 format('(A',i1,')')
+! else
+! write(fomat(k),6002) i1vs(k)
+! 6002 format('(A',i2,')')
+! endif
+! endif
+! nfl=nfl+i1vs(k)
+! enddo
+ !read(114) a3
+ !call choosrec(label,nrecsh,nchs)
+ do j=1,nrecs
+ do k=1,nrecsh
+ read(114) field(1:i1vs(k))
+ read(field,fomat(k)) vtemp(k)
+ enddo
+ val(j)=vtemp(NCHS)
+ read(114) a3
+ enddo
+ else
+ do JJ=1,100000
+ read(113,end=500) ai7,ai8
+ CALL BTOL(AI7,IA7)
+ CALL BTOL(AI8,IA8)
+ read(113) istp,FP1,FP2,FP3,FP4,npart,npts,nd1
+! do j=1,nrecs
+ do k=1,nrecsh
+ read(114) field(1:i1vs(k))
+ read(field,fomat(k)) vtemp(k)
+ enddo
+ read(114) a3
+! enddo
+ JL=JL+1
+ LINTYP(JL)=1
+ do k=1,npts
+ read(113) fp1,fp2
+ WRITE(155,*) JK,JL,FP1,FP2,VTEMP(NCHS)
+ jk=jk+1
+ CMAP(jk,1)=FP1
+ CMAP(jk,2)=FP2
+ XMAP(jk)=FP1
+ YMAP(jk)=FP2
+ MAXPTS=jk
+ val(jK)=vtemp(NCHS)
+
+ enddo
+ jk=jk+1
+ CMAP(jk,1)=-1.e10
+ CMAP(jk,2)=-1.e10
+ XMAP(jk)=-1.e10
+ YMAP(jk)=-1.e10
+ MAXPTS=jk
+ val(jK)=0.
+ enddo
+ 500 continue
+ MAXPTS=JK-1
+ KLINT=JL
+ JLINT=MAXPTS
+ endif
+ CLOSE (113)
+ RETURN
+ END
+
+
+ SUBROUTINE BTOL(AICHG,ICHG)
+ INTEGER ICHG,ITEMP
+ CHARACTER*4 AICHG,AAICHG
+ EQUIVALENCE(ITEMP,AAICHG)
+ aaICHG(1:1)=aICHG(4:4)
+ aaICHG(2:2)=aICHG(3:3)
+ aaICHG(3:3)=aICHG(2:2)
+ aaICHG(4:4)=aICHG(1:1)
+ ICHG=ITEMP
+ RETURN
+ END
+
+ subroutine choosrec(label,nrecsh,nchs)
+ use winteracter
+ implicit none
+ include 'D.inc'
+ SAVE
+ character*11 label(*)
+ INTEGER NRECSH,NCHS,IERR,N
+
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ call wdialogload(IDD_CHSTYP)
+ ierr=infoerror(1)
+
+ do n=1,NRECSH
+ write(90,'(a)') 'file',n,LABEL(N)
+ CALL WDialogPutString(idf_string25+n-1,LABEL(n))
+ call wdialogputradiobutton(idf_radio1)
+ enddo
+ CALL WDialogSelect(IDD_CHSTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ call wdialogGetradiobutton(idf_radio1,NCHS)
+ ENDIF
+ RETURN
+ END
+
+
+
+
\ No newline at end of file
diff --git a/src/src83e/REATTACH.F90 b/src/src83e/REATTACH.F90
new file mode 100644
index 0000000..4403408
--- /dev/null
+++ b/src/src83e/REATTACH.F90
@@ -0,0 +1,110 @@
+ SUBROUTINE REATTACH
+
+
+ USE BLK1MOD
+ USE BLK2MOD
+
+ INTEGER NS1(3,4),NT1(3,4)
+ CHARACTER*1 IFLAG,ANSW(10)
+ DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/
+
+! SETUP CONNECTIVITY TABLE
+ CALL KCON(0)
+! SELECT FIRST ELEMENT
+10 CONTINUE
+ NHTPSV=NHTP
+ NMESSSV=NMESS
+ NBRRSV=NBRR
+ NHTP=0
+ NMESS=20
+ NBRR=8
+ CALL HEDR
+
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+ CALL HEDR
+ RETURN
+ ENDIF
+ IF(IFLAG .EQ. 'c' .AND. IBOX .GT. 0) THEN
+ IFLAG=ANSW(IBOX)
+ ENDIF
+!
+ IF(IFLAG .EQ. 'q') THEN
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+ CALL HEDR
+ RETURN
+ ENDIF
+ call fillem(ielem)
+! GET UNATTACHED NOP
+ kk=0
+ DO K=2,NCORN(IELEM),2
+ NSX=NOP(IELEM,K)
+ IF(NDELM(NSX) .EQ. 1) THEN
+! FOUND IT
+ KK=KK+1
+ NS1(1,KK)=NOP(IELEM,K-1)
+ NS1(2,KK)=NSX
+ KKK=MOD(K,NCORN(IELEM))+1
+ NS1(3,KK)=NOP(IELEM,KKK)
+! GO TO 280
+ ENDIF
+ ENDDO
+280 CONTINUE
+
+
+! SELECT NEXT ELEMENT
+
+ CALL PROX(XC,YC,NE,XX,YY,IELEM1,IFLAG,IESKP,IBOX)
+ call fillem(ielem1)
+
+! GET UNNATCHED SIDE
+! FIND AN UNATTACHED SIDE (INDICATE OF TRIANGLE OR QUADRILATERAL)
+ LL=0
+ DO K=2,NCORN(IELEM1),2
+ NSX=NOP(IELEM1,K)
+ IF(NDELM(NSX) .EQ. 1) THEN
+! FOUND IT
+ LL=LL+1
+ NT1(1,LL)=NOP(IELEM1,K-1)
+ NT1(2,LL)=NSX
+ KKK=MOD(K,NCORN(IELEM1))+1
+ NT1(3,LL)=NOP(IELEM1,KKK)
+! GO TO 300
+ ENDIF
+ ENDDO
+300 CONTINUE
+
+! FORM A NEW ELEMENT ASSIGN TYPE AS INDICATED
+! GET THE NEAREST TWO FACES
+ DISTKP=1.E20
+ DO NN=1,KK
+ DO MM=1,LL
+ DIST=(XUSR(NS1(2,NN))-XUSR(NT1(2,MM)))**2+(YUSR(NS1(2,NN))-YUSR(NT1(2,MM)))**2
+ IF(DIST .LT. DISTKP) THEN
+ NNN=NN
+ MMM=MM
+ DISTKP=DIST
+ ENDIF
+ ENDDO
+ ENDDO
+ CALL GETELM(J)
+ DO K=1,3
+ NOP(J,K)=NS1(K,NNN)
+ NOP(J,K+4)=NT1(K,MMM)
+ ENDDO
+ NOP(J,4)=0
+ NOP(J,8)=0
+ IMAT(J)=1
+ IESKP(J) = 0
+ NCORN(J)=8
+
+! GO BACK TO LOOK FOR NEW PAIR
+ CALL PLOTOT(1)
+ GO TO 10
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/REFINB.F90 b/src/src83e/REFINB.F90
new file mode 100644
index 0000000..72fabb6
--- /dev/null
+++ b/src/src83e/REFINB.F90
@@ -0,0 +1,1436 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR CHNAGED ELEMENTS/NODES
+! last update Sept 20 1999
+! Last change: IPK 13 Jan 98 10:05 am
+!ipk last update Nov 18 1997
+!ipk last update Oct 24 1996
+ SUBROUTINE REFB
+!
+! Routines to control refinement of elements
+!
+ USE BLK1MOD
+
+ INCLUDE 'BFILES.I90'
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*1 ANS,ANSW(10)
+ DATA ANSW/'f','l','s','t','v','n',' ','m',' ','q'/
+!
+! Draw box around selections
+!
+ 100 CONTINUE
+ NHTP=8
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+!
+! Get answer
+!
+!ipk jan98
+ 210 continue
+ call wrtbox(idelv)
+ call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!ipk jan98 add option for deleting elevation on move
+ IF(IBOX .EQ. 7 .or. ANS .eq. 'e') THEN
+ IDELV=MOD(IDELV+1,2)
+ GO TO 210
+ ENDIF
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 210
+ ANS=ANSW(IBOX)
+ ENDIF
+!
+! Element generation
+!
+ IF (ANS .EQ. 'f') THEN
+!
+! Refine elements by four
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL REFIN(0)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ ELSEIF (ANS .EQ. 'l') THEN
+!
+! Refine elements by two long
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL REFIN(1)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ ELSEIF (ANS .EQ. 's') THEN
+!
+! Refine elements by two short
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL REFIN(2)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+!
+ ELSEIF (ANS .EQ. 't') THEN
+!
+! Refine elements by splitting quads
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL REFIN(3)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+!
+ ELSEIF (ANS .EQ. 'v') THEN
+!
+! Reverse element diagonals for quads
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL REFIN(4)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ ELSEIF (ANS .EQ. 'n') THEN
+!
+! Clean up element refinement
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL CLENUP(0)
+ IRDONE=0
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ ELSEIF (ANS .EQ. 'm') THEN
+ IF(IRMAIN .EQ. 1) RETURN
+!
+! simplify layout
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL SMFY !
+ IRDONE=0
+ ELSEIF (ANS .EQ. 'q') THEN
+ CALL WRTOUT(0) !
+
+
+ RETURN
+!
+! Look again
+!
+ ENDIF
+ GO TO 100
+ END
+!
+ SUBROUTINE REFIN(ITYPT)
+!
+! Routine to refine elements
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ DIMENSION NTRAN(9),IELGB(8)
+ CHARACTER*1 IFLAG
+ DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
+ & +(CORD(N1,2)-CORD(N2,2))**2)
+!
+ ITYP=ITYPT
+ IF(NEFL .GT. 0) GO TO 150
+!ipk may94 change so that refine does not change display
+! DO 2 I=1,9
+! IPSW(I)=0
+! 2 CONTINUE
+! IPSW(4)=1
+! CALL PLOTOT
+!ipk may94 end changes
+ 3 CONTINUE
+ NHTP=0
+ NMESS=12
+ NBRR=3
+ CALL HEDR
+!
+! Write out
+!
+ NEFL=0
+ 4 CONTINUE
+ IBOX=1
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF (IFLAG .EQ. 'c') THEN
+ NEFL=NEFL+1
+ NEFLAG(NEFL)=IELEM
+ CALL FILLEM(IELEM)
+ ELSEIF (IFLAG .EQ. 'U') THEN
+ NEFLAG(NEFL)=0
+ NEFL=NEFL-1
+ CALL PLOTOT(1)
+ CALL HEDR
+ DO IELEM=1,NEFL
+ CALL FILLEM(NEFLAG(IELEM))
+ ENDDO
+!
+! ELSEIF(IFLAG .EQ. 'r') THEN
+! CALL PLOTS(0)
+! CALL PLOTOT
+! GO TO 4
+ ELSEIF(IFLAG .EQ. 'q' .OR. IFLAG .EQ. 'e') THEN
+ GO TO 152
+!
+ ELSE
+!IPK JAN98 WRITE(*,*) CHAR(7),CHAR(7)
+ ENDIF
+!
+ GOTO 4
+!
+!
+ 150 CONTINUE
+! IPSWO=IPSW
+! IPSW=4
+! CALL PLOTS(0)
+!ipk oct96 DO 151 I=1,9
+!ipk oct96 IPSW(I)=0
+!ipk oct96 151 CONTINUE
+!ipk oct96 IPSW(4)=1
+
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+! IPSW=IPSWO
+!
+! Define NEF and process elements
+!
+ 152 CONTINUE
+
+ DO N=1,NE
+ DO M=1,8
+ NOPSV(N,M)=NOP(N,M)
+ ENDDO
+ IMATSV(N)=IMAT(N)
+ ENDDO
+ NPUNDO=0
+ NEUNDO=0
+ NESAV=NE
+ NEFSAV=NENTRY
+ IF(NENTRY .GT. 0) THEN
+ DO N=1,NENTRY
+ DO M=1,3
+ NEFSV(N,M)=NEF(N,M)
+ ENDDO
+ ENDDO
+ ENDIF
+ ITYPSV=ITYP
+ DO 250 NN=1,NEFL
+ ITYP=ITYPSV
+ N=NEFLAG(NN)
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) GO TO 250
+! IF(IMAT(N) .EQ. 999) ITYP=1
+ NCN=NCORN(N)
+!
+! Split a one-dimensional element in two
+!
+ IF(NCN .EQ. 3) THEN
+ N1=NOP(N,1)
+ N2=NOP(N,2)
+ N3=NOP(N,3)
+ IF(NOP(N,2) .EQ. 0) THEN
+ CALL GETNOD(N2)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N2
+ ELSEIF(INEW(N2) .EQ. 1) THEN
+ GO TO 153
+ ENDIF
+ CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2.
+ CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2.
+ IF(LOCK(N1) .EQ. 1 .AND. LOCK(N3) .EQ. 1) LOCK(N2)=1
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ INEW(N2) = 1
+ INSKP(N2) =0
+ 153 CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ NOP(NEM,3)=N3
+ NOP(N,2)=0
+ NOP(N,3)=N2
+ NOP(NEM,1)=N2
+ NOP(NEM,2)=0.
+ NOP(NEM,3)=N3
+ IMAT(NEM)=IMAT(N)
+ IESKP(NEM)=0
+ NCORN(NEM)=3
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(N2)=-9999.
+ WIDTH(N2)=0.
+ SS1(N2)=0.
+ SS2(N2)=0.
+ WIDS(N2)=0.
+ ELSE
+ WD(N2)=(WD(N1)+WD(N3))/2.
+ WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2.
+ SS1(N2)=(SS1(N1)+SS1(N3))/2.
+ SS2(N2)=(SS2(N1)+SS2(N3))/2.
+ WIDS(N2)=(WIDS(N1)+WIDS(N3))/2.
+ IF(ICRIN .EQ. 23) CALL COMPWGT
+ ENDIF
+ GO TO 250
+ ENDIF
+!
+! Setup for each type of refinement
+!
+!ipk jan08
+ IF(ITYP .EQ. 0) THEN
+!
+! Full refinement all nodes are eligible
+!
+! IF(imat(n) .eq. 999) then
+! IELGB(2)=2
+! IELGB(4)=0
+! IELGB(6)=2
+! IELGB(8)=0
+! ELSE
+ DO M=2,NCN
+ IELGB(M)=1
+ ENDDO
+! ENDIF
+ ELSEIF(ITYP .EQ. 1 .OR. ITYP .EQ. 2) THEN
+!
+! Setup for long or short side refinement
+!
+ IF(ITYP .EQ. 1) THEN
+ DISTLL=0.
+ DISTL=0.
+ ELSE
+ DISTLL=-VOID
+ DISTL=-VOID
+ ENDIF
+!
+! Sort out longest or shortest sides
+!
+ DO 165 M=2,NCN,2
+ IELGB(M)=0
+ N1=NOP(N,M-1)
+ N2=MOD(M,NCN)+1
+ N2=NOP(N,N2)
+ DSEP=DIST(N1,N2)
+ IF(ITYP .EQ. 1) THEN
+ IF(DISTLL .LT. DSEP) THEN
+! Separation greater DISTLL
+ IF(DISTLL .GT. 0.) THEN
+! DISTLL already exists then move it down the line
+ DISTL=DISTLL
+ NDS=NDSS
+ ENDIF
+! Save separation
+ DISTLL=DSEP
+ NDSS=M
+ GO TO 165
+ ELSEIF(DISTL .LT. DSEP) THEN
+! 2nd longest
+ DISTL=DSEP
+ NDS=M
+ ENDIF
+ ELSE
+ IF(DSEP .LT. DISTLL) THEN
+! Separation less than DISTLL
+ IF(DISTLL .LT. -VDX) THEN
+! DISTLL already exists then move it up the line
+ DISTL=DISTLL
+ NDS=NDSS
+ ENDIF
+ DISTLL=DSEP
+ NDSS=M
+ GO TO 165
+ ELSEIF(DSEP .LT. DISTL) THEN
+! 2nd shortest
+ DISTL=DSEP
+ NDS=M
+ ENDIF
+ ENDIF
+ 165 CONTINUE
+ IELGB(NDSS)=2
+ IELGB(NDS)=2
+ ELSEIF(ITYP .EQ. 3) THEN
+!ipk jan98 IF(NCN .EQ. 8) CALL SPLIT(N)
+ IF(NCN .GT. 5) CALL SPLIT(N)
+ GO TO 250
+ ELSEIF(ITYP .EQ. 4) THEN
+ NPL=NEFLAG(NN+1)
+ CALL REVERS(N,NPL)
+ GO TO 255
+ ENDIF
+!
+! Loop through element sides
+!
+ DO 200 M=2,NCN,2
+ IF(IELGB(M) .EQ. 0) GO TO 200
+ N1=NOP(N,M-1)
+ N3=MOD(M+1,NCN)
+ N3=NOP(N,N3)
+!
+! Search table for N1
+!
+ IF(NENTRY .EQ. 0) GO TO 182
+ DO 180 J=1,NENTRY
+ IF(N1 .EQ. NEF(J,3) .AND. N3 .EQ. NEF(J,1)) THEN
+!
+! We have found match so use this info
+!
+ NOP(N,M)=NEF(J,2)
+!
+! For regular ops remove value in NEF(J,1) so that it seems blank and s
+! otherwise set value negative
+ IF(IELGB(M) .EQ. 1) THEN
+ NEF(J,1)=0
+ ELSE
+ NEF(J,1)=-NEF(J,1)
+ ENDIF
+ GO TO 200
+ ENDIF
+ 180 CONTINUE
+ 182 CONTINUE
+!
+! Define a node, enter it, initialize it, and make entry in NEF
+!
+ IF(IMAT(N) .EQ. 999 .AND. (M .EQ. 4 .OR. M .EQ. 8)) GO TO 200
+
+ IF(NOP(N,M) .EQ. 0) THEN
+ CALL GETNOD(N2)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N2
+ NOP(N,M)=N2
+ CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2.
+ CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2.
+ IF(LOCK(N1) .EQ. 1 .AND. LOCK(N3) .EQ. 1) LOCK(N2)=1
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ INEW(N2) = 1
+ INSKP(N2) =0
+ ELSE
+ N2=NOP(N,M)
+ IF(INEW(N2) .NE. 1) THEN
+ CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2.
+ CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2.
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ INEW(N2) = 1
+ INSKP(N2) =0
+ ENDIF
+ ENDIF
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(N2)=-9999.
+ ELSE
+ WD(N2)=(WD(N1)+WD(N3))/2.
+ ENDIF
+ IF(M .EQ. 2 .AND. IMAT(N) .EQ. 999) THEN
+ WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2.
+ SS1(N2)=(SS1(N1)+SS1(N3))/2.
+ SS2(N2)=(SS2(N1)+SS2(N3))/2.
+ WIDS(N2)=(WIDS(N1)+WIDS(N3))/2.
+ ELSE
+ WIDTH(N2)=0.
+ SS1(N2)=0.
+ SS2(N2)=0.
+ WIDS(N2)=0.
+ ENDIF
+ NENTRY=NENTRY+1
+ NEF(NENTRY,1)=N1
+ NEF(NENTRY,2)=N2
+ NEF(NENTRY,3)=N3
+ 200 CONTINUE
+ IF(ITYP .GT. 0) GO TO 250
+!
+! Copy NOP into temporary NTRAN for processing then delete element
+!
+ DO 220 K=1,8
+ NTRAN(K)=NOP(N,K)
+ NOP(N,K)=0
+ 220 CONTINUE
+ NRMAT=IMAT(N)
+ IMAT(N)=0
+ IESKP(N)=-1
+ NTYP=1
+ NELAST= MIN(NELAST,N)
+ IF(NCN .EQ. 8) THEN
+ IF(NRMAT .EQ. 999) THEN
+ IF(NTRAN(2) .EQ. 0) THEN
+ CALL GETNOD(N2)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N2
+ N1=NTRAN(1)
+ N3=NTRAN(3)
+ CORD(N2,1)=(CORD(N1,1)+CORD(N3,1))/2.
+ CORD(N2,2)=(CORD(N1,2)+CORD(N3,2))/2.
+ INEW(N2) = 1
+ IF(LOCK(N1) .EQ. 1 .AND. LOCK(N3) .EQ. 1) LOCK(N2)=1
+ NTRAN(2)=N2
+ WD(N2)=(WD(N1)+WD(N3))/2.
+ WIDTH(N2)=(WIDTH(N1)+WIDTH(N3))/2.
+ SS1(N2)=(SS1(N1)+SS1(N3))/2.
+ SS2(N2)=(SS2(N1)+SS2(N3))/2.
+ WIDS(N2)=(WIDS(N1)+WIDS(N3))/2.
+ ENDIF
+ IF(NTRAN(6) .EQ. 0) THEN
+ CALL GETNOD(N6)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N6
+ N5=NTRAN(5)
+ N7=NTRAN(7)
+ CORD(N6,1)=(CORD(N5,1)+CORD(N7,1))/2.
+ CORD(N6,2)=(CORD(N5,2)+CORD(N7,2))/2.
+ INEW(N6) = 1
+ IF(LOCK(N5) .EQ. 1 .AND. LOCK(N7) .EQ. 1) LOCK(N6)=1
+ NTRAN(6)=N6
+ WD(N6)=(WD(N5)+WD(N7))/2.
+ WIDTH(N6)=(WIDTH(N5)+WIDTH(N7))/2.
+ SS1(N6)=(SS1(N5)+SS1(N7))/2.
+ SS2(N6)=(SS2(N5)+SS2(N7))/2.
+ WIDS(N6)=(WIDS(N5)+WIDS(N7))/2.
+ ENDIF
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ NOP(NEM,1)=NTRAN(1)
+ NOP(NEM,3)=NTRAN(2)
+ NOP(NEM,5)=NTRAN(6)
+ NOP(NEM,7)=NTRAN(7)
+ IMAT(NEM)=999
+ IESKP(NEM)=0
+ NCORN(NEM)=8
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ NOP(NEM,1)=NTRAN(2)
+ NOP(NEM,3)=NTRAN(3)
+ NOP(NEM,5)=NTRAN(5)
+ NOP(NEM,7)=NTRAN(6)
+ IMAT(NEM)=999
+ IESKP(NEM)=0
+ NCORN(NEM)=8
+ ELSE
+ CALL GETNOD(N2)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N2
+ CORD(N2,1)=(CORD(NTRAN(1),1)+CORD(NTRAN(3),1) &
+ & +CORD(NTRAN(5),1)+CORD(NTRAN(7),1))/4.
+ CORD(N2,2)=(CORD(NTRAN(1),2)+CORD(NTRAN(3),2) &
+ & +CORD(NTRAN(5),2)+CORD(NTRAN(7),2))/4.
+ INEW(N2) = 1
+ IF(LOCK(NTRAN(1)) .EQ. 1 .AND. LOCK(NTRAN(3)) .EQ. 1 .AND. &
+ & LOCK(NTRAN(5)) .EQ. 1 .AND. LOCK(NTRAN(7)) .EQ. 1) LOCK(N2)=1
+
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(N2)=-9999.
+ ELSE
+ WD(N2) =(WD(NTRAN(1))+WD(NTRAN(3)) &
+ & +WD(NTRAN(5))+WD(NTRAN(7)))/4.
+ ENDIF
+ WIDTH(N2)=0.
+ SS1(N2)=0.
+ SS2(N2)=0.
+ WIDS(N2)=0.
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ NTRAN(9)=N2
+ INSKP(N2)=0
+ CALL RGEN(NTRAN,NTYP,NRMAT)
+ ENDIF
+ ELSE
+ CALL TGEN(NTRAN,NTYP,NRMAT)
+ ENDIF
+ IF(MOD(NN,20) .EQ. 0) THEN
+!
+! Compress NEF for later use
+!
+ NCT=0
+ DO 245 N=1,NENTRY
+ IF(NEF(N,1) .NE. 0) THEN
+ NCT=NCT+1
+ NEF(NCT,1)=NEF(N,1)
+ NEF(NCT,2)=NEF(N,2)
+ NEF(NCT,3)=NEF(N,3)
+ ENDIF
+ 245 CONTINUE
+ NENTRY=NCT
+ ENDIF
+ 250 END DO
+ 255 CONTINUE
+ IF(ITYP .GT. 2) THEN
+!ipk nov97 add (1)
+ call plotot(1)
+ NEFL=0
+ RETURN
+ ENDIF
+!
+! Process the ITYP = 1 or 2 situation
+!
+ IF(ITYP .GT. 0) THEN
+ CALL CLENUP(ITYP)
+ ENDIF
+!
+! Search for left over entries NEF
+!
+ DO 600 I=1,NENTRY
+ DO 500 N=1,NE
+ IF(IMAT(N) .EQ. 0) GO TO 500
+ NCN=NCORN(N)
+
+!ipk sep99 add test for line element
+
+ if(ncn .eq. 3) go to 500
+!
+! Loop on sides
+!
+ DO 400 K=2,NCN,2
+ IF(NOP(N,K-1) .EQ. NEF(I,3)) THEN
+ KP=MOD(K+1,NCN)
+ IF(NOP(N,KP) .EQ. ABS(NEF(I,1))) THEN
+!
+! We have a match, quit search for this entry
+!
+ GO TO 600
+ ENDIF
+ ENDIF
+ 400 CONTINUE
+ 500 CONTINUE
+!
+! No match this must be a boundary eliminate NEF value
+!
+ NEF(I,1)=0
+ NEF(I,3)=0
+ 600 END DO
+!
+! Now compress remaining NEF for later use
+!
+ NCT=0
+ DO 700 N=1,NENTRY
+ IF(NEF(N,1) .GT. 0) THEN
+ NCT=NCT+1
+ NEF(NCT,1)=NEF(N,1)
+ NEF(NCT,2)=NEF(N,2)
+ NEF(NCT,3)=NEF(N,3)
+ ENDIF
+ 700 END DO
+ NENTRY=NCT
+ NEFL=0
+ RETURN
+ END
+!
+ SUBROUTINE CLENUP(ITYP)
+!
+! Clean up transitions on the boundary of the refined area
+!
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ DIMENSION NTEMP(9),NTRAN(9),NSWT(8)
+!
+! First loop through elements looking for transitions
+!
+ IF(ITYP .EQ. 0) THEN
+ NEO=NE
+ ELSE
+ NEO=NEFL
+ ENDIF
+! DO KN=1,NEO
+! WRITE(234,*) KN,NEFLAG(KN),NEF(KN,1),NEF(KN,2),NEF(KN,3)
+! ENDDO
+ DO 500 KN=1,NEO
+ IF(ITYP .EQ. 0) THEN
+ N=KN
+ IF(IMAT(N) .EQ. 0) GO TO 500
+ ELSE
+ N=NEFLAG(KN)
+ ENDIF
+ NCN=NCORN(N)
+
+!ipk sep99 add test for line element
+
+ if(ncn .eq. 3) go to 500
+!
+! Loop on sides
+!
+ IFND=0
+ NSWT(8)=0
+ DO 400 K=2,NCN,2
+!
+! Search for left over entry in NEF
+!
+ DO 350 I=1,NENTRY
+ IF(NOP(N,K-1) .EQ. NEF(I,3)) THEN
+ KP=MOD(K+1,NCN)
+ IF(NOP(N,KP) .EQ. ABS(NEF(I,1))) THEN
+!
+! We have a match, start building TEMP
+!
+ NTEMP(K-1)=NEF(I,3)
+ NTEMP(K)=NEF(I,2)
+ NSWT(K)=1
+ IFND=1
+ GO TO 400
+ ENDIF
+ ENDIF
+ IF(ITYP .GT. 0) THEN
+ IF(NOP(N,K-1) .EQ. ABS(NEF(I,1))) THEN
+ KP=MOD(K+1,NCN)
+ IF(NOP(N,KP) .EQ. NEF(I,3)) THEN
+!
+! We have a match, start building TEMP
+!
+ NTEMP(K-1)=ABS(NEF(I,1))
+ NTEMP(K)=NEF(I,2)
+ NSWT(K)=1
+ IFND=1
+ GO TO 400
+ ENDIF
+ ENDIF
+ ENDIF
+ 350 CONTINUE
+!
+! No match copy old values
+!
+ NTEMP(K-1)=NOP(N,K-1)
+ NTEMP(K)=NOP(N,K)
+ NSWT(K)=0
+ 400 CONTINUE
+ IF(IFND .EQ. 0) GO TO 500
+!
+! Now test for match
+!
+ NTOT=NSWT(2)+NSWT(4)+NSWT(6)+NSWT(8)
+ IF(NTOT .EQ. 0) GO TO 500
+!
+! Delete element
+!
+ DO 420 K=1,8
+ NOP(N,K)=0
+ 420 CONTINUE
+ NRMAT=IMAT(N)
+ IMAT(N)=0
+ NELAST=MIN(NELAST,N)
+!
+! Work with triangles first
+!
+ IF(NCN .EQ. 6) THEN
+!
+! Determine transition type and prepare to rotate connections
+!
+ IF(NTOT .EQ. 1) THEN
+ NTYP=3
+ IF(NSWT(2) .EQ. 1) THEN
+ ISHIFT=0
+ ELSEIF(NSWT(4) .EQ. 1) THEN
+ ISHIFT=2
+ ELSEIF(NSWT(6) .EQ. 1) THEN
+ ISHIFT=4
+ ENDIF
+ ELSEIF(NTOT .EQ. 2) THEN
+ NTYP=2
+ IF(NSWT(2) .EQ. 0) THEN
+ ISHIFT=2
+ ELSEIF(NSWT(4) .EQ. 0) THEN
+ ISHIFT=4
+ ELSEIF(NSWT(6) .EQ. 0) THEN
+ ISHIFT=0
+ ENDIF
+ ELSE
+ NTYP=1
+ ISHIFT=0
+ ENDIF
+!
+! Now rotate so that first mid node is refined
+!
+ DO 430 K=1,NCN
+ KS=MOD(K+ISHIFT,NCN)
+ IF(KS .EQ. 0) KS=NCN
+ NTRAN(K)=NTEMP(KS)
+ 430 CONTINUE
+!
+! Now generate transition refined elements
+!
+ CALL TGEN(NTRAN,NTYP,NRMAT)
+!
+! Now work on quadrilateral elements
+!
+ ELSE
+!
+! Determine transition type and prepare to rotate connections
+!
+ IF(NTOT .EQ. 1) THEN
+ NTYP=2
+ IF(NSWT(2) .EQ. 1) THEN
+ ISHIFT=0
+ ELSEIF(NSWT(4) .EQ. 1) THEN
+ ISHIFT=2
+ ELSEIF(NSWT(6) .EQ. 1) THEN
+ ISHIFT=4
+ ELSEIF(NSWT(8) .EQ. 1) THEN
+ ISHIFT=6
+ ENDIF
+ ELSEIF(NTOT .EQ. 2) THEN
+ IF(NSWT(2) .EQ. 1) THEN
+ IF(NSWT(4) .EQ. 1) THEN
+ NTYP=3
+ ISHIFT=0
+ ELSEIF(NSWT(6) .EQ. 1) THEN
+ NTYP=4
+ ISHIFT=0
+ ELSE
+ NTYP=3
+ ISHIFT=6
+ ENDIF
+ ELSEIF(NSWT(4) .EQ. 1) THEN
+ IF(NSWT(6) .EQ. 1) THEN
+ NTYP=3
+ ISHIFT=2
+ ELSEIF(NSWT(8) .EQ. 1) THEN
+ NTYP=4
+ ISHIFT=2
+ ENDIF
+ ELSE
+ NTYP=3
+ ISHIFT=4
+ ENDIF
+ ELSEIF(NTOT .EQ. 3) THEN
+ NTYP=5
+ IF(NSWT(2) .EQ. 0) THEN
+ ISHIFT=2
+ ELSEIF(NSWT(4) .EQ. 0) THEN
+ ISHIFT=4
+ ELSEIF(NSWT(6) .EQ. 0) THEN
+ ISHIFT=6
+ ELSEIF(NSWT(8) .EQ. 0) THEN
+ ISHIFT=0
+ ENDIF
+ ELSE
+ NTYP=1
+ ISHIFT=0
+ ENDIF
+!
+! Now rotate so that first mid node is refined
+!
+ DO 450 K=1,NCN
+ KS=MOD(K+ISHIFT,NCN)
+ IF(KS .EQ. 0) KS=NCN
+ NTRAN(K)=NTEMP(KS)
+ 450 CONTINUE
+!
+ IF(NTYP .EQ. 1 .OR. NTYP .EQ. 5) THEN
+!
+! If appropriate define a new node at the centroid
+!
+ CALL GETNOD(N2)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=N2
+ CORD(N2,1)=(CORD(NTEMP(1),1)+CORD(NTEMP(3),1) &
+ & +CORD(NTEMP(5),1)+CORD(NTEMP(7),1))/4.
+ CORD(N2,2)=(CORD(NTEMP(1),2)+CORD(NTEMP(3),2) &
+ & +CORD(NTEMP(5),2)+CORD(NTEMP(7),2))/4.
+ IF(LOCK(NTEMP(1)) .EQ. 1 .AND. LOCK(NTEMP(3)) .EQ. 1 .AND. &
+ & LOCK(NTEMP(5)) .EQ. 1 .AND. LOCK(NTEMP(7)) .EQ. 1) LOCK(N2)=1
+ INEW(N2) = 1
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(N2)=-9999.
+ ELSE
+ WD(N2)= (WD(NTEMP(1))+WD(NTEMP(3)) &
+ & +WD(NTEMP(5))+WD(NTEMP(7)))/4.
+ ENDIF
+ WIDTH(N2)=0.
+ SS1(N2)=0.
+ SS2(N2)=0.
+ WIDS(N2)=0.
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ NTRAN(9)=N2
+ INSKP(N2)=0
+!
+! Now generate transition refined elements
+!
+ ENDIF
+ CALL RGEN(NTRAN,NTYP,NRMAT)
+ ENDIF
+ 500 END DO
+ IF(ITYP .EQ. 0) THEN
+ NENTRY=0
+ ELSE
+ DO 600 I=1,NENTRY
+ IF(NEF(I,1) .LT. 0) NEF(I,1)=0
+ 600 CONTINUE
+ ENDIF
+ RETURN
+ END
+!
+ SUBROUTINE RGEN(NTRAN,NTYP,NRMAT)
+!
+! Routine to refine quadrilateral elements
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! IRGEN contains pointers to the various connections
+!
+ INTEGER*2 IRGEN
+ DIMENSION NTRAN(9),IRGEN(8,5,5)
+!
+ DATA IRGEN /1,0,2,0,9,0,8,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0, &
+ & 7,0,8,0,9,0,6,0,8*0, &
+ & 1,0,2,0,7,8,0,0,3,4,5,0,2,0,0,0,5,6,7,0,2,0,0,0,16*0, &
+ & 1,0,2,0,7,8,0,0,3,0,4,0,2,0,0,0,5,6,7,0,4,0,0,0, &
+ & 7,0,2,0,4,0,0,0,8*0, &
+ & 1,0,2,0,6,0,7,8,2,0,3,4,5,0,6,0,24*0, &
+ & 1,0,2,0,9,0,0,0,3,0,4,0,9,0,2,0,5,0,6,0,9,0,4,0, &
+ & 7,0,9,0,6,0,0,0,7,8,1,0,9,0,0,0/
+!
+ DO 300 N=1,5
+ IF(IRGEN(1,N,NTYP) .EQ. 0) GO TO 310
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ DO 250 K=1,7,2
+ INN=IRGEN(K,N,NTYP)
+ INP=IRGEN(K+1,N,NTYP)
+ IF(INN .GT. 0) INN=NTRAN(INN)
+ IF(INP .GT. 0) INP=NTRAN(INP)
+ NOP(NEM,K)=INN
+ NOP(NEM,K+1)=INP
+ 250 CONTINUE
+ IF(NOP(NEM,7) .EQ. 0) THEN
+ NCORN(NEM)=6
+ ELSE
+ NCORN(NEM)=8
+ ENDIF
+ IMAT(NEM)=NRMAT
+ IESKP(NEM)=0
+!IPK JAN98
+ IERC=0
+ CALL PLTELM(NEM,IERC)
+ 300 END DO
+ 310 CONTINUE
+ RETURN
+ END
+!
+ SUBROUTINE TGEN(NTRAN,NTYP,NRMAT)
+!
+! Routine to refine triangular elements
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! ITGEN contains pointers to the various connections
+!
+ INTEGER*2 ITGEN
+ DIMENSION NTRAN(9),ITGEN(8,4,3)
+!
+ DATA ITGEN /1,0,2,0,6,0,0,0,3,0,4,0,2,0,0,0, &
+ & 5,0,6,0,4,0,0,0,2,0,4,0,6,0,0,0, &
+ & 1,0,2,0,4,0,5,6,2,0,3,0,4,0,0,0,16*0, &
+ & 1,0,2,0,5,6,0,0,3,4,5,0,2,0,0,0,16*0/
+!
+ DO 300 N=1,4
+ IF(ITGEN(1,N,NTYP) .EQ. 0) GO TO 310
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ DO 250 K=1,7,2
+ INN=ITGEN(K,N,NTYP)
+ INP=ITGEN(K+1,N,NTYP)
+ IF(INN .GT. 0) INN=NTRAN(INN)
+ IF(INP .GT. 0) INP=NTRAN(INP)
+ NOP(NEM,K)=INN
+ NOP(NEM,K+1)=INP
+ 250 CONTINUE
+ IF(NOP(NEM,7) .EQ. 0) THEN
+ NCORN(NEM)=6
+ ELSE
+ NCORN(NEM)=8
+ ENDIF
+ IMAT(NEM)=NRMAT
+ IESKP(NEM)=0
+ IERC=0
+ CALL PLTELM(NEM,IERC)
+ 300 END DO
+ 310 CONTINUE
+ RETURN
+ END
+ SUBROUTINE SPLIT(N)
+!
+! Routine to split quadrilateral elements in two
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+ DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
+ & +(CORD(N1,2)-CORD(N2,2))**2)
+ if(nop(n,7) .eq. 0) go to 100
+!
+! Loop around element looking for longest diagonal
+!
+ L1=NOP(N,1)
+ L5=NOP(N,5)
+ D15=DIST(L1,L5)
+ L3=NOP(N,3)
+ L7=NOP(N,7)
+ D37=DIST(L3,L7)
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ IF(D15 .LT. D37) THEN
+ NOP(NEM,1)=L1
+ NOP(NEM,2)=0
+ NOP(NEM,3)=L5
+ NOP(NEM,4)=NOP(N,6)
+ NOP(NEM,5)=L7
+ NOP(NEM,6)=NOP(N,8)
+ IMAT(NEM)=IMAT(N)
+ IESKP(NEM)=0
+ NCORN(NEM)=6
+ NOP(N,6)=0
+ NOP(N,7)=0
+ NOP(N,8)=0
+ NCORN(N)=6
+ ELSE
+ NOP(NEM,1)=L3
+ NOP(NEM,2)=NOP(N,4)
+ NOP(NEM,3)=L5
+ NOP(NEM,4)=NOP(N,6)
+ NOP(NEM,5)=L7
+ NOP(NEM,6)=0
+ IMAT(NEM)=IMAT(N)
+ IESKP(NEM)=0
+ NCORN(NEM)=6
+ NOP(N,4)=0
+ NOP(N,5)=L7
+ NOP(N,6)=NOP(N,8)
+ NOP(N,7)=0
+ NOP(N,8)=0
+ NCORN(N)=6
+ ENDIF
+
+! call plotot
+ RETURN
+ 100 continue
+!
+! triangle split
+!
+ l1=nop(n,1)
+ l3=nop(n,3)
+ l5=nop(n,5)
+ d13=dist(l1,l3)
+ d35=dist(l3,l5)
+ d51=dist(l5,l1)
+ CALL GETELM(NEM)
+ NEUNDO=NEUNDO+1
+ IELDEL(NEUNDO)=NEM
+ IMAT(NEM)=IMAT(N)
+ IESKP(NEM)=0
+ NCORN(NEM)=6
+ write(90,*) l1,l3,l5,d13,d35,d51,nentry
+ if(d13 .gt. d35) then
+ if(d13 .gt. d51) then
+!
+! Search table for L1
+!
+ IF(NENTRY .NE. 0) THEN
+ DO J=1,NENTRY
+ IF(L1 .EQ. NEF(J,3) .AND. L3 .EQ. NEF(J,1)) THEN
+!
+! We have found match so use this info
+!
+ NOP(N,2)=NEF(J,2)
+ NEWND=NEF(J,2)
+!
+! For regular ops remove value in NEF(J,1) so that it seems blank and s
+! otherwise set value negative
+! IF(IELGB(2) .EQ. 1) THEN
+! NEF(J,1)=0
+! ELSE
+ NEF(J,1)=-NEF(J,1)
+! ENDIF
+ GO TO 200
+ ENDIF
+ ENDDO
+ ENDIF
+!
+! Define a node, enter it, initialize it, and make entry in NEF
+!
+ IF(NOP(N,2) .EQ. 0) THEN
+ CALL GETNOD(NEWND)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=NEWND
+ NOP(N,2)=NEWND
+ CORD(NEWND,1)=(CORD(L1,1)+CORD(L3,1))/2.
+ CORD(NEWND,2)=(CORD(L1,2)+CORD(L3,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ IF(LOCK(L1) .EQ. 1 .AND. LOCK(L3) .EQ. 1 ) LOCK(NEWND)=1
+
+ INSKP(NEWND) =0
+ ELSE
+ NEWND=NOP(N,2)
+ IF(INEW(NEWND) .NE. 1) THEN
+ CORD(NEWND,1)=(CORD(L1,1)+CORD(L3,1))/2.
+ CORD(NEWND,2)=(CORD(L1,2)+CORD(L3,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ INSKP(NEWND) =0
+ ENDIF
+ ENDIF
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(NEWND)=-9999.
+ ELSE
+ WD(NEWND)=(WD(L1)+WD(L3))/2.
+ ENDIF
+ WIDTH(NEWND)=0.
+ SS1(NEWND)=0.
+ SS2(NEWND)=0.
+ WIDS(NEWND)=0.
+ NENTRY=NENTRY+1
+ NEF(NENTRY,1)=L1
+ NEF(NENTRY,2)=NEWND
+ NEF(NENTRY,3)=L3
+ 200 CONTINUE
+
+ nop(nem,1)=nop(n,1)
+ nop(nem,3)=newnd
+ nop(nem,5)=nop(n,5)
+ nop(nem,6)=nop(n,6)
+ nop(n,1)=newnd
+ nop(n,2)=0
+ nop(n,6)=0
+ else
+
+!
+! Search table for L5
+!
+ IF(NENTRY .NE. 0) THEN
+ DO J=1,NENTRY
+ IF(L5 .EQ. NEF(J,3) .AND. L1 .EQ. NEF(J,1)) THEN
+!
+! We have found match so use this info
+!
+ NOP(N,2)=NEF(J,2)
+ NEWND=NEF(J,2)
+!
+! For regular ops remove value in NEF(J,1) so that it seems blank and s
+! otherwise set value negative
+! IF(IELGB(2) .EQ. 1) THEN
+! NEF(J,1)=0
+! ELSE
+ NEF(J,1)=-NEF(J,1)
+! ENDIF
+ GO TO 300
+ ENDIF
+ ENDDO
+ ENDIF
+!
+! Define a node, enter it, initialize it, and make entry in NEF
+!
+ IF(NOP(N,6) .EQ. 0) THEN
+ CALL GETNOD(NEWND)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=NEWND
+ NOP(N,6)=NEWND
+ CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2.
+ CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ IF(LOCK(L1) .EQ. 1 .AND. LOCK(L5) .EQ. 1) LOCK(NEWND)=1
+ INSKP(NEWND) =0
+ ELSE
+ NEWND=NOP(N,6)
+ IF(INEW(NEWND) .NE. 1) THEN
+ CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2.
+ CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ INSKP(NEWND) =0
+ ENDIF
+ ENDIF
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(NEWND)=-9999.
+ ELSE
+ WD(NEWND)=(WD(L5)+WD(L1))/2.
+ ENDIF
+ WIDTH(NEWND)=0.
+ SS1(NEWND)=0.
+ SS2(NEWND)=0.
+ WIDS(NEWND)=0.
+ NENTRY=NENTRY+1
+ NEF(NENTRY,1)=L5
+ NEF(NENTRY,2)=NEWND
+ NEF(NENTRY,3)=L1
+ 300 CONTINUE
+
+ nop(nem,1)=nop(n,1)
+ nop(nem,2)=nop(n,2)
+ nop(nem,3)=nop(n,3)
+ nop(nem,5)=newnd
+ nop(n,1)=newnd
+ nop(n,2)=0
+ nop(n,6)=0
+ endif
+ elseif(d35 .gt. d51) then
+
+!
+! Search table for L3
+!
+ IF(NENTRY .NE. 0) THEN
+ DO J=1,NENTRY
+ IF(L3 .EQ. NEF(J,3) .AND. L5 .EQ. NEF(J,1)) THEN
+!
+! We have found match so use this info
+!
+ NOP(N,4)=NEF(J,2)
+ NEWND=NEF(J,2)
+!
+! For regular ops remove value in NEF(J,1) so that it seems blank and s
+! otherwise set value negative
+! IF(IELGB(2) .EQ. 1) THEN
+! NEF(J,1)=0
+! ELSE
+ NEF(J,1)=-NEF(J,1)
+! ENDIF
+ GO TO 400
+ ENDIF
+ ENDDO
+ ENDIF
+!
+! Define a node, enter it, initialize it, and make entry in NEF
+!
+ IF(NOP(N,4) .EQ. 0) THEN
+ CALL GETNOD(NEWND)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=NEWND
+ NOP(N,4)=NEWND
+ CORD(NEWND,1)=(CORD(L3,1)+CORD(L5,1))/2.
+ CORD(NEWND,2)=(CORD(L3,2)+CORD(L5,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ IF(LOCK(L3) .EQ. 1 .AND. LOCK(L5) .EQ. 1) LOCK(NEWND)=1
+ INSKP(NEWND) =0
+ ELSE
+ NEWND=NOP(N,4)
+ IF(INEW(NEWND) .NE. 1) THEN
+ CORD(NEWND,1)=(CORD(L3,1)+CORD(L5,1))/2.
+ CORD(NEWND,2)=(CORD(L3,2)+CORD(L5,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ INSKP(NEWND) =0
+ ENDIF
+ ENDIF
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(NEWND)=-9999.
+ ELSE
+ WD(NEWND)=(WD(L3)+WD(L5))/2.
+ ENDIF
+ WIDTH(NEWND)=0.
+ SS1(NEWND)=0.
+ SS2(NEWND)=0.
+ WIDS(NEWND)=0.
+ NENTRY=NENTRY+1
+ NEF(NENTRY,1)=L3
+ NEF(NENTRY,2)=NEWND
+ NEF(NENTRY,3)=L5
+ 400 CONTINUE
+
+ nop(nem,1)=nop(n,1)
+ nop(nem,2)=nop(n,2)
+ nop(nem,3)=nop(n,3)
+ nop(nem,5)=newnd
+ nop(n,3)=newnd
+ nop(n,2)=0
+ nop(n,4)=0
+ else
+
+!
+! Search table for L5
+!
+ IF(NENTRY .NE. 0) THEN
+ DO J=1,NENTRY
+ IF(L5 .EQ. NEF(J,3) .AND. L1 .EQ. NEF(J,1)) THEN
+!
+! We have found match so use this info
+!
+ NOP(N,2)=NEF(J,2)
+ NEWND=NEF(J,2)
+!
+! For regular ops remove value in NEF(J,1) so that it seems blank and s
+! otherwise set value negative
+! IF(IELGB(2) .EQ. 1) THEN
+! NEF(J,1)=0
+! ELSE
+ NEF(J,1)=-NEF(J,1)
+! ENDIF
+ GO TO 500
+ ENDIF
+ ENDDO
+ ENDIF
+!
+! Define a node, enter it, initialize it, and make entry in NEF
+!
+ IF(NOP(N,6) .EQ. 0) THEN
+ CALL GETNOD(NEWND)
+ NPUNDO=NPUNDO+1
+ NODDEL(NPUNDO)=NEWND
+ NOP(N,6)=NEWND
+ CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2.
+ CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ IF(LOCK(L1) .EQ. 1 .AND. LOCK(L5) .EQ. 1) LOCK(NEWND)=1
+ INSKP(NEWND) =0
+ ELSE
+ NEWND=NOP(N,6)
+ IF(INEW(NEWND) .NE. 1) THEN
+ CORD(NEWND,1)=(CORD(L5,1)+CORD(L1,1))/2.
+ CORD(NEWND,2)=(CORD(L5,2)+CORD(L1,2))/2.
+ XUSR(NEWND) = CORD(NEWND,1)*TXSCAL - XS
+ YUSR(NEWND) = CORD(NEWND,2)*TXSCAL - YS
+ INEW(NEWND) = 1
+ INSKP(NEWND) =0
+ ENDIF
+ ENDIF
+!ipk jan98
+ IF(IDELV .EQ. 1) then
+ WD(NEWND)=-9999.
+ ELSE
+ WD(NEWND)=(WD(L5)+WD(L1))/2.
+ ENDIF
+ WIDTH(NEWND)=0.
+ SS1(NEWND)=0.
+ SS2(NEWND)=0.
+ WIDS(NEWND)=0.
+ NENTRY=NENTRY+1
+ NEF(NENTRY,1)=L5
+ NEF(NENTRY,2)=NEWND
+ NEF(NENTRY,3)=L1
+ 500 CONTINUE
+
+ nop(nem,1)=nop(n,1)
+ nop(nem,2)=nop(n,2)
+ nop(nem,3)=nop(n,3)
+ nop(nem,5)=newnd
+ nop(n,1)=newnd
+ nop(n,2)=0
+ nop(n,6)=0
+ endif
+ return
+ END
+ SUBROUTINE REVERS(N1,N2)
+!
+! Routine to reverse diagonal of two quadrilateral elements
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+! Search for common nodes on the elements
+!
+ DO 300 M=1,NCORN(N1),2
+ J=NOP(N1,M)
+ DO 250 MM=1,NCORN(N2),2
+ JJ=NOP(N2,MM)
+ IF(JJ .EQ. J) THEN
+!
+! We have a match find the other nodes around element
+!
+ MID1=M+1
+ JMID1=NOP(N1,MID1)
+ write(90,*) n1,mid1,jmid1
+ MID2=M+3
+ IF(M .EQ. 5) MID2=2
+ JMID2=NOP(N1,MID2)
+ MID3=M+5
+ IF(MID3 .GT. 6) MID3=MID3-6
+ JMID3=NOP(N1,MID3)
+!
+! Now find the other node
+!
+ M1=M+2
+ IF(M1 .GT. 6) M1=1
+ J1=NOP(N1,M1)
+ MM1=MM-2
+ IF(MM1 .LT. 1) MM1=5
+ JJ1=NOP(N2,MM1)
+ IF(J1 .EQ. JJ1) THEN
+!
+! We have the other match find nodes around the element
+!
+ MID4=MM+1
+ JMID4=NOP(N2,MID4)
+ MID5=MM+3
+ IF(MM .EQ. 5) MID5=2
+ JMID5=NOP(N2,MID5)
+ M2=9-M-M1
+ MM2=9-MM-MM1
+ J2=NOP(N1,M2)
+ JJ2=NOP(N2,MM2)
+ NOP(N1,1)=J2
+ NOP(N1,2)=JMID3
+ NOP(N1,3)=J
+ NOP(N1,4)=JMID4
+ NOP(N1,5)=JJ2
+ NOP(N1,6)=JMID1
+ NOP(N2,1)=JJ2
+ NOP(N2,2)=JMID5
+ NOP(N2,3)=J1
+ NOP(N2,4)=JMID2
+ NOP(N2,5)=J2
+ NOP(N2,6)=JMID1
+ write(90,*) (nop(n1,i),i=1,6)
+ write(90,*) (nop(n2,i),i=1,6)
+ if(jmid1 .gt. 0) then
+ CORD(JMID1,1) = (CORD(J2,1)+CORD(JJ2,1))/2.0
+ CORD(JMID1,2) = (CORD(J2,2)+CORD(JJ2,2))/2.0
+ XUSR(JMID1) = CORD(JMID1,1)*TXSCAL - XS
+ YUSR(JMID1) = CORD(JMID1,2)*TXSCAL - YS
+ IF(NECON(JMID2,1) .EQ. N1) NECON(JMID2,1)=N2
+ IF(NECON(JMID2,2) .EQ. N1) NECON(JMID2,2)=N2
+ IF(NECON(JMID4,1) .EQ. N2) NECON(JMID4,1)=N1
+ IF(NECON(JMID4,2) .EQ. N2) NECON(JMID4,2)=N1
+ endif
+ GO TO 350
+ ENDIF
+ ENDIF
+ 250 CONTINUE
+ 300 END DO
+ 350 CONTINUE
+! CALL PLOTOT
+ RETURN
+ END
diff --git a/src/src83e/REGSTR.F90 b/src/src83e/REGSTR.F90
new file mode 100644
index 0000000..c7c4238
--- /dev/null
+++ b/src/src83e/REGSTR.F90
@@ -0,0 +1,345 @@
+! Last change: IPK 24 Aug 2001 3:08 pm
+ SUBROUTINE REGISTR(I)
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+
+ CALL SLPOINT(A1,B1,A2,B2,C1,D1,C2,D2,N)
+!
+! A1 = X CORD OF DESIRED WORLD-1
+! B1 = Y CORD OF DESIRED WORLD-1
+! A2 = X CORD OF DESIRED WORLD-2
+! B2 = X CORD OF DESIRED WORLD-2
+! C1 = X CORD OF INPUT WORLD-1
+! D1 = Y CORD OF INPUT WORLD-1
+! C2 = X CORD OF INPUT WORLD-2
+! D2 = X CORD OF INPUT WORLD-2
+
+ IF(N .EQ. 1) THEN
+
+! Compute new locations
+
+ SCALEER= (A2-A1)/(C2-C1)
+ ASIZ=(BFMINMAX(I,3)-BFMINMAX(I,1))*SCALEER
+ FLEFT=(C1-BFMINMAX(I,1))/(BFMINMAX(I,3)-BFMINMAX(I,1))
+ XNEW1=A1-FLEFT*ASIZ
+ XNEW2=XNEW1+ASIZ
+ WRITE(90,*) 'X-SCAL',SCALEER,ASIZ,FLEFT,XNEW1,XNEW2
+ SCALEER= (B2-B1)/(D2-D1)
+ BSIZ=(BFMINMAX(I,4)-BFMINMAX(I,2))*SCALEER
+ FBEL=(D1-BFMINMAX(I,2))/(BFMINMAX(I,4)-BFMINMAX(I,2))
+ YNEW1=B1-FBEL*BSIZ
+ YNEW2=YNEW1+BSIZ
+ WRITE(90,*) 'Y-SCAL',SCALEER,BSIZ,FBEL,YNEW1,YNEW2
+
+! Confirm that they are acceptable
+
+ CALL DISPREG(BFMINMAX(I,1),BFMINMAX(I,2),BFMINMAX(I,3),BFMINMAX(I,4),XNEW1,YNEW1,XNEW2,YNEW2,NN)
+ WRITE(90,*) 'AFTER DIS',NN,XNEW1,YNEW1,XNEW2,YNEW2
+
+! Store them in the appropriate array
+
+ IF(NN .EQ. 1) THEN
+ BFMINMAX(I,1)=XNEW1
+ BFMINMAX(I,2)=YNEW1
+ BFMINMAX(I,3)=XNEW2
+ BFMINMAX(I,4)=YNEW2
+ ELSE
+ RETURN
+ ENDIF
+
+! Save them if they are wanted
+
+ CALL SAVORG(I,1)
+
+ ENDIF
+
+ RETURN
+ END SUBROUTINE
+
+! Display selected origins
+
+ SUBROUTINE DISPREG(A1,B1,A2,B2,C1,D1,C2,D2,NN)
+
+! This subroutine gets points
+!
+ USE WINTERACTER
+
+ IMPLICIT NONE
+!
+! Define some parameters to match those in the resource file
+!
+ include 'd.inc'
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: N,IBOX,NN
+ INTEGER :: IERR
+ REAL :: A1,B1,A2,B2,C1,D1,C2,D2
+ CHARACTER*1 :: IFLAG
+
+
+
+ call wdialogload(IDD_CONFIRM)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_CONFIRM)
+ ierr=infoerror(1)
+
+ CALL WDialogPutReal(IDF_REAL1,A1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL2,B1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL5,A2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL6,B2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL3,C1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL4,D1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL7,C2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL8,D2,'(F8.0)')
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+
+! Branch depending on type of message.
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ NN=1
+ CALL WDialogGetReal(IDF_REAL1,A1)
+ CALL WDialogGetReal(IDF_REAL2,B1)
+ CALL WDialogGetReal(IDF_REAL5,A2)
+ CALL WDialogGetReal(IDF_REAL6,B2)
+ CALL WDialogGetReal(IDF_REAL3,C1)
+ CALL WDialogGetReal(IDF_REAL4,D1)
+ CALL WDialogGetReal(IDF_REAL7,C2)
+ CALL WDialogGetReal(IDF_REAL8,D2)
+ RETURN
+ ELSEIF(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ NN=0
+ RETURN
+ ENDIF
+!ipk sep02
+ NN=0
+ RETURN
+ ENDDO
+ RETURN
+ END
+
+! Select points
+
+ SUBROUTINE SLPOINT(A1,B1,A2,B2,C1,D1,C2,D2,NN)
+!
+! This subroutine gets points
+!
+ USE WINTERACTER
+
+ IMPLICIT NONE
+!
+!
+! Define some parameters to match those in the resource file
+!
+ include 'd.inc'
+
+ INTEGER :: NP,NE,NHTP,NMESS,NBRR,IPSW,IRMAIN,ISCRN,icolon,IQSW,IRDISP,ntempin,IGFGSW,IGFGSWB,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+!
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER :: N,IBOX,NN
+ INTEGER :: IERR
+!IPK MAY02
+ REAL :: A1,B1,A2,B2,C1,D1,C2,D2,XX,YY
+ CHARACTER*1 :: IFLAG
+
+
+ call wdialogload(IDD_SLRGNO)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_SLRGNO)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,N)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+
+! Branch depending on type of message.
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,N)
+ GO TO 150
+ ENDIF
+!ipk sep02
+ RETURN
+ ENDDO
+ 150 CONTINUE
+
+ NHTP=0
+ NBRR=3
+ NMESS=43
+ CALL HEDR
+ WRITE(90,*) 'BACK FROM HEDR'
+ IF(N .EQ. 1) THEN
+ CALL XYLOC(XX,YY,iflag,ibox)
+ C1 = XX*TXSCAL - XS
+ D1 = YY*TXSCAL - YS
+ WRITE(90,*) 'BACK FROM XYLOC-1',C1,D1,IBOX,IFLAG
+ ELSE
+ CALL XYLOC(XX,YY,iflag,ibox)
+ C2 = XX*TXSCAL - XS
+ D2 = YY*TXSCAL - YS
+ WRITE(90,*) 'BACK FROM XYLOC-2',C2,D2,IBOX,IFLAG
+ ENDIF
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ CALL WRTOUT(0)
+ RETURN
+ ENDIF
+
+ call wdialogload(IDD_REGST)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_REGST)
+ ierr=infoerror(1)
+
+ CALL WDialogPutReal(IDF_REAL1,A1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL2,B1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL3,A2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL4,B2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL5,C1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL6,D1,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL7,C2,'(F8.0)')
+ CALL WDialogPutReal(IDF_REAL8,D2,'(F8.0)')
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+
+! Branch depending on type of message.
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDADJUST) THEN
+
+ CALL WDialogGetReal(IDF_REAL1,A1)
+ CALL WDialogGetReal(IDF_REAL2,B1)
+ CALL WDialogGetReal(IDF_REAL3,A2)
+ CALL WDialogGetReal(IDF_REAL4,B2)
+ CALL WDialogGetReal(IDF_REAL5,C1)
+ CALL WDialogGetReal(IDF_REAL6,D1)
+ CALL WDialogGetReal(IDF_REAL7,C2)
+ CALL WDialogGetReal(IDF_REAL8,D2)
+ NN=1
+ RETURN
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDFSWITCH) THEN
+
+ CALL WDialogGetReal(IDF_REAL1,A1)
+ CALL WDialogGetReal(IDF_REAL2,B1)
+ CALL WDialogGetReal(IDF_REAL3,A2)
+ CALL WDialogGetReal(IDF_REAL4,B2)
+ CALL WDialogGetReal(IDF_REAL5,C1)
+ CALL WDialogGetReal(IDF_REAL6,D1)
+ CALL WDialogGetReal(IDF_REAL7,C2)
+ CALL WDialogGetReal(IDF_REAL8,D2)
+ IF(N .EQ. 1) THEN
+ N=2
+ ELSE
+ N=1
+ ENDIF
+ GO TO 150
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ NN=0
+ RETURN
+ ENDIF
+!IPK SEP02
+ NN=0
+ RETURN
+ ENDDO
+ RETURN
+ END
+
+
+ SUBROUTINE SAVORG(NN,III)
+
+! This subroutine askf to check first then saves ORG file data
+!
+ USE WINTERACTER
+
+ IMPLICIT NONE
+!
+! Define some parameters to match those in the resource file
+!
+ include 'd.inc'
+!
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INCLUDE 'BFILES.I90'
+ CHARACTER(LEN=256) :: FILTER
+
+ INTEGER :: NN,I,III
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ INTEGER :: INFO(3)
+ REAL :: XSIZ,YSIZ
+ IF(III .EQ. 1) THEN
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK, 'Do you wish to '// &
+ 'save locations as ORG or JPGW file?', 'SAVE ORG/JPGW FILE')
+!
+! If answer 'NO', return
+!
+ IF (WInfoDialog(4) .EQ. 2) RETURN
+ ENDIF
+
+! Otherwise process
+ call IGrFileInfo(BFNAME(NN),INFO,3)
+
+ FILTER ="Registration Files|*.org;*.jpgw|ORG file -- *.org|*.org|JPGW file -- *.jpgw|*.jpgw|"
+
+ CALL WSelectFile(FILTER,SaveDialog+PromptOn+AppendExt,FNAME,'Save ORG/JPGW File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+! SUB='org'
+ OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ if(sub .eq. 'jpg') then
+ XSIZ=(BFMINMAX(NN,3)-BFMINMAX(NN,1))/FLOAT(INFO(2))
+ YSIZ=(BFMINMAX(NN,2)-BFMINMAX(NN,4))/FLOAT(INFO(3))
+ WRITE(104,*) XSIZ
+ WRITE(104,*) ' 0.0'
+ WRITE(104,*) ' 0.0'
+ WRITE(104,*) YSIZ
+ WRITE(104,*) BFMINMAX(NN,1)
+ WRITE(104,*) BFMINMAX(NN,4)
+ CLOSE(104)
+ else
+! CALL ADDSUB(FNAME,SUB)
+! OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
+ WRITE(104,'(4G16.8)') (BFMINMAX(NN,I),I=1,4)
+ CLOSE(104)
+ endif
+ ENDIF
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/REORD.F90 b/src/src83e/REORD.F90
new file mode 100644
index 0000000..edc863b
--- /dev/null
+++ b/src/src83e/REORD.F90
@@ -0,0 +1,1049 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR REORDERING
+ SUBROUTINE ORDALL
+
+ INCLUDE 'BFILES.I90'
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+
+ ISWALL=1
+ nmess=45
+
+ CALL GETINT(ISWALL)
+ IF(ISWALL .EQ. 0) ISWALL=1
+ ISW=0
+ CALL REORD(ISW,ISWALL)
+ CALL WMessageBox(0,4,1,'REORDERING COMPLETE',' ')
+
+ IRDONE=1
+
+ RETURN
+
+ END
+
+
+
+!IPK LAST UPDATE JULY 11 2005 FIX BUG IN REORDERING
+!ipk last update Nov 18 1996
+! Last change: IPK 12 Jan 98 2:06 pm
+!ipk last update Jan 6 1997 disallow negative sums
+ SUBROUTINE ADDORD(ISW)
+!
+! Enter reordering sequence
+!
+ USE WINTERACTER
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+
+! INCLUDE 'BLK1.COM'
+!iPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+! dimension ilisttmp(100)
+!
+ CHARACTER*1 IFLAG
+ CHARACTER*14 HEADR
+ CHARACTER*60 STRELS
+ CHARACTER*80 LIND
+! INTEGER*2 IPAG,NT
+ DATA MULTPG/0/
+ DATA STRELS/' You have tried to reorder before executing "FILL"'/
+ DATA XPRT/0./
+!
+! Test to make sure fill has been executed.
+!
+ IF(ISW .NE. 1) THEN
+ DO 70 N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ DO 60 M=2,NCORN(N),2
+!ipkoct93
+ if(imat(n) .gt. 900) go to 60
+ IF(NOP(N,M) .EQ. 0) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
+ 'You have tried to reorder before executing "FILL"'//CHAR(13) &
+ //'Reordering terminated',&
+ 'UNABLE TO REORDER')
+! CALL SYMBL(0.,7.30,0.20,STRELS,0.,60)
+ RETURN
+ ENDIF
+ 60 CONTINUE
+ ENDIF
+ 70 CONTINUE
+ ENDIF
+!
+!
+ IF(ISW .EQ. 0) THEN
+!
+! Change screens if possible
+!
+ IF(MULTPG .EQ. 1) THEN
+! IPAG=1
+! NT=SETACTIVEPAGE(IPAG)
+! NT=SETVISUALPAGE(IPAG)
+ ELSE
+ CALL CLSCRN
+ CALL SETD(23)
+ ENDIF
+ ISWW=0
+ CALL WCursorShape(CurHourGlass )
+ ISWALL=0
+ CALL REORD(ISWW,ISWALL)
+ IRDONE=1
+!IPK AUG05 CALL REORD(ISWW)
+ CALL WCursorShape(CurArrow )
+!
+! Restore screen
+!
+!pk jan98 WRITE(*,*) 'Press "Return" to restore grapical screen'
+
+ CALL SHOWORD
+! WRITE(LIND,6002)
+! 6002 FORMAT( 'Press "Return" to restore grapical screen')
+! call rblue
+! call symbl &
+! & (1.1,3.0,0.20,LIND,0.0,80)
+! ndig=1
+! CALL GTCHARX(IFLAG,NDIG,5.0,7.6)
+
+!ipk jan98 READ(*,'(A)') IFLAG
+ IF(MULTPG .EQ. 1) THEN
+ IPAG=0
+! NT=SETACTIVEPAGE(IPAG)
+! NT=SETVISUALPAGE(IPAG)
+ ELSE
+ CALL CLSCRN
+ CALL SETD(2)
+! CALL PLOTS(0)
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ do n=1,ne
+ nn=iem(n)
+ if(imat(nn) .ne. 0 .AND. IESKP(NN) .EQ. 0) then
+
+ call fillemC(nn,MOD(N/25,15))
+ endif
+! if(mod(n,200) .eq. 0) then
+! READ(*,'(A)') IFLAG
+! endif
+ enddo
+ ENDIF
+ ELSEIF(ISW .EQ. 1) THEN
+ 100 continue
+! 100 WRITE(HEADR,5000) NLST
+! 5000 FORMAT(' NLIST = ',I5)
+! NHTP = 0
+! NMESS = 13
+! NBRR = 0
+! CALL HEDR
+! CALL SYMBL(0.,7.50,0.20,HEADR,0.,14)
+! XPRT=3.2
+!
+! Form element reordering list by clicking on elements with cursor
+!
+ 5001 FORMAT(I10)
+! CALL GETINT(NLIST)
+! READ(*,5001,ERR=220) NLIST
+!
+! Find element nearest cursor
+!
+ J=0
+ 200 IBOX=1
+ NMESS = 12
+ NBRR = 9
+ CALL HEDR
+ CALL PLOTORDS
+ INREORD=1
+ CALL PROX(XC,YC,NE,XX,YY,IELEM,IFLAG,IESKP,IBOX)
+ INREORD=0
+ CALL PLOTORDS
+! write(90,*) 'reord'
+! write(90,'(i10,a10)') ibox,iflag
+ IF(IRMAIN .EQ. 1) THEN
+ DO J=1,100
+ ilisttmp (j)=0
+ ENDDO
+ RETURN
+ ENDIF
+ 210 IF(IFLAG .EQ. 'c' .and. ibox .ne. 7) THEN
+ CALL FILLEM(IELEM)
+ XPRT=XPRT+0.5
+ IF(XPRT .GT. HSIZE) XPRT=0.
+ FPN= IELEM
+ CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1)
+ J=J+1
+ ilisttmp (j)=ielem
+! ILIST(NLIST,J)=IELEM
+ GO TO 200
+ ELSEIF (IFLAG .EQ. 'U') THEN
+ ilisttmp (j)=0
+ J=J-1
+ CALL PLOTOT(1)
+ CALL HEDR
+ DO IELEM=1,J
+ CALL FILLEM(ILISTTMP(IELEM))
+ ENDDO
+ GO TO 200
+ ELSEIF(IFLAG .EQ. 'e') THEN
+! LLIST(NLIST)=J
+ nlist=nlst+1
+ call getnlist(nlist)
+ LLIST(NLIST)=J
+ do i=1,j
+ ilist(nlist,i)=ilisttmp(i)
+ enddo
+ IF(NLIST .GT. NLST) NLST=NLIST
+ DO J=1,100
+ ilisttmp (j)=0
+ ENDDO
+ GO TO 100
+ ELSEIF(IFLAG .EQ. 'a' .or. ibox .eq. 7) THEN
+ nlist=nlst+1
+ IF(IRECD .NE.2) call getnlist(nlist)
+ LLIST(NLIST)=J
+ do i=1,j
+ ilist(nlist,i)=ilisttmp(i)
+ enddo
+ IF(NLIST .GT. NLST) NLST=NLIST
+ DO J=1,100
+ ilisttmp (j)=0
+ ENDDO
+ GO TO 100
+ ELSEIF(IFLAG .EQ. 'q') THEN
+! LLIST(NLIST)=J
+! IF(NLIST .GT. NLST) NLST=NLIST
+! CALL REORD(NLIST)
+! CALL WRTOUT(0)
+ DO J=1,100
+ ilisttmp (j)=0
+ ENDDO
+ ENDIF
+ ELSEIF(ISW .EQ. 2) THEN
+!
+! Change screens if possible
+!
+ IF(MULTPG .EQ. 1) THEN
+ IPAG=1
+! NT=SETACTIVEPAGE(IPAG)
+! NT=SETVISUALPAGE(IPAG)
+ ELSE
+ CALL CLSCRN
+ CALL SETD(23)
+ ENDIF
+ ISWW=NLIST
+ ISWALL=0
+ CALL REORD(ISWW,ISWALL)
+!IPK AUG05 CALL REORD(ISWW)
+!
+! Restore screen
+!
+!IPK JAN98 WRITE(*,*) 'Press "Return" to restore grapical screen'
+!IPK JAN98 READ(*,'(A)') IFLAG
+ CALL SHOWORD
+! WRITE(LIND,6002)
+! call symbl &
+! & (1.1,3.0,0.20,LIND,0.0,80)
+! ndig=1
+! CALL GTCHARX(IFLAG,NDIG,5.0,7.6)
+ IF(MULTPG .EQ. 1) THEN
+ IPAG=0
+! NT=SETACTIVEPAGE(IPAG)
+! NT=SETVISUALPAGE(IPAG)
+ ELSE
+ CALL CLSCRN
+ CALL SETD(2)
+! CALL PLOTS(0)
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ ENDIF
+ ENDIF
+ 220 RETURN
+ END
+ SUBROUTINE REORD (ISW,ISWALL)
+!
+! DRIVING ROUTINE TO REORDER ELEMENTS
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! INITIALIZE
+!
+ IF(IECHG .EQ. 0) THEN
+ NCM=MAXECON
+ NCMI=MAXECON
+ NAD=0
+ MP=0
+ IPASS=1
+!
+! GET TABLE OF ELEMENT CONNECTIONS
+!
+ CALL KCON(0)
+!
+! SETUP NELIM. IDENTIFIES 3 NODE ELEMENTS OR JUNCTIONS WHEN = 1
+!
+ DO 250 N=1,NE
+ IF(IMAT(N) .NE. 0) THEN
+!ipkoct93
+ IF(NCORN(N) .EQ. 3 .OR. (IMAT(N) .GT. 900 .and. &
+ & ncorn(n) .ne. 8)) THEN
+ NELIM(N)=1
+ ELSE
+ NELIM(N)=0
+ ENDIF
+ ELSE
+ NELIM(N)=1
+ ENDIF
+ 250 CONTINUE
+ IECHG=1
+!IPK MAY03
+ ICHG=0
+
+!
+! PROCESS INITIAL ORDER
+!
+ IF(ISW .EQ. 0) THEN
+ CALL ORDER(ISWALL)
+ ISW=ISW+1
+ ENDIF
+ ENDIF
+ IF(ISW .EQ. 0) ISW=1
+!
+! OTHERWISE RESET MLIST
+!
+ 305 DO 310 N=1,NAE
+ MLIST(N)=0
+ 310 END DO
+!
+! SET STARTING SEQUENCE
+!
+
+!IPK AUG05
+ IF(ISWALL .EQ. 0) THEN
+
+ NN=1
+ DO 320 N=1,NAE
+ MLIST(NN)=ILIST(ISW,N)
+ IF(NN .GT. 1) THEN
+ IF(MLIST(NN) .EQ. MLIST(NN-1)) THEN
+ NN=NN-1
+ ENDIF
+!IPK JUL05 FIX BUG MOVE DOWN NN=NN+1
+ ENDIF
+ NN=NN+1
+! write(90,*) 'Entries forming start of list',n,mlist(n)
+ IF(MLIST(N) .EQ. 0) GO TO 325
+ 320 END DO
+ ELSE
+ 322 CONTINUE
+ IF(MOD(ISW,ISWALL) .EQ. 0) THEN
+ MLIST(1)=ISW
+ ELSE
+ ISW=ISW+1
+ GO TO 322
+ ENDIF
+
+ ENDIF
+!
+ 325 MP=0
+ NAD=0
+!
+! RESET NODE TO ELEMENT LIST
+!
+ DO 340 N=1,NP
+ DO 335 M=1,NCM
+ IF(NECON(N,M) .EQ. 0) GO TO 338
+ 335 CONTINUE
+ 338 NDELM(N)=M-1
+ 340 END DO
+!
+! RESET ELEMENT CONNECTIONS
+!
+ DO 350 N=1,NE
+ DO 350 M=1,NCMI
+ ICON(N,M)=IABS(ICON(N,M))
+ 350 CONTINUE
+!
+! GO TO PROCESS THIS SEQUENCE
+!
+ IF(MLIST(1) .GT. 0) THEN
+ CALL ORDER(ISWALL)
+ ISW=ISW+1
+ ELSE
+ GO TO 600
+ ENDIF
+ IF(ISWALL .EQ. 0) THEN
+ IF(ISW .GT. NLST) GO TO 600
+ ELSE
+ WRITE(90,*) MLIST(1),MTSUMSV(NSEQ),NFWSV(NSEQ),IEM(1),MRSUM
+
+ IF(ISW .GT. NE) GO TO 600
+ ENDIF
+ GO TO 305
+!
+! PRINT FINAL ORDER
+!
+ 600 WRITE(90,6040) (IEM(K),K=1,NAE)
+ 6040 FORMAT(//' SELECTED ELEMENT ORDER'/(10I6))
+!
+! RETURN TO MAIN
+!
+ RETURN
+ END
+ SUBROUTINE ORDER(ISWALL)
+!
+! FIND ORDER AND FRONT SUM FOR A GIVEN START POINT
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! SET LIST OF INCORPORATED NODES
+!
+ DO 200 N=1,NP
+ 200 NINC(N)=0
+!
+! SET COUNTER ON ELEMENTS
+!
+ KNT=0
+ MTSUM=0
+!ipk feb97 add mtsum1
+ mtsum1=0
+!IPK MAY94 LINE ADDED
+ NFWSAV=0
+!
+! PROCESS THROUGH ELEMENTS
+!
+ 300 CONTINUE
+!
+! SET MLIST FROM INPUT IF NON-ZERO WE MUST FIND KREC
+!
+ KREC=MLIST(KNT+1)
+!
+! GET NEXT ELEMENT TO ADDED
+!
+ CALL MOVFNT(KREC,ISWALL)
+
+!ipk mar04
+ IF(KREC .lt. 0) THEN
+ write(90,*) 'krec',knt,mlist(knt)
+ MTSUM=9999999999999
+ MTSUM1=9999999999999
+ GO TO 310
+ ENDIF
+!
+! SAVE SELECTED VALUE
+!
+ MLIST(KNT+1)=KREC
+ KNT=KNT+1
+!
+! UPDATE FRONT AND CONNECTION TABLES
+!
+ CALL UPFNT(KREC)
+! WRITE(91,9000) KREC,MTSUM,MSUM,MP,NAD
+! 9000 FORMAT(' KREC MTSUM MSUM MP NAD'/I6,2I15,2I5)
+!
+! TEST FOR FULL SET OF ELEMENTS
+!
+ IF (KNT.LT.NAE) GO TO 300
+!
+! FOR COMPLETE ORDER CHECK IF IT IS IMPROVEMENT
+!
+!IPK MAR04
+ 310 CONTINUE
+ CALL CHKOUT(ISWALL)
+!
+! FINISHED
+!
+ RETURN
+ END
+ SUBROUTINE MOVFNT(KREC,ISWALL)
+!
+! GET ELEMENT THAT INCREASES FRONT WIDTH LEAST
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INTEGER*8 MSAV,MSA
+ CHARACTER*80 LIND
+ CHARACTER*1 JUNK
+!
+! INITIALIZE
+!
+ MSAV=99999999
+ NSN=99999
+!
+! SKIP IF KREC ALREADY DEFINED
+!
+ IF(KREC .GT. 0) GO TO 310
+!
+! SEARCH ADJACENT ELEMENTS
+!
+ NTST=NITST
+ 260 NFD=0
+ if(nad .eq. 0) then
+!IPK JAN98 write(*,*) 'nad in trouble type q and press return,enxt(1)',enxt(1)
+!IPK JAN98 read(*,*) njunk
+!ipk mar04 WRITE(LIND,6002)krec,nsn
+!ipk mar04 6002 FORMAT( 'NAD =0 illegal connection. krec,nsn',2i5,'Type q to exit')
+!ipk mar04 call symbl &
+!ipk mar04 & (1.1,3.0,0.20,LIND,0.0,80)
+!ipk mar04 ndig=1
+!ipk mar04 CALL GTCHARX(JUNK,NDIG,5.0,7.6)
+!ipk mar04 stop
+ IF(ISWALL .GT. 0) THEN
+ KREC=-1
+ RETURN
+ ENDIF
+ write(90,*) nae
+ write(90,'(5(i7,i6))') (n,mlist(n),n=1,ne)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK, &
+ 'No active adjacent elements found '//CHAR(13) &
+ //'Possible network error.'//CHAR(13) &
+ //'or erroneous starting element'//CHAR(13) &
+ //'Reordering terminated',&
+ 'ERROR')
+ krec=-1
+ return
+ endif
+ DO 300 K=1,NAD
+ NEL=ENXT(K)
+ IF(NTST .EQ. 0) GO TO 270
+ IF(NELIM(NEL) .EQ. 1) GO TO 300
+ 270 CONTINUE
+ NFD=1
+!
+! GET SUMS FOR NEL
+!
+ CALL SUMIT(NEL)
+!
+! MSA IS THE AVERAGE PER NODE ADDED
+!
+ MSA=MSUM
+! MSA=9999999
+ IF(NDP .GT. 1) MSA=(MSUM+NDP/2)/NDP
+!
+! CHECK IF IT IS LESS
+!
+ IF (MSA.GT.MSAV) GO TO 300
+ IF (MSA.LT.MSAV) GO TO 280
+!
+! IF EQUAL TAKE CASE WITH LEAST NODES ADDED
+!
+ IF (NDP.GE.NSN) GO TO 300
+ 280 KREC=NEL
+ NSN=NDP
+ MSAV=MSA
+ 300 END DO
+ IF(NFD .EQ. 0) THEN
+ NTST=0
+ GO TO 260
+ ENDIF
+ 310 CONTINUE
+!
+! GET INFORMATION AGAIN FOR SELECTED ELEMENT
+!
+ CALL SUMIT(KREC)
+!IPK MAY94 ADD A LINE
+ IF(NFWS .GT. NFWSAV) NFWSAV=NFWS
+ IF(MSUM .EQ. 9999999) MSUM=0
+ MTSUM=MTSUM+MSUM
+!ipk feb97 add pseudo double precision
+ 320 continue
+! if(mtsum .gt. 100000000) then
+! mtsum1=mtsum1+1
+! mtsum=mtsum-100000000
+! go to 320
+! endif
+!
+! UPDATE LIST OF NODES IN FRONT
+!
+ MPN=MP
+ IF (MP.EQ.0) GO TO 420
+ IF (NDP.EQ.0) GO TO 420
+!
+! REMOVE THE DROPPED NODES
+!
+! ict2=ict2+1
+! write(88,*) ict2,'z',krec,ndp,(ndrop(n),n=1,ndp)
+ DO 400 N=1,NDP
+!
+! FIND THE NODE TO BE DROPPED IN LIST
+!
+ DO 390 M=1,MP
+ IF (LIST(M).NE.NDROP(N)) GO TO 390
+ LIST(M)=-LIST(M)
+ GO TO 400
+ 390 CONTINUE
+ 400 END DO
+!
+! NOW DROP THEM
+!
+ MPN=0
+ DO 410 M=1,MP
+ IF (LIST(M).LT.0) GO TO 410
+ MPN=MPN+1
+ LIST(MPN)=LIST(M)
+ 410 END DO
+!
+! NOW ADD NEWLY GENERATED NODES
+!
+ IF (NNEW.EQ.0) GO TO 435
+ 420 DO 430 M=1,NNEW
+!
+! FIRST SEE IF LNEW IS IN DROP LIST
+!
+ IF(NDP .EQ. 0) GO TO 428
+ DO 425 N=1,NDP
+ IF(LNEW(M) .EQ. NDROP(N)) GO TO 430
+ 425 CONTINUE
+ 428 CONTINUE
+ MPN=MPN+1
+ LIST(MPN)=LNEW(M)
+ K=LNEW(M)
+ NINC(K)=1
+ 430 END DO
+!
+! REDUCE COUNT OF ELEMENTS ACQUIRED AT THE NODES OF THE ELEMENT
+!
+ 435 CONTINUE
+ MP=MPN
+! ict1=ict1+1
+! write(85,*) ict1,'x',krec,mp,(list(n),n=1,mp)
+ DO 440 K=1,8
+ N=NOP(KREC,K)
+ IF (N.EQ.0) GO TO 440
+ NDELM(N)=NDELM(N)-1
+ 440 END DO
+ RETURN
+ END
+ SUBROUTINE UPFNT(KREC)
+!
+! DEFINE NEW INFO ON FRONT
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! SET ICON ENTRIES NEGATIVE TO SAY THIS ELEMENT ALREADY ADDED
+!
+ DO 450 M=1,NCMI
+ K=ICON(KREC,M)
+ IF (K.EQ.0) GO TO 460
+ IF (K.LT.0) GO TO 450
+ DO 430 J=1,NCMI
+ IF (ICON(K,J).NE.KREC) GO TO 430
+ ICON(K,J)=-ICON(K,J)
+ GO TO 450
+ 430 CONTINUE
+ 450 END DO
+!
+! UPDATE LIST OF ELEMENTS STILL IN FRONT
+!
+ 460 MNAD=0
+!
+! FIRST ELIMINATE KREC
+!
+ IF(NAD .EQ. 0) GO TO 510
+ DO 500 K=1,NAD
+ IF (ENXT(K).EQ.KREC) GO TO 500
+ MNAD=MNAD+1
+ ENXT(MNAD)=ENXT(K)
+ 500 END DO
+ 510 CONTINUE
+ NAD=MNAD
+!
+! NOW ADD NEW ELEMENTS
+!
+ DO 520 J=1,NCMI
+ K=ICON(KREC,J)
+ IF (K.LE.0) GO TO 520
+!
+! CHECK OF -K- ALREADY IN LIST
+!
+ DO 515 M=1,NAD
+ IF(K .EQ. ENXT(M)) GO TO 520
+ 515 CONTINUE
+ MNAD=MNAD+1
+ ENXT(MNAD)=K
+ 520 END DO
+ NAD=MNAD
+ RETURN
+ END
+ SUBROUTINE SUMIT(NEL)
+!
+! DEVELOP SUMS FOR MAKING ELIMINATION CHOICE
+!
+ USE BLK1MOD
+ USE BLK2MOD
+ INTEGER*8 MSUMP
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! LOCATE NEW NODES
+!
+ NDP=0
+ NNEW=0
+ DO 280 K=1,8
+ N=NOP(NEL,K)
+ IF (N.EQ.0) GO TO 280
+!
+! TEST WHETHER THIS NODE ALREADY INCORPORATED
+!
+ IF (NINC(N).EQ.1) GO TO 260
+ NNEW=NNEW+1
+ LNEW(NNEW)=N
+!
+! NOW TEST IF THE NODE IS COMPLETELY FORMED
+!
+ 260 IF (NDELM(N).GT.1) GO TO 280
+ NDP=NDP+1
+ NDROP(NDP)=N
+ 280 END DO
+!
+! IMMEDIATELY ON ADDING NEW FRONT SIZE IS
+!
+ NFW=MP+NNEW
+!IPK MAY94 ADD A LINE
+ NFWS=NFW
+!
+! NOW TAKE OUT ALL WE CAN
+!
+ MSUM=99999999
+! MSUM=0
+ IF(NDP .EQ. 0) RETURN
+ MSUMP=0
+ DO 300 K=1,NDP
+ MSUMP=MSUMP+NFW**2
+ NFW=NFW-1
+ 300 END DO
+ msum=msump
+ if(msum .gt. 99999999) THEN
+ write(90,*) ndp,msum,nfw,nel
+ ENDIF
+ RETURN
+ END
+ SUBROUTINE CHKOUT(ISWALL)
+!
+! CHECK FINAL TOTAL SAVE ORDER IF BETTER
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ CHARACTER*80 LIND
+!
+ DATA ITIME/0/
+ IF(ITIME .EQ. 0) THEN
+! call rblue
+! call clscrn
+! YT=7.5
+! WRITE(90,6010) mtsum1,MTSUM,NFWSAV
+! WRITE(LIND,6010) mtsum1,MTSUM,NFWSAV
+! WRITE(90,6010) MTSUM,NFWSAV
+! WRITE(LIND,6010) MTSUM,NFWSAV
+! call symbl &
+! & (0.1,YT,0.20,LIND,0.0,80)
+ NSEQ=0
+ MTSUMSV(NSEQ)=MTSUM
+ NFWSV(NSEQ)=NFWSAV
+! elseif(mtsum1 .gt. mrsum1) then
+! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
+! YT=YT-0.3
+! call symbl &
+! & (0.1,YT,0.20,LIND,0.0,80)
+! RETURN
+! elseif(mtsum1 .eq. mrsum1) then
+!IPK AUG05 ELSE
+ ELSEIF(ISWALL .EQ. 0) THEN
+ NSEQ=NSEQ+1
+ MTSUMSV(NSEQ)=MTSUM
+ NFWSV(NSEQ)=NFWSAV
+ if(mtsum .ge. mrsum .AND. MRSUM .GT. 0) then
+! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(90,6020) MTSUM,NFWSAV
+! WRITE(LIND,6020) MTSUM,NFWSAV
+! YT=YT-0.3
+! call symbl &
+! & (0.1,YT,0.20,LIND,0.0,80)
+ RETURN
+ else
+! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(90,6020) MTSUM,NFWSAV
+! WRITE(LIND,6020) MTSUM,NFWSAV
+! YT=YT-0.3
+! call symbl &
+! & (0.1,YT,0.20,LIND,0.0,80)
+ endif
+! ELSE
+! WRITE(90,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(LIND,6020) mtsum1,MTSUM,NFWSAV
+! WRITE(90,6020) MTSUM,NFWSAV
+! WRITE(LIND,6020) MTSUM,NFWSAV
+! YT=YT-0.3
+! call symbl &
+! & (0.1,YT,0.20,LIND,0.0,80)
+ ELSE
+! NSEQ=NSEQ+1
+ if(mtsum .ge. mrsum .AND. MRSUM .GT. 0) then
+ NSEQ=0
+ MTSUMSV(NSEQ)=MTSUM
+ NFWSV(NSEQ)=NFWSAV
+ RETURN
+ ELSE
+ NSEQ=0
+ MTSUMSV(NSEQ)=MTSUM
+ NFWSV(NSEQ)=NFWSAV
+ endif
+ ENDIF
+! mrsum1=mtsum1
+ MRSUM=MTSUM
+ ITIME=1
+! 6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT' &
+! &,I4,I8.8,I7)
+! 6020 FORMAT('ORDERING SUM, LATEST START POINT, MAX FRONT' &
+! &,I4,I8.8,I7)
+ 6010 FORMAT('ORDERING SUM, ORIGINAL ELEMENT ORDER, MAX FRONT' &
+ &,I12,I7)
+ 6020 FORMAT('ORDERING SUM, LATEST START POINT, MAX FRONT' &
+ &,I12,I7)
+!ipk feb97 end changes
+!
+! COPY ORDER
+!
+ DO 300 N=1,NAE
+ IEM(N)=MLIST(N)
+ 300 END DO
+!
+! FILL IEM ARRAY
+!
+ NAEP=NAE+1
+ DO 400 N=1,NE
+ IF(IMAT(N) .EQ. 0) THEN
+ IEM(NAEP)=N
+ NAEP=NAEP+1
+ ENDIF
+ 400 END DO
+ RETURN
+ END
+ SUBROUTINE KCON(isw1)
+!
+! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! INITIALIZE
+!
+ DO 200 J=1,NCM
+ DO 200 N=1,NP
+ 200 NECON(N,J)=0
+ DO 210 J=1,NCMI
+ DO 210 M=1,NE
+ 210 ICON(M,J)=0
+ DO 230 N=1,NP
+ 230 NDELM(N)=0
+!
+! FORM TABLE OF ELEMENTS CONNECTED TO EACH NODE
+!
+ DO 300 M=1,NE
+ IF(IMAT(M) .EQ. 0) GO TO 300
+ if(isw1 .eq. 1) then
+ if(imat(m) .eq. 999) go to 300
+ endif
+ DO 280 K=1,8
+ N=NOP(M,K)
+ IF (N .GT. 0) THEN
+ NDELM(N)=NDELM(N)+1
+ J=NDELM(N)
+ NECON(N,J)=M
+!ipkoct93 ELSE
+!ipkoct93 GO TO 300
+ ENDIF
+ 280 CONTINUE
+ 300 END DO
+! do n=1,np
+! write(87,'(31i6)') n,(necon(n,j),j=1,ncmi)
+! enddo
+! write(89,*) 'yy'
+! DO N=1,NP
+! WRITE(89,*) 'NDELM',N,NDELM(N)
+! ENDDO
+!
+! CONVERT TABLE TO ELEMENT TO ELEMENT CONNECTION
+!
+ DO 600 N=1,NP
+!
+! PLACE PAIRS OF ENTRIES FOR EACH NODE INTO APPROPRIATE ROWS
+!
+ NL=NDELM(N)-1
+!
+! SKIP OUT WHEN ONE ELEMENT OR LESS NODE
+!
+ IF (NL.LE.0) GO TO 600
+ DO 420 J=1,NL
+ M=NECON(N,J)
+!
+! PROCESS SECOND ELEMENT IN A GIVEN ROW
+!
+ DO 370 K=J+1,NL+1
+ MR=NECON(N,K)
+ MS=M
+!
+! PROCESS EACH DIRECTION OF CONNECTION
+!
+ DO 360 MX=1,2
+!
+! SEARCH IN CASE CONNECTION ALREADY FOUND
+!
+ DO 350 L=1,NCMI
+ IF (ICON(MS,L).NE.0) GO TO 345
+ ICON(MS,L)=MR
+ GO TO 355
+ 345 IF (ICON(MS,L).EQ.MR) GO TO 355
+ 350 CONTINUE
+!
+! REVERSE MR-MS FOR SECOND PASS
+!
+ 355 CONTINUE
+ MS=MR
+ MR=M
+ 360 CONTINUE
+!
+! END LOOP ON SECOND ELEMENT
+!
+ 370 CONTINUE
+!
+! END LOOP ON FIRST ELEMENT
+!
+ 420 CONTINUE
+!
+! END LOOP FOR THIS NODE
+!
+ 600 END DO
+
+! do n=1,ne
+! write(86,'(31i6)') n,(icon(n,j),j=1,ncmi)
+! enddo
+
+
+
+!
+! PROCESS TO FIND NUMBER OF ACTIVE ELEMENTS
+!
+ NAE=0
+ NTE=NE+1
+ DO 700 M=1,NE
+ IF (IMAT(M) .LT. 1) GO TO 650
+ NAE=NAE+1
+ MLIST(NAE)=M
+ GO TO 700
+ 650 NTE=NTE-1
+ MLIST(NTE)=M
+ 700 END DO
+ RETURN
+ END
+
+!ipk jan01
+ subroutine getnlist(ipos)
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+
+ INTEGER :: IPOS,IERR
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ call wdialogload(IDD_DIALOG001)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG001)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,IPOS)
+
+! write(90,*) 'iposin',ipos
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,IPOS)
+! write(90,*) 'iposout',ipos
+
+ return
+ endif
+ return
+ enddo
+
+ RETURN
+ END
+
+!ipk jan04
+ subroutine SHOWORD
+ use winteracter
+
+
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ include 'd.inc'
+
+ INTEGER :: IERR
+ CHARACTER*6 SCOL1(101)
+ CHARACTER*18 SCOL2(101)
+ CHARACTER*8 SCOL3(101)
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ call wdialogload(IDD_ORDEROUT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_ORDEROUT)
+ ierr=infoerror(1)
+ DO I=0,NSEQ
+ WRITE(SCOL1(I+1),'(I4)') I
+ WRITE(SCOL2(I+1),'(I16)') MTSUMSV(I)
+ WRITE(SCOL3(I+1),'(I8)') NFWSV(I)
+ ENDDO
+
+ CALL WGridPutString(IDF_GRID1,1,SCOL1,NSEQ+1)
+ CALL WGridPutString(IDF_GRID1,2,SCOL2,NSEQ+1)
+ CALL WGridPutString(IDF_GRID1,3,SCOL3,NSEQ+1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ return
+ endif
+ enddo
+
+ RETURN
+ END
+
diff --git a/src/src83e/RESETREG.f90 b/src/src83e/RESETREG.f90
new file mode 100644
index 0000000..ec3b3bd
--- /dev/null
+++ b/src/src83e/RESETREG.f90
@@ -0,0 +1,87 @@
+ SUBROUTINE RESETREG
+
+ USE WINTERACTER
+
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+
+ CHARACTER*1 IFLAG
+
+
+ XORIGMIN=BFMINMAX(NBKFL,1)
+ YORIGMIN=BFMINMAX(NBKFL,2)
+ XORIGMAX=BFMINMAX(NBKFL,3)
+ YORIGMAX=BFMINMAX(NBKFL,4)
+
+! get reference point
+! xrefpt
+! yrefpt
+
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Fixed Reference point','CHOOSE REFERENCE')
+
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XREFPT = XTEMP*TXSCAL - XS
+ YREFPT = YTEMP*TXSCAL - YS
+
+! get start move point
+! xlocs
+! ylocs
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Starting point','CHOOSE START')
+
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XLOCS = XTEMP*TXSCAL - XS
+ YLOCS = YTEMP*TXSCAL - YS
+
+! get finish move point
+! xlocf
+! ylocf
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Finishing point','CHOOSE FINISH')
+
+
+ CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
+ XLOCF = XTEMP*TXSCAL - XS
+ YLOCF = YTEMP*TXSCAL - YS
+
+! establish x moves
+
+ stscal=(xlocf-xrefpt)/(xlocs-xrefpt)
+ xnewmin=xrefpt-(xrefpt-xorigmin)*stscal
+ xnewmax=xrefpt+(xorigmax-xrefpt)*stscal
+
+! establish y moves
+
+ stscal=(ylocf-yrefpt)/(ylocs-yrefpt)
+ ynewmin=yrefpt-(yrefpt-yorigmin)*stscal
+ ynewmax=yrefpt+(yorigmax-yrefpt)*stscal
+
+ BFMINMAX(NBKFL,1)=xnewmin
+ BFMINMAX(NBKFL,2)=ynewmin
+ BFMINMAX(NBKFL,3)=xnewmax
+ BFMINMAX(NBKFL,4)=ynewmax
+
+ CALL CLSCRN
+ CALL PLOTOT(1)
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to use and save'//&
+ CHAR(13)//'this registration?','CHOOSE REGISTRATION?')
+!
+! If answer NO revert
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ BFMINMAX(NBKFL,1)=XORIGMIN
+ BFMINMAX(NBKFL,2)=YORIGMIN
+ BFMINMAX(NBKFL,3)=XORIGMAX
+ BFMINMAX(NBKFL,4)=YORIGMAX
+ CALL CLSCRN
+ CALL PLOTOT(1)
+ else
+ !
+ ! otherwise SAVE
+
+ CALL SAVORG(NBKFL,2)
+ END IF
+!
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/RESETWHGT.f90 b/src/src83e/RESETWHGT.f90
new file mode 100644
index 0000000..dfb5f29
--- /dev/null
+++ b/src/src83e/RESETWHGT.f90
@@ -0,0 +1,291 @@
+ SUBROUTINE RESETWHGT
+ USE BLK1MOD
+ USE BLK2MOD
+ INCLUDE 'TXFRM.COM'
+ SAVE
+ DIST(N,M)=Sqrt((cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2)*txscal
+! INCLUDE 'BLK1A.COM'
+! DIMENSION K1(50000),levrem(50000)
+! ALLOCATABLE NRF(:),AREF(:),LEVREM(:),TRANSEL(:),WLEN(:),WHGT(:),TRCEL(:)
+ IF(.NOT. ALLOCATED (NRF)) THEN
+ ALLOCATE (NRF(MAXP),AREF(MAXP),LEVREM(MAXP))
+ ENDIF
+ IF(.NOT. ALLOCATED (TRANSEL)) THEN
+ ALLOCATE(TRANSEL(MAXP),WLEN(MAXP),WHGT(MAXP))
+ ENDIF
+ NRF=0
+ AREF=0
+ K1=0
+ levrem=0
+ WHGT=-9999.
+ call kcon(1)
+ CALL PANELWHT(IWTYP,ISWL,R1,R2)
+ IF(IWTYP .LE. 0) RETURN
+ IF(ISWL .EQ. 2) GO TO 300
+ DO N=1,NE
+ IF(IMAT(N) .EQ. IWTYP) THEN
+ DO K=2,6,4
+ KK=NOP(N,K)
+ DO M=1,NE
+ IF(IMAT(M) .EQ. IWTYP) CYCLE
+ DO L=2,NCORN(M),2
+ IF(NOP(M,L) .EQ. KK) THEN
+ IF(NCORN(M) .EQ. 8) THEN
+ IF(L .EQ. 2) THEN
+ IOP1=NOP(M,5)
+ IOP2=NOP(M,7)
+ ELSEIF(L .EQ. 4) THEN
+ IOP1=NOP(M,7)
+ IOP2=NOP(M,1)
+ ELSEIF(L .EQ. 6) THEN
+ IOP1=NOP(M,1)
+ IOP2=NOP(M,3)
+ ELSEIF(L .EQ. 8) THEN
+ IOP1=NOP(M,3)
+ IOP2=NOP(M,5)
+ ENDIF
+
+ ELSE
+ IF(L .EQ. 2) THEN
+ IOP1=NOP(M,5)
+ IOP2=NOP(M,5)
+ ELSEIF(L .EQ. 4) THEN
+ IOP1=NOP(M,1)
+ IOP2=NOP(M,1)
+ ELSE
+ IOP1=NOP(M,3)
+ IOP2=NOP(M,3)
+ ENDIF
+ ENDIF
+ IF(NRF(NOP(N,K-1)) .EQ. 0) THEN
+ NRF(NOP(N,K-1))=IOP1
+ AREF(NOP(N,K-1))=WD(IOP1)
+ ELSEIF(WD(IOP1) .GT. WD(NOP(N,K-1))) THEN
+ NRF(NOP(N,K-1))=IOP1
+ AREF(NOP(N,K-1))=WD(IOP1)
+ ENDIF
+ IF(NRF(NOP(N,K+1)) .EQ. 0) THEN
+ NRF(NOP(N,K+1))=IOP2
+ AREF(NOP(N,K+1))=WD(IOP2)
+ ELSEIF(WD(IOP2) .GT. WD(NOP(N,K+1))) THEN
+ NRF(NOP(N,K+1))=IOP2
+ AREF(NOP(N,K+1))=WD(IOP2)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ DO N=1,NE
+ IF(IMAT(N) .EQ. IWTYP) THEN
+ DO K=1,7,2
+ IF(AREF(NOP(N,K)) .GE. WD(NOP(N,K))-0.1) THEN
+ IMAT(N)=IWTYP
+ nnn=nop(n,k)
+ write(151,*) 'levee reset',n,k,nnn,aref(nnn),WD(nnn)
+ do kk=1,7,2
+ levrem(nop(n,kk))=1
+ enddo
+ GO TO 150
+ ELSEIF(NRF(NOP(N,K)) .EQ. 0) THEN
+ IMAT(N)=99
+ nnn=nop(n,k)
+ write(151,*) 'Levee element removed',n,k,nnn
+ GO TO 150
+ ELSE
+ WRITE(151,*) 'Levee active', n,aref(nop(n,k)),iop1
+ IMAT(N)=IWTYP+900
+ ENDIF
+ ENDDO
+ ENDIF
+ 150 CONTINUE
+ ENDDO
+ IF(IWTP .LT. 900) IWTYP=IWTYP+900
+ DO N=1,NE
+ IF(IMAT(N) .EQ. IWTYP) THEN
+ KCT=1
+ NPK1=NOP(N,1)
+ NPK2=NOP(N,3)
+ 160 CONTINUE
+ IF(levrem(NPK1) .eq. 1) then
+ if(levrem(npk2) .eq. 1) then
+ IMAT(N)=IWTYP-900
+ GO TO 180
+ else
+ IF(KCT .EQ. 1) THEN
+ MA=NECON(NOP(N,4),1)
+ MB=NECON(NOP(N,4),2)
+ ELSE
+ MA=NECON(NOP(N,8),1)
+ MB=NECON(NOP(N,8),2)
+ ENDIF
+ IF(MA .EQ. N) MA=MB
+ IF(MA .NE. 0) THEN
+ IF(NOP(MA,1) .EQ. NPK2) THEN
+ IF(LEVREM(NOP(MA,3)) .EQ. 1) THEN
+ IMAT(N)=IWTYP-900
+ IMAT(MA)=IWTYP-900
+ ENDIF
+ ELSEIF(NOP(MA,3) .EQ. NPK2) THEN
+ IF(LEVREM(NOP(MA,1)) .EQ. 1) THEN
+ IMAT(N)=IWTYP-900
+ IMAT(MA)=IWTYP-900
+ ENDIF
+ ENDIF
+ ENDIF
+ endif
+ ENDIF
+ NPK2=NOP(N,1)
+ NPK1=NOP(N,3)
+ IF(KCT .EQ. 1) THEN
+ KCT=2
+ GO TO 160
+ ENDIF
+ ENDIF
+ 180 CONTINUE
+ ENDDO
+ DO N=1,NE
+ IF(IMAT(N) .EQ. IWTYP) THEN
+ DO K=1,7,2
+ IOP1=NRF(NOP(N,K))
+ IF(IOP1 .GT. 0) THEN
+ NPK=NOP(N,K)
+ WHGT(NPK)=WD(NPK)
+ TRANSEL(NPK)=WHGT(NPK)+R1
+ n1=nop(n,k)
+ n2=nop(n,8-k)
+ wlen(NPK)=dist(n1,n2)
+ NRF(NPK)=-NRF(NPK)
+ if(levrem(NPK) .eq. 0) then
+ WD(NPK)=WD(IOP1)
+ TRANSEL(NPK)=WHGT(NPK)+R1
+ n1=nop(n,k)
+ n2=nop(n,8-k)
+ wlen(NPK)=dist(n1,n2)
+! wlen(NPK)=8.
+ endif
+ ENDIF
+ ENDDO
+ 200 CONTINUE
+! AMMN=(WHGT(NOP(N,1))+WHGT(NOP(N,3)))/2.
+! IF(AMMN .GT. WHGT(NOP(N,1))) THEN
+! TRCEL(N)=AMMN - WHGT(NOP(N,1))+0.1
+! ELSE
+! TRCEL(N)=AMMN - WHGT(NOP(N,3))+0.1
+! ENDIF
+! TRCEL(N)=0.25
+! write(151,*) 'levee element trc set',n,trcel(n),whgt(nop(n,1))&
+! ,whgt(nop(n,3))
+ ENDIF
+ ENDDO
+ DEALLOCATE (NRF,AREF,LEVREM)
+ GO TO 400
+ 300 CONTINUE
+ DO N=1,NE
+ IF(IMAT(N) .EQ. IWTYP) THEN
+ DO K=1,7,2
+ NPK=NOP(N,K)
+ WHGT(NPK)=WD(NPK)+R2
+ TRANSEL(NPK)=WHGT(NPK)+R1
+ n1=nop(n,k)
+ n2=nop(n,8-k)
+ wlen(NPK)=dist(n1,n2)
+ ENDDO
+ ENDIF
+ ENDDO
+ 400 call OUTWDT
+ RETURN
+ END
+
+ SUBROUTINE PANELWHT(N1,ISWL,R1,R2)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,IERR,ISWL
+ real :: R1,R2
+ character*3 :: sub
+
+ call wdialogload(IDD_SETWRS)
+ ierr=infoerror(1)
+
+ call wdialogputRadioButton(idf_radio1)
+ CALL WDialogPutInteger(idf_integer1,n1)
+ CALL WDialogPutReal(idf_real1,r1)
+ CALL WDialogPutReal(idf_real2,r2)
+
+
+ CALL WDialogSelect(IDD_SETWRS)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ call wdialoggetradiobutton(idf_radio1,ISWL)
+ CALL WDialogGetInteger(idf_integer1,n1)
+ CALL WDialogGetReal(idf_real1,r1)
+ CALL WDialogGetReal(idf_real2,r2)
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ N1=-1
+
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE OUTWDT
+
+ USE WINTERACTER
+ USE BLK1MOD
+ INCLUDE 'TXFRM.COM'
+
+ CHARACTER(LEN=255) :: FNAME,FILTER
+ CHARACTER(LEN=4) :: SUB
+ LOGICAL OPENED
+ CHARACTER*1 IFLAG,ANS(10)
+
+ IOUTWR=81
+ INQUIRE(81, OPENED=OPENED)
+ if(.not. opened) then
+ Filter='WDT file -- *.dat|*.dat|'
+
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Weir Data File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+ OPEN(IOUTWR,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
+ GO TO 3
+ ELSE
+ GO TO 1
+ ENDIF
+ ELSE
+ REWIND(IOUTWR)
+ GO TO 3
+ ENDIF
+
+1 RETURN
+
+3 DO N=1,NP
+ IF(WHGT(N) .GT. -9999.) THEN
+ WRITE(IOUTWR,7778) N,WHGT(N),WLEN(N),TRANSEL(N)
+7778 FORMAT('WDT',5X,I8,3F8.2)
+ ENDIF
+ ENDDO
+ CLOSE(IOUTWR)
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/RESOURCE.F90 b/src/src83e/RESOURCE.F90
new file mode 100644
index 0000000..7873ca2
--- /dev/null
+++ b/src/src83e/RESOURCE.F90
@@ -0,0 +1,32 @@
+! Winteracter module created : 07/Nov/1998 14:27:06
+!
+ MODULE MENUED
+ INTEGER, PARAMETER :: IDR_MENU1 = 30001
+ INTEGER, PARAMETER :: ID_FILE = 40001
+ INTEGER, PARAMETER :: ID_EXIT = 40002
+ INTEGER, PARAMETER :: ID_NODE = 40003
+ INTEGER, PARAMETER :: ID_ELTS = 40004
+ INTEGER, PARAMETER :: ID_ORDR = 40005
+ INTEGER, PARAMETER :: ID_CCLN = 40006
+ INTEGER, PARAMETER :: ID_CSEC = 40007
+ INTEGER, PARAMETER :: ID_ZOOM = 40008
+ INTEGER, PARAMETER :: ID_DRAW = 40009
+ INTEGER, PARAMETER :: ID_HELP = 40010
+ INTEGER, PARAMETER :: ID_STRING1 = 50001
+ INTEGER, PARAMETER :: ID_STRING2 = 50002
+ INTEGER, PARAMETER :: ID_STRING3 = 50003
+ INTEGER, PARAMETER :: ID_STRING4 = 50004
+ INTEGER, PARAMETER :: ID_STRING5 = 50005
+ INTEGER, PARAMETER :: ID_ITEM11 = 40011
+ INTEGER, PARAMETER :: ID_ITEM12 = 40012
+ INTEGER, PARAMETER :: ID_ITEM13 = 40013
+ INTEGER, PARAMETER :: ID_ITEM14 = 40014
+ INTEGER, PARAMETER :: ID_ITEM15 = 40015
+ INTEGER, PARAMETER :: ID_ITEM16 = 40016
+ INTEGER, PARAMETER :: ID_ITEM17 = 40017
+ INTEGER, PARAMETER :: ID_ITEM18 = 40018
+ INTEGER, PARAMETER :: ID_ITEM19 = 40019
+ INTEGER, PARAMETER :: IDF_STRING1 = 1002
+ INTEGER, PARAMETER :: IDF_GROUP1 = 1001
+ INTEGER, PARAMETER :: IDF_STRING3 = 1003
+ END MODULE MENUED
diff --git a/src/src83e/RMAGEN.F90 b/src/src83e/RMAGEN.F90
new file mode 100644
index 0000000..0b55c8a
--- /dev/null
+++ b/src/src83e/RMAGEN.F90
@@ -0,0 +1,694 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR CHNAGED ELEMENTS/NODES OR REORDERING
+! Last change: IPK 13 Jan 98 10:01 am
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ SUBROUTINE RMAGEN(MENUS,N1,N2,N3,N4,N5,N6,N7,N8,N9)
+!
+!
+!
+! RMAGEN Version 4.2
+!
+! Release date Jan 13 1998
+!
+!
+! Changes in this version include:
+! (1) Revisions to operate in a graphical mode, reducing the amount of
+! DOS screen input.
+! (2) Addition of options for both the node move operation and refine
+! options to allow the user to stop preservation or automatic
+! interpolation of bottom elevations from the corner node values.
+! This option is a user setting. The default initial setting
+! retains the value for the move operation and interpolaton during
+! refinement.
+! (3) Input of "geo" has been made more flexible. The model
+! automatically detects binary files with and without headers. Note
+! that this option is only relevant for PC versions.
+! (4) The screen now displays compilation limits on startup.
+!
+!
+! RMAGEN Version 4.1(a)
+!
+! Release date Nov 18 1997
+!
+!
+!
+! Changes in this version include:
+! (1) Revised interpolation scheme for computing bottom elevations from
+! map file data.
+! (2) More consistent backup
+! (3) Addition of option to split triangles when refining
+!
+! RMAGEN Version 4.1
+!
+! Release date Oct 19 1996
+
+! Changes in this version include:
+! (1) New options that allow selective drawing of maps in different
+! colours
+! (2) An option that allows construction of continuity lines from the
+! map screen
+
+! RMAGEN Version 3.3
+
+! Release date April 1 1994
+
+! Changes in this version include:
+! (1) Incorporation of the ability to record and play scripts.
+! (2) Correction to correctly operate in the top half inch of the network
+
+! RMAGEN Version 3.2
+
+! Release date March 1 1994
+
+! Changes in this version include:
+! (1) Modification to the save options to enter a menu of save choices.
+! (2) Addition of the capability to save a binary version of the map file.
+! (3) Correction to the "backup file" to make it work consistently.
+! (4) Changes to the algorithm of the bottom elevation generation routine
+! to improve reliability.
+! (5) Removal of an implied limitation of 32000 lines for the map file by
+! deleting some INTEGER*2 variable to INTEGER*4.
+
+! RMAGEN Version 3.1(a)
+
+! Release date Aug 1 1993
+
+! Changes in this version include:
+! (1) Correction to colurs that make them more readable.
+! (2) Additions to the SELECT options that permit more flexible choice
+! of elements.
+
+! RMAGEN Version 3.1
+
+! Release date March 1 1993
+
+! Changes in this version include:
+! (1) Correction in fill operation to ensure correct fill when there are
+! a number of gaps in the nodal sequence.
+! (2) Additions to the NODE-DELETE options that permit more flexible
+! deletion options such as all mid-side nodes, all exact mid-side
+! location nodes or all unused nodes. The fill option has added
+! flexibility.
+
+
+! Version 3.0(c) August 1 1992
+
+! Changes in this version include:
+! (1) Revisions to incorporate REGIS graphics capability
+! (2) Block of routines available to use DEC 340 REGIS graphics
+! terminal with unix system
+
+
+! Version 3.0(b) May 20 1992
+
+! Changes in this version include:
+! (1) Renaming of all colours for compatibility with Silicon Graphics
+! (2) Modification of nodal delete so that when a mid-side node is
+! selected for deletion it is removed and the associated reference
+! in the element is set to zero. The element is no longer deleted.
+! (3) Cleanup of array subscripts in SUBROUTINE HEDRC
+
+! Version 3.0(a) April 1992
+
+! Changes to a number of routines to correct minor errors
+! and nuisances.
+
+! Version 3.0 January 1992
+
+! This version revises the naming of input and output files.
+! Output files may be generated in ASCII or BINARY form.
+! The binary file is designed to bypass RMA-1.
+! This file optionally may contain element reordering numbers
+! New capabilities include:
+! (1) Automatic filling of zero's in element connection arrays.
+! (2) Input of reordering sequences and executing the reordering
+! process.
+
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'BFILES.I90'
+
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+!ipk oct96
+ character*64 fnams
+ character*25 mesg
+ CHARACTER*1 ANS,ANSW(0:9),ansx(0:9)
+ DATA ANSW/'e','n','o','h','s','l','t','z','r','q'/
+ data ansx/'s','b','m','p',2*' ','h','z','r','q'/
+
+ DATA IFIRST / 1 /
+
+ IF(N3 .EQ. 1) GO TO 101
+
+ ISWTAGN=0
+ ISWTINTP=0
+ WIDSCL=1.0
+ WIDEL=0.0
+ IPW1=1
+ IMP=N1
+ IIN=N2
+ IOT=N4
+ IOT1=N5
+ IGFG=N6
+ ITRIAN=N7
+!ipk jul98
+ LCROSS=.FALSE.
+ ICRS=0
+ DFACTOR=50.
+ ZREF=5.
+
+!iPK JAN98
+ IDELV=0
+ IRESTT=0
+ 1 CONTINUE
+ IFIRST=1
+ IECHG=0
+ NELAST=1
+ NPLAST=1
+ NLST=0
+ NENTRY=0
+ TXSCAL = 1.
+ XS=0.
+ YS=0.
+ VDX = - 1.0E+10
+ VOID = - 1.0E+20
+
+ IPSW(1)=0
+ IPSW(2)=0
+ IPSW(3)=0
+ IPSW(4)=1
+ IPSW(5)=0
+ IPSW(6)=0
+ IPSW(7)=0
+ IPSW(8)=0
+ IPSW(9)=0
+ IPSW(12)=0
+! IF(N8 .GT. 100000) THEN
+! IPSW(2)=1
+! IPSW(4)=0
+! ENDIF
+ MAXPTS=MAXPL
+!ipk jan98
+ call file(1)
+
+
+ write(90,*) 'rmagen',iot,iot1
+
+! Initialize plot
+
+!! CALL GINIT
+
+! Startup files
+ WRITE(MESG,6010)
+ 6010 FORMAT(' Going to initialisation ')
+ CALL SYMBL(1.1,6.3,0.15,mesg,0.0,25)
+
+ CALL FILE(2)
+
+ WRITE(MESG,6011)
+ 6011 FORMAT(' Back from initialisation')
+ CALL SYMBL(1.1,5.3,0.15,mesg,0.0,25)
+
+ IF(MENUS .EQ. -1) CALL DEMOS
+
+ IF(IIN .EQ. 0) IPSW(1)=1
+
+! Initialize plot
+
+!ipk jan98 CALL GINIT
+
+ IF(IMP .GT. 0) THEN
+
+! Read map file
+ WRITE(90,*) 'GOING TO READ MAP'
+ CALL RDMAP(0,0,0,0)
+ IF (IFIRST .EQ. 1) THEN
+
+! Find max and min
+
+ XMIN = 1.E+20
+ XMAX = -XMIN
+ YMIN = 1.E+20
+ YMAX = -YMIN
+
+ DO 8 J=1,MAXPTS
+ IF (CMAP(J,1) .LT. VDX) GOTO 8
+ IF (CMAP(J,1) .LT. XMIN) XMIN = CMAP(J,1)
+ IF (CMAP(J,1) .GT. XMAX) XMAX = CMAP(J,1)
+ IF (CMAP(J,2) .LT. YMIN) YMIN = CMAP(J,2)
+ IF (CMAP(J,2) .GT. YMAX) YMAX = CMAP(J,2)
+ 8 CONTINUE
+ 9 CONTINUE
+ ENDIF
+ ENDIF
+
+! Read in header lines
+
+ ISET=1
+ WRITE(90,*) 'GOING TO HEADIN'
+ CALL HEADIN(IIN,ISET)
+
+! Read in existing elements
+ WRITE(90,*) 'GOING TO RDELEM'
+ CALL RDELEM(IIN)
+
+! Read in nodal coordinates
+
+ WRITE(90,*) 'GOING TO RDCORD'
+ CALL RDCORD(IIN)
+
+ WRITE(90,*) 'RMAGEN-243 NCLM',NCLM
+
+
+!ipk may03
+ ichg=1
+
+! Close input file
+
+ if(iin .ne. 0) then
+ CLOSE(IIN)
+ endif
+
+! Scale for plotting
+
+ IF (IFIRST .EQ. 1) THEN
+ IF (IMP .EQ. 0) THEN
+ XMIN = 1.E+20
+ XMAX = -XMIN
+ YMIN = 1.E+20
+ YMAX = -YMIN
+ ENDIF
+
+ IF(NP .GT. 0) THEN
+ DO 10 J=1,NP
+ IF (CORD(J,1) .LT. VDX) GOTO 10
+ IF (CORD(J,1) .LT. XMIN) XMIN = CORD(J,1)
+ IF (CORD(J,1) .GT. XMAX) XMAX = CORD(J,1)
+ IF (CORD(J,2) .LT. YMIN) YMIN = CORD(J,2)
+ IF (CORD(J,2) .GT. YMAX) YMAX = CORD(J,2)
+ 10 CONTINUE
+ ENDIF
+
+! Check for background limits
+ WRITE(90,*) 'NBKFL',NBKFL
+ IF(NBKFL .GT. 0) THEN
+ DO I=1,NBKFL
+ IF(BFMINMAX(I,1) .LT. XMIN) XMIN=BFMINMAX(I,1)
+ IF(BFMINMAX(I,2) .LT. YMIN) YMIN=BFMINMAX(I,2)
+ IF(BFMINMAX(I,3) .GT. XMAX) XMAX=BFMINMAX(I,3)
+ IF(BFMINMAX(I,4) .GT. YMAX) YMAX=BFMINMAX(I,4)
+ WRITE(90,*) 'XX',XMIN,XMAX,YMIN,YMAX
+ WRITE(90,*) 'BFMIN',(BFMINMAX(I,K4),K4=1,4)
+ ENDDO
+ ENDIF
+
+!rrr
+ WRITE(90,*) 'GOING TO PGRID'
+ CALL PGRID
+
+ AMAP=(XMAX-XMIN)*(YMAX-YMIN)
+ XSCALE = (XMAX-XMIN)/(hsize-0.5)
+ YSCALE = (YMAX-YMIN)/6.5
+ PSCALE = MAX(XSCALE,YSCALE)
+
+ XAVE = (XMIN + XMAX) /2.0
+ YAVE = (YMIN + YMAX) /2.0
+ XMIN = XAVE - hsize/2.*PSCALE
+ YMIN = YAVE - 3.5*PSCALE
+ XMAX = XAVE + (hsize-0.5)/2.*PSCALE
+ YMAX = YAVE + 3.25*PSCALE
+! YMIN = YMIN - .01*PSCALE
+! XMIN = XMIN - .01*PSCALE
+
+! Reset values if STARTUP.DAT file is used
+
+ IF(IS11 .GT. 0) THEN
+ READ(IS11,5200) XS,YS,PSCALE
+ 5200 FORMAT(3F15.0)
+ XMIN=-XS
+ YMIN=-YS
+ ENDIF
+
+ IFIRST = 0
+
+ ENDIF
+
+! Plot all data
+
+ CALL PLOTSV(0)
+!ipk nov97 add (1)
+ CALL PLOTOT(1)
+ GO TO 101
+
+! Top of loop ********************************
+
+ 100 CONTINUE
+ 101 CONTINUE
+ if(menus .gt. 9) go to 25
+ IF(MENUS .GT. 0) THEN
+ ANS=ANSW(MENUS-1)
+ MENUS=0
+ GO TO 130
+ ENDIF
+
+! List options
+
+ 25 CONTINUE
+
+! Draw box around selections
+
+ IF(MENUS .EQ. -3) THEN
+ CALL PLOTOT(0)
+ MENUS=-2
+ ENDIF
+ NHTP=1
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+! Get answer
+
+ call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+ IF(ANS .EQ. 'c') THEN
+ I=IBOX-1
+ if(i .lt. 0) go to 25
+ ANS=ANSW(I)
+ ENDIF
+
+ 130 CONTINUE
+
+! Add elements
+
+ IF (ANS .EQ. 'e') THEN
+ CALL ELTS
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+
+! Go to help facility
+
+ ELSEIF (ANS .EQ. 'h') THEN
+ CALL HELPS(1)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+
+! Process nodes
+
+ ELSEIF (ANS .EQ. 'n') THEN
+ CALL ADDNOD
+!ipk feb94 call for backup
+ CALL WRTOUT(0)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+
+! Add element reordering sequence
+
+ ELSEIF (ANS .EQ. 'o') THEN
+
+! Draw box around selections
+
+ 140 CONTINUE
+ NHTP=3
+ NMESS=0
+ NBRR=0
+ CALL PLOTORDS
+
+ CALL HEDR
+
+! Get answer
+
+ call xyloc(XPT,YPT,ANS,IBOX)
+ CALL PLOTORDS
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+ IF(ANS .EQ. 'c') THEN
+ I=IBOX-1
+ ELSE
+ IF(ANS .EQ. 'l') THEN
+
+! Process current list including baseine order
+
+ I=0
+ ELSEIF(ANS .EQ. 'g') THEN
+
+! Add another order to the list
+
+ I=1
+ ELSEIF(ANS .EQ. 'p') THEN
+
+! Process the latest addition to the list
+
+ I=2
+ ELSEIF(ANS .EQ. 'o') THEN
+ I=3
+ ELSEIF(ANS .EQ. 't') THEN
+ I=4
+ ELSEIF(ANS .EQ. 'h') THEN
+ I=5
+ ELSEIF(ANS .EQ. 'z') THEN
+ I=7
+ ELSEIF(ANS .EQ. 'r') THEN
+ I=8
+ ELSEIF(ANS .EQ. 'q') THEN
+ I=9
+ ENDIF
+ ENDIF
+ IF(I .LT. 3) THEN
+
+ CALL ADDORD(I)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+ GO TO 140
+ ELSEIF(I .gt. 2 .and. I .lt. 5) THEN
+!
+! compact elements and nodes
+!
+ call compact(i)
+ go to 100
+
+ ELSEIF(I .EQ. 5) THEN
+
+! Get help screen
+
+ CALL HELPS(5)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+
+ ELSEIF(I .EQ. 9) THEN
+
+! Return to main menu
+
+ GO TO 100
+
+ ELSE
+
+! Return to try for character again
+
+ GO TO 140
+ ENDIF
+ GO TO 140
+
+! ENDIF
+!ipk oct96 add continuity lines
+
+ ELSEIF (ANS .EQ. 'l') THEN
+ CALL CCLINE(1)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+
+!ycw mar97 add cross section
+
+ ELSEIF (ANS .EQ. 't') THEN
+ CALL CRSECT
+ IF(IRMAIN .EQ. 1) THEN
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+!ycw
+ ELSEIF (ANS .EQ. 'r') THEN
+! Save display parameters
+
+ n1=nhtp
+ n2=nmess
+ n3=nbrr
+ CALL RDRW(0)
+ if(irmain .eq. 1) return
+
+! Restore display parameters
+
+ nhtp=n1
+ nmess=n2
+ nbrr=n3
+
+ ELSEIF (ANS .EQ. 's') THEN
+
+! Save files
+
+
+! Draw box around selections
+
+ 210 NHTP=11
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+
+! Get answer
+
+ call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .le. 0) go to 210
+ I=IBOX-1
+ ANS=ANSX(I)
+ ENDIF
+
+! Save plot file
+
+ IF (ANS .EQ. 'p') THEN
+
+ CALL PLOTSV(1)
+!ipk nov97 add(1)
+ CALL PLOTOT(1)
+ CALL NDPLSV
+
+ ELSEIF (ANS .EQ. 'b') THEN
+
+! Save file in binary form
+
+ CALL WRTOUT(2)
+
+ ELSEIF (ANS .EQ. 'm') THEN
+
+! Save map file
+
+ CALL WRTMAP(0)
+
+ ELSEIF (ANS .EQ. 's') THEN
+
+! Save file
+
+ CALL WRTOUT(1)
+
+! Go to help facility
+
+ ELSEIF (ANS .EQ. 'h') THEN
+ CALL HELPS(8)
+ IF(IRMAIN .EQ. 1) THEN
+!ipk may94 add line
+ CALL RESCAL
+ IRMAIN=0
+ GO TO 100
+ ENDIF
+ ELSEIF (ANS .EQ. 'q') THEN
+ GO TO 100
+ ENDIF
+ GO TO 210
+
+
+ ELSEIF (ANS .EQ. 'q') THEN
+
+! Quit program after checking
+
+
+ CALL RQUIT(IYES)
+ IF(IYES .EQ. 1) THEN
+ CALL Quit_Pgm
+ STOP
+!!SEP02 CALL CLSCRN
+!!SEP02 CALL SETD(23)
+!ipk oct96 move to screen output
+
+!!SEP02 WRITE(FNAMS,*) 'Do you really want to quit? (y) or (n)'
+!!SEP02 CALL SYMBL(1.,7.20,0.20,FNAMS,0.,38)
+!!SEP02 ndig=1
+!!SEP02 call gtcharx(ans,ndig,6.,7.2)
+!ipk oct96 READ(*,'(A)') ANS
+!!SEP02 IF(ANS .EQ. 'y' .OR. ANS .EQ. 'Y') THEN
+!!SEP02 CALL Quit_Pgm
+!!SEP02 STOP
+!!SEP02 ELSE
+!!SEP02 WRITE(FNAMS,*)'Do you want to restart? (y) or (n)'
+!!SEP02 CALL SYMBL(1.,6.20,0.20,FNAMS,0.,34)
+!!SEP02 ndig=1
+!!SEP02 call gtcharx(ans,ndig,6.,7.2)
+!ipk oct96 READ(*,'(A)') ANS
+!!SEP02 IF(ANS .EQ. 'y' .OR. ANS .EQ. 'Y') THEN
+!!SEP02 IRESTT=1
+!!SEP02 GO TO 1
+!!SEP02 ENDIF
+!!SEP02 CALL SETD(2)
+ ENDIF
+
+ ENDIF
+
+ GOTO 100
+
+ END
+
+
+ SUBROUTINE RQUIT(IYES)
+
+ USE WINTERACTER
+
+ INCLUDE 'BFILES.I90'
+
+ INCLUDE 'D.INC'
+
+ IF(IRDONE .NE. 0) THEN
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you really wish to quit?'//&
+ CHAR(13)//' ','Quit option')
+ ELSE
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'You have not reordered'//Char(13)//'Do you really wish to quit?'//&
+ CHAR(13)//' ','Quit option')
+ ENDIF
+!
+! If answer 'No', return
+!
+ iyes=1
+ IF (WInfoDialog(4).EQ.2) iyes=0
+ return
+ end
+
diff --git a/src/src83e/RMAGENV83d.rc b/src/src83e/RMAGENV83d.rc
new file mode 100644
index 0000000..33d9f03
--- /dev/null
+++ b/src/src83e/RMAGENV83d.rc
@@ -0,0 +1,2432 @@
+///////////////////////////////////////////////////
+//
+// THIS FILE SHOULD NOT BE EDITED USING A TEXT
+// EDITOR OR 3RD PARTY RESOURCE EDITOR, EXCEPT
+// WHEN SPECIFICALLY INSTRUCTED BY I.S.S.
+//
+///////////////////////////////////////////////////
+//
+// Winteracter resource script.
+//
+// Modified : 13/Feb/2017 12:04:28
+//
+///////////////////////////////////////////////////
+//
+// Include files
+//
+#include "winparam.h"
+
+///////////////////////////////////////////////////
+//
+// Parameter Definitions
+//
+#define IDR_MENU1 30001
+#define ID_FILE 40001
+#define ID_EXIT 40002
+#define ID_NODE 40003
+#define ID_ELTS 40004
+#define ID_ORDRT 40005
+#define ID_CCLNA 40006
+#define ID_CSEC1 40007
+#define ID_ZOOM 40008
+#define ID_DRAW 40009
+#define ID_HELP 40010
+#define ID_STRING1 50001
+#define ID_STRING2 50002
+#define ID_STRING3 50003
+#define ID_STRING4 50004
+#define ID_STRING5 50005
+#define ID_STRING6 50006
+#define ID_STRING7 50007
+#define ID_STRING8 50008
+#define ID_STRING9 50009
+#define ID_STRING10 50010
+#define ID_STRING11 50011
+#define ID_ITEM11 40011
+#define ID_ITEM12 40012
+#define ID_ITEM13 40013
+#define ID_ITEM14 40014
+#define ID_ITEM15 40015
+#define ID_ITEM16 40016
+#define ID_ITEM17 40017
+#define ID_ITEM18 40018
+#define ID_ITEM19 40019
+#define IDF_STRING24 1041
+#define IDD_DIALOG1 101
+#define IDF_LABEL5 1042
+#define IDC_BUTTON2 20001
+#define ID_ITEM20 40021
+#define ID_ITEM73 40022
+#define ID_ITEM23 40023
+#define ID_ITEM24 40024
+#define ID_TOOLBAR1 30101
+#define ID_ZIN 40025
+#define ID_ZOUT 40026
+#define ID_OUT2 40027
+#define ID_OUT4 40028
+#define ID_RSET 40029
+#define ID_PLEFT 40031
+#define ID_PRIGHT 40032
+#define ID_PUP 40033
+#define ID_PDOWN 40034
+#define ID_IDRWT 40035
+#define ID_TYPD 40039
+#define ID_DRAWD 40041
+#define ID_MAPOPD 40042
+#define ID_CONTR 40060
+#define IDF_LABEL1 1001
+#define IDF_LABEL2 1002
+#define IDF_LABEL3 1003
+#define IDF_LABEL4 1004
+#define IDF_STRING1 1013
+#define IDF_STRING2 1014
+#define IDF_STRING3 1015
+#define IDF_STRING4 1016
+#define IDF_STRING5 1017
+#define IDF_STRING6 1018
+#define IDF_STRING7 1019
+#define IDF_STRING8 1020
+#define IDF_STRING9 1021
+#define IDF_STRING10 1022
+#define IDF_STRING11 1023
+#define IDF_STRING12 1024
+#define IDD_DIALOG02 102
+#define IDF_STRING13 1025
+#define IDF_STRING14 1026
+#define IDF_STRING15 1027
+#define IDF_STRING16 1028
+#define IDF_STRING17 1029
+#define IDF_STRING18 1030
+#define IDF_STRING19 1031
+#define IDF_STRING20 1032
+#define IDF_STRING21 1033
+#define IDF_STRING22 1034
+#define IDF_STRING23 1035
+#define IDF_CHECK1 1036
+#define IDF_CHECK2 1037
+#define IDF_CHECK3 1038
+#define IDF_CHECK4 1039
+#define IDF_CHECK5 1040
+#define ID_DCONTR 40056
+#define ID_CONTOPT 40061
+#define ID_ITYPN 40064
+#define ID_ITYPC 40065
+#define ID_ICOPY 40067
+#define IDD_DIALOG04 104
+#define ID_BACGD 40050
+#define ID_ITEM26 40071
+#define IDD_DIALOG05 103
+#define IDF_CMAP8 1005
+#define IDF_CMAP9 1006
+#define IDF_CMAP0 1007
+#define IDF_CMAP1 1008
+#define IDF_CMAP2 1009
+#define IDF_CMAP10 1010
+#define IDF_CMAP11 1011
+#define IDF_CMAP3 1012
+#define IDF_CMAP4 1043
+#define IDF_CMAP5 1044
+#define IDF_CMAP6 1045
+#define IDF_CMAP7 1046
+#define IDD_DIALOG006 105
+#define IDF_RADIO1 1047
+#define IDF_RADIO2 1048
+#define IDF_RADIO3 1049
+#define IDF_RADIO4 1050
+#define IDF_RADIO5 1051
+#define IDF_RADIO6 1052
+#define IDF_RADIO7 1053
+#define IDF_RADIO8 1054
+#define IDF_RADIO9 1055
+#define ID_MMAP 40043
+#define IDD_DIALOG07 106
+#define IDD_DIALOG08 107
+#define ID_Help1 40040
+#define ID_Help2 40044
+#define IDD_DIALOG09 108
+#define IDF_LABEL7 1056
+#define IDD_DIALOG10 109
+#define IDF_INTEGER1 1057
+#define IDF_INTEGER2 1058
+#define ID_LAYFL 40046
+#define IDF_RADIO10 1056
+#define IDD_DIALOG010 110
+#define IDD_DIALOG001 111
+#define ID_BKF 40047
+#define IDD_DIALOG012 113
+#define IDF_CHECK6 1041
+#define IDF_CHECK7 1042
+#define IDF_CHECK8 1043
+#define IDF_CHECK9 1044
+#define IDF_CHECK10 1045
+#define IDF_CHECK11 1059
+#define ID_Clip 40020
+#define ID_UNDOM 40030
+#define ID_BSEL 40036
+#define ID_REGST 40037
+#define IDD_REGST 112
+#define IDF_LABEL6 1005
+#define IDF_REAL1 1060
+#define IDF_REAL2 1061
+#define IDF_REAL3 1062
+#define IDF_REAL4 1063
+#define IDF_LABEL8 1006
+#define IDF_LABEL9 1007
+#define IDF_LABEL10 1008
+#define IDF_LABEL11 1043
+#define IDF_REAL5 1064
+#define IDF_REAL6 1065
+#define IDF_REAL7 1066
+#define IDF_REAL8 1067
+#define IDF_LABEL12 1009
+#define IDADJUST 1068
+#define IDFSWITCH 1069
+#define IDD_SLRGNO 114
+#define IDD_CONFIRM 115
+#define ID_network 40038
+#define ID_NMAP 40045
+#define ID_ITEM56 40048
+#define ID_Nodedata 40049
+#define ID_Eltdata 40051
+#define IDD_nodedata 116
+#define IDF_REAL9 1068
+#define IDF_REAL10 1069
+#define IDD_eltdata 117
+#define IDF_INTEGER3 1059
+#define IDF_INTEGER4 1060
+#define IDF_INTEGER5 1061
+#define IDF_INTEGER6 1062
+#define IDF_INTEGER7 1063
+#define IDF_INTEGER8 1064
+#define IDF_INTEGER9 1070
+#define IDF_INTEGER10 1071
+#define IDD_SELNODE 118
+#define IDNEXT 1072
+#define IDD_SELELT 119
+#define IDD_ELTERR 120
+#define ID_DRAG 40052
+#define ID_DELM 40103
+#define ID_FILL 40102
+#define IDF_Delete 1073
+#define IDFROTATE 1074
+#define IDF_RADIO11 1057
+#define ID_GETELM 40053
+#define ID_mapm 40054
+#define ID_map 40055
+#define IDD_GETINTP 160
+#define ID_SBIN 40057
+#define IDD_headertp 121
+#define ID_TRIAN 40058
+#define ID_SWMAP 40059
+#define ID_SWRM1 40062
+#define IDD_TRIAN 122
+#define IDD_NODERR 123
+#define IDF_STRING25 1106
+#define IDF_STRING26 1107
+#define IDF_STRING27 1108
+#define IDF_STRING28 1109
+#define IDF_STRING29 1110
+#define IDF_STRING30 1111
+#define IDF_STRING31 1112
+#define IDF_STRING32 1113
+#define IDF_STRING33 1114
+#define IDF_STRING34 1115
+#define IDD_SELTFL2 148
+#define ID_LOADRM1 40063
+#define ID_cdata 40066
+#define ID_SELRM1 40068
+#define ID_addmesh 40069
+#define ID_MRGMESH 40070
+#define ID_ITEM22 40072
+#define ID_ALLNODES 40073
+#define ID_UNUSNODES 40074
+#define ID_TRIANG 40075
+#define IDD_TRIANG 124
+#define IDD_QUAD 125
+#define ID_QUAD 40076
+#define ID_JOIN 40104
+#define ID_CSEC 40077
+#define ID_CRSCAL 40078
+#define ID_SAVCRS 40079
+#define ID_crsf 40080
+#define IDD_DIALOG06 126
+#define IDF_RADIO13 1076
+#define IDF_RADIO12 1058
+#define IDD_GETFPN 154
+#define IDD_GETINT 153
+#define ID_CSLOC 40081
+#define IDD_CSLOC 127
+#define ID_UNDO 40082
+#define ID_UNDOS 40083
+#define ID_CREATM 40084
+#define IDD_CREATM 128
+#define IDD_TEMPLATE001 129
+#define IDF_GRID1 1075
+#define ISS1 1077
+#define ISS2 1078
+#define ISS3 1079
+#define IDD_CREATM1 130
+#define ID_CGEN 40085
+#define IDF_STRING35 1042
+#define IDD_ORDEROUT 131
+#define IDD_TEMPLATE002 132
+#define IDF_RADIO14 1080
+#define IDF_RADIO15 1081
+#define IDF_RADIO16 1082
+#define ID_selarea 40086
+#define ID_crsect 40087
+#define IDD_selcrsec 133
+#define IDD_TEMPLATE003 134
+#define ISS4 1083
+#define ISS5 1084
+#define IDD_LIMITS 135
+#define IDF_RADIO17 1059
+#define IDD_lAY 136
+#define IDD_TEMPLATE004 137
+#define ISS6 1085
+#define ISS7 1086
+#define ID_EDLAY 40088
+#define IDF_RADIO18 1062
+#define ID_ORDR 40089
+#define ID_ORDR1 40090
+#define id_chk 2002
+#define id_chck 2001
+#define idchk 2003
+#define ID_SPLITN 40091
+#define IDD_DISPLIT 138
+#define IDD_DIRSPLIT 139
+#define ID_OUTLAY 40093
+#define ID_FORM999 40092
+#define ID_g1d 40094
+#define IDD_SETOPT 140
+#define ID_CCLN 40095
+#define ID_CHKCCLN 40096
+#define ID_GOUTLIN 40097
+#define ID_XOUTLIN 40098
+#define IDD_SETMAXMAP 141
+#define ID_RESETLIM 40099
+#define IDD_MLIMITS 143
+#define IDD_VIEWANG 174
+#define ID_3DVIEW 40100
+#define ID_VIEWANGLE 40101
+#define ID_ROTATE 40106
+#define ID_RESETRG 40105
+#define IDD_CHKOPT 142
+#define ID_ITEM103 40107
+#define ID_SECGRP 40108
+#define IDD_SETSEL 144
+#define ID_SELPR 40109
+#define IDD_CHK1DOPT 145
+#define ID_VROTATE 40110
+#define id_mchck 40111
+#define ID_MOVMESH 40112
+#define IDD_DIALOG047 146
+#define IDD_DIALOG048 147
+#define ID_SELELTYP 40113
+#define IDD_SELELTYP 149
+#define ID_OPENGP 40114
+#define ID_SAVGP 40115
+#define IDF_RADIO19 1063
+#define ID_IGPN 40116
+#define ID_IGPC 40117
+#define ID_DISPTYP 40118
+#define ID_TRANSFORM 40119
+#define IDD_TRANSFORM 151
+#define ID_deletelm 40120
+#define IDD_ELTERR2 152
+#define ID_FORM2D 40121
+#define ID_JOINALL 40122
+#define ID_MOVGRP 40123
+#define ID_CRGRID 40124
+#define IDD_GENBLK 155
+#define ID_SETUPLEV 40125
+#define IDD_SETWRS 156
+#define ID_findnode 40126
+#define ID_findelem 40127
+#define IDD_FORMLINE 157
+#define ID_FILLAGAP 40129
+#define IDD_MATTYP 158
+#define ID_ITEM126 40130
+#define ID_SETTYPLEV 40131
+#define IDD_LEVSETTYP 159
+#define ID_Complex 40132
+#define ID_attach 40133
+#define IDD_CHSTYP 161
+#define ID_SAVSHP 40128
+#define ID_ADDMAP 40134
+#define ID_OUTLINFL 40135
+#define ID_GETSTRESSFIL 40136
+#define IDD_FBED 162
+#define IDD_SETYRDT 163
+#define ID_SMOOTHMAP 40137
+#define IDD_GETINTR 164
+#define ID_RVSDIAG 40138
+#define ID_TESTOUT 40139
+#define ID_LOADELTLD 40140
+#define ID_SHOWELTLD 40141
+#define IDD_CHOOSEMODEL 165
+#define IDD_SETUPELDISP 166
+#define ID_SAVELTLD 40142
+#define ID_RESHOWELTLD 40143
+#define ID_ASSIGNELTLD 40144
+#define ID_FILLTR 40145
+#define IDD_FTRIAN 167
+#define ID_addmeshtr 40146
+#define ID_UNDOGEN 40147
+#define IDD_GETFL 168
+#define ID_DDRAW 40148
+
+///////////////////////////////////////////////////
+//
+// Dialogs
+//
+IDD_DIALOG02 DIALOG 0, 0, 402, 255
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT CONTOURS"
+BEGIN
+ CONTROL "Computed max and min",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 20, 120, 8
+ CONTROL "Over-riding maximum limit",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 48, 120, 8
+ CONTROL "Over-riding minimum limit",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 68, 120, 8
+ CONTROL "c-max",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 150, 17, 40, 14
+ CONTROL "c-min",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 200, 17, 40, 14
+ CONTROL "Max",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 160, 45, 40, 14
+ CONTROL "Min",IDF_STRING22,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 160, 65, 40, 14
+ CONTROL "Number",IDF_STRING23,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 160, 85, 40, 14
+ CONTROL " Accept values",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 250, 8, 100, 10
+ CONTROL " Use logarithmic interval",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 250, 28, 100, 10
+ CONTROL " Recompute use input limits to set values",IDF_CHECK3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 250, 48, 144, 10
+ CONTROL " Use values input below",IDF_CHECK4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 250, 68, 100, 10
+ CONTROL " Retain these values",IDF_CHECK5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 250, 88, 100, 10
+ CONTROL "v1",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 111, 40, 14
+ CONTROL "String",IDF_STRING5,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 80, 111, 40, 14
+ CONTROL "String",IDF_STRING6,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 140, 111, 40, 14
+ CONTROL "String",IDF_STRING7,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 200, 111, 40, 14
+ CONTROL "String",IDF_STRING8,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 260, 111, 40, 14
+ CONTROL "v6",IDF_STRING9,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 320, 111, 40, 14
+ CONTROL "String",IDF_STRING10,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 20, 133, 40, 14
+ CONTROL "String",IDF_STRING11,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 80, 133, 40, 14
+ CONTROL "String",IDF_STRING12,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 140, 133, 40, 14
+ CONTROL "String",IDF_STRING13,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 200, 133, 40, 14
+ CONTROL "String",IDF_STRING14,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 260, 133, 40, 14
+ CONTROL "v12",IDF_STRING15,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 320, 133, 40, 14
+ CONTROL "String",IDF_STRING16,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 19, 155, 40, 14
+ CONTROL "String",IDF_STRING17,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 79, 155, 40, 14
+ CONTROL "String",IDF_STRING18,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 139, 155, 40, 14
+ CONTROL "String",IDF_STRING19,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 201, 155, 40, 14
+ CONTROL "String",IDF_STRING20,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 259, 155, 40, 14
+ CONTROL "v18",IDF_STRING21,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 319, 155, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 181, 228, 40, 14
+ CONTROL "Number of contours",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 88, 120, 8
+ CONTROL "String",IDF_STRING25,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 78, 176, 40, 14
+ CONTROL "String",IDF_STRING26,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 138, 176, 40, 14
+ CONTROL "String",IDF_STRING27,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 200, 176, 40, 14
+ CONTROL "String",IDF_STRING28,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 259, 176, 40, 14
+ CONTROL "String",IDF_STRING29,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 320, 176, 40, 14
+ CONTROL "v18",IDF_STRING30,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 20, 198, 40, 14
+ CONTROL "String",IDF_STRING24,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 20, 176, 40, 14
+ CONTROL "String",IDF_STRING31,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 79, 197, 40, 14
+ CONTROL "String",IDF_STRING32,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 139, 197, 40, 14
+ CONTROL "String",IDF_STRING33,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 201, 197, 40, 14
+ CONTROL "String",IDF_STRING34,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 259, 197, 40, 14
+ CONTROL "v18",IDF_STRING35,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 319, 197, 40, 14
+END
+
+IDD_DIALOG02 RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 1 \n"
+" 1037 0 \n"
+" 1038 0 \n"
+" 1039 0 \n"
+" 1040 0 \n"
+,0
+END
+
+IDD_DIALOG1 DIALOG 0, 0, 182, 79
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 10, "MS Sans Serif"
+CAPTION "TITLE"
+BEGIN
+ CONTROL "",IDF_STRING24,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 0, 24, 181, 20
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 74, 52, 40, 14
+ CONTROL "Enter Title for Ouput File",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 32, 4, 136, 14
+END
+
+IDD_DIALOG04 DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ERROR"
+BEGIN
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 56, 40, 14
+ CONTROL "Error in Data -- Press OK and Re-enter Values as Needed",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 15, 20, 130, 16
+END
+
+IDD_DIALOG04 RCDATA
+BEGIN
+"[Colours] \n"
+" 1 256 256 256 255 000 000 \n"
+" 1001 000 000 000 255 000 000 \n"
+,0
+END
+
+IDD_DIALOG05 DIALOG 0, 0, 260, 116
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "MAP DISPLAY OPTIONS"
+BEGIN
+ CONTROL "Map-3",IDF_CMAP3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 200, 12, 40, 14
+ CONTROL "Map-4",IDF_CMAP4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 20, 36, 40, 14
+ CONTROL "Map-5",IDF_CMAP5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 80, 36, 40, 14
+ CONTROL "Map-6",IDF_CMAP6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 140, 36, 40, 14
+ CONTROL "Map-7",IDF_CMAP7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 200, 36, 40, 14
+ CONTROL "Map-8",IDF_CMAP8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 20, 60, 40, 14
+ CONTROL "Map-9",IDF_CMAP9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 80, 60, 40, 14
+ CONTROL "Map-0",IDF_CMAP0,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 20, 12, 40, 14
+ CONTROL "Map-1",IDF_CMAP1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 80, 12, 40, 14
+ CONTROL "Map-2",IDF_CMAP2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 140, 12, 40, 14
+ CONTROL "Map-10",IDF_CMAP10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 140, 60, 40, 14
+ CONTROL "Map-11",IDF_CMAP11,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 200, 60, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 112, 92, 40, 14
+END
+
+IDD_DIALOG05 RCDATA
+BEGIN
+"[Checks] \n"
+" 1012 0 \n"
+" 1043 0 \n"
+" 1044 0 \n"
+" 1045 0 \n"
+" 1046 0 \n"
+" 1005 0 \n"
+" 1006 0 \n"
+" 1007 0 \n"
+" 1008 0 \n"
+" 1009 0 \n"
+" 1010 0 \n"
+" 1011 0 \n"
+"[Colours] \n"
+" 1012 256 256 256 128 255 128 \n"
+" 1043 256 256 256 128 255 128 \n"
+" 1044 256 256 256 128 255 128 \n"
+" 1045 256 256 256 128 255 128 \n"
+" 1046 256 256 256 128 255 128 \n"
+" 1005 256 256 256 128 255 128 \n"
+" 1006 256 256 256 128 255 128 \n"
+" 1007 256 256 256 128 255 128 \n"
+" 1008 256 256 256 128 255 128 \n"
+" 1009 256 256 256 128 255 128 \n"
+" 1010 256 256 256 128 255 128 \n"
+" 1011 256 256 256 128 255 128 \n"
+,0
+END
+
+IDD_DIALOG006 DIALOG 0, 0, 199, 183
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT DISPLAY OPTIONS"
+BEGIN
+ CONTROL "Map",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 12, 40, 14
+ CONTROL "Outline",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 80, 12, 40, 14
+ CONTROL "Network",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 140, 12, 40, 14
+ CONTROL "Nodes",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 32, 40, 14
+ CONTROL "B-elev",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 52, 40, 14
+ CONTROL "Elements",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 80, 32, 40, 14
+ CONTROL "Type",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 80, 52, 40, 14
+ CONTROL "Data",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 140, 32, 40, 14
+ CONTROL "Grid",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 140, 52, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 80, 148, 40, 14
+ CONTROL "CC-lines",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 80, 40, 14
+ CONTROL "Con Str",IDF_RADIO11,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 142, 80, 38, 14
+END
+
+IDD_DIALOG006 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+" 1051 0 \n"
+" 1052 0 \n"
+" 1053 0 \n"
+" 1054 0 \n"
+" 1055 0 \n"
+" 1056 0 \n"
+" 1057 0 \n"
+,0
+END
+
+IDD_DIALOG07 DIALOG 0, 0, 213, 170
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SAVE OPTIONS"
+BEGIN
+ CONTROL "Skip checking and then save",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 34, 40, 146, 17
+ CONTROL "Terminate save",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 34, 56, 146, 17
+ CONTROL "Execute fill then save",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 34, 72, 146, 17
+ CONTROL "You have entered save without executing fill",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | SS_LEFT, 34, 16, 146, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 87, 144, 40, 14
+ CONTROL "Continue checking",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 34, 88, 146, 17
+ CONTROL "Note that if checking is continued without fill, Checks for duplicate elements are ineffective",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | SS_LEFT, 38, 116, 138, 20
+END
+
+IDD_DIALOG07 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+"[Colours] \n"
+" 1001 256 256 256 255 255 128 \n"
+" 1002 256 256 256 255 255 128 \n"
+,0
+END
+
+IDD_DIALOG08 DIALOG 0, 0, 140, 88
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT CCLINE TYPES"
+BEGIN
+ CONTROL "Save corner nodes only",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 12, 102, 14
+ CONTROL "Save corner and mid-sides",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 36, 100, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 50, 64, 40, 14
+END
+
+IDD_DIALOG08 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+,0
+END
+
+IDD_DIALOG09 DIALOG 0, 0, 160, 86
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "RMAGEN INFO"
+BEGIN
+ CONTROL "RMAGEN Version 8.3 Nov 2014",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 14, 8, 130, 12
+ CONTROL "Resource Modelling Associates",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_CENTER, 20, 36, 120, 12
+ CONTROL "Sydney, NSW Australia",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_CENTER, 20, 48, 118, 12
+ CONTROL "Copyright",IDF_LABEL7,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 22, 24, 118, 8
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 64, 40, 14
+END
+
+IDD_DIALOG10 DIALOG 0, 0, 320, 115
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT PROPERTIES"
+BEGIN
+ CONTROL "Number of figures beyond decimal",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 20, 60, 16
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 20, 40, 16
+ CONTROL "Frequency for display",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 44, 60, 16
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 44, 40, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 140, 88, 40, 14
+ CONTROL "Draw as colour dots",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 180, 14, 120, 10
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 260, 57, 40, 14
+ CONTROL "Radius of dot circle (m)",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 180, 56, 60, 16
+ CONTROL "Colour interval (m)",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 181, 36, 60, 12
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 261, 32, 40, 14
+END
+
+IDD_DIALOG10 RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_DIALOG010 DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT CONTINUITY LINE NUMBER"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 104, 28, 42, 14
+ CONTROL " Continuity line number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | SS_LEFT, 20, 28, 76, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 56, 52, 40, 14
+END
+
+IDD_DIALOG010 RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 256 256 256 255 255 255 \n"
+,0
+END
+
+IDD_DIALOG001 DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT REORDERING LIST NUMBER"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 104, 28, 42, 14
+ CONTROL "List Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | SS_CENTER, 20, 28, 76, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 56, 52, 40, 14
+END
+
+IDD_DIALOG001 RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 256 256 256 255 255 255 \n"
+,0
+END
+
+IDD_DIALOG012 DIALOG 0, 0, 300, 224
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT ACTIVE BACKGROUND COLOURS AND FILES"
+BEGIN
+ CONTROL "",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 36, 180, 12
+ CONTROL "",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 50, 180, 12
+ CONTROL "",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 64, 180, 12
+ CONTROL "",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 78, 180, 12
+ CONTROL "",IDF_STRING5,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 92, 180, 12
+ CONTROL "",IDF_STRING6,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 106, 180, 12
+ CONTROL "",IDF_STRING7,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 120, 180, 12
+ CONTROL "",IDF_STRING8,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 134, 180, 12
+ CONTROL "",IDF_STRING9,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 148, 180, 12
+ CONTROL "",IDF_STRING10,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 162, 180, 12
+ CONTROL "",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 36, 40, 14
+ CONTROL "",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 50, 40, 14
+ CONTROL "",IDF_CHECK3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 64, 40, 14
+ CONTROL "",IDF_CHECK4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 78, 40, 14
+ CONTROL "",IDF_CHECK5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 92, 40, 14
+ CONTROL "",IDF_CHECK6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 106, 40, 14
+ CONTROL "",IDF_CHECK7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 120, 40, 14
+ CONTROL "",IDF_CHECK8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 134, 40, 14
+ CONTROL "",IDF_CHECK9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 148, 40, 14
+ CONTROL "",IDF_CHECK10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 240, 162, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 130, 196, 40, 14
+ CONTROL "Grey Background on",IDF_CHECK11,"BUTTON",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 106, 12, 86, 14
+END
+
+IDD_DIALOG012 RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+" 1037 0 \n"
+" 1038 0 \n"
+" 1039 0 \n"
+" 1040 0 \n"
+" 1041 0 \n"
+" 1042 0 \n"
+" 1043 0 \n"
+" 1044 0 \n"
+" 1045 0 \n"
+" 1059 0 \n"
+"[Colours] \n"
+" 1013 256 256 256 255 255 128 \n"
+" 1014 256 256 256 255 255 128 \n"
+" 1015 256 256 256 255 255 128 \n"
+" 1016 256 256 256 255 255 128 \n"
+" 1017 256 256 256 255 255 128 \n"
+" 1018 256 256 256 255 255 128 \n"
+" 1019 256 256 256 255 255 128 \n"
+" 1020 256 256 256 255 255 128 \n"
+" 1021 256 256 256 255 255 128 \n"
+" 1022 256 256 256 255 255 128 \n"
+" 1059 256 256 256 255 255 128 \n"
+,0
+END
+
+IDD_REGST DIALOG 0, 0, 322, 183
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "REGISTER BACKGROUND LOCATION"
+BEGIN
+ CONTROL "1st Value from Image",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 220, 12, 66, 12
+ CONTROL "X coordinate",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 32, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 48, 40, 8
+ CONTROL " 2nd True Location",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 48, 68, 76, 12
+ CONTROL "Y coordinate",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 112, 40, 8
+ CONTROL "X coordinate",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 92, 40, 8
+ CONTROL " 1st True Location",IDF_LABEL7,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 46, 12, 74, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 80, 32, 60, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 48, 58, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 88, 58, 14
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 108, 58, 14
+ CONTROL "X coordinate",IDF_LABEL8,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 36, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL9,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 48, 40, 8
+ CONTROL "X coordinate",IDF_LABEL10,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 92, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL11,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 112, 40, 8
+ CONTROL "0.0000",IDF_REAL5,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 241, 35, 56, 14
+ CONTROL "0.0000",IDF_REAL6,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 48, 58, 11
+ CONTROL "0.0000",IDF_REAL7,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 92, 60, 14
+ CONTROL "0.0000",IDF_REAL8,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 112, 58, 14
+ CONTROL "2nd Value from Image",IDF_LABEL12,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 220, 70, 67, 9
+ CONTROL "Adjust Register",IDADJUST,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 20, 148, 52, 12
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 141, 148, 40, 14
+ CONTROL "Switch Point",IDFSWITCH,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 246, 148, 54, 14
+END
+
+IDD_REGST RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_SLRGNO DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT REGISTER POINT NUMBER"
+BEGIN
+ CONTROL "Choose Point Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 20, 24, 60, 16
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 24, 42, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 58, 56, 40, 14
+END
+
+IDD_SLRGNO RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_CONFIRM DIALOG 0, 0, 322, 171
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "CONFIRM REGISTER LOCATIONS"
+BEGIN
+ CONTROL "Current upper right",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 220, 12, 66, 12
+ CONTROL "X coordinate",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 32, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 48, 40, 8
+ CONTROL "Proposed lower left",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 48, 68, 76, 12
+ CONTROL "Y coordinate",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 112, 40, 8
+ CONTROL "X coordinate",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 92, 40, 8
+ CONTROL "Current lower left",IDF_LABEL7,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 46, 12, 74, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 80, 32, 60, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 48, 58, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 88, 58, 14
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 82, 108, 58, 14
+ CONTROL "X coordinate",IDF_LABEL8,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 36, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL9,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 48, 40, 8
+ CONTROL "X coordinate",IDF_LABEL10,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 92, 40, 8
+ CONTROL "Y coordinate",IDF_LABEL11,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 180, 112, 40, 8
+ CONTROL "0.0000",IDF_REAL5,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 241, 35, 56, 14
+ CONTROL "0.0000",IDF_REAL6,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 48, 58, 11
+ CONTROL "0.0000",IDF_REAL7,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 92, 60, 14
+ CONTROL "0.0000",IDF_REAL8,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 112, 58, 14
+ CONTROL "Proposed upper right",IDF_LABEL12,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 220, 70, 66, 9
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 82, 140, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 199, 140, 40, 14
+END
+
+IDD_CONFIRM RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_nodedata DIALOG 0, 0, 334, 175
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Node Data"
+BEGIN
+ CONTROL "Node Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 34, 20, 66, 8
+ CONTROL "X-coordinate",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 34, 36, 66, 8
+ CONTROL "Y-coordinate",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 34, 52, 66, 8
+ CONTROL "Bed Elevation",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 34, 68, 66, 8
+ CONTROL "Bottom Width",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 20, 66, 8
+ CONTROL "Side Slope 1",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 36, 66, 8
+ CONTROL "Side Slope 2",IDF_LABEL7,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 52, 66, 8
+ CONTROL "Storage Width",IDF_LABEL8,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 68, 66, 8
+ CONTROL "Storage Base Elevation",IDF_LABEL9,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 84, 77, 8
+ CONTROL "Storage Slope",IDF_LABEL10,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 100, 66, 8
+ CONTROL "Bed Slope",IDF_LABEL11,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 170, 116, 66, 8
+ CONTROL "Elevation Locked",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 34, 88, 126, 11
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE | ES_READONLY, 110, 19, 50, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 110, 36, 50, 12
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 110, 51, 50, 12
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 110, 67, 50, 12
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 19, 50, 12
+ CONTROL "0.0000",IDF_REAL5,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 35, 50, 12
+ CONTROL "0.0000",IDF_REAL6,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 50, 50, 12
+ CONTROL "0.0000",IDF_REAL7,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 66, 50, 12
+ CONTROL "0.0000",IDF_REAL8,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 82, 50, 12
+ CONTROL "0.0000",IDF_REAL9,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 97, 50, 12
+ CONTROL "0.0000",IDF_REAL10,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 250, 114, 50, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 140, 40, 14
+ CONTROL "NEXT",IDNEXT,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 147, 140, 40, 14
+ CONTROL "CANCEL",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 236, 140, 40, 14
+END
+
+IDD_nodedata RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_eltdata DIALOG 0, 0, 352, 156
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Element Data"
+BEGIN
+ CONTROL "Element Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 70, 12, 70, 8
+ CONTROL "Element Connections",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 141, 34, 70, 8
+ CONTROL "0",IDF_INTEGER2,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 20, 50, 30, 12
+ CONTROL "0",IDF_INTEGER3,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 60, 50, 30, 12
+ CONTROL "0",IDF_INTEGER4,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 50, 30, 12
+ CONTROL "0",IDF_INTEGER5,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 140, 50, 30, 12
+ CONTROL "0",IDF_INTEGER6,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 50, 30, 12
+ CONTROL "0",IDF_INTEGER7,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 220, 50, 30, 12
+ CONTROL "0",IDF_INTEGER8,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 260, 50, 30, 12
+ CONTROL "0",IDF_INTEGER9,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 300, 50, 30, 12
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE | ES_READONLY, 180, 10, 40, 14
+ CONTROL "Element Type Number",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 70, 72, 70, 8
+ CONTROL "0",IDF_INTEGER10,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 68, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 96, 40, 14
+ CONTROL "NEXT",IDNEXT,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 116, 96, 40, 14
+ CONTROL "CANCEL",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 270, 96, 40, 14
+ CONTROL "DELETE",IDF_Delete,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 195, 96, 40, 14
+ CONTROL "ROTATE",IDFROTATE,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 156, 124, 40, 14
+END
+
+IDD_eltdata RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_SELNODE DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Select Node Number"
+BEGIN
+ CONTROL "Node Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 26, 21, 54, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 18, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 46, 40, 14
+END
+
+IDD_SELNODE RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_SELELT DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Select Element Number"
+BEGIN
+ CONTROL "Element Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 26, 21, 54, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 18, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 46, 40, 14
+END
+
+IDD_SELELT RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_ELTERR DIALOG 0, 0, 160, 105
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Element Data Error"
+BEGIN
+ CONTROL "ERROR IN ELEMENT CONNECTIONS",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 15, 12, 130, 8
+ CONTROL "Remove Element by Deleting Connections",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 12, 28, 136, 8
+ CONTROL "Element Number",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 23, 58, 58, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 101, 57, 38, 11
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 78, 40, 14
+ CONTROL "or Edit Entries",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 57, 40, 46, 8
+END
+
+IDD_ELTERR RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 256 256 256 255 128 000 \n"
+,0
+END
+
+IDD_GETINTP DIALOG 0, 0, 194, 126
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Set Interpolation"
+BEGIN
+ CONTROL "Number of X interpolation points",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 17, 100, 8
+ CONTROL "Number of Y interpolation points",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 20, 37, 100, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 125, 15, 40, 14
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 125, 35, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 72, 100, 40, 14
+ CONTROL "X-interpolation interval",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 58, 100, 8
+ CONTROL "Y-interpolation interval",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 78, 100, 8
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 125, 55, 40, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 125, 75, 40, 14
+END
+
+IDD_GETINTP RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_headertp DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT HEADER TYPE"
+BEGIN
+ CONTROL "Little Endian",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 24, 10, 112, 14
+ CONTROL "Big Endian",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 24, 26, 112, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 52, 40, 14
+END
+
+IDD_headertp RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+,0
+END
+
+IDD_TRIAN DIALOG 0, 0, 260, 100
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "TRIANGULARIZATION OPTIONS"
+BEGIN
+ CONTROL "Data frequency (default=1)",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 22, 100, 10
+ CONTROL "Minimum spacing (default = 0.0)",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 40, 110, 10
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 21, 60, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 39, 60, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 110, 67, 40, 14
+END
+
+IDD_TRIAN RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_NODERR DIALOG 0, 0, 240, 111
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ERROR IN FILL PROCESS"
+BEGIN
+ CONTROL "MAXIMUM NUMBER OF ELEMENTS CONNECTED",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 36, 8, 168, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 110, 89, 40, 14
+ CONTROL "ALLOWABLE LIMIT IS",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 50, 80, 12
+ CONTROL "CONNECTIONS DETECTED",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 67, 96, 12
+ CONTROL "0",IDF_INTEGER2,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 50, 40, 12
+ CONTROL "0",IDF_INTEGER3,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 161, 66, 40, 12
+ CONTROL " TO NODE EXCEEDED",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 80, 20, 80, 10
+ CONTROL "FILL TERMINATED",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 87, 30, 65, 11
+END
+
+IDD_NODERR RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1002 256 256 256 255 255 128 \n"
+" 1042 256 256 256 255 255 128 \n"
+" 1005 256 256 256 255 255 128 \n"
+,0
+END
+
+IDD_SELTFL2 DIALOG 0, 0, 400, 224
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION " SELECT FILE"
+BEGIN
+ CONTROL "",IDF_STRING25,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 36, 340, 12
+ CONTROL "",IDF_STRING26,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 50, 340, 12
+ CONTROL "",IDF_STRING27,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 64, 340, 12
+ CONTROL "",IDF_STRING28,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 78, 340, 12
+ CONTROL "",IDF_STRING29,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 92, 340, 12
+ CONTROL "",IDF_STRING30,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 106, 340, 12
+ CONTROL "",IDF_STRING31,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 120, 340, 12
+ CONTROL "",IDF_STRING32,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 134, 340, 12
+ CONTROL "",IDF_STRING33,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 148, 340, 12
+ CONTROL "",IDF_STRING34,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 162, 340, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 88, 196, 40, 14
+ CONTROL "",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 36, 20, 12
+ CONTROL "",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 50, 20, 12
+ CONTROL "",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 64, 20, 12
+ CONTROL "",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 78, 20, 12
+ CONTROL "",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 92, 20, 12
+ CONTROL "",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 106, 20, 12
+ CONTROL "",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 120, 20, 12
+ CONTROL "",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 134, 20, 12
+ CONTROL "",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 148, 20, 12
+ CONTROL "",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_TEXT, 20, 162, 20, 12
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 278, 195, 40, 14
+END
+
+IDD_SELTFL2 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+" 1051 0 \n"
+" 1052 0 \n"
+" 1053 0 \n"
+" 1054 0 \n"
+" 1055 0 \n"
+" 1056 0 \n"
+"[Colours] \n"
+" 1106 256 256 256 255 255 128 \n"
+" 1107 256 256 256 255 255 128 \n"
+" 1108 256 256 256 255 255 128 \n"
+" 1109 256 256 256 255 255 128 \n"
+" 1110 256 256 256 255 255 128 \n"
+" 1111 256 256 256 255 255 128 \n"
+" 1112 256 256 256 255 255 128 \n"
+" 1113 256 256 256 255 255 128 \n"
+" 1114 256 256 256 255 255 128 \n"
+" 1115 256 256 256 255 255 128 \n"
+,0
+END
+
+IDD_TRIANG DIALOG 0, 0, 197, 103
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "TRIANGULAR BLOCK"
+BEGIN
+ CONTROL "Elements on side 1",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 18, 62, 8
+ CONTROL "Elements on side 2",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 30, 62, 8
+ CONTROL "Elements on side 3",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 42, 62, 8
+ CONTROL "1",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 16, 40, 12
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 30, 40, 12
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 42, 40, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 80, 64, 40, 14
+END
+
+IDD_TRIANG RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_QUAD DIALOG 0, 0, 197, 103
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "QUADRILATERAL BLOCK"
+BEGIN
+ CONTROL "Elements on side 1",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 18, 62, 8
+ CONTROL "Elements on side 2",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 32, 62, 8
+ CONTROL "Elements on side 3",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 46, 62, 8
+ CONTROL "1",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 16, 40, 12
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 30, 40, 12
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 44, 40, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 80, 79, 40, 14
+ CONTROL "Elements on side 4",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 41, 60, 62, 8
+ CONTROL "0",IDF_INTEGER4,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 58, 40, 12
+END
+
+IDD_QUAD RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_DIALOG06 DIALOG 0, 0, 316, 202
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT DISPLAY OPTIONS"
+BEGIN
+ CONTROL "Map",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 12, 40, 14
+ CONTROL "Outline",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 80, 12, 40, 14
+ CONTROL "Network",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 200, 12, 40, 14
+ CONTROL "Nodes",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 20, 36, 40, 14
+ CONTROL "B-elev",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 80, 36, 40, 14
+ CONTROL "Layers",IDF_RADIO17,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 140, 36, 40, 14
+ CONTROL "No nodal display",IDF_RADIO18,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 198, 36, 80, 14
+ CONTROL "Elements",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 60, 40, 14
+ CONTROL "Type",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 80, 60, 40, 14
+ CONTROL "Group",IDF_RADIO19,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 140, 60, 40, 14
+ CONTROL "Data",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 260, 57, 40, 14
+ CONTROL "Grid",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 140, 12, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 200, 137, 40, 14
+ CONTROL "CC-lines",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 260, 12, 40, 14
+ CONTROL "Con Str",IDF_RADIO11,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 200, 58, 40, 14
+ CONTROL "1-D cross-sec locactions",IDF_RADIO12,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 160, 91, 100, 14
+ CONTROL "Cross-sec weighting factors",IDF_RADIO13,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 160, 109, 100, 14
+ CONTROL "Display 1-D as input RM1 width",IDF_RADIO14,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 21, 93, 108, 16
+ CONTROL "Display 1-D as computed width",IDF_RADIO15,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 21, 109, 108, 16
+ CONTROL "Display 1-D as computed area",IDF_RADIO16,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 21, 126, 108, 16
+ CONTROL "Nominal Elevation",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 151, 62, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 88, 150, 40, 14
+ CONTROL "Width scale factor",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 168, 62, 12
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 88, 167, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 200, 169, 40, 14
+END
+
+IDD_DIALOG06 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+" 1051 0 \n"
+" 1059 0 \n"
+" 1062 0 \n"
+" 1052 0 \n"
+" 1053 0 \n"
+" 1063 0 \n"
+" 1054 0 \n"
+" 1055 0 \n"
+" 1056 0 \n"
+" 1057 0 \n"
+" 1058 0 \n"
+" 1076 0 \n"
+" 1080 0 \n"
+" 1081 0 \n"
+" 1082 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_GETFPN DIALOG 0, 0, 160, 89
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ENTER FLOATING POINT"
+BEGIN
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 60, 32, 40, 14
+ CONTROL "",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | ES_LEFT | ES_CENTER | ES_MULTILINE | ES_UPPERCASE | ES_READONLY, 15, 8, 130, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 59, 40, 14
+END
+
+IDD_GETFPN RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1013 256 256 256 255 255 255 \n"
+"[Formats] \n"
+,0
+END
+
+IDD_GETINT DIALOG 0, 0, 181, 88
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ENTER INTEGER"
+BEGIN
+ CONTROL "",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | ES_LEFT | ES_CENTER | ES_MULTILINE | ES_UPPERCASE | ES_READONLY, 13, 8, 154, 16
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 70, 36, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 70, 60, 40, 14
+END
+
+IDD_GETINT RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1013 256 256 256 255 255 255 \n"
+,0
+END
+
+IDD_CSLOC DIALOG 0, 0, 219, 147
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "GET CROSS-SECTION LOCATIONS"
+BEGIN
+ CONTROL "Cross-section Number",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 35, 27, 74, 12
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 142, 24, 44, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 148, 112, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 35, 112, 40, 14
+ CONTROL "After selecting Cross-section number, press OK and click location on network display. Press Cancel to terminate.",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_MULTILINE, 36, 52, 148, 36
+END
+
+IDD_CSLOC RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_CREATM DIALOG 0, 0, 259, 177
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT CONTOUR LINES AND INTERVALS"
+BEGIN
+ CONTROL "",IDF_GRID1,"ISSGRID",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_HSCROLL | WS_GROUP | WS_TABSTOP | GS_DEFROWLABELS | GS_COLUMNLABELS, 33, 20, 192, 112
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 62, 144, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 159, 144, 40, 14
+END
+
+IDD_CREATM RCDATA
+BEGIN
+"[Grids] \n"
+" 1075 3 21 129 \n"
+,0
+END
+
+IDD_TEMPLATE001 DIALOG 0, 0, 1000, 16
+STYLE DS_3DLOOK
+FONT 8, "MS Sans Serif"
+BEGIN
+ CONTROL "Activate Contour",ISS1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT, 0, 0, 60, 14
+ CONTROL "Contour value",ISS2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 60, 14
+ CONTROL "Nodal interval",ISS3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 60, 14
+END
+
+IDD_TEMPLATE001 RCDATA
+BEGIN
+"[Checks] \n"
+" 1077 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_CREATM1 DIALOG 0, 0, 200, 120
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "CHOOSE OPTIONS"
+BEGIN
+ CONTROL "Use all contour lines",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 40, 17, 120, 14
+ CONTROL "Use same interval for all lines",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 40, 37, 120, 14
+ CONTROL "Nodal interval along lines",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 61, 78, 8
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 121, 58, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 85, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 121, 84, 40, 14
+END
+
+IDD_CREATM1 RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+" 1037 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_ORDEROUT DIALOG 0, 0, 276, 248
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "RE-ORDERING RESULTS"
+BEGIN
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 118, 216, 40, 14
+ CONTROL "",IDF_GRID1,"ISSGRID",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_HSCROLL | WS_GROUP | WS_TABSTOP | GS_DEFROWLABELS | GS_COLUMNLABELS | GS_ROWLABELS, 33, 24, 211, 148
+ CONTROL "Note that sequence number 0 is original order",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 60, 186, 156, 12
+END
+
+IDD_ORDEROUT RCDATA
+BEGIN
+"[Grids] \n"
+" 1075 3 101 132 \n"
+" 0 \n"
+"[Colours] \n"
+" 1001 256 256 256 255 255 000 \n"
+,0
+END
+
+IDD_TEMPLATE002 DIALOG 0, 0, 1000, 16
+STYLE DS_3DLOOK
+FONT 8, "MS Sans Serif"
+BEGIN
+ CONTROL "SEQUENCE NO.",ISS1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_CENTER | ES_MULTILINE, 0, 0, 63, 14
+ CONTROL "RE-ORDERING SUM",ISS2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 80, 14
+ CONTROL "MAX-FRONT",ISS3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 55, 14
+END
+
+IDD_selcrsec DIALOG 0, 0, 225, 123
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT CROSS-SECTION NUMBERS"
+BEGIN
+ CONTROL "",IDF_GRID1,"ISSGRID",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | GS_DEFROWLABELS | GS_COLUMNLABELS, 37, 24, 150, 28
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 52, 97, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 149, 97, 40, 14
+ CONTROL "Use automatic axis scales",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 68, 60, 88, 12
+ CONTROL "Input axis scales",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 68, 73, 88, 12
+END
+
+IDD_selcrsec RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+"[Grids] \n"
+" 1075 5 1 134 \n"
+,0
+END
+
+IDD_TEMPLATE003 DIALOG 0, 0, 1000, 16
+STYLE DS_3DLOOK
+FONT 8, "MS Sans Serif"
+BEGIN
+ CONTROL "SEC-1",ISS1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 30, 14
+ CONTROL "SEC-2",ISS2,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 30, 14
+ CONTROL "SEC-3",ISS3,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 30, 14
+ CONTROL "SEC-4",ISS4,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 30, 14
+ CONTROL "SEC-5",ISS5,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 30, 14
+END
+
+IDD_TEMPLATE003 RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_LIMITS DIALOG 0, 0, 209, 141
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SET CROSS-SECTION AXIS LIMITS"
+BEGIN
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 126, 20, 40, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 126, 40, 40, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 126, 60, 40, 14
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 126, 80, 40, 14
+ CONTROL "X-Axis Minimum",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 23, 80, 8
+ CONTROL "Y-Axis Minimum",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 63, 80, 8
+ CONTROL "X-Axis Maximum",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 43, 80, 8
+ CONTROL "Y-Axis Maximum",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 82, 80, 8
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 108, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 140, 108, 40, 14
+END
+
+IDD_LIMITS RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_lAY DIALOG 0, 0, 279, 113
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "LAYER DATA"
+BEGIN
+ CONTROL "Layer type LD2",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 50, 12, 58, 14
+ CONTROL "Layer type LD3",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 50, 29, 58, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 88, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 180, 88, 40, 14
+ CONTROL "",IDF_GRID1,"ISSGRID",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | GS_DEFROWLABELS | GS_COLUMNLABELS, 16, 52, 248, 28
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 200, 20, 40, 14
+ CONTROL "Number of layers",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 140, 23, 52, 8
+END
+
+IDD_lAY RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+"[Ranges] \n"
+"[Grids] \n"
+" 1075 7 1 137 \n"
+,0
+END
+
+IDD_TEMPLATE004 DIALOG 0, 0, 1000, 16
+STYLE DS_3DLOOK
+FONT 8, "MS Sans Serif"
+BEGIN
+ CONTROL "layer 1",ISS1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 2",ISS2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 3",ISS3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 4",ISS4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 5",ISS5,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 6",ISS6,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+ CONTROL "layer 7",ISS7,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 0, 0, 35, 14
+END
+
+IDD_TEMPLATE004 RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_DISPLIT DIALOG 0, 0, 180, 240
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT SPLIT OPTIONS"
+BEGIN
+ CONTROL "Distance Apart of Split Nodes",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 22, 65, 98, 10
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 122, 64, 38, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 70, 201, 40, 14
+ CONTROL "Element type number",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 47, 104, 68, 10
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 123, 102, 35, 12
+ CONTROL "Insert elements",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 61, 83, 70, 11
+ CONTROL "Add end triangles",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 56, 123, 75, 11
+ CONTROL "Direction to split nodes for single node split",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 24, 173, 79, 18
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 122, 176, 38, 12
+ CONTROL "Continuity Line Number",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 22, 46, 98, 10
+ CONTROL "Form Line by Clicking Nodes",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 22, 8, 110, 12
+ CONTROL "Use Existing Continuity Line",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 22, 27, 110, 12
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 123, 47, 35, 12
+ CONTROL "End Element type number",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 34, 144, 80, 10
+ CONTROL "0",IDF_INTEGER6,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 142, 35, 12
+END
+
+IDD_DISPLIT RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+" 1037 0 \n"
+" 1047 0 \n"
+" 1048 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_DIRSPLIT DIALOG 0, 0, 177, 81
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "DIRECTION OF SPLIT"
+BEGIN
+ CONTROL "Direction to split nodes",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 21, 21, 79, 11
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 122, 20, 38, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 68, 48, 40, 14
+END
+
+IDD_DIRSPLIT RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_SETOPT DIALOG 0, 0, 160, 103
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Set option"
+BEGIN
+ CONTROL "Set nodal value",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 12, 80, 14
+ CONTROL "Apply as adjustment",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 24, 80, 14
+ CONTROL "Lock value after adjustment",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 32, 48, 95, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 76, 40, 14
+END
+
+IDD_SETOPT RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1036 0 \n"
+,0
+END
+
+IDD_SETMAXMAP DIALOG 0, 0, 175, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "RESET MAXIMUM MAP FILE SIZE"
+BEGIN
+ CONTROL "Maximum number of map lines",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 20, 24, 60, 16
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 24, 60, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 58, 56, 40, 14
+END
+
+IDD_SETMAXMAP RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 255 000 000 255 255 000 \n"
+,0
+END
+
+IDD_MLIMITS DIALOG 0, 0, 175, 159
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "RESET LIMITS"
+BEGIN
+ CONTROL "Maximum number of nodes",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 20, 22, 60, 24
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 26, 60, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 68, 127, 40, 14
+ CONTROL "Maximum Number of Elements",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 22, 53, 60, 24
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 101, 56, 60, 16
+ CONTROL "Maximum Number of Map Points",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 20, 88, 60, 24
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 91, 60, 16
+END
+
+IDD_MLIMITS RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 255 000 000 255 255 000 \n"
+" 1002 255 000 000 255 255 000 \n"
+" 1003 255 000 000 255 255 000 \n"
+,0
+END
+
+IDD_CHKOPT DIALOG 0, 0, 230, 147
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "CHECK OPTIONS"
+BEGIN
+ CONTROL "Check areas",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 40, 18, 150, 11
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 50, 115, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 140, 115, 40, 14
+ CONTROL "Check bed elevation/section differences",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 34, 150, 11
+ CONTROL "Check normailized depth/section differences",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 50, 150, 11
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 130, 67, 60, 14
+ CONTROL "Reference elevation",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 68, 80, 11
+ CONTROL "Additional options for 1-D elements",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 40, 86, 150, 11
+END
+
+IDD_CHKOPT RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 1 \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1037 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_SETSEL DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SET SELECTION FRACTION"
+BEGIN
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 18, 40, 14
+ CONTROL "Selection fraction",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 20, 60, 8
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 48, 40, 14
+END
+
+IDD_SETSEL RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_CHK1DOPT DIALOG 0, 0, 200, 116
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SET 1-D OPTIONS"
+BEGIN
+ CONTROL "Check width differences",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 16, 120, 11
+ CONTROL "Check area differences",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 35, 120, 11
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 84, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 84, 40, 14
+ CONTROL "Reference elevation",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 40, 55, 80, 11
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 54, 40, 14
+END
+
+IDD_CHK1DOPT RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_VIEWANG DIALOG 0, 0, 219, 263
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Set Viewing Angle and Vertical Scale"
+BEGIN
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 33, 40, 14
+ CONTROL "90.000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 72, 40, 14
+ CONTROL "Angle of View Horizontally",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 29, 90, 10
+ CONTROL "Angle of View Looking Down",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 69, 95, 11
+ CONTROL "To North = 0.0 to West = 90.0",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 40, 100, 11
+ CONTROL "Horizontal = 0.0 Vertical = 90.0",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 80, 114, 11
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 90, 230, 40, 14
+ CONTROL "Vertical Scale Factor",IDF_LABEL5,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 109, 95, 11
+ CONTROL "1.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 115, 40, 14
+ CONTROL "Prototype Dimension per Unit Plot Dimension",IDF_LABEL6,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 120, 114, 16
+ CONTROL "Vertical Scale Origin for Contour Plot",IDF_LABEL7,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 21, 154, 95, 17
+ CONTROL "Units of Contour Plot",IDF_LABEL8,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 21, 176, 85, 15
+ CONTROL "1.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 161, 160, 40, 14
+ CONTROL "Hold vertical/horizontal aspect ratio constant",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 22, 202, 176, 14
+END
+
+IDD_VIEWANG RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_DIALOG047 DIALOG 0, 0, 199, 132
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SET MOVE OPTIONS"
+BEGIN
+ CONTROL "X-Shift or X-Origin for scaling",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 18, 100, 8
+ CONTROL "Y-Shift or Y-Origin for scaling",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 40, 100, 8
+ CONTROL "X-Scale",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 21, 62, 100, 8
+ CONTROL "Y-Scale",IDF_LABEL4,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 82, 100, 8
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 140, 15, 40, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 141, 37, 40, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 141, 59, 40, 14
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 141, 81, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 42, 104, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 104, 40, 14
+END
+
+IDD_DIALOG047 RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_DIALOG048 DIALOG 0, 0, 160, 90
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT METHOD"
+BEGIN
+ CONTROL "Use fixed shift or scaling",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 20, 12, 120, 14
+ CONTROL "Use graphical adjustment",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 20, 35, 120, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 22, 60, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 99, 60, 40, 14
+END
+
+IDD_DIALOG048 RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+,0
+END
+
+IDD_SELELTYP DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT ELEMENT TYPE"
+BEGIN
+ CONTROL "Element Type",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 26, 21, 54, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 18, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 46, 40, 14
+END
+
+IDD_SELELTYP RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_TRANSFORM DIALOG 0, 0, 302, 197
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "TRANSFORM COEFFICIENTS"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 152, 17, 40, 14
+ CONTROL "SELECT OPTION",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 75, 16, 66, 14
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 94, 40, 40, 14
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 94, 58, 40, 14
+ CONTROL "0",IDF_INTEGER4,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 95, 78, 40, 14
+ CONTROL "0",IDF_INTEGER5,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 95, 99, 40, 14
+ CONTROL "INT COEFFICIENT 1",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 19, 41, 70, 14
+ CONTROL "INT COEFFICIENT 2",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 59, 70, 14
+ CONTROL "INT COEFFICIENT 3",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 78, 70, 14
+ CONTROL "INT COEFFICIENT 4",IDF_STRING5,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 99, 70, 14
+ CONTROL "RL COEFFICIENT 1",IDF_STRING6,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 40, 70, 14
+ CONTROL "RL COEFFICIENT 2",IDF_STRING7,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 58, 70, 14
+ CONTROL "RL COEFFICIENT 3",IDF_STRING8,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 77, 70, 14
+ CONTROL "RL COEFFICIENT 4",IDF_STRING9,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 98, 70, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 40, 40, 14
+ CONTROL "0.0000",IDF_REAL4,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 58, 40, 14
+ CONTROL "0.0000",IDF_REAL5,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 78, 40, 14
+ CONTROL "0.0000",IDF_REAL6,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 241, 96, 40, 14
+ CONTROL "INT COEFFICIENT 5",IDF_STRING10,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 120, 70, 14
+ CONTROL "0",IDF_INTEGER9,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 95, 120, 40, 14
+ CONTROL "RL COEFFICIENT 5",IDF_STRING11,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 119, 70, 14
+ CONTROL "0.0000",IDF_REAL7,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 241, 117, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 76, 175, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 188, 174, 40, 14
+ CONTROL "INT COEFFICIENT 6",IDF_STRING12,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 144, 70, 14
+ CONTROL "0",IDF_INTEGER10,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 94, 144, 40, 14
+ CONTROL " RL COEFFICIENT 6",IDF_STRING13,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 160, 143, 70, 14
+ CONTROL "0.0000",IDF_REAL8,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 240, 141, 40, 14
+END
+
+IDD_TRANSFORM RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_ELTERR2 DIALOG 0, 0, 220, 105
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Element Data Error"
+BEGIN
+ CONTROL "ERROR IN ELEMENT CONNECTIONS NODE UNDEFINED",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 20, 12, 181, 8
+ CONTROL "Element Number",IDF_LABEL3,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 56, 35, 58, 8
+ CONTROL "0",IDF_INTEGER1,"INTEGEREDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 123, 33, 38, 11
+ CONTROL "YES",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 78, 40, 14
+ CONTROL "REMOVE ELEMENT?",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 75, 56, 70, 8
+ CONTROL "NO",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 78, 40, 14
+END
+
+IDD_ELTERR2 RCDATA
+BEGIN
+"[Ranges] \n"
+"[Colours] \n"
+" 1001 256 256 256 255 128 000 \n"
+" 1002 256 256 256 255 128 000 \n"
+,0
+END
+
+IDD_GENBLK DIALOG 0, 0, 260, 188
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT GENBLK VALUES"
+BEGIN
+ CONTROL "1",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 22, 40, 12
+ CONTROL "10.000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 43, 40, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 110, 156, 40, 14
+ CONTROL "Number of Elements in Cross-Section",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 22, 120, 12
+ CONTROL "Element Length along Channel",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 40, 43, 100, 12
+ CONTROL "Right Bank Map Line Number",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 40, 98, 100, 12
+ CONTROL "Left Bank Map Line Number",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 40, 65, 102, 12
+ CONTROL "1",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 67, 40, 12
+ CONTROL "2",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 180, 100, 40, 12
+ CONTROL "Reverse Order",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 158, 83, 60, 10
+ CONTROL "Reverse Order",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 158, 112, 60, 10
+ CONTROL "Connection Option",IDF_STRING5,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 41, 129, 100, 12
+ CONTROL "1",IDF_INTEGER5,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 179, 130, 40, 12
+END
+
+IDD_GENBLK RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+" 1037 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_SETWRS DIALOG 0, 0, 236, 176
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SETUP LEVEE/WEIR DATA"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 96, 40, 14
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 122, 40, 14
+ CONTROL "Element Type for Transformation",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 96, 102, 14
+ CONTROL " Incr. on Weir Height for Transition",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 122, 118, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 60, 150, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 140, 150, 40, 14
+ CONTROL "Option 1 Add increment to form levee height",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 24, 160, 16,WS_EX_STATICEDGE
+ CONTROL "Option 2 Use Bed Levels for Height,- Reset Bed",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 49, 160, 16,WS_EX_STATICEDGE
+ CONTROL "Increment to Form Weir Height",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 75, 96, 14
+ CONTROL "0.0000",IDF_REAL2,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 160, 75, 40, 14
+END
+
+IDD_SETWRS RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+"[Ranges] \n"
+"[Colours] \n"
+" 1047 256 256 256 255 255 255 \n"
+" 1048 256 256 256 255 255 255 \n"
+"[Formats] \n"
+,0
+END
+
+IDD_FORMLINE DIALOG 0, 0, 201, 267
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "FORM LINE OPTIONS"
+BEGIN
+ CONTROL "Form Simple Line",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 20, 120, 14
+ CONTROL "Form Complex Line",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 36, 120, 14
+ CONTROL "Nodal Spacing",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 57, 54, 14
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 57, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 223, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 223, 40, 14
+ CONTROL " Input Controls From File",IDF_CHECK3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 40, 196, 120, 14
+ CONTROL "Element Type Number",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 123, 72, 14
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 122, 123, 40, 14
+ CONTROL "Form Only Nodes",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 75, 120, 14
+ CONTROL "Add One-D Elements",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 89, 120, 14
+ CONTROL "Add Two-D Elements",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 40, 103, 120, 14
+ CONTROL "Number of Elements in Section",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_MULTILINE, 44, 170, 72, 19
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 122, 172, 40, 14
+ CONTROL "Starting Structure Number",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 39, 145, 79, 14
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 121, 145, 40, 14
+END
+
+IDD_FORMLINE RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1038 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+" 1051 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_MATTYP DIALOG 0, 0, 160, 80
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Input an Element Type"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 108, 16, 40, 14
+ CONTROL "Element Type Number",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 24, 16, 74, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 20, 48, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 100, 49, 40, 14
+END
+
+IDD_MATTYP RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_LEVSETTYP DIALOG 0, 0, 181, 92
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Set Element by Level"
+BEGIN
+ CONTROL "Bed Elevation",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 16, 70, 12
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 16, 40, 14
+ CONTROL "Element Type",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 20, 38, 70, 12
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 120, 37, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 20, 64, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 64, 40, 14
+END
+
+IDD_LEVSETTYP RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_CHSTYP DIALOG 0, 0, 181, 224
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SELECT DATA SET"
+BEGIN
+ CONTROL "",IDF_STRING25,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 36, 80, 12
+ CONTROL "",IDF_STRING26,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 50, 80, 12
+ CONTROL "",IDF_STRING27,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 64, 80, 12
+ CONTROL "",IDF_STRING28,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 78, 80, 12
+ CONTROL "",IDF_STRING29,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 92, 80, 12
+ CONTROL "",IDF_STRING30,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 106, 80, 12
+ CONTROL "",IDF_STRING31,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 120, 80, 12
+ CONTROL "",IDF_STRING32,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 134, 80, 12
+ CONTROL "",IDF_STRING33,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 148, 80, 12
+ CONTROL "",IDF_STRING34,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 40, 162, 80, 12
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 71, 196, 40, 14
+ CONTROL "",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 36, 20, 12
+ CONTROL "",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 50, 20, 12
+ CONTROL "",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 64, 20, 12
+ CONTROL "",IDF_RADIO4,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 78, 20, 12
+ CONTROL "",IDF_RADIO5,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 92, 20, 12
+ CONTROL "",IDF_RADIO6,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 106, 20, 12
+ CONTROL "",IDF_RADIO7,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 120, 20, 12
+ CONTROL "",IDF_RADIO8,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 134, 20, 12
+ CONTROL "",IDF_RADIO9,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 148, 20, 12
+ CONTROL "",IDF_RADIO10,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 120, 162, 20, 12
+END
+
+IDD_CHSTYP RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+" 1050 0 \n"
+" 1051 0 \n"
+" 1052 0 \n"
+" 1053 0 \n"
+" 1054 0 \n"
+" 1055 0 \n"
+" 1056 0 \n"
+"[Colours] \n"
+" 1106 256 256 256 255 255 128 \n"
+" 1107 256 256 256 255 255 128 \n"
+" 1108 256 256 256 255 255 128 \n"
+" 1109 256 256 256 255 255 128 \n"
+" 1110 256 256 256 255 255 128 \n"
+" 1111 256 256 256 255 255 128 \n"
+" 1112 256 256 256 255 255 128 \n"
+" 1113 256 256 256 255 255 128 \n"
+" 1114 256 256 256 255 255 128 \n"
+" 1115 256 256 256 255 255 128 \n"
+,0
+END
+
+IDD_FBED DIALOG 0, 0, 219, 137
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "FAILED TO INTERPOLATE ALL"
+BEGIN
+ CONTROL "INTERPOLATION FAILURE DETECTED",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 46, 20, 126, 14
+ CONTROL "Nodes Failed",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 110, 47, 52, 14
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 51, 46, 40, 14
+ CONTROL "Use Adjacent Node Value?",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 67, 72, 84, 14
+ CONTROL "YES",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 53, 100, 40, 14
+ CONTROL "NO",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 131, 100, 40, 14
+END
+
+IDD_FBED RCDATA
+BEGIN
+"[Ranges] \n"
+,0
+END
+
+IDD_SETYRDT DIALOG 0, 0, 219, 157
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "SET YEAR AND DATE"
+BEGIN
+ CONTROL "SET YEAR AND DATE",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 46, 20, 126, 14
+ CONTROL "Year",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 48, 39, 52, 14
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 132, 37, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 90, 124, 40, 14
+ CONTROL "Month",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 48, 57, 52, 14
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 132, 57, 40, 14
+ CONTROL "Day",IDF_STRING4,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 48, 75, 52, 14
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 132, 75, 40, 14
+ CONTROL "Hour",IDF_STRING5,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 48, 93, 52, 14
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 132, 93, 40, 14
+END
+
+IDD_SETYRDT RCDATA
+BEGIN
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_GETINTR DIALOG 0, 0, 200, 111
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "GET NUMBER OF ELEMENTS TO REVERSE"
+BEGIN
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 139, 20, 40, 14
+ CONTROL "Number of pairs to reverse",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 19, 20, 94, 14
+ CONTROL "Do Not Reverse Equal Elevations",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 20, 48, 155, 14,WS_EX_STATICEDGE
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 40, 80, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 120, 80, 40, 14
+END
+
+IDD_GETINTR RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+"[Ranges] \n"
+,0
+END
+
+IDD_CHOOSEMODEL DIALOG 0, 0, 179, 137
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "CHOOSE MODEL"
+BEGIN
+ CONTROL "RMA-2",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 45, 25, 90, 18,WS_EX_STATICEDGE
+ CONTROL "RMA-10",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 45, 50, 90, 14,WS_EX_STATICEDGE
+ CONTROL "RMA-11",IDF_RADIO3,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 45, 75, 90, 14,WS_EX_STATICEDGE
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 69, 100, 40, 14
+END
+
+IDD_CHOOSEMODEL RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1049 0 \n"
+,0
+END
+
+IDD_SETUPELDISP DIALOG 0, 0, 249, 233
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Setup Element Load Display"
+BEGIN
+ CONTROL " Display Maximum Flow",IDF_RADIO1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 69, 14, 110, 14
+ CONTROL " Display Cumulative Flow",IDF_RADIO2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTORADIOBUTTON | BS_LEFTTEXT | BS_TEXT, 69, 40, 110, 14
+ CONTROL " Use Limited Time Period",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 69, 67, 110, 14
+ CONTROL "Start Time",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 104, 88, 40, 14
+ CONTROL "YEAR JUL DAY HOUR",IDF_STRING2,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT, 54, 110, 140, 14
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 54, 127, 40, 14
+ CONTROL "0",IDF_INTEGER2,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 127, 40, 14
+ CONTROL "0.0000",IDF_REAL1,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 145, 127, 40, 14
+ CONTROL "End Time",IDF_STRING3,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 104, 149, 40, 14
+ CONTROL "0",IDF_INTEGER3,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 54, 171, 40, 14
+ CONTROL "0",IDF_INTEGER5,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 100, 171, 40, 14
+ CONTROL "0.0000",IDF_REAL3,"REALEDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 145, 171, 40, 14
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 54, 202, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 143, 201, 40, 14
+END
+
+IDD_SETUPELDISP RCDATA
+BEGIN
+"[Checks] \n"
+" 1047 0 \n"
+" 1048 0 \n"
+" 1036 0 \n"
+"[Ranges] \n"
+"[Formats] \n"
+,0
+END
+
+IDD_FTRIAN DIALOG 0, 0, 200, 142
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "Options for TRIANG"
+BEGIN
+ CONTROL "Nominal Element Length",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT, 26, 52, 86, 14
+ CONTROL "Add Nodes to Improve Mesh Quality",IDF_CHECK1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 26, 28, 148, 14,WS_EX_STATICEDGE
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 28, 108, 40, 14
+ CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 132, 108, 40, 14
+ CONTROL "Force Conforming Boundary Nodes",IDF_CHECK2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_AUTOCHECKBOX | BS_LEFTTEXT | BS_TEXT, 26, 80, 148, 14,WS_EX_STATICEDGE
+ CONTROL "0",IDF_INTEGER1,"INTEGERSPIN",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | WS_TABSTOP | ES_LEFT | ES_RIGHT | ES_MULTILINE, 130, 52, 40, 14
+END
+
+IDD_FTRIAN RCDATA
+BEGIN
+"[Checks] \n"
+" 1036 0 \n"
+" 1037 0 \n"
+"[Ranges] \n"
+,0
+END
+
+IDD_GETFL DIALOG 0, 0, 233, 89
+STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
+FONT 8, "MS Sans Serif"
+CAPTION "ENTER FILE DIRECTORY FOR TRIANGLE"
+BEGIN
+ CONTROL "",IDF_STRING1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_GROUP | ES_LEFT | ES_CENTER | ES_MULTILINE | ES_UPPERCASE, 17, 24, 198, 16
+ CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 96, 59, 40, 14
+END
+
+IDD_GETFL RCDATA
+BEGIN
+"[Colours] \n"
+" 1013 256 256 256 255 255 255 \n"
+,0
+END
+
+///////////////////////////////////////////////////
+//
+// Menus
+//
+IDR_MENU1 MENU
+BEGIN
+ POPUP "&File"
+ BEGIN
+ MENUITEM "&New", ID_ITEM11
+ MENUITEM "&Open\aCtrl+O", ID_ITEM12
+ MENUITEM "Open Additional Mesh Files", ID_LOADRM1
+ MENUITEM "Open Background file", ID_BKF
+ MENUITEM "Open &Layer Data File", ID_LAYFL
+ MENUITEM "Open New Map file", ID_NMAP
+ MENUITEM "Open Additional Map File (Combine)", ID_ADDMAP
+ MENUITEM "Open Cross-Section file", ID_crsf
+ MENUITEM "Open &Group File", ID_OPENGP
+ MENUITEM "Open Outline File", ID_OUTLINFL
+ MENUITEM "Reset Limits", ID_RESETLIM
+ MENUITEM "Save a&scii\aCtrl+S", ID_ITEM13
+ MENUITEM "&Save binary\aCtrl+B", ID_ITEM14
+ MENUITEM "Save as &bin map", ID_ITEM18
+ MENUITEM "Save &as ascii", ID_ITEM15
+ MENUITEM "Save as &binary", ID_ITEM16
+ MENUITEM "Save as binary with header", ID_SBIN
+ MENUITEM "Save Cross-Section Data", ID_SAVCRS
+ MENUITEM "Save Layer Data File", ID_OUTLAY
+ MENUITEM "Save ASCII Group File", ID_SAVGP
+ MENUITEM "Copy to File", ID_ICOPY
+ MENUITEM "Copy to Clipboard", ID_Clip
+ MENUITEM "Copy to Shapefile", ID_SAVSHP
+ MENUITEM "&Print", ID_ITEM24
+ MENUITEM "&Demo", ID_ITEM19
+ MENUITEM "E&xit", ID_ITEM17
+ END
+ POPUP "Edit"
+ BEGIN
+ MENUITEM "Node Data", ID_Nodedata
+ MENUITEM "Element Data", ID_Eltdata
+ MENUITEM "Select Element", ID_GETELM
+ MENUITEM "Layer data", ID_EDLAY
+ END
+ MENUITEM "&Node", ID_NODE
+ MENUITEM "&Elts", ID_ELTS
+ POPUP "&Order"
+ BEGIN
+ MENUITEM "Reorder menu\aCtrl+R", ID_ORDR
+ MENUITEM "Reorder All", ID_ORDR1
+ END
+ POPUP "Mesh"
+ BEGIN
+ MENUITEM "Select mesh file", ID_SELRM1
+ MENUITEM "Input Outline to Add Mesh", ID_addmeshtr
+ MENUITEM "Add mesh to existing", ID_addmesh
+ MENUITEM "Merge mesh to existing", ID_MRGMESH
+ MENUITEM "Generate triangular block", ID_TRIANG
+ MENUITEM "Generate quadrilateral block", ID_QUAD
+ MENUITEM "Form a line of 1-D elements", ID_g1d
+ MENUITEM "Create mesh from map lines", ID_CREATM
+ MENUITEM "Create Block From 2 Map Lines", ID_CRGRID
+ MENUITEM "Generate Contour lines", ID_CGEN
+ MENUITEM "Split a line", ID_SPLITN
+ MENUITEM "Form type 999 line", ID_FORM999
+ MENUITEM "Form 2D elements from 1-D", ID_FORM2D
+ MENUITEM "Generate outline file", ID_GOUTLIN
+ MENUITEM "Extract Outline List", ID_XOUTLIN
+ MENUITEM "Check mesh", id_mchck
+ MENUITEM "Move mesh", ID_MOVMESH
+ MENUITEM "Transform mesh", ID_TRANSFORM
+ MENUITEM "Delete element type", ID_deletelm
+ MENUITEM "Join all overlapping nodes", ID_JOINALL
+ MENUITEM "Setup Levee Elements", ID_SETUPLEV
+ END
+ POPUP "Map"
+ BEGIN
+ MENUITEM "Make map from nodes", ID_MMAP
+ MENUITEM "Interpolate to make map", ID_map
+ MENUITEM "Triangulate Map data", ID_TRIAN
+ MENUITEM "Switch to show MAP data", ID_SWMAP
+ MENUITEM "Switch to show RM1 data", ID_SWRM1
+ MENUITEM "Create map data", ID_cdata
+ END
+ POPUP "Cc&line"
+ BEGIN
+ MENUITEM "Get Ccline", ID_CCLN
+ MENUITEM "Update Ccline", ID_CHKCCLN
+ END
+ POPUP "Contour"
+ BEGIN
+ MENUITEM "Contour Options", ID_CONTOPT
+ MENUITEM "Draw Contour", ID_DCONTR
+ END
+ POPUP "Csec&t"
+ BEGIN
+ MENUITEM "Trapezoids", ID_CSEC
+ MENUITEM "Assign Cross-section locations", ID_CSLOC
+ MENUITEM "Compute Weighting", ID_CRSCAL
+ MENUITEM "View Cross-sections", ID_crsect
+ END
+ MENUITEM "&Distance", ID_ITEM20
+ POPUP "S&elect"
+ BEGIN
+ POPUP "Nodes"
+ BEGIN
+ MENUITEM "Use Polygon", ID_ITEM22
+ MENUITEM "All Nodes", ID_ALLNODES
+ MENUITEM "Unused Nodes", ID_UNUSNODES
+ MENUITEM "By Element Type", ID_SELELTYP
+ MENUITEM "Nodes for Move", ID_MOVGRP
+ END
+ MENUITEM "Elem&ents", ID_ITEM23
+ MENUITEM "Select Area for extraction", ID_selarea
+ POPUP "Select Group"
+ BEGIN
+ MENUITEM "Select Processed Differences", ID_SECGRP
+ END
+ MENUITEM "Select pairs for reversal", ID_SELPR
+ MENUITEM "Find and Display Element type", ID_DISPTYP
+ END
+ POPUP "&Undo"
+ BEGIN
+ MENUITEM "Undo Refine or Gblock", ID_UNDO
+ MENUITEM "Undo Last Selected Element", ID_UNDOS
+ MENUITEM "Undo Last Auto Mesh Gneration", ID_UNDOGEN
+ END
+ POPUP "&View"
+ BEGIN
+ MENUITEM "Zoom &In\aCtrl+Z", ID_ZIN
+ POPUP "Zoom &Out"
+ BEGIN
+ MENUITEM "&2 times", ID_OUT2
+ MENUITEM "&4 times", ID_OUT4
+ END
+ MENUITEM "Drag", ID_DRAG
+ MENUITEM "Pan &Left", ID_PLEFT
+ MENUITEM "Pan &Right", ID_PRIGHT
+ MENUITEM "Pan &Up", ID_PUP
+ MENUITEM "Pan &Down", ID_PDOWN
+ MENUITEM "Re&set", ID_RSET
+ MENUITEM "View in 3-D", ID_3DVIEW
+ MENUITEM "Set View Angle", ID_VIEWANGLE
+ MENUITEM "Rotate 3-D view", ID_VROTATE
+ MENUITEM "Find Node\aCtrl+F", ID_findnode
+ MENUITEM "Find Element\aCtrl+E", ID_findelem
+ END
+ POPUP "&Rdraw"
+ BEGIN
+ MENUITEM "Re-draw", ID_DRAWD
+ MENUITEM "Draw Options", ID_IDRWT
+ POPUP "&Background"
+ BEGIN
+ MENUITEM "Select", ID_BSEL
+ MENUITEM "Register", ID_REGST
+ MENUITEM "Reset Registration", ID_RESETRG
+ END
+ POPUP "Type/Group Options"
+ BEGIN
+ MENUITEM "Type Number", ID_ITYPN
+ MENUITEM "Type Colour", ID_ITYPC
+ MENUITEM "Group Number", ID_IGPN
+ MENUITEM "Group Colour", ID_IGPC
+ END
+ MENUITEM "Map Options", ID_MAPOPD
+ MENUITEM "Force Direct Draw", ID_DDRAW
+ END
+ POPUP "&Help"
+ BEGIN
+ MENUITEM "Open &help file", ID_Help1
+ MENUITEM "About RMAGEN", ID_Help2
+ END
+ POPUP "Experimental"
+ BEGIN
+ MENUITEM "Select Elements to attach", ID_attach
+ MENUITEM "Fill a Gap Between Elements", ID_FILLAGAP
+ MENUITEM "Set Type by Level", ID_SETTYPLEV
+ MENUITEM "Form a complex line of elements", ID_Complex
+ MENUITEM "Interpolate Map File for Stress File", ID_GETSTRESSFIL
+ MENUITEM "Smooth Map Contours", ID_SMOOTHMAP
+ MENUITEM "Smooth Mesh Using Reversal", ID_RVSDIAG
+ MENUITEM "Remove Elements Outside Outline", ID_TESTOUT
+ MENUITEM "Input Element Load file", ID_LOADELTLD
+ MENUITEM "Assign Element Loads to Elements", ID_ASSIGNELTLD
+ MENUITEM "Show Element Loads", ID_SHOWELTLD
+ MENUITEM "Re-Show Element Loads", ID_RESHOWELTLD
+ MENUITEM "Save Element Load File", ID_SAVELTLD
+ MENUITEM "Form Elements from Map File", ID_FILLTR
+ END
+ MENUITEM "E&xit", ID_EXIT
+END
+
+IDR_MENU1 RCDATA
+BEGIN
+ID_FILE,1,0,
+ID_ITEM56,2,0,
+ID_ORDRT,5,0,
+ID_network,6,0,
+ID_mapm,7,0,
+ID_CCLNA,8,0,
+ID_CONTR,9,0,
+ID_CSEC1,10,0,
+ID_ITEM26,12,0,
+ID_ITEM73,12,1,0,
+ID_ITEM103,12,4,0,
+ID_UNDOM,13,0,
+ID_ZOOM,14,0,
+ID_ZOUT,14,2,0,
+ID_DRAW,15,0,
+ID_BACGD,15,3,0,
+ID_TYPD,15,4,0,
+ID_HELP,16,0,
+ID_ITEM126,17,0,
+0
+END
+
+///////////////////////////////////////////////////
+//
+// Accelerators
+//
+IDR_MENU1 ACCELERATORS
+BEGIN
+ 79 , ID_ITEM12 ,NOINVERT,VIRTKEY,CONTROL
+ 83 , ID_ITEM13 ,NOINVERT,VIRTKEY,CONTROL
+ 66 , ID_ITEM14 ,NOINVERT,VIRTKEY,CONTROL
+ 82 , ID_ORDR ,NOINVERT,VIRTKEY,CONTROL
+ 90 , ID_ZIN ,NOINVERT,VIRTKEY,CONTROL
+ 70 , ID_findnode ,NOINVERT,VIRTKEY,CONTROL
+ 69 , ID_findelem ,NOINVERT,VIRTKEY,CONTROL
+END
+
+///////////////////////////////////////////////////
+//
+// Bitmaps
+//
+ID_TOOLBAR1 BITMAP DISCARDABLE "zoom.BMP"
+id_chck BITMAP DISCARDABLE "chck.bmp"
+id_chk BITMAP DISCARDABLE "chck.bmp"
+idchk BITMAP DISCARDABLE "chck.bmp"
+
+///////////////////////////////////////////////////
+//
+// Icons
+//
+icon1 ICON DISCARDABLE "winter.ico"
+IDC_BUTTON2 ICON DISCARDABLE "button.ico"
+IDOK ICON DISCARDABLE "ok.ico"
+IDCANCEL ICON DISCARDABLE "cancel.ico"
+
+///////////////////////////////////////////////////
+//
+// Strings
+//
+STRINGTABLE DISCARDABLE
+BEGIN
+ ID_STRING1 "Map file -- *.map |*.map|Bin Map file -- *.mpb|*.mpb|Bin Map file (no head) -- *.mbb|*.mbb|RM1 file (as map) -- *.rm1|*.rm1|ESRI ASC file -- *.asc|*.asc|SURFER GRD file -- *.grd|*.grd|SHAPE FILE -- *.shp|*.shp|"
+ ID_STRING2 "Network files |*.rm1,*.geo,*.gfg,*.rst,*.bin|Rm1 file -- *.rm1|*.rm1|Geo file -- *.geo|*.geo|Gfg file -- *.gfg|*.gfg|Rst file -- *.rst|*.rst|Bin file -- *.bin|*.bin|"
+ ID_STRING3 "Rm1 file -- *.rm1|*.rm1|"
+ ID_STRING4 "Geo file -- * .geo|*.geo|"
+ ID_STRING5 "Bin Map file -- *.mpb|*.mpb|"
+ ID_STRING6 "jpeg file -- *.jpg|*.jpg|png file -- *.png|*.png|pcx file -- *.pcx|*.pcx|bmp file -- *.bmp|*.bmp|cgm file -- *.cgm|*.cgm|pic file -- *.pic|*.pic|emf file -- *.emf|*.emf|wmf file -- *.wmf|*.wmf|dxf file -- *.dxf|*.dxf|"
+ ID_STRING7 "Map file -- *.map |*.map|"
+ ID_STRING8 "Cln file -- *.cln |*.cln|"
+ ID_STRING9 "Layer file -- *.lay |*.lay|"
+ ID_STRING10 "jpeg file -- *.jpg|*.jpg|wmf file -- *.wmf|*.wmf|bmp file -- *.bmp|*.bmp|pcx file -- *.pcx|*.pcx|png file -- *.png|*.png|cgm file -- *.cgm|*.cgm|pic file -- *.pic|*.pic|"
+ ID_STRING11 "org file -- *.org|*.org|"
+ ID_DELM "Delete all Mid-side nodes"
+ ID_FILL "Fill Mid-side nodes"
+ ID_RSET "Reset to basic view"
+ ID_DRAG "Pan Screen"
+ ID_ZIN "Zoom In"
+ ID_OUT2 "Zoom Out"
+ ID_JOIN "Merge Two Nodes"
+ ID_IDRWT "Show Network Display Options"
+ id_chck "Check Network"
+ ID_ROTATE "Rotate 3-D View"
+END
+
+///////////////////////////////////////////////////
+//
+// Toolbar Data
+//
+ID_TOOLBAR1 RCDATA
+BEGIN
+ 16, 16,
+ ID_ZIN,
+ ID_OUT2,
+ ID_DRAG,
+ ID_RSET,
+ ID_DELM,
+ ID_FILL,
+ ID_JOIN,
+ ID_IDRWT,
+ id_chck,
+ ID_ROTATE,
+0,0
+END
+
+
+///////////////////////////////////////////////////
+//
+// Winteracter Visual Tool Settings
+//
+//*WI* BASEMENU 30001
+//*WI* BASEITEM 40001
+//*WI* BASEDIALOG 101
+//*WI* BASEFIELD 1001
+//*WI* BASETOOLBAR 30101
+//*WI* BASEBUTTON 40101
+//*WI* BASEIMAGE 2001
+//*WI* F90MODULE 0
+//*WI* FORTSAVE 1
+//*WI* FILENAME D.INC
+//*WI* FMODNAME
+//*WI* LASTTYPE 1
+//*WI* LASTRES 1
diff --git a/src/src83e/RMAGENV83d.res b/src/src83e/RMAGENV83d.res
new file mode 100644
index 0000000..f1e506c
Binary files /dev/null and b/src/src83e/RMAGENV83d.res differ
diff --git a/src/src83e/RVSDIAG.F90 b/src/src83e/RVSDIAG.F90
new file mode 100644
index 0000000..9fe8d99
--- /dev/null
+++ b/src/src83e/RVSDIAG.F90
@@ -0,0 +1,121 @@
+ SUBROUTINE RVSDIAG
+! routine to test for and reverse diagonals
+ USE BLK1MOD
+ USE BLK2MOD
+ INCLUDE 'BFILES.I90'
+
+ REAL IGrDistanceLine
+ dist(n1,n2)=sqrt((xusr(n1)-xusr(n2))**2+(yusr(n1)-yusr(n2))**2)
+! save current file
+
+ IFILOUT=IACTVFIL+50
+ CALL WRTFIL(IFILOUT)
+
+! fill midsides
+ CALL FILM(1)
+! get elements connected to nodes table
+ MIDSIDE=0
+ IERR=1
+ CALL NDNECON(IERR)
+
+! gets nodes nodes opposite
+! loop on midsides
+ KCOUNT=0
+ DO N=1,NP
+ IF(NECON(N,2) .EQ. 0) CYCLE
+ NEL1=NECON(N,1)
+ NEL2=NECON(N,2)
+ WRITE(160,*) 'ELTS',NEL1,NEL2
+! test for two triangles
+ IF(NCORN(NEL1) .EQ. 8 .OR. NCORN(NEL1) .LT. 6) CYCLE
+ IF(NCORN(NEL2) .EQ. 8 .OR. NCORN(NEL2) .LT. 6) CYCLE
+! get the adjacent nodes N1 and N2
+ DO K=2,6,2
+ IF(N .EQ. NOP(NEL1,K)) THEN
+! get the adjacent nodes N1 and N2
+ N1=NOP(NEL1,K-1)
+ N2=K+1
+ IF(N2 .GT. 6) N2=1
+ N2=NOP(NEL1,N2)
+! get first of two nodes facing each other N3
+ N3=K+3
+ IF(N3 .GT. 6) N3=N3-6
+ N3=NOP(NEL1,N3)
+ ENDIF
+ ENDDO
+! get second of two nodes facing each other N4
+ DO K=2,6,2
+ IF(N .EQ. NOP(NEL2,K)) THEN
+ N4=K+3
+ IF(N4 .GT. 6) N4=N4-6
+ N4=NOP(NEL2,N4)
+ ENDIF
+ ENDDO
+ IF(WD(N1) .EQ. WD(N3) .AND. WD(N2) .EQ. WD(N3)) GO TO 500
+ IF(WD(N1) .EQ. WD(N4) .AND. WD(N2) .EQ. WD(N4)) GO TO 500
+ IF(WD(N1) .EQ. WD(N3) .AND. WD(N1) .EQ. WD(N4)) GO TO 500
+ IF(WD(N2) .EQ. WD(N3) .AND. WD(N2) .EQ. WD(N4)) GO TO 500
+ X1=XUSR(N1)
+ X2=XUSR(N2)
+ X3=XUSR(N3)
+ X4=XUSR(N4)
+ Y1=YUSR(N1)
+ Y2=YUSR(N2)
+ Y3=YUSR(N3)
+ Y4=YUSR(N4)
+ CALL IGRINTERSECTLINE(X1,Y1,X2,Y2,X3,Y3,X4,Y4,XINTER,YINTER,ISTAT)
+ IF(ISTAT .NE. 5) GO TO 500
+ METHOD=1
+ D1=IGrDistanceLine(X1,Y1,X2,Y2,XINTER,YINTER,METHOD)
+! D2=IGrDistanceLine(X1,Y1,X2,Y2,X4,Y4,METHOD)
+ D1=SQRT((X1-XINTER)**2+(Y1-YINTER)**2)
+ D2=SQRT((X2-XINTER)**2+(Y2-YINTER)**2)
+ D3=SQRT((X1-X2)**2+(Y1-Y2)**2)
+ IF(D1 .LT. 0.05*D3) GO TO 500
+ IF(D2 .LT. 0.05*D3) GO TO 500
+ IF(WD(N3) .EQ. WD(N1)) THEN
+ IF(ABS(WD(N4)-WD(N3)) .LT. ABS(WD(N2)-WD(N3))) THEN
+ KCOUNT=KCOUNT+1
+ WRITE(160,*) 'QV1',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
+ CALL DUMPBIN(KCOUNT,1)
+ CALL REVERS(NEL1,NEL2)
+ GO TO 500
+ ELSE
+ GO TO 500
+ ENDIF
+ ELSEIF(WD(N3) .EQ. WD(N2)) THEN
+ IF(ABS(WD(N4)-WD(N3)) .LT. ABS(WD(N3)-WD(N2))) THEN
+ KCOUNT=KCOUNT+1
+ WRITE(160,*) 'QV2',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
+ CALL DUMPBIN(KCOUNT,1)
+ CALL REVERS(NEL1,NEL2)
+ GO TO 500
+ ELSE
+ GO TO 500
+ ENDIF
+ ENDIF
+! test if they are equal height
+ IF(WD(N3) .EQ. WD(N4) .or. ABS(WD(N3) -WD(N4)) .LT. ABS(WD(N1)-WD(N2))) THEN
+! if so reverse connections
+ if(dist(n1,n2)*1.5 .lt. dist(n3,n4)) go to 500
+ KCOUNT=KCOUNT+1
+ WRITE(160,*) 'RV1',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
+ CALL REVERS(NEL1,NEL2)
+ CALL DUMPBIN(KCOUNT,1)
+
+ ELSE
+! test if N4 closer or equal to N3 than N1 or N2
+ IF(ABS(WD(N4) - WD(N3)) .LT. ABS(WD(N1) - WD(N3)) .OR. ABS(WD(N4) - WD(N3)) .LT. ABS(WD(N2) - WD(N3))) THEN
+! if so reverse connections
+ if(dist(n1,n2)*1.5 .lt. dist(n3,n4)) go to 500
+ KCOUNT=KCOUNT+1
+ WRITE(160,*) 'RV2',KCOUNT,NEL1,NEL2,N1,N2,N3,N4
+ CALL REVERS(NEL1,NEL2)
+ CALL DUMPBIN(KCOUNT,1)
+ ENDIF
+ ENDIF
+500 CONTINUE
+! end loop
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/SAVELTLD.F90 b/src/src83e/SAVELTLD.F90
new file mode 100644
index 0000000..60e8176
--- /dev/null
+++ b/src/src83e/SAVELTLD.F90
@@ -0,0 +1,110 @@
+ SUBROUTINE SAVEEQ
+ USE WINTERACTER
+
+ USE BLKELTLD
+
+ include 'D.inc'
+ character*255 fnamein,filter
+ CHARACTER *24 DATAOUT
+
+ filter='Element Input files|*.elt|'
+ CALL WSelectFile(filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAMEIN,'Element Load File Name')
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ OPEN(202,FILE=FNAMEIN,STATUS='UNKNOWN')
+ ELSE
+ RETURN
+ ENDIF
+ IF(IRMATYP .EQ. 11) WRITE(202,6000)
+6000 FORMAT('TI')
+ IF(IRMATYP .EQ. 2 .OR. IRMATYP .EQ. 10) WRITE(202,6001)
+6001 FORMAT('TE')
+ DO I=1,NQHYD
+ HRYEAR=365*24.
+ IYR=IYDATE(I)
+ IF(MOD(IYDATE(I),4) .EQ. 0) HRYEAR=HRYEAR+24.
+ IF(IRMATYP .EQ. 2 .OR. IRMATYP .EQ. 10) THEN
+ WRITE(202,6002) NCLINE(I),NEST(I),IYDATE(I),XYCEL(I,1),XYCEL(I,2)
+!6002 FORMAT('QEI',5X,3I8)
+6002 FORMAT('QEI',5X,3I8,2F16.2)
+ NST=NHYE(I)
+ DO N=1,NST
+ IF(TAE(N,I) .GE. HRYEAR) THEN
+ TAOUT=TAE(N,I)-HRYEAR
+ IYR=IYR+1
+ ELSE
+ IF(N .GT. 1) THEN
+ IF(TAE(N,I) .LT.TAE(N-1,I)) IYR=IYR+1
+ ENDIF
+ TAOUT=TAE(N,I)
+ ENDIF
+ CALL ENCODDAT(DATAOUT,TAE(N,I),IYR)
+ IF(IRMATYP .EQ. 2) THEN
+ WRITE(202,6003) DATAOUT,HAE(N,I)
+6003 FORMAT(A24,F8.3)
+ ELSE
+ WRITE(202,6004) DATAOUT,ILAYRE(N,I),HAE(N,I),(HDE(N,I,K),K=1,3)
+6004 FORMAT(A24,I8,F8.3,3F8.2)
+ ENDIF
+ ENDDO
+
+ ELSEIF(IRMATYP .EQ. 11) THEN
+ WRITE(202,6002) NCLINE(I),NEST(I),IYDATE(I),XYCEL(I,1),XYCEL(I,2)
+ NST=NHYE(I)
+ DO N=1,NST
+ IF(TAE(N,I) .GE. HRYEAR) THEN
+ TAOUT=TAE(N,I)-HRYEAR
+ IYR=IYR+1
+ ELSE
+ IF(N .GT. 1 .AND. TAE(N,I) .LT.TAE(N-1,I)) IYR=IYR+1
+ TAOUT=TAE(N,I)
+ ENDIF
+ CALL ENCODDAT(DATAOUT,TAE(N,I),IYR)
+ WRITE(202,6006) DATAOUT,HAE(N,I),(HDE(N,I,K),K=1,3)
+6006 FORMAT(A24,4F8.3)
+ ENDDO
+ ENDIF
+ ENDDO
+ WRITE(202,6010)
+6010 FORMAT('ENDDATA')
+ CLOSE (202)
+ RETURN
+ END
+
+ SUBROUTINE ENCODDAT(DATAOUT,DAYJUL,IYR)
+ CHARACTER*24 DATAOUT
+ REAL DAYJUL,TIME
+ INTEGER IMTS(12,2),IDAY,IMO,IYR,RMIN
+ DATA IMTS/0,31,59,90,120,151,181,212,243,273,304,334,0,31,60,91,121,152,182,213,244,274,305,335/
+ LP=1
+ IF(MOD(IYR,4) .EQ. 0) LP=2
+ DO K=1,12
+
+ IF(DAYJUL/24. .LT. IMTS(K,LP)) THEN
+ IMO=K-1
+ IDAY=DAYJUL/24.-IMTS(IMO,LP)+1
+ IDT=DAYJUL/24.
+ HR=DAYJUL-FLOAT(IDT)*24.
+ IHR=HR
+ RMIN=(HR-FLOAT(IHR))*60.+.5
+ GO TO 100
+ ENDIF
+ ENDDO
+ IMO=12
+ IDAY=DAYJUL/24.-(334+LP-1)+1
+ IDT=DAYJUL/24.
+ HR=DAYJUL-FLOAT(IDT)*24.
+ IHR=HR
+ RMIN=(HR-FLOAT(IHR))*60.+.5
+
+ 100 IF(IHR .LT. 10) THEN
+ WRITE(DATAOUT(1:24),6000) IDAY,IMO,IYR,IHR,RMIN
+6000 FORMAT('QM',7X,I2.2,'/',I2.2,'/',I4,I2,':',I2.2)
+ ELSE
+ WRITE(DATAOUT(1:24),6001) IDAY,IMO,IYR,IHR,RMIN
+6001 FORMAT('QM',6X,I2.2,'/',I2.2,'/',I4,I3,':',I2.2)
+ ENDIF
+ RETURN
+ END
+
+
\ No newline at end of file
diff --git a/src/src83e/SAVESHP.F90 b/src/src83e/SAVESHP.F90
new file mode 100644
index 0000000..e8b7fd7
--- /dev/null
+++ b/src/src83e/SAVESHP.F90
@@ -0,0 +1,175 @@
+ SUBROUTINE SAVESHP
+!
+! ROUTINE TO SAVE NETWORK AS A SHAPEFILE
+!
+
+ USE WINTERACTER
+ USE BLK1MOD
+
+ REAL*8 XK(12),YK(12),DEP(12)
+! SAVE INFO TO A SCRATCH
+ VOID = -1.E10
+
+ Call WMessageBox(3,2,1,'Do you wish to save as a complex polygon'//Char(13)//&
+ 'shapefile containing all the network data'//'Press YES to accept',&
+ 'CHOOSE SHAPEFILE TYPE -1- !!')
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ IOPTSV=1
+ IOPTSVNOD=0
+ IOPTSVEL=0
+ ELSE
+ IOPTSV=2
+ Call WMessageBox(3,2,1,'Do you wish to save as a polygon'//Char(13)//&
+ 'shapefile containing network outline'//'Press YES to accept',&
+ 'CHOOSE SHAPEFILE TYPE -2- !!')
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ IOPTSVEL=1
+ ELSE
+ IOPTSVEL=0
+ ENDIF
+ Call WMessageBox(3,2,1,'Do you wish to save as a point'//Char(13)//&
+ 'shapefile containing bed levels'//'Press YES to accept',&
+ 'CHOOSE SHAPEFILE TYPE -3- !!')
+ IF(WinfoDialog(ExitButtonCommon) .eq. CommonOK) then
+ IOPTSVNOD=1
+ ELSE
+ IOPTSVNOD=0
+ ENDIF
+ ENDIF
+ IF(IOPTSVEL .EQ. 1 .OR. IOPTSV .EQ. 1) THEN
+ OPEN(113,FORM='BINARY',STATUS='SCRATCH')
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ NC=0
+ IF(NCORN(N) .GT. 5) THEN
+ DO KK=1,NCORN(N)+1
+ K=MOD(KK,NCORN(N))
+ IF(K .EQ. 0) K=NCORN(N)
+ NODE=NOP(N,K)
+ IF(NODE .GT. 0) THEN
+ NC=NC+1
+ XK(NC)=XUSR(NODE)
+ YK(NC)=YUSR(NODE)
+ DEP(NC)=WD(NODE)
+ ENDIF
+ ENDDO
+ IMATT=IMAT(N)
+ WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
+ !ELSEIF(NCORN(N) .EQ. 5) THEN
+ ! DO K=1,5
+ ! NODE=NOP(N,K)
+ ! IF(NODE .GT. 0) THEN
+ ! NC=NC+1
+ ! XK(NC)=XUSR(NODE)
+ ! YK(NC)=YUSR(NODE)
+ ! DEP(NC)=WD(NODE)
+ ! ENDIF
+ ! ENDDO
+ ! DO K=3,1,-1
+ ! NODE=NOP(N,K)
+ ! IF(NODE .GT. 0) THEN
+ ! NC=NC+1
+ ! XK(NC)=XUSR(NODE)
+ ! YK(NC)=YUSR(NODE)
+ ! DEP(NC)=WD(NODE)
+ ! ENDIF
+ ! ENDDO
+ ! IMATT=IMAT(N)
+ ! WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
+ ELSEIF(NCORN(N) .LT. 6 .AND. (IMAT(N) .LT. 900 .OR. IMAT(N) .GT. 903)) THEN
+ NODE1=NOP(N,1)
+ DO K=1,3
+ NODE=NOP(N,K)
+ IF(NODE .GT. 0) THEN
+ NC=NC+1
+ XK(NC)=XUSR(NODE)
+ YK(NC)=YUSR(NODE)
+ DEP(NC)=WD(NODE)
+ ENDIF
+ ENDDO
+ IF(WIDTH(NODE) .GT. 0.) THEN
+ eldir=atan2(YUSR(NOP(N,3))-YUSR(NOP(N,1)),XUSR(NOP(N,3))-XUSR(NOP(N,1)))
+ elnorm=eldir-1.5708
+ NC=NC+1
+ xK(NC)=XK(NC-1)+cos(elnorm)*WIDTH(NODE)/2.
+ yK(NC)=YK(NC-1)+sin(elnorm)*WIDTH(NODE)/2.
+ NMID=0
+ IF(NOP(N,2) .GT. 0) THEN
+ NMID=1
+ NC=NC+1
+ xK(NC)=XK(2)+cos(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
+ yK(NC)=YK(2)+sin(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
+ ENDIF
+ NC=NC+1
+ xK(NC)=XK(1)+cos(elnorm)*WIDTH(NODE1)/2.
+ yK(NC)=YK(1)+sin(elnorm)*WIDTH(NODE1)/2.
+ NC=NC+1
+ xK(NC)=XK(1)-cos(elnorm)*WIDTH(NODE1)/2.
+ yK(NC)=YK(1)-sin(elnorm)*WIDTH(NODE1)/2.
+ IF(NMID .GT. 0) THEN
+ NC=NC+1
+ xK(NC)=XK(2)-cos(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
+ yK(NC)=YK(2)-sin(elnorm)*(WIDTH(NODE)+WIDTH(NODE1))/4.
+ NC=NC+1
+ xK(NC)=XK(3)-cos(elnorm)*WIDTH(NODE)/2.
+ yK(NC)=YK(3)-sin(elnorm)*WIDTH(NODE)/2.
+ NC=NC+1
+ XK(NC)=XK(3)
+ YK(NC)=YK(3)
+ ELSE
+ NC=NC+1
+ xK(NC)=XK(2)-cos(elnorm)*WIDTH(NODE)/2.
+ yK(NC)=YK(2)-sin(elnorm)*WIDTH(NODE)/2.
+ NC=NC+1
+ XK(NC)=XK(2)
+ YK(NC)=YK(2)
+ ENDIF
+ ELSE
+ DO K=2,1,-1
+ NODE=NOP(N,K)
+ IF(NODE .GT. 0) THEN
+ NC=NC+1
+ XK(NC)=XUSR(NODE)
+ YK(NC)=YUSR(NODE)
+ DEP(NC)=WD(NODE)
+ ENDIF
+ ENDDO
+ ENDIF
+ IMATT=IMAT(N)
+ WRITE(113) N,IMATT,NC,(XK(K),YK(K),DEP(K),K=1,NC)
+ ENDIF
+ ENDIF
+ ENDDO
+ REWIND 113
+
+! CALL FORMSHP TO WRITE OUT SHAPEFILE
+ IF(IOPTSV .EQ. 1) THEN
+ ISTYP=25
+! ISTYP=25 is saving element list
+ IVECACT=4
+ ELSE
+! ISTYP=5 is saving element list with polygons?
+ ISTYP=5
+ IVECACT=5
+ ENDIF
+ CALL FORMSHP2(istyp,ivecact)
+ CLOSE(113)
+ ENDIF
+
+ IF(IOPTSVNOD .EQ. 1) THEN
+ OPEN(113,FORM='BINARY',STATUS='SCRATCH')
+ DO NODE=1,NP
+ IF(XUSR(NODE) .GT. VOID) THEN
+ WRITE(113) NODE,XUSR(NODE),YUSR(NODE),WD(NODE)
+ ENDIF
+ ENDDO
+ REWIND 113
+! ISTYP=1 is saving of nodal values
+ ISTYP=1
+ IVECACT=6
+ CALL FORMSHP2(istyp,ivecact)
+ CLOSE (113)
+ ENDIF
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/SELT.F90 b/src/src83e/SELT.F90
new file mode 100644
index 0000000..19824a7
--- /dev/null
+++ b/src/src83e/SELT.F90
@@ -0,0 +1,958 @@
+! last update feb 10 2002 add lock/unlock
+! Last change: IPK 2 Mar 1999 12:05 pm
+ SUBROUTINE SELNODE(ISW)
+
+ USE WINTERACTER
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+
+ include 'd.inc'
+
+ dimension xot(100),yot(100)
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+ dimension nodlist(maxp),RLAY(9)
+! DIMENSION ICN(MAXP)
+ character*1 iflag
+ CHARACTER*1 ANS,ANSW(10)
+ CHARACTER*63 STRELS
+ DATA ANSW/'m','a','f','s','k','u','t','w','h','q'/
+ DATA STRELS/' You have tried set to set elevation with no mapfile"'/
+
+
+!
+! save nhtp etc
+
+ nhtps=nhtp
+ nbrs=nbrr
+ nmessv=nmess
+ if(isw .eq. 0 .or. isw .eq. 4) then
+
+ CALL GETPOLY(XOT,YOT,NPTS)
+
+! look for points inside polygon
+
+ ndlist=0
+ do j=1,np
+ if(inskp(j) .eq. 0) then
+ inswt=0
+ call cpoly(xot,yot,npts,cord(j,1),cord(j,2),inswt)
+ if(inswt .eq. 1) then
+ call rred
+ fpn=j
+ x = cord(j,1)
+ y = cord(j,2) - .11
+ call numbr(x,y,ht,fpn,0.0,-1)
+ ndlist=ndlist+1
+ nodlist(ndlist)=j
+ endif
+ endif
+ enddo
+ call rblue
+ elseif(isw .eq. 1) then
+!
+! Add all nodes to list
+!
+ NDLIST=0
+ DO J=1,NP
+ IF(INEW(J) .EQ. 1) THEN
+ NDLIST=NDLIST+1
+ NODLIST(NDLIST)=J
+ ENDIF
+ END DO
+
+ elseif(isw .eq. 2) then
+
+! Get inactive nodes
+
+ DO I=1,NP
+ ICN(I) = 0
+ ENDDO
+ DO J = 1, NE
+ IF( IMAT(J) .NE. 0 ) THEN
+ DO K = 1, 8
+ IF( NOP(J,K) .GT. 0) THEN
+ ICN(NOP(J,K))=999
+ ENDIF
+ ENDDO
+ ENDIF
+ END DO
+!
+! Add nodes to list
+!
+ NDLIST=0
+ DO J=1,NP
+ IF(ICN(J) .EQ. 0 .AND. INEW(J) .EQ. 1) THEN
+ NDLIST=NDLIST+1
+ NODLIST(NDLIST)=J
+ ENDIF
+ END DO
+
+ elseif(isw .eq. 3) then
+ NS=1
+ call wdialogload(IDD_SELELTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,NS)
+
+ CALL WDialogSelect(IDD_SELELTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,NS)
+ go to 80
+ ENDIF
+ enddo
+ 80 CONTINUE
+ DO I=1,NP
+ ICN(I) = 0
+ ENDDO
+ NDLIST=0
+ DO K=1,NE
+ IF(IMAT(K) .EQ. NS) THEN
+ DO L=1,8
+ NST=NOP(K,L)
+ IF(NST .GT. 0) THEN
+ IF(ICN(NST) .EQ. 0) THEN
+ NDLIST=NDLIST+1
+ NODLIST(NDLIST)=NST
+ ICN(NST)=1
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+
+ endif
+! NEW MOVE OPERATION
+
+ IF(ISW .EQ. 4) THEN
+ CALL MVGRP(NDLIST,NODLIST)
+ nhtp=nhtps
+ nbrr=nbrs
+ nmess=nmessv
+ call hedr
+ RETURN
+ ENDIF
+ nbrr=0
+ nhtp=14
+ call hedr
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ if(ibox .eq. 1 .or. iflag .eq. 'd') then
+ do n=1,ndlist
+ j=nodlist(n)
+ call deletn(j)
+ enddo
+ elseif(ibox .eq. 2 .or. iflag .eq. 'e') then
+ do n=1,ndlist
+ j=nodlist(n)
+ wd(j)=-9999.
+ enddo
+ elseif(ibox .eq. 3 .or. iflag .eq. 't') then
+!
+! Establish size for range
+!
+! IF(IMP .EQ. 0) THEN
+! CALL SYMBL(0.,7.25,0.20,STRELS,0.,63)
+! nhtp=nhtps
+! nbrr=nbrs
+! nmess=nmessv
+! call hedr
+! RETURN
+! endif
+
+ 100 CONTINUE
+ NHTP = 16
+ NMESS = 0
+ NBRR = 0
+ CALL HEDR
+!
+! Get answer
+!
+ 110 call xyloc(XPT,YPT,ANS,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 110
+ ANS=ANSW(IBOX)
+ ENDIF
+ IF(ANS .EQ. 'm') THEN
+!
+! This option allows changes to bottom elevations
+!
+ CALL ADDPTH2(NODLIST,NDLIST)
+ GO TO 220
+
+ ELSEIF (ANS .EQ. 'a') THEN
+!
+! All nodes
+!
+ ISWT = -1
+ ELSEIF(ANS .EQ. 'f') THEN
+!
+! Fill nodes
+!
+ ISWT = 0
+! ELSEIF(ANS .EQ. 's') THEN
+!
+! Single node at a time
+!
+! ISWT = 1
+
+!ipk feb02 add lock/unlock and remove cdata
+
+! ELSEIF(ANS .EQ. 'w') THEN
+!
+! This option allows changes to nodal widths
+!
+! CALL ADDWID
+! IF(IRMAIN .EQ. 1) RETURN
+! GO TO 100
+!
+! Call to help screen
+!
+ ELSEIF(ANS .EQ. 'h') THEN
+ CALL HELPS(4)
+ IF(IRMAIN .EQ. 1) RETURN
+ GO TO 100
+!
+ ELSEIF(ANS .EQ. 'q') THEN
+!
+! Writeout and return
+!
+ CALL WRTOUT(0)
+ RETURN
+ ENDIF
+
+ IF(IMP .EQ. 0) THEN
+ CALL SYMBL(0.,7.25,0.20,STRELS,0.,63)
+ go to 100
+ endif
+!
+! Establish size for range
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ IF(ISWTAGN .EQ. 0) THEN
+
+! IF(IRECD .EQ. 2) THEN
+! iswtintp=0
+! iswtagn=0
+! go to 210
+! ENDIF
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to interpolate '//&
+ CHAR(13)//'from the triangulated map file?' ,&
+ 'Select Interpolation method?')
+! If answer 'Yes' set interpolate switch to 1
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ iswtintp=0
+ ELSE
+ iswtintp=1
+ ENDIF
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Ask this question again?'//&
+ CHAR(13)//' ' ,&
+ 'Ask again?')
+! If answer 'Yes' set again switch to 0
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ iswtagn=1
+ ELSE
+ iswtagn=0
+ ENDIF
+ ENDIF
+
+ 210 CONTINUE
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ IF(ISWTINTP .EQ. 0) THEN
+
+ call setrng(xnears,nmap)
+ iswt=0
+ do n=1,ndlist
+ m=nodlist(n)
+!ipk feb02
+!ipk jan08 chnage subscript
+ if(lock(m) .eq. 0) CALL SETELV(XNEARS,NMAP,M,ISWT)
+ enddo
+ ELSE
+ if(nelts .eq. 0) then
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'No triangulated exists'//&
+ CHAR(13)//'Do you wish to triangulate now?' ,&
+ 'NO TRIANGULATION AVAILABLE?')
+! If answer 'Yes' set triangulate now
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ return
+ ELSE
+ call triang
+ ENDIF
+
+ endif
+ do n=1,ndlist
+ m=nodlist(n)
+ if(lock(m) .eq. 0) CALL TRIANINT(NMAP,M,ISWT,ITIME)
+ enddo
+ ENDIF
+ 220 CONTINUE
+
+ elseif(ibox .eq. 4 .or. iflag .eq. 'l') then
+
+! Define layers
+
+ call openlay
+
+ NHTP=0
+ NBRR=0
+ NMESS=45
+ CALL HEDR
+ NMESS=4
+ xprt=3.2
+!
+! call getint(nlay)
+
+ call GETLAYDAT(NLAY,ipos,RLAY)
+ ILAYTP=IPOS
+
+ do n=1,ndlist
+ j=nodlist(n)
+ lay(j)=nlay
+ DO I=1,NLAY
+ WTLAY(J,I)=RLAY(I)
+ ENDDO
+ enddo
+ REWIND 102
+ DO J=1,NP
+ IF(LAY(J) .GT. -9998) THEN
+ if(ILAYTP .eq. 1) then
+ write(102,6000) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6000 format('LD2 ',2i8,9F8.2)
+ else
+ write(102,6001) J,LAY(J),(WTLAY(J,I),I=1,LAY(J))
+ 6001 format('LD3 ',2i8,9F8.2)
+ endif
+ ENDIF
+ ENDDO
+ nlayd=1
+!ipk feb02 add lcok/unlock
+ elseif(ibox .eq. 5 .or. iflag .eq. 'k') then
+ do n=1,ndlist
+ j=nodlist(n)
+ lock(j)=1
+ enddo
+ elseif(ibox .eq. 6 .or. iflag .eq. 'u') then
+ do n=1,ndlist
+ j=nodlist(n)
+ lock(j)=0
+ enddo
+ elseif(ibox .eq. 7 .or. iflag .eq. 'f') then
+ do n=1,np
+ list(n)=0
+ enddo
+ do n=1,ndlist
+ list(nodlist(n))=1
+ enddo
+ call deln2(np,0)
+ endif
+
+! CALL PLOTOT(1)
+
+ nhtp=nhtps
+ nbrr=nbrs
+ nmess=nmessv
+ call hedr
+ RETURN
+ END
+
+ SUBROUTINE SELELT(ISW)
+
+ USE BLK1MOD
+ save fracd
+ dimension xot(100),yot(100)
+
+! INCLUDE 'BLK1.COM'
+!
+ dimension nodlist(maxp)
+ character*1 iflag
+
+ data itime/0/
+
+ if(itime .eq. 0) then
+ mat=0
+ itime=1
+ endif
+
+ IF(ISW .EQ. 2) GO TO 200
+
+ CALL GETPOLY(XOT,YOT,NPTS)
+
+
+!
+! save nhtp etc
+
+ nhtps=nhtp
+ nbrs=nbrr
+ nmessv=nmess
+
+! look for points inside polygon
+
+ ndlist=0
+ nefl=0
+ do n=1,ne
+ ieswt=0
+ if(ieskp(n) .eq. 0) then
+ ieswt=1
+ do m=1,ncorn(n)
+ j=nop(n,m)
+ if(j .gt. 0) then
+ inswt=0
+ call cpoly(xot,yot,npts,cord(j,1),cord(j,2),inswt)
+ if(inswt .eq. 1) then
+! call rred
+! fpn=j
+! x = cord(j,1)
+! y = cord(j,2) - .11
+! call numbr(x,y,ht,fpn,0.0,-1)
+ ndlist=ndlist+1
+ nodlist(ndlist)=j
+ else
+ ieswt=0
+ endif
+ endif
+ enddo
+ endif
+ if(ieswt .eq. 1) then
+ nefl=nefl+1
+ neflag(nefl)=n
+! call rcyan
+! fpn = n
+! x = xc(n)
+! y = yc(n) + .01
+! call numbr(x,y,0.20,fpn,0.0,-1)
+ call fillem(n)
+ endif
+ enddo
+ call rblue
+
+ GO TO 300
+200 CONTINUE
+!
+! save nhtp etc
+
+ nhtps=nhtp
+ nbrs=nbrr
+ nmessv=nmess
+ NEFL=0
+ CALL GETFRAC(FRACD)
+ call plotot(0)
+ DO N=1,NE
+ IF(EDIF(N) .GT. (1.-FRACD)*EDIF(0)) THEN
+ nefl=nefl+1
+ neflag(nefl)=n
+ call fillem(n)
+ ENDIF
+ ENDDO
+300 CONTINUE
+ if(isw .eq. 0 .OR. ISW .EQ. 2) then
+ nbrr=0
+ nhtp=15
+ call hedr
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ if(ibox .eq. 1 .or. iflag .eq. 'd') then
+ do n=1,nefl
+ j=neflag(n)
+ call deltel(j)
+ enddo
+ nefl=0
+ elseif(ibox .eq. 2 .or. iflag .eq. 'e') then
+ call refb
+ elseif(ibox .eq. 3 .or. iflag .eq. 't') then
+ nhtp=0
+ nbrr=4
+ NMESS=45
+ call hedr
+ nmess=2
+ call getint(mat)
+ ipsw(7)=1
+ ipsw(5)=0
+ do n=1,nefl
+ j=neflag(n)
+ imat(j) = mat
+ enddo
+ nefl=0
+ elseif(ibox .eq. 4 .or. iflag .eq. 'm') then
+!
+! simplify layout
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL SMFY
+
+!ipk dec11
+ elseif(ibox .eq. 5 .or. iflag .eq. 'g') then
+!
+! form group
+!
+ CALL FORMGP
+
+ endif
+
+
+
+ CALL PLOTOT(1)
+
+ nhtp=nhtps
+ nbrr=nbrs
+ nmess=nmessv
+ call clrbox
+ call hedr
+ else
+ call extract(NODLIST,NDLIST)
+
+! display extracted file
+
+
+ CALL PLOTOT(1)
+
+ nhtp=nhtps
+ nbrr=nbrs
+ nmess=nmessv
+ call clrbox
+ call hedr
+ endif
+
+
+ RETURN
+ END
+
+ SUBROUTINE CPOLY(XOT,YOT,NPTS,X,Y,INSWT)
+ DIMENSION XOT(*),YOT(*)
+ REAL*8 X,Y
+ DATA PI/3.14159/
+ SUMA=0
+ DO N=1,NPTS-1
+ ANG1=ATAN2(YOT(N+1)-Y,XOT(N+1)-X)
+ ANG2=ATAN2(YOT(N)-Y,XOT(N)-X)
+ DIFA=ANG2-ANG1
+ IF(ABS(DIFA) .GT. PI) THEN
+ IF(DIFA .LT. -PI) DIFA=DIFA+2.*PI
+ IF(DIFA .GT. PI) DIFA=DIFA-2.*PI
+ ENDIF
+ SUMA=SUMA+DIFA
+ ENDDO
+ IF(ABS(SUMA) .GT. PI) THEN
+ INSWT=1
+ ELSE
+ INSWT=0
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE GETPOLY(XOT,YOT,NPTS)
+
+ USE BLK1MOD
+ dimension xot(*),yot(*)
+! INCLUDE 'BLK1.COM'
+!
+ CHARACTER*23 SELN3
+ CHARACTER*32 SELN
+ CHARACTER*24 SELN2
+ CHARACTER*1 IFLAG
+ data SELN/' Click at points to form polygon'/
+ data SELN2/' Click next point '/
+ data SELN3/' Click last point again'/
+
+ 80 CALL CLRBOX
+ nhtp=0
+ nbrr=5
+ nmess=0
+ call hedr
+ CALL SYMBL(0.,7.70,0.20,SELN,0.,32)
+!
+ 100 continue
+!
+! Get cursor location
+!
+ CALL XYLOC(xscrn,yscrn,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ if (iflag .eq. 'q') return
+!
+ if(iflag .eq. 'c') then
+ xot(1)=xscrn
+ yot(1)=yscrn
+ npts=1
+!
+! This option is creating an inset locations
+!
+ 120 continue
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(ibox .eq. 6 .or. iflag .eq. 'b') then
+ npts=npts-1
+ go to 120
+ endif
+ if(iflag .eq. 'c') then
+!
+! Look for a screen size
+!
+ 122 continue
+ xsiz=abs(xscrn1-xscrn)
+ ysiz=abs(yscrn1-yscrn)
+!ipk jun96 test for zero sizes
+ if(xsiz .lt. 0.001 .or. ysiz .lt. 0.001) then
+ CALL CLRBOX
+ call hedr
+ CALL SYMBL(0.,7.70,0.20,seln3,0.,23)
+ go to 120
+ endif
+ npts=npts+1
+ xot(npts)=xscrn1
+ yot(npts)=yscrn1
+ call DASHLN(xot,yot,npts,1)
+ CALL CLRBOX
+ call hedr
+
+ CALL SYMBL(0.,7.70,0.20,seln2,0.,24)
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+
+ if(ibox .eq. 6 .or. iflag .eq. 'b') then
+ npts=npts-1
+ go to 120
+ elseif(ibox .eq. 7 .or. iflag .eq. 'n') then
+ npts=npts+1
+ xot(npts)=xot(1)
+ yot(npts)=yot(1)
+ call DASHLN(xot,yot,npts,1)
+ go to 280
+ else
+ go to 122
+ endif
+ endif
+ ENDIF
+ 280 continue
+ RETURN
+ END
+
+ subroutine extract(NODLIST,NDLIST)
+
+ USE WINTERACTER
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+! include 'blk1.com'
+
+
+ include 'd.inc'
+
+ DIMENSION NODLIST(*)
+ CHARACTER(LEN=256) :: FILTER
+ CHARACTER(LEN=255) :: FNAME,FNAMRM
+
+! select filename for new file
+
+ FILTER ="Rm1 file -- *.rm1|*.rm1|"
+ CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Filename for extracted file')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+ GO TO 200
+ ELSE
+ GO TO 500
+ ENDIF
+ 200 CONTINUE
+ CALL IlowerCase(FNAME)
+
+ ITOTFIL=ITOTFIL+1
+ FNAMEOUT(ITOTFIL)=FNAME
+
+! save current file
+
+ IFILOUT=IACTVFIL+50
+ CALL WRTFIL(IFILOUT)
+
+! create network structure
+
+ CALL ZERORELM(NODLIST,NDLIST)
+
+ IACTVFIL=ITOTFIL
+
+
+
+! save new structure
+
+ IOT = 20
+ FNAMRM=FNAME
+ igfgsw=0
+ close(iot)
+ OPEN(IOT,FILE=FNAME,STATUS='UNKNOWN')
+!
+! Check if file cords format to be short or long
+!
+!
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
+ CHAR(13)//'coordinates in long format?' ,&
+ 'Coordinate save format')
+!
+! If answer 'No', use short format
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ ntempin=0
+ else
+ ntempin=2
+ END IF
+!
+ call wrtout(1)
+ CLOSE (IOT)
+ OPEN(IOT,FILE=FNAMRM,STATUS='UNKNOWN')
+
+ 500 continue
+ return
+ end
+
+ SUBROUTINE ZERORELM(NODLIST,NDLIST)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ dimension nodlist(*)
+
+ DO N=1,NP
+
+! search nodlist
+
+ do k=1,ndlist
+ if(n .eq. nodlist(K)) go to 300
+ enddo
+ call deletn(n)
+ 300 continue
+ ENDDO
+
+! reset NP
+
+ do k=np,1,-1
+ if(inew(k) .gt. 0) then
+ np=k
+ go to 350
+ endif
+ enddo
+ 350 continue
+
+! reset NE
+
+ do k=ne,1,-1
+ if(imat(k) .gt. 0) then
+ ne=k
+ go to 400
+ endif
+ enddo
+ 400 continue
+
+ RETURN
+ END
+
+ SUBROUTINE GETFRAC(FRACD)
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ save
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: I1,I2,I3,ITIME,IPOS
+
+ REAL :: FRACD
+
+ data itime/0/
+
+ IF(ITIME .EQ. 0) THEN
+ FRACD=0.1
+ itime=1
+ ENDIF
+
+ call wdialogload(IDD_SETSEL)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_SETSEL)
+ ierr=infoerror(1)
+
+ CALL WDialogPutReal(IDF_REAL1,FRACD)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialoggetReal(IDF_REAL1,FRACD)
+ GO TO 100
+
+ ENDIF
+
+ enddo
+
+ 100 CONTINUE
+ return
+ end
+
+ SUBROUTINE FINDTYP
+
+ USE WINTERACTER
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+ character*1 iflag
+
+ include 'd.inc'
+
+ DATA NS/1/
+
+
+ call wdialogload(IDD_SELELTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogPutInteger(IDF_INTEGER1,NS)
+
+ CALL WDialogSelect(IDD_SELELTYP)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,ModaL)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetInteger(IDF_INTEGER1,NS)
+ go to 80
+ ENDIF
+ enddo
+80 CONTINUE
+ ICLL=4
+ call clscrn
+ call plotot(0)
+ nefl=0
+ DO N=1,NE
+ IF(IMAT(N) .EQ. NS) THEN
+ CALL FILLEMC(N,ICLL)
+ nefl=nefl+1
+ neflag(nefl)=n
+
+ ENDIF
+ ENDDO
+ nbrr=0
+ nhtp=15
+ call hedr
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ if(ibox .eq. 1 .or. iflag .eq. 'd') then
+ do n=1,nefl
+ j=neflag(n)
+ call deltel(j)
+ enddo
+ nefl=0
+ elseif(ibox .eq. 2 .or. iflag .eq. 'e') then
+ call refb
+ elseif(ibox .eq. 3 .or. iflag .eq. 't') then
+ nhtp=0
+ nbrr=4
+ NMESS=45
+ call hedr
+ nmess=2
+ call getint(mat)
+ ipsw(7)=1
+ ipsw(5)=0
+ do n=1,nefl
+ j=neflag(n)
+ imat(j) = mat
+ enddo
+ nefl=0
+ elseif(ibox .eq. 4 .or. iflag .eq. 'm') then
+!
+! simplify layout
+!
+ IECHG=0
+!IPK MAY03
+ ICHG=0
+ CALL SMFY
+
+!ipk dec11
+ elseif(ibox .eq. 5 .or. iflag .eq. 'g') then
+!
+! form group
+!
+ CALL FORMGP
+
+ elseif(ibox .eq. 6) then
+ do n=1,nefl
+ j=neflag(n)
+ do jj=1,8
+ if(nop(j,jj) .ne. 0) then
+ wd(nop(j,jj))=-9999.
+ endif
+ enddo
+ enddo
+ endif
+
+ RETURN
+ END
+
+ SUBROUTINE MVGRP(NDLIST,NODLIST)
+
+ USE WINTERACTER
+ USE BLK1MOD
+ INCLUDE 'TXFRM.COM'
+ dimension nodlist(maxp),RLAY(9)
+ character*1 iflag
+! GET AMOUNT OF SHIFT IN PAGE UNITS
+ 200 continue
+ NHTP = 16
+ NMESS = 47
+ NBRR = 0
+ CALL HEDR
+ CALL xyloc(xscrn1,yscrn1,iflag,ibox)
+ CALL XYLOC(XSCRN2,YSCRN2,IFLAG,IBOX)
+ XSHIFT=XSCRN2-XSCRN1
+ YSHIFT=YSCRN2-YSCRN1
+! APPLY SHIFT TO NODES IN THE LIST
+ DO N=1,NDLIST
+ CORD(NODLIST(N),1)=CORD(NODLIST(N),1)+XSHIFT
+ CORD(NODLIST(N),2)=CORD(NODLIST(N),2)+YSHIFT
+ ENDDO
+ CALL PLOTOT(0)
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to save'//&
+ CHAR(13)//'new coordinate location?' ,&
+ 'COORDINATE MOVE')
+ IF (WInfoDialog(4) .EQ. 2) then
+! revert to old
+ DO N=1,NDLIST
+ CORD(NODLIST(N),1)=(XUSR(NODLIST(N))+XS)/TXSCAL
+ CORD(NODLIST(N),2)=(YUSR(NODLIST(N))+YS)/TXSCAL
+ ENDDO
+ CALL PLOTOT(0)
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to '//&
+ CHAR(13)//'try again?' ,&
+ 'COORDINATE MOVE')
+ IF (WInfoDialog(4) .EQ. 2) then
+ return
+ else
+ go to 200
+ endif
+ else
+! accept
+ END IF
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/SHOWEQ.F90 b/src/src83e/SHOWEQ.F90
new file mode 100644
index 0000000..735dc5c
--- /dev/null
+++ b/src/src83e/SHOWEQ.F90
@@ -0,0 +1,237 @@
+ SUBROUTINE SHOWEQ(ISWT)
+ use winteracter
+ USE BLKELTLD
+ save
+ include 'D.inc'
+ INCLUDE 'TXFRM.COM'
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ REAL HMAX(200),HRSTART,HREND
+ INTEGER IYSTART, IYEND, IDYSTART,IDYEND,ick1
+ data ick1/0/,ITIME/0/
+ IF(ISWT .EQ. 1) GO TO 140
+ IF(ITIME .EQ. 0) THEN
+ IYSTART=IYDATE(1)
+ IYEND=IYDATE(1)
+ IDYSTART=TAE(1,1)/24.
+ HRSTART=TAE(1,1)-IDYSTART*24
+ IDYSTART=IDYSTART+1
+ IDYEND=IDYSTART
+ HREND=HRSTART
+ ITIME=1
+ ENDIF
+ call wdialogload(IDD_SETUPELDISP)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_IDD_SETUPELDISP)
+ ierr=infoerror(1)
+ call wdialogputRadioButton(idf_radio1)
+ call wdialogputCheckBox(idf_check1,ick1)
+ CALL WDialogPutInteger(idf_integer1,IYSTART)
+ CALL WDialogPutInteger(idf_integer2,IDYSTART)
+ CALL WDialogPutInteger(idf_integer3,IYEND)
+ CALL WDialogPutInteger(idf_integer5,IDYEND)
+ CALL WDialogPutReal(idf_real1,HRSTART)
+ CALL WDialogPutReal(idf_real3,HREND)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ call wdialogGetRadioButton(idf_radio1,iopt)
+ call wdialogGetCheckBox(idf_check1,ick1)
+ CALL WDialogGetInteger(idf_integer1,IYSTART)
+ CALL WDialogGetInteger(idf_integer2,IDYSTART)
+ CALL WDialogGetInteger(idf_integer3,IYEND)
+ CALL WDialogGetInteger(idf_integer5,IDYEND)
+ CALL WDialogGetReal(idf_real1,HRSTART)
+ CALL WDialogGetReal(idf_real3,HREND)
+ GO TO 80
+
+ elseif(WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ ENDIF
+ ENDDO
+80 CONTINUE
+ TTMIN=1.E20
+ TTMAX=-1.E20
+ if(ick1 .eq. 0) then
+ DO I=1,NQHYD
+ IF(IRMATYP .EQ. 11) THEN
+ IF(NEST(I) .EQ. 3) CYCLE
+ ENDIF
+ NST=NHYE(I)
+ if(iopt .eq. 1) then
+ HMAX(I)=-1.E20
+ DO K=1,NST
+ HMAX(I)=MAX(HAE(K,I),HMAX(I))
+ ENDDO
+ TTMIN=MIN(HMAX(I),TTMIN)
+ TTMAX=MAX(HMAX(I),TTMAX)
+ else
+ HMAX(I)=0.0
+ DO K=2,NST
+ IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
+ IF(MOD(IYDATE(I),4) .EQ. 0) THEN
+ TCOR=366*24.
+ ELSE
+ TCOR=365*24.
+ ENDIF
+ ELSE
+ TCOR=0.
+ ENDIF
+ HMAX(I)=HMAX(I)+(HAE(K-1,I)+HAE(K,I))/2.*(TAE(K,I)+TCOR-TAE(K-1,I))*3.600E-3
+ ENDDO
+ TTMIN=MIN(HMAX(I),TTMIN)
+ TTMAX=MAX(HMAX(I),TTMAX)
+ endif
+ ENDDO
+ else
+ DO I=1,NQHYD
+ IF(IRMATYP .EQ. 11) THEN
+ IF(NEST(I) .EQ. 3) CYCLE
+ ENDIF
+ TASTART=(IDYSTART-1)*24.+HRSTART
+ TAEND=(IDYEND-1)*24.+HREND
+ IF(IYSTART-IYDATE(I) .GT. 0) THEN
+ TASTART=TASTART+365*24.*(IYSTART-IYDATE(I))
+ IF(MOD(IYDATE(I),4) .EQ. 0) TASTART=TASTART+24.
+ ENDIF
+ IF(IYEND-IYDATE(I) .GT. 0) THEN
+ TAEND=TAEND+365*24.*(IYEND-IYDATE(I))
+ IF(MOD(IYDATE(I),4) .EQ. 0) TAEND=TAEND+24.
+ ENDIF
+ NST=NHYE(I)
+ if(iopt .eq. 1) then
+ HMAX(I)=-1.E20
+ TCOR=0.
+ DO K=2,NST
+ IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
+ TCOR=TCOR+365*24.
+ ENDIF
+ TTEMP=TAE(K,I)+TCOR
+ IF(TTEMP .LT. TASTART) CYCLE
+ IF(TTEMP .GT. TAEND) GO TO 120
+ HMAX(I)=MAX(HAE(K,I),HMAX(I))
+ ENDDO
+120 CONTINUE
+ TTMIN=MIN(HMAX(I),TTMIN)
+ TTMAX=MAX(HMAX(I),TTMAX)
+ else
+ HMAX(I)=0.0
+ TCOR=0.
+ DO K=2,NST
+ IF(TAE(K,I)-TAE(K-1,I) .LT. 0.) THEN
+ IF(MOD(IYDATE(I),4) .EQ. 0) THEN
+ TCOR=TCOR+366*24.
+ ELSE
+ TCOR=TCOR+365*24.
+ ENDIF
+! TCOR=TCOR+365*24.
+ TDIF=TAE(K,I)-TAE(K-1,I)+TCOR
+ ELSE
+ TDIF=TAE(K,I)-TAE(K-1,I)
+ ENDIF
+ TTEMP=TAE(K,I)+TCOR
+ IF(TTEMP .LT. TASTART) CYCLE
+ IF(TTEMP .GT. TAEND) GO TO 130
+ HMAX(I)=HMAX(I)+(HAE(K-1,I)+HAE(K,I))/2.*TDIF*3.600E-3
+ ENDDO
+130 CONTINUE
+ TTMIN=MIN(HMAX(I),TTMIN)
+ TTMAX=MAX(HMAX(I),TTMAX)
+ endif
+ ENDDO
+ endif
+ ISZ=1
+ RAD=10.
+ CALL CSET(TTMIN,TTMAX,isz)
+140 CONTINUE
+ DO I=1,NQHYD
+ IF(IRMATYP .EQ. 11) THEN
+ IF(NEST(I) .EQ. 3) CYCLE
+ ENDIF
+ DO J=1,NUMV
+ IF(HMAX(I) .LE. CONTUR(J)) THEN
+ ncoln=mod(J,13)+4
+ JJ=NCLINE(I)
+! CALL GETXCL(JJ,XCJ,YCJ)
+ call change_color(ncoln)
+! CALL FILLEMC(NCLINE(I),NCOLN)
+
+ raddisp=0.05
+! if(raddisp .lt. 0.01) raddisp=0.01
+! call circle(xcj,ycj,raddisp)
+ XCT=(XYCEL(I,1)+XS)/TXSCAL
+ YCT=(XYCEL(I,2)+YS)/TXSCAL
+ call circle(xct,yct,raddisp)
+ GO TO 200
+ ENDIF
+ ENDDO
+200 CONTINUE
+ ENDDO
+ CALL RBLACK
+ DO I=1,NQHYD
+ IF(IRMATYP .EQ. 11) THEN
+ IF(NEST(I) .EQ. 3) CYCLE
+ ENDIF
+ JJ=NCLINE(I)
+! CALL GETXCL(JJ,XCJ,YCJ)
+! CALL NUMBR(XCJ,YCJ,0.15,HMAX(I),0.0,1)
+ XCT=(XYCEL(I,1)+XS)/TXSCAL
+ YCT=(XYCEL(I,2)+YS)/TXSCAL
+ CALL NUMBR(XCT,YCT,0.15,HMAX(I),0.0,1)
+ enddo
+ RETURN
+
+ END
+
+ SUBROUTINE GETXCL(J,XCJ,YCJ)
+
+ USE BLK1MOD
+
+ XXC=0.
+ YYC=0.
+ IF(IMAT(J) .EQ. 0) GO TO 50
+ NCN = NCORN(J)
+ IF(NCN .EQ. 9) THEN
+ NCNR=8
+ ELSE
+ NCNR=NCN
+ ENDIF
+ NCNT=0
+ DO 25 K=1,NCNR
+ N = NOP(J,K)
+!
+ IF (N .EQ. 0 .OR. XUSR(N) .LT. VDX) GOTO 25
+! !
+ IF (NCN .NE. 5 .OR. K .LT. 5) THEN
+ IF (MOD(K,2) .EQ. 1) THEN
+ XXC = XXC + XUSR(N)
+ YYC = YYC + YUSR(N)
+ NCNT=NCNT+1
+ ENDIF
+ ENDIF
+ 25 CONTINUE
+
+ IF(NCN .LT. 9) THEN
+ XCJ = XXC/NCNT
+ YCJ = YYC/NCNT
+ ELSE
+ XCJ= XUSR(NOP(J,9))
+ YCJ= YUSR(NOP(J,9))
+ ENDIF
+ 50 CONTINUE
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/SHOWEQ.FOR b/src/src83e/SHOWEQ.FOR
new file mode 100644
index 0000000..8d7972b
--- /dev/null
+++ b/src/src83e/SHOWEQ.FOR
@@ -0,0 +1,8 @@
+ SUBROUTINE SHOWEQ
+ USE BLKELTLD
+ DO I=1,NQHYD
+ IELEM=NCLINE(I)
+ CALL FILLEM(IELEM)
+ ENDDO
+ RETURN
+ END
diff --git a/src/src83e/SMFY.F90 b/src/src83e/SMFY.F90
new file mode 100644
index 0000000..ac1810f
--- /dev/null
+++ b/src/src83e/SMFY.F90
@@ -0,0 +1,70 @@
+ SUBROUTINE SMFY
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+ DATA SPAC/0.0/
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+! First delete selected elements and create list of nodes
+
+ do n=1,np
+ list(n)=0
+ ninc(n)=0
+ enddo
+
+ do n=1,nefl
+ j=neflag(n)
+ do k=1,8,2
+ if(nop(j,k) .gt. 0) list(nop(j,k))=1
+ enddo
+ call deltel(j)
+ enddo
+
+! All corner nodes connected to elements now have LIST=1
+
+! Remove nodes that are still connected from list
+! But keep list of nodes that are dropped
+! Now form list of nodes to be refined
+ do n=1,ne
+ if(imat(n) .gt. 0) then
+ do k=1,8,2
+ if(nop(n,k) .gt. 0) then
+ if(list(nop(n,k)) .eq. 1) then
+ ninc(nop(n,k))=1
+ endif
+ list(nop(n,k))=0
+ endif
+ enddo
+ endif
+ enddo
+
+
+! Get simplification options
+
+ CALL TRIANOPT(NINTV,SPAC)
+
+! Sort points into ascending x order
+
+ CALL SORTDB(XUSR,NKEY,NP)
+
+! Drop points based on spacing
+
+ IF(NINTV .GT. 1 .OR. SPAC .GT. 0.) THEN
+ CALL DROPPTS(NP,NINTV,SPAC)
+ ENDIF
+
+! Add back in the edge nodes
+
+ DO N=1,NP
+ IF(NINC(N) .EQ. 1) LIST(N)=1
+ ENDDO
+
+! Form new triangles
+
+ call deln2(np,2)
+
+!
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/SPLIT.F90 b/src/src83e/SPLIT.F90
new file mode 100644
index 0000000..ed7c10c
--- /dev/null
+++ b/src/src83e/SPLIT.F90
@@ -0,0 +1,345 @@
+!IPK NEW ROUTINE SEP 9 2006
+ SUBROUTINE SPLITN
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'TXFRM.COM'
+ CHARACTER*1 IFLAG
+ DIMENSION DIRL(350),IPROCES(MAXE)
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+
+ DATA SPAC/10./,ieltyp/1/,ielsw/1/,iensw/0/
+
+! DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
+! & +(CORD(N1,2)-CORD(N2,2))**2)
+ PROJ(N1,N2,DR)= (CORD(N2,1)-CORD(N1,1))*COS(DR)+(CORD(N2,2)-CORD(N1,2))*SIN(DR)
+!
+ icln=1
+ dirsplIt=0.
+ ieltyp=1
+ ientyp=1
+ SPAC=10.
+ call wdialogload(IDD_DISPLIT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DISPLIT)
+ ierr=infoerror(1)
+
+ call wdialogputradiobutton(idf_radio1)
+ CALL WDialogPutinteger(IDF_INTEGER3,icln)
+ CALL WDialogPutReal(IDF_REAL1,SPAC)
+ CALL WDialogPutinteger(IDF_INTEGER2,IELTYP)
+ call wdialogputcheckbox(IDF_check1,ielsw)
+ call wdialogputcheckbox(IDF_check2,iensw)
+ CALL WDialogPutinteger(IDF_INTEGER6,IENTYP)
+ CALL WDialogPutReal(IDF_REAL2,DIRSPLIT)
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,iswr)
+ CALL WDialogGetinteger(IDF_INTEGER3,icln)
+ CALL WDialogGetREAL(IDF_REAL1,SPAC)
+ CALL WDialogGetinteger(IDF_INTEGER2,IELTYP)
+ call wdialogGetcheckbox(IDF_check1,ielsw)
+ call wdialogGetcheckbox(IDF_check2,iensw)
+ CALL WDialogGetinteger(IDF_INTEGER6,IENTYP)
+ CALL WDialogGetREAL(IDF_REAL2,DIRSPLIT)
+ GO TO 100
+ ENDIF
+
+ enddo
+
+100 CONTINUE
+
+ if(iswr .eq. 1) then
+ CALL CCLINE(2)
+ else
+ DO KK=1,350
+ if(iccln(icln,KK) .eq. 0) then
+ ntract=kk-1
+ go to 102
+ endif
+ itrac(kk)=ICCLN(icln,KK)
+ enddo
+102 continue
+ endif
+ DO N=1,NTRACT
+
+ N1=ITRAC(N)
+ IF(N .GT. 1) THEN
+ N0=ITRAC(N-1)
+ ENDIF
+ IF(N .LT. NTRACT) THEN
+ N2=ITRAC(N+1)
+ ENDIF
+
+! Get direction
+
+ IF(N .EQ. 1) THEN
+ IF(NTRACT .GT. 1) THEN
+ DIRX=XUSR(N2)-XUSR(N1)
+ DIRY=YUSR(N2)-YUSR(N1)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ELSE
+ DIRL(N)=DIRSPLIT
+ ENDIF
+ ELSEIF(N .EQ. NTRACT) THEN
+ DIRX=XUSR(N1)-XUSR(N0)
+ DIRY=YUSR(N1)-YUSR(N0)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ELSE
+ DIRX=XUSR(N2)-XUSR(N0)
+ DIRY=YUSR(N2)-YUSR(N0)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ENDIF
+ ENDDO
+! Move nodes apart adding new numbers
+
+ DO N=1,NTRACT
+ N1=ITRAC(N)
+ CALL GETNOD(J)
+ JTRAC(N)=J
+ XUSR(J)=XUSR(N1)-SPAC/2.*COS(DIRL(N))
+ YUSR(J)=YUSR(N1)-SPAC/2.*SIN(DIRL(N))
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ INEW(J)=1
+ INSKP(J) = 0
+
+ XUSR(N1)=XUSR(N1)+SPAC/2.*COS(DIRL(N))
+ YUSR(N1)=YUSR(N1)+SPAC/2.*SIN(DIRL(N))
+ CORD(N1,1)=(XUSR(N1)+XS)/TXSCAL
+ CORD(N1,2)=(YUSR(N1)+YS)/TXSCAL
+ WD(J)=WD(N1)
+ WIDTH(J)=WIDTH(N1)
+ SS1(J)=SS1(N1)
+ SS2(J)=SS2(N1)
+ WIDS(J)=WIDS(N1)
+ WIDBS(J)=WIDBS(N1)
+ SSO(J)=SSO(N1)
+ ENDDO
+
+
+! Form list of elements connected to nodes
+ IERR=0
+ CALL NDNECON(IERR)
+
+! find each element
+
+ IPROCES=0
+
+ IF(NTRACT .GT. 1) THEN
+ DO N=1,NTRACT-1
+ DO K=1,NDELM(ITRAC(N))
+ J=NECON(ITRAC(N),K)
+! IF(IPROCES(J) .EQ. 0) THEN
+ IJ=0
+ II=0
+ DO L=1,NCORN(J),2
+ IF(NOP(J,L) .EQ. ITRAC(N) .or. NOP(J,L) .EQ. JTRAC(N)) II=L
+ IF(NOP(J,L) .EQ. ITRAC(N+1)) IJ=L
+ ENDDO
+ IF(IJ .NE. 0) THEN
+ IF(IJ .LT. II .OR. (II .EQ. 1 .and. ij .ne. 3) ) THEN
+ IF(II .EQ. NCORN(J)-1 .AND. IJ .EQ. 1) GO TO 200
+! MATCH FOUND
+ NOP(J,II)= JTRAC(N)
+ NOP(J,IJ)= JTRAC(N+1)
+ IPROCES(J)=1
+ GO TO 300
+ ENDIF
+ 200 CONTINUE
+ IPROCES(J)=1
+ ENDIF
+ 300 CONTINUE
+! ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+ DO N=1,NTRACT
+ DO K=1,NDELM(ITRAC(N))
+ J=NECON(ITRAC(N),K)
+ IF(IPROCES(J) .EQ. 0) THEN
+ II=0
+ DO L=1,NCORN(J),2
+ IF(NOP(J,L) .EQ. ITRAC(N)) II=L
+ ENDDO
+ IF(II .NE. 0) THEN
+ A0P=-9999.
+ A0M=9999.
+ B0P=-9999.
+ B0M=9999.
+ DO L=1,NCORN(J),2
+ IF(II .NE. NOP(J,L)) THEN
+ ITEST=NOP(J,L)
+ ENDIF
+ A1=PROJ(ITEST,ITRAC(N),DIRL(N))
+ IF(A1 .GT. A0P) A0P=A1
+ IF(A1 .LT. A0M) A0M=A1
+ B1=PROJ(ITEST,JTRAC(N),DIRL(N))
+ IF(B1 .GT. B0P) B0P=B1
+ IF(B1 .LT. B0M) B0M=B1
+ ENDDO
+ IF(ABS(A0M) .GT. ABS(A0P)) THEN
+ A0P=A0M
+ B0P=B0M
+ ENDIF
+ IF(ABS(A0P) .GT. ABS(B0P)) THEN
+ NOP(J,II)= JTRAC(N)
+ ENDIF
+ IPROCES(J)=1
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ IERR=0
+ CALL NDNECON(IERR)
+
+ IF(IELSW .EQ. 0) GO TO 400
+! form new elements
+
+ DO N=1,NTRACT-1
+ CALL GETELM(J)
+ NOP(J,1)=JTRAC(N)
+ NOP(J,3)=JTRAC(N+1)
+ NOP(J,5)=ITRAC(N+1)
+ NOP(J,7)=ITRAC(N)
+ NOP(J,2)=0
+ NOP(J,4)=0
+ NOP(J,6)=0
+ NOP(J,8)=0
+ IMAT(J)=IELTYP
+ NCORN(J) = 8
+ IESKP(J) = 0
+ NE = MAX(J,NE)
+ ENDDO
+
+ 400 CONTINUE
+
+ if(iensw .gt. 0) then
+
+
+
+! start at first node
+ IF(NDELM(ITRAC(1)) .GT. 1) THEN
+ DO K=1,NDELM(ITRAC(1))
+ J=NECON(ITRAC(1),K)
+ DO KZ=1,NCORN(J),2
+ IF(NOP(J,KZ) .EQ. ITRAC(1)) THEN
+ K1=KZ
+ GO TO 500
+ ENDIF
+ ENDDO
+ 500 KK=K1-2
+ IF(KK .LT. 0) KK=NCORN(J)-1
+ KUP=NOP(J,KK)
+ DO KZ=1,NDELM(KUP)
+ JJ=NECON(KUP,KZ)
+ DO KY=1,NCORN(JJ),2
+ IF(NOP(JJ,KY) .EQ. KUP) THEN
+ K2=KY
+ GO TO 550
+ ENDIF
+ ENDDO
+ 550 KL=K2-2
+ IF(KL .LT. 0) KL=NCORN(JJ)-1
+ IF(NOP(JJ,KL) .EQ. JTRAC(1)) THEN
+ GO TO 600
+ ENDIF
+ ENDDO
+ ENDDO
+
+! FOUND A MATCH
+
+ 600 CONTINUE
+ CALL GETELM(JK)
+ NOP(JK,1)=ITRAC(1)
+ NOP(JK,3)=KUP
+ NOP(JK,5)=JTRAC(1)
+ NOP(JK,2)=0
+ NOP(JK,4)=0
+ NOP(JK,6)=0
+ IMAT(JK)=IENTYP
+ NCORN(JK) = 6
+ IESKP(JK) = 0
+ NE = MAX(JK,NE)
+ ENDIF
+
+ IF(NDELM(ITRAC(NTRACT)) .GT. 1) THEN
+ DO K=1,NDELM(ITRAC(NTRACT))
+ J=NECON(ITRAC(NTRACT),K)
+ DO KZ=1,NCORN(J),2
+ IF(NOP(J,KZ) .EQ. ITRAC(NTRACT)) THEN
+ K1=KZ
+ GO TO 650
+ ENDIF
+ ENDDO
+ 650 KK=K1+2
+ IF(KK .GT. NCORN(J)) KK=1
+ KUP=NOP(J,KK)
+ DO KK=1,NDELM(KUP)
+ JJ=NECON(KUP,KK)
+ DO KY=1,NCORN(JJ),2
+ IF(NOP(JJ,KY) .EQ. KUP) THEN
+ K2=KY
+ GO TO 700
+ ENDIF
+ ENDDO
+ 700 KL=K2+2
+ IF(KL .GT. NCORN(JJ)) KL=1
+ IF(NOP(JJ,KL) .EQ. JTRAC(NTRACT)) THEN
+ GO TO 750
+ ENDIF
+ ENDDO
+ ENDDO
+ GO TO 800
+
+! FOUND A MATCH
+
+ 750 CONTINUE
+ CALL GETELM(JK)
+
+ NOP(JK,1)=JTRAC(NTRACT)
+ NOP(JK,3)=KUP
+ NOP(JK,5)=ITRAC(NTRACT)
+ NOP(JK,2)=0
+ NOP(JK,4)=0
+ NOP(JK,6)=0
+ IMAT(JK)=IENTYP
+ NCORN(JK) = 6
+ IESKP(JK) = 0
+ NE = MAX(JK,NE)
+ ENDIF
+
+ endif
+
+ 800 CONTINUE
+ call clscrn
+ CALL PLOTOT(1)
+ NHTP=1
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/SWMAP.F90 b/src/src83e/SWMAP.F90
new file mode 100644
index 0000000..e57ddef
--- /dev/null
+++ b/src/src83e/SWMAP.F90
@@ -0,0 +1,91 @@
+ SUBROUTINE SWMAP
+
+ USE BLKMAP
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+
+ LOGICAL OPENTS
+ CHARACTER*1 iflag
+
+ ISWAP=IBAK
+ IBAK=15
+
+! Write out RM1 file
+
+ INQUIRE(IBAK, OPENED=OPENTS)
+ IF(.NOT. OPENTS) THEN
+ OPEN(IBAK,STATUS='SCRATCH',FORM='UNFORMATTED')
+ ENDIF
+ REWIND IBAK
+ CALL WRTOUT(0)
+ REWIND IBAK
+ IBAK=ISWAP
+
+! Now put map data into RM1 position
+
+ NE=NELTS
+ DO J=1,NE
+ DO K=1,8
+ NOP(J,K)=0.
+ ENDDO
+ IF(NOPEL(J,1) .GT. 0) THEN
+ NOP(J,1)=NOPEL(J,1)
+ NOP(J,3)=NOPEL(J,2)
+ NOP(J,5)=NOPEL(J,3)
+ NCORN(J)=6
+ IMAT(J)=1
+ IESKP(J) = 0
+ ELSE
+ NCORN(J)=0
+ IMAT(J)=0
+ IESKP(J) = 1
+ ENDIF
+ ENDDO
+ NP=MAXPTS
+ DO J=1,NP
+ XUSR(J)=XMAP(J)
+ YUSR(J)=YMAP(J)
+ CORD(J,1) = XUSR(J)
+ CORD(J,2) = YUSR(J)
+ WD(J)=VAL(J)
+ INSKP(J)=0
+ IF (CORD(J,1) .GT. VDX) THEN
+ INEW(J) = 1
+ ENDIF
+ ENDDO
+ NLST=0
+ NENTRY=0
+ NLAYD=0
+ NCLM=0
+ CALL RESCAL
+ CALL HEDR
+ RETURN
+ END
+
+ SUBROUTINE SWRM1
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ NOPEL(N,1)=NOP(N,1)
+ NOPEL(N,2)=NOP(N,3)
+ NOPEL(N,3)=NOP(N,5)
+ ELSE
+ NOPEL(N,1)=0
+ NOPEL(N,2)=0
+ NOPEL(N,3)=0
+ ENDIF
+ ENDDO
+ CALL RDRST(1,15)
+ CALL RDRST(2,15)
+ CALL RDRST(3,15)
+ REWIND 15
+ CALL RESCAL
+ CALL HEDR
+ RETURN
+ END
diff --git a/src/src83e/SYMBL.F90 b/src/src83e/SYMBL.F90
new file mode 100644
index 0000000..7ef3282
--- /dev/null
+++ b/src/src83e/SYMBL.F90
@@ -0,0 +1,1441 @@
+!IPK LAST UPDATE SEP 23 2015 REVISE TESTING FOR RIVER SECTIONS
+ subroutine tekgin(x,y,iflag)
+ save
+!iPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+ character*1 iflag,iiflag,iflags
+ data rsclx,rscly/100.0,100./
+ data itime/0/
+ if(itime .eq. 0) then
+ itime=1
+ iky=0
+ endif
+!iPK APR94
+ IF(IRECD .EQ. 2) THEN
+ if(iky .eq. 0) then
+ READ(91,'(2F7.2,A1)') X,Y,IFLAG
+ iflags=iflag
+ xs=x
+ ys=y
+ else
+ iflag=iflags
+ x=xs
+ y=ys
+ endif
+! write(*,'(2f7.2,a1,i4)') x,y,iflag,iky
+ call flush_screen
+ CALL INTRVL(TA,0)
+ 90 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 90
+ if(tspc .eq. 0.) then
+ call gim_an_event(ix,iy,iiflag)
+ if(iiflag .eq. '~') then
+ iflag='P'
+ iky=1
+ return
+ endif
+ endif
+ iky=0
+ ENDIF
+100 continue
+! write(*,'(2i15,a1,i3)') ix,iy,iflag,iky
+ if(irecd .eq. 2) return
+ call flush_screen
+ CALL gim_an_event(ix, iy, iiflag)
+! write(*,'(2i5,a1)') ix,iy,iiflag
+ IF (iiflag.eq.'~') then
+! call hedr
+! CALL plotot
+! call hedr
+ iflag='P'
+ iky=1
+! go to 100
+ return
+ endif
+ iky=0
+! if(irecd .eq. 2) return
+ x= float(ix)/rsclx
+! y= 8.0-float(iy)/rscly
+ y= float(iy)/rscly
+ iflag=iiflag
+! write(90,666) x,y,iflag,ix,iy,iiflag,iky
+! 666 format('tekgin',2f8.2,a1,2i5,a1,i2)
+ if(iflag .eq. 'u') then
+ go to 100
+ endif
+
+!ipk apr94
+ if(irecd .eq. 1) then
+ write(91,'(2f7.2,a1)') x,y,iflag
+ endif
+
+ return
+ end
+
+ subroutine draw(x,y)
+ save
+ common /pltc/ipsav,iflg,xll,yll
+
+ data rsclx,rscly/100.,100./
+ ix=x*rsclx
+ iy=y*rscly
+ CALL gim_a_line(ix, iy)
+
+! save data on file if requested
+
+ if(ipsav .gt. 0) then
+
+! don't write out point unless > .005" from previous point
+
+ if (abs(xll-x) .ge. .005 .or. abs(yll-y) .ge. .005 ) then
+ write(ipsav,99) 'pa',x,y
+ xll = x
+ yll = y
+ iflg = 0
+ else
+ iflg = 1
+ endif
+ endif
+99 format (a2,2f8.3)
+ return
+ end
+
+
+ subroutine move(x,y)
+ save
+ common /pltc/ipsav,iflg,xll,yll
+
+ data rsclx,rscly/100.,100./
+ ix=x*rsclx
+ iy=y*rscly
+ CALL move_da_pointer(ix, iy)
+
+! save data on file if requested
+
+ if(ipsav .gt. 0) then
+
+! don't write out point unless > .005" from previous point
+
+ write(ipsav,99) 'ma',x,y
+ xll = x
+ yll = y
+ iflg = 0
+ endif
+99 format (a2,2f8.3)
+ return
+ end
+
+!*************************************************************
+!
+! SYMBOL SUBROUTINE
+!
+! ROUTINE TO OUTPUT !HARACTER STRINGS.
+!
+!*****************************************************************
+ SUBROUTINE SYMBL (X,Y,HEIGHT,STRING,ANGLE,NCHAR)
+ save
+ COMMON /PLTC/IPSAV,IFLG,XLL,YLL
+ CHARACTER*(*) STRING
+ CHARACTER*32 FMT1
+ CHARACTER*2 PS
+ CHARACTER*2 IHT
+ DATA PS/'PS'/,HT/0.8/
+ integer*4 nchar
+ IHT(1:1)=CHAR(27)
+ IHT(2:2)=':'
+
+ HT=height*5.
+
+! if(height .gt. 0.7) then
+! ht=height
+! else
+! ipk mar01
+! ht=0.6
+! endif
+!
+! Centered symbols
+!
+ ICHR = -1
+ IF (NCHAR .LT. 0) THEN
+ ICHR = ICHAR(STRING(1:1))
+ IF (ICHR .EQ. 0) STRING(1:1) = CHAR(35)
+ IF (ICHR .EQ. 1) STRING(1:1) = CHAR(33)
+ IF (ICHR .EQ. 2) STRING(1:1) = CHAR(39)
+ IF (ICHR .EQ. 3) STRING(1:1) = CHAR(41)
+!cc WRITE(2,'(A)') 'SS "CENTERED.SYM"'
+ ENDIF
+!
+ ZANGLE = ANGLE
+ LSTR = LENSTR(STRING)
+ LSTR = MIN(LSTR,IABS(NCHAR))
+!
+! ixx = x*scrnx
+! iyy = (7.50-y-0.2)*scrny
+
+!
+!
+ CALL QUAD(X,Y,ITS)
+ IF(ITS .EQ. 22) THEN
+ yy=y
+! CALL move( x, yy)
+ CALL LABL(X,YY,LSTR,HT,STRING)
+ ANGL = ZANGLE/3.14159
+ XLAS = X + COS(ANGL)*(HEIGHT*LSTR)
+ YLAS = Y + SIN(ANGL)*(HEIGHT*LSTR)
+!
+ IF(IPSAV .GT. 0) THEN
+ HTG=HT*0.75
+ WRITE(FMT1,198) NCHAR
+ 198 FORMAT(18h(A2,4F8.3,1X,1H",A,i2,5h,1H"))
+ WRITE(ipsav,FMT1) PS,X,Y,HTG,ANGLE,STRING
+ ENDIF
+
+ ENDIF
+!
+ RETURN
+ END
+ SUBROUTINE QUAD(X,Y,IST)
+!-
+!...... Subroutine to establish location of X and Y relative to bounds
+!-
+ COMMON /PAGE/ XL,XH,YL,YH
+!-
+!...... Test side of X
+!-
+ IST=22
+ IF(X .LT. XL) IST=12
+ IF(X .GT. XH) IST=32
+!-
+!...... Test side of Y
+!-
+ IF(Y .LT. YL) IST=IST-1
+ IF(Y .GT. YH) IST=IST+1
+!-
+!...... Final pattern for IST is
+!-
+! 13 23 33
+! ------
+! 12 | 22 | 32
+! ------
+! 11 21 31
+!
+ RETURN
+ END
+
+ SUBROUTINE TRIM(XO,YO,XI,YI,XB,YB,IST,ISTN)
+
+!...... Subroutine to compute coordinates for XB and YB on the boundary
+
+ COMMON /PAGE/ XL,XH,YL,YH
+ IF(IST .LT. 20) THEN
+
+!...... XO is to the left
+
+ IF(ISTN .LT. 20) THEN
+
+!...... XI is also left skip out
+! by setting IST negative
+
+ IST=-IST
+ RETURN
+ ELSE
+ XB = XL
+ YB = YO+(YI-YO)/(XI-XO)*(XL-XO)
+
+!...... Check location of YB. If its within limits we are done
+! or have found a totally crossing line
+
+ IF(YB .LT. YL) THEN
+
+!...... Below
+
+ IF (YI .EQ. YB) THEN
+ XB = 999.
+ ELSE
+ XB = XB+(XI-XB)/(YI-YB)*(YL-YB)
+ ENDIF
+ YB = YL
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+
+!...... Signify that final point is still out by negative IST
+
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+
+!...... Part of a crossing line set ISTN negative
+
+ ISTN=-ISTN
+ ENDIF
+ ELSEIF(YB .GT. YH) THEN
+
+!...... Above
+
+ IF (YI .EQ. YB) THEN
+ XB = 999.
+ ELSE
+ XB = XB+(XI-XB)/(YI-YB)*(YH-YB)
+ ENDIF
+ YB = YH
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ENDIF
+ ELSEIF(IST .GT. 30) THEN
+
+!...... XO is to the right
+
+ IF(ISTN .GT. 30) THEN
+
+!...... XI is also right skip out
+ IST=-IST
+ ELSE
+ XB = XH
+ YB = YO+(YI-YO)/(XI-XO)*(XH-XO)
+
+!...... Check location of YB. If its within limits we are done
+
+ IF(YB .LT. YL) THEN
+
+!...... Below
+
+ IF (YI .EQ. YB) THEN
+ XB = 999.
+ ELSE
+ XB = XB+(XI-XB)/(YI-YB)*(YL-YB)
+ ENDIF
+ YB = YL
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ELSEIF(YB .GT. YH) THEN
+
+!...... Above
+
+ IF (YI .EQ. YB) THEN
+ XB = 999.
+ ELSE
+ XB = XB+(XI-XB)/(YI-YB)*(YH-YB)
+ ENDIF
+ YB = YH
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ENDIF
+ ELSE
+
+!...... XO is in the middle section
+
+!...... Check location of YB. If its within limits we are done
+
+ IF(YO .LT. YL) THEN
+
+!...... Below
+
+ IF(MOD(ISTN,10) .EQ. 1) THEN
+
+!...... still out
+
+ IST=-IST
+ ELSE
+ YB = YL
+ IF (YI .EQ. YO) THEN
+ XB = 999.
+ ELSE
+ XB = XO+(XI-XO)/(YI-YO)*(YL-YO)
+ ENDIF
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ENDIF
+ ELSEIF(YO .GT. YH) THEN
+
+!...... Above
+
+ IF(MOD(ISTN,10) .EQ. 3) THEN
+
+!...... still out
+
+ IST=-IST
+ ELSE
+ YB = YH
+ IF (YI .EQ. YO) THEN
+ XB = 999.
+ ELSE
+ XB = XO+(XI-XO)/(YI-YO)*(YH-YO)
+ ENDIF
+ IF(XB .GT. XH .OR. XB .LT. XL) THEN
+ IST=-IST
+ ELSEIF(ISTN .NE. 22) THEN
+ ISTN=-ISTN
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE NUMBR(X,Y,HITE,RNUM,THETA,NDEC)
+! This routine has been extensively rewritten AUG 94
+ SAVE
+ COMMON /PLTC/IPSAV,IFLG,XLL,YLL
+ integer*4 ndec
+ CHARACTER*36 FMT,FMT1,NARRAY
+ CHARACTER*1 QOT
+
+
+! WHERE: X,Y DEFINE THE COORDINATES OF THE LOWER-LEFT CORNER OF THE
+! FIRST DIGIT TO BE PLOTTED
+! HITE CHARACTER HEIGHT (INCHES)
+! RNUM THE REAL NUMBER TO BE PLOTTED
+! THETA THE ANGLE (IN DEGREES) THE CHARACTER STRING MAKES WITH THE
+! X-AXIS
+! NDEC THE OF DECIMAL PLACES TO WHICH THE IS PLOTTED
+
+
+ DATA QOT/'"'/
+ CALL CVF(RNUM,NDEC,NARRAY,NUMC)
+ CALL SYMBL(X,Y,HITE,NARRAY,THETA,NUMC)
+ IF(IPSAV .GT. 0) THEN
+ XLAS=X+NUMC*HITE*0.75
+ YLAS=Y
+ ZANGLE = THETA
+ HTG=HITE*0.75
+ WRITE(IPSAV,199) 'PS',X,Y,HTG,ZANGLE,(NARRAY(I:I),I=1,NUMC),QOT
+199 FORMAT (A2,2F8.3,2F8.3,1X,1H",11A1)
+ ENDIF
+ RETURN
+
+ END
+
+
+
+ subroutine polyfl(x,y,npts,icol)
+! polygon fill routine npts close it , colour code is icol
+ save
+ dimension x(*),y(*)
+ dimension itran(0:16)
+ data itran/0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/
+ IF(icol .EQ. -11) then
+ icll=8
+ else
+ icll=itran(icol)
+ endif
+ if (npts .lt. 4) return
+ CALL nwpen(icll)
+ CALL fill_a_polygon(x,y,npts)
+ call Rblue
+ return
+ end
+! ---------------------------------------------------------------------------
+
+ subroutine nwpen(icl)
+
+ CALL change_color(icl)
+ return
+ end
+
+ subroutine RGrey
+ icl=15
+! 240
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+
+ subroutine RBlack
+ icl=14
+! 223
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+ subroutine Rwhite
+ icl=0
+! 224
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+ subroutine Rwhiteb
+ icl=1
+! 224
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+ subroutine RRed
+ icl=12
+! 16
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+ subroutine RBlue
+ icl=3
+! 175
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+ subroutine Rcyan
+ icl=5
+! 112
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+ subroutine RGreen
+ icl=7
+! 96
+ call nwpen(icl)
+ return
+ end
+! -----------------------------------------------------------------------------
+
+
+
+
+! Routine to obtain keyboard entry in ascii code
+
+ SUBROUTINE KEYBRD(K)
+ character*1 cha
+ call gim_a_charac(K,cha,x,y)
+ RETURN
+ END
+
+
+ subroutine clscrn
+ CALL clear_screen
+ return
+ end
+
+
+ SUBROUTINE PLOTT(XX,YY,II)
+ SAVE
+ COMMON /PLTC/IPSAV,IFLG,XLL,YLL
+
+ COMMON /PAGE/ XL,XH,YL,YH
+ COMMON /PLXZ/ XLAS,YLAS,NPLT,NCHRS,XORG,YORG
+
+
+! Save data on file if requested
+
+ IF(IPSAV .GT. 0 .AND. II .LT. 0) THEN
+ WRITE(IPSAV,99) 'tr',XX,YY
+ WRITE(IPSAV,99) 'pi',0.0,0.0
+ WRITE(IPSAV,99) 'ma',0.0,0.0
+ xold=xx
+ yold=yy
+ ENDIF
+ 99 FORMAT (a2,2F8.3)
+
+ IF(II .EQ. 3) THEN
+ CALL QUAD(XX,YY,ITS)
+ XOLD=XX
+ YOLD=YY
+ IF(ITS .EQ. 22) call move(xx,yy)
+ ENDIF
+ IF(II .EQ. 2) THEN
+ IF(ITS .EQ. 22) THEN
+! was in
+ CALL QUAD(XX,YY,ITS)
+ IF(ITS .EQ. 22) THEN
+! still in
+ CALL DRAW(XX,YY)
+ XOLD=XX
+ YOLD=YY
+ ELSE
+! now out
+ ITSN=22
+ CALL TRIM(XX,YY,XOLD,YOLD,XB,YB,ITS,ITSN)
+ CALL DRAW(XB, YB)
+ XOLD=XX
+ YOLD=YY
+ ITS=IABS(ITS)
+ ENDIF
+ ELSE
+! was out
+ CALL QUAD(XX,YY,ITSN)
+ IF(ITSN .EQ. 22) THEN
+! now in
+ CALL TRIM(XOLD,YOLD,XX,YY,XB,YB,ITS,ITSN)
+ CALL MOVE(XB, YB)
+ CALL DRAW(XX, YY)
+ XOLD=XX
+ YOLD=YY
+ ITS=22
+ ELSE
+! still out but could have been in for a time so test
+ CALL TRIM(XOLD,YOLD,XX,YY,XB,YB,ITS,ITSN)
+ IF(ITS .LT. 0) THEN
+! yes
+ XOLD=XX
+ YOLD=YY
+ ITS=IABS(ITSN)
+ ELSEIF(ITSN .LT. 0) THEN
+ CALL MOVE(XB,YB)
+ ITSN=-ITSN
+ ITS=22
+ XOLD=XB
+ YOLD=YB
+ CALL TRIM(XX,YY,XOLD,YOLD,XB,YB,ITSN,ITS)
+ CALL DRAW(XB, YB)
+ XOLD=XX
+ YOLD=YY
+ ITS=IABS(ITSN)
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+ XLAS=XOLD
+ YLAS=YOLD
+ RETURN
+ END
+
+
+ subroutine quit_pgm
+ call setd(24)
+ close (90)
+ CALL get_rid_window
+ stop
+ end
+
+! -----------------------------------------------------------------------------
+
+ subroutine clrbox
+ CALL clear_box
+ return
+ end
+
+ SUBROUTINE INTRVL(TA,IS)
+
+!...... Timing routine
+
+! TA is interval time in seconds
+
+!IPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+
+ INTEGER*4 ITA,ITN
+
+ IF(IS .EQ. 0) THEN
+! CALL TIMER(ITA)
+ CALL GETTIM(IHR,IMIN,ISEC,IHUN)
+ TB=3600.*IHR+60.*IMIN+ISEC+ FLOAT(IHUN)/100.
+ RETURN
+ ELSE
+ CALL GETTIM(IHR,IMIN,ISEC,IHUN)
+ TA=3600.*IHR+60.*IMIN+ISEC+ FLOAT(IHUN)/100.
+! CALL TIMER(ITN)
+ ENDIF
+! ITIC=ITN-ITA
+! IF(ITIC .LT. 0) THEN
+! ITA=ITN
+! ITIC=0
+! ENDIF
+! TA=FLOAT(ITIC)/100.
+ TA=TA-TB
+ IF(TSPC .EQ. 0.) THEN
+ TA=TA-0.5
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE DASHLN(XLIN,YLIN,NLINP,ICD)
+
+! Routine to draw a line with dashes
+
+ DIMENSION XLIN(*),YLIN(*)
+
+! Work through points
+
+ DO 200 K=1,NLINP
+ IF(K .EQ. 1) THEN
+ CALL PLOTT(XLIN(K),YLIN(K),3)
+ ELSEIF(ICD .EQ. 0) THEN
+ CALL PLOTT(XLIN(K),YLIN(K),2)
+ ELSE
+
+! Draw dashed line
+
+ DASHNT=0.2/2.**ICD
+ SC1=(XLIN(K)-XLIN(K-1))**2
+ SC2=(YLIN(K)-YLIN(K-1))**2
+ SLEN=SQRT(SC1+SC2)
+ NDASH=IFIX(SLEN/DASHNT)+1
+ XINC=(XLIN(K)-XLIN(K-1))/SLEN*DASHNT
+ YINC=(YLIN(K)-YLIN(K-1))/SLEN*DASHNT
+ XP=XLIN(K-1)
+ YP=YLIN(K-1)
+ DO 180 ND=1,NDASH
+ IF(ND .LT. NDASH) THEN
+ XP=XP+XINC
+ YP=YP+YINC
+ ELSE
+ XP=XLIN(K)
+ YP=YLIN(K)
+ ENDIF
+ IF(MOD(ND,2) .EQ. 1) THEN
+ CALL PLOTT(XP,YP,2)
+ ELSE
+ CALL PLOTT(XP,YP,3)
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 200 CONTINUE
+ RETURN
+ END
+
+ subroutine chint(iflag)
+ character*1 iflag
+ iflag='c'
+ return
+ end
+ SUBROUTINE GETINTAA(INUM)
+
+ COMMON /RECOD/ IRECD,TSPC
+
+ character*50 cha
+ CHARACTER*11 DATA
+
+ CHARACTER*30 MES
+ DATA MES/'Error reading integer, Reenter'/
+
+ if(irecd .eq. 2) then
+ read(91,'(i7)') inum
+ CALL INTRVL(TA,0)
+ 70 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 70
+ return
+ endif
+
+ 80 CONTINUE
+ DO 90 I=1,11
+ DATA(I:I)=' '
+ 90 CONTINUE
+
+ I = 1
+ 10 CONTINUE
+ I = I+1
+
+ call gim_a_charac(key,cha,x,y)
+
+! write(90,*) 'key',key
+
+ IF (KEY .EQ. 8) THEN
+ I = I-2
+ GO TO 10
+ ENDIF
+ IF(KEY .EQ. 13) GO TO 200
+ DATA(I:I)=CHAR(KEY)
+ CALL GTEXT(4,I+20,DATA(I:I))
+ 100 CONTINUE
+ GO TO 10
+ 200 CONTINUE
+
+ READ(DATA,5000,ERR=300) INUM
+ 5000 FORMAT(1X,I10)
+
+ if(irecd .eq. 1) then
+ write(91,'(i7)') inum
+ endif
+
+ RETURN
+
+ 300 CONTINUE
+ CALL SYMBL(3.0,7.6,0.2,MES,0.0,30)
+ GO TO 80
+ END
+
+
+ SUBROUTINE GETFPNA(FPN)
+
+!IPK APR94
+ COMMON /RECOD/ IRECD,TSPC
+
+ CHARACTER*11 DATA
+ character*50 cha
+
+ CHARACTER*30 MES
+ DATA MES/'Error reading number, Reenter.'/
+
+ if(irecd .eq. 2) then
+ read(91,'(f7.2)') fpn
+ CALL INTRVL(TA,0)
+ 70 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 70
+ return
+ endif
+
+ 80 CONTINUE
+ DO 90 I=1,11
+ DATA(I:I)=' '
+ 90 CONTINUE
+
+ I = 1
+ 10 CONTINUE
+ I = I+1
+
+ call gim_a_charac(key,cha,x,y)
+
+! write(90,*) 'key',key
+ IF (KEY .EQ. 8) THEN
+ I = I-2
+ GO TO 10
+ ENDIF
+ IF(KEY .EQ. 13) GO TO 200
+ DATA(I:I)=CHAR(KEY)
+ CALL GTEXT(4,I+20,DATA(I:I))
+ 100 CONTINUE
+ GO TO 10
+ 200 CONTINUE
+
+ READ(DATA,5000,ERR=300) FPN
+ 5000 FORMAT(1X,F10.0)
+
+ if(irecd .eq. 1) then
+ write(91,'(f7.2)') fpn
+ endif
+
+ RETURN
+
+ 300 CONTINUE
+ CALL SYMBL(3.0,7.6,0.2,MES,0.0,30)
+ GO TO 80
+ END
+
+ SUBROUTINE FLUSHWN
+ CALL FLUSH_SCREEN
+ RETURN
+ END
+
+ subroutine gtext(j,i,cha)
+ character*1 cha
+ y=8.0-0.1*j
+ x=i*0.15
+ call symbl(x,y,0.15,cha,0.0,1)
+ return
+ end
+
+ subroutine fillem(ielem)
+
+ USE BLK1MOD
+ INCLUDE 'TXFRM.COM'
+ dimension xvs(9),yvs(9)
+! include 'BLK1.COM'
+
+ ncn=ncorn(ielem)
+ if(ncn .gt. 5) go to 200
+ N1=NOP(IELEM,1)
+ N2=NOP(IELEM,3)
+
+ IF(IPW1 .EQ. 1) THEN
+ wd11=width(n1)/txscal
+ wd2=width(n2)/txscal
+ ELSE
+ BT1= &
+ CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
+ CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
+ BT2= &
+ CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
+ CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
+ H1=WIDEL-BT1
+ H2=WIDEL-BT2
+ CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
+ CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
+ WIDTH(N1)=WR1
+ WIDTH(N2)=WR2
+ IF(IPW1 .EQ. 2) THEN
+ WD11=WR1*WIDSCL/TXSCAL
+ WD2=WR2*WIDSCL/TXSCAL
+ ELSE
+ WD11=AR1*WIDSCL/TXSCAL
+ WD2=AR2*WIDSCL/TXSCAL
+ ENDIF
+
+ ENDIF
+
+
+ IF(WD11 .GT. 0. .AND. WD2 .GT. 0.) THEN
+ X1= CORD(N1,1)
+ X2= CORD(N2,1)
+ Y1= CORD(N1,2)
+ Y2= CORD(N2,2)
+ ELDIR=ATAN2(Y2-Y1,X2-X1)
+ ELNORM=ELDIR-1.5708
+ XVS(1)=X1+COS(ELNORM)*WD11/2.
+ XVS(4)=X1-COS(ELNORM)*WD11/2.
+ XVS(2)=X2+COS(ELNORM)*WD2/2.
+ XVS(3)=X2-COS(ELNORM)*WD2/2.
+ YVS(1)=Y1+SIN(ELNORM)*WD11/2.
+ YVS(4)=Y1-SIN(ELNORM)*WD11/2.
+ YVS(2)=Y2+SIN(ELNORM)*WD2/2.
+ YVS(3)=Y2-SIN(ELNORM)*WD2/2.
+ NPTS=4
+ call polyfl(xvs,yvs,npts,14)
+ ENDIF
+ RETURN
+
+ 200 xvs(1)=cord(nop(ielem,1),1)
+ yvs(1)=cord(nop(ielem,1),2)
+
+ npts=1
+ do 100 n=1,ncn
+
+ if(n .ge. 9) go to 100
+ if(nop(ielem,n) .eq. 0) go to 100
+ npts=npts+1
+ xvs(npts)=cord(nop(ielem,n),1)
+ yvs(npts)=cord(nop(ielem,n),2)
+ 100 continue
+
+ call polyfl(xvs,yvs,npts,14)
+ return
+ end
+
+ SUBROUTINE CLRSTP(y1,y2)
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ dimension x(4),y(4)
+ x(1)=0.
+ x(2)=HSIZE
+ x(3)=HSIZE
+ x(4)=0.
+ y(1)=y1
+ y(2)=y1
+ y(3)=y2
+ y(4)=y2
+ call Rwhite
+ CALL fill_a_polygon(x,y,4)
+ call RBlue
+ return
+ end
+
+ SUBROUTINE FILLEMC(IELEM,ICCT)
+
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+ INCLUDE 'TXFRM.COM'
+
+! INCLUDE 'BLK1.COM'
+ DIMENSION X(4),Y(4)
+ DO 300 N=1,NCORN(IELEM),2
+ M=NOP(IELEM,N)
+ IF(M .EQ. 0) THEN
+ GO TO 310
+ ELSE
+ X((N+1)/2)=CORD(M,1)
+ Y((N+1)/2)=CORD(M,2)
+ if(i3dview .eq. 1) then
+ Y((N+1)/2)=Y((N+1)/2)+(WD(M)-VRTORIG)*COS(VANG/57.29578)/VRTSCAL
+ endif
+ NPOL=(N+1)/2
+ ENDIF
+ 300 CONTINUE
+ 310 CONTINUE
+ IF(NCORN(IELEM) .GT. 5) THEN
+ CALL NWPEN(ICCT)
+ CALL fill_a_polygon(x,y,npol)
+ ELSE
+ N1=NOP(IELEM,1)
+ N2=NOP(IELEM,3)
+ IF(IPW1 .EQ. 1) THEN
+ wd11=width(n1)/txscal
+ wd2=width(n2)/txscal
+ ELSE
+ IF(NRIVCR1(N1) .EQ. 0 .AND. NRIVCR2(N1) .EQ. 0) RETURN
+ IF(NRIVCR1(N2) .EQ. 0 .AND. NRIVCR2(N2) .EQ. 0) RETURN
+ BT1= &
+ CRSDAT(NRIVCR1(N1),1,1)*WTRIVCR1(N1)+ &
+ CRSDAT(NRIVCR2(N1),1,1)*WTRIVCR2(N1)
+ BT2= &
+ CRSDAT(NRIVCR1(N2),1,1)*WTRIVCR1(N2)+ &
+ CRSDAT(NRIVCR2(N2),1,1)*WTRIVCR2(N2)
+ H1=WIDEL-BT1
+ H2=WIDEL-BT2
+ CALL INTERPWLV(N1,H1,AR1,WR1,DWR1)
+ CALL INTERPWLV(N2,H2,AR2,WR2,DWR2)
+ WIDTH(N1)=WR1
+ WIDTH(N2)=WR2
+ IF(IPW1 .EQ. 2) THEN
+ WD11=WR1*WIDSCL/TXSCAL
+ WD2=WR2*WIDSCL/TXSCAL
+ ELSE
+ WD11=AR1*WIDSCL/TXSCAL
+ WD2=AR2*WIDSCL/TXSCAL
+ ENDIF
+
+ ENDIF
+ IF(WD11 .GT. 0. .AND. WD2 .GT. 0.) THEN
+ X1= CORD(N1,1)
+ X2= CORD(N2,1)
+ Y1= CORD(N1,2)
+ Y2= CORD(N2,2)
+ ELDIR=ATAN2(Y2-Y1,X2-X1)
+ ELNORM=ELDIR-1.5708
+ X(1)=X1+COS(ELNORM)*WD11/2.
+ X(4)=X1-COS(ELNORM)*WD11/2.
+ X(2)=X2+COS(ELNORM)*WD2/2.
+ X(3)=X2-COS(ELNORM)*WD2/2.
+ Y(1)=Y1+SIN(ELNORM)*WD11/2.
+ Y(4)=Y1-SIN(ELNORM)*WD11/2.
+ Y(2)=Y2+SIN(ELNORM)*WD2/2.
+ Y(3)=Y2-SIN(ELNORM)*WD2/2.
+ NPOL=4
+ CALL NWPEN(ICCT)
+ CALL fill_a_polygon(x,y,npol)
+ ENDIF
+ ENDIF
+ CALL RBlue
+ RETURN
+ END
+
+ SUBROUTINE POLYG(AX,AY,NPT,N)
+ SAVE
+ DIMENSION AX(10),AY(10),BX(15),BY(15)
+
+! Duplicate numbers around AX to form long list
+!
+ DO 200 I=1,NPT
+ AX(I+NPT)=AX(I)
+ AY(I+NPT)=AY(I)
+ 200 CONTINUE
+
+! Find a starting point that is on the page
+
+ DO 250 I=1,NPT
+ CALL QUAD(AX(I),AY(I),ITS)
+ IF(ITS .EQ. 22) THEN
+
+! We have a starting point
+
+ II=I
+ GO TO 350
+ ENDIF
+
+! Keep looking
+
+ 250 CONTINUE
+
+! No point on page then skip out
+
+ RETURN
+
+! Loop to check each point and trim as required
+
+ 350 CONTINUE
+ JJ=1
+ BX(1)=AX(II)
+ BY(1)=AY(II)
+ XOLD=AX(II)
+ YOLD=AY(II)
+ DO 500 J=2,NPT+1
+ II=II+1
+ IF(ITS .EQ. 22) THEN
+ CALL QUAD(AX(II),AY(II),ITS)
+ IF(ITS .EQ. 22) THEN
+
+! still in copy over from A to B
+
+ JJ=JJ+1
+ BX(JJ)=AX(II)
+ BY(JJ)=AY(II)
+ XOLD=AX(II)
+ YOLD=AY(II)
+ ELSE
+
+! now out copy over boundary
+
+ ITSN=22
+ CALL TRIM(AX(II),AY(II),XOLD,YOLD,XB,YB,ITS,ITSN)
+ JJ=JJ+1
+ BX(JJ)=XB
+ BY(JJ)=YB
+ XOLD=AX(II)
+ YOLD=AY(II)
+ ITS=IABS(ITS)
+ ENDIF
+ ELSE
+
+! WAS OUT
+
+ CALL QUAD(AX(II),AY(II),ITSN)
+ IF(ITSN .EQ. 22) THEN
+
+! now in copy over point of return
+
+ CALL TRIM(XOLD,YOLD,AX(II),AY(II),XB,YB,ITS,ITSN)
+ JJ=JJ+1
+ BX(JJ)=XB
+ BY(JJ)=YB
+
+! Copy destination point
+
+ JJ=JJ+1
+ BX(JJ)=AX(II)
+ BY(JJ)=AY(II)
+ XOLD=AX(II)
+ YOLD=AY(II)
+ ITS=22
+ ELSE
+
+! still out but could have been in for a time so test
+
+ CALL TRIM(XOLD,YOLD,AX(II),AY(II),XB,YB,ITS,ITSN)
+ IF(ITS .LT. 0) THEN
+
+! no
+
+ XOLD=AX(II)
+ YOLD=AY(II)
+ ITS=IABS(ITSN)
+ ELSEIF(ITSN .LT. 0) THEN
+
+! Temporarily in. Copy point of return
+
+ JJ=JJ+1
+ BX(JJ)=XB
+ BY(JJ)=YB
+ ITSN=-ITSN
+ ITS=22
+ XOLD=XB
+ YOLD=YB
+ CALL TRIM(AX(II),AY(II),XOLD,YOLD,XB,YB,ITSN,ITS)
+
+! Now copy over point of exit
+
+ JJ=JJ+1
+ BX(JJ)=XB
+ BY(JJ)=YB
+ XOLD=AX(II)
+ YOLD=AY(II)
+ ITS=IABS(ITSN)
+ ENDIF
+ ENDIF
+ ENDIF
+ 500 CONTINUE
+
+! Record final number of points
+
+ NPTS=JJ
+!ipk sep 94 icl=mod(n,16)+1
+ icl=mod(n-1,14)
+ call polyfl(bx,by,npts,icl)
+ RETURN
+ END
+
+ SUBROUTINE DBDASHLN(XLIN,YLIN,NLINP,ICD)
+
+! Routine to draw a line with dashes
+
+ REAL*8 XLIN(*),YLIN(*)
+
+! Work through points
+
+ DO 200 K=1,NLINP
+ IF(K .EQ. 1) THEN
+ XCT=XLIN(K)
+ YCT=YLIN(K)
+ CALL PLOTT(XCT,YCT,3)
+ ELSEIF(ICD .EQ. 0) THEN
+ XCT=XLIN(K)
+ YCT=YLIN(K)
+ CALL PLOTT(XCT,YCT,2)
+ ELSE
+
+! Draw dashed line
+
+ DASHNT=0.2/2.**ICD
+ SC1=(XLIN(K)-XLIN(K-1))**2
+ SC2=(YLIN(K)-YLIN(K-1))**2
+ SLEN=SQRT(SC1+SC2)
+ if(slen .lt. 0.1) then
+ XP=XLIN(K-1)
+ YP=YLIN(K-1)
+ CALL PLOTT(XP,YP,3)
+ XP=XLIN(K)
+ YP=YLIN(K)
+ CALL PLOTT(XP,YP,2)
+ cycle
+ endif
+ NDASH=IFIX(SLEN/DASHNT)+1
+ XINC=(XLIN(K)-XLIN(K-1))/SLEN*DASHNT
+ YINC=(YLIN(K)-YLIN(K-1))/SLEN*DASHNT
+ XP=XLIN(K-1)
+ YP=YLIN(K-1)
+ DO 180 ND=1,NDASH
+ IF(ND .LT. NDASH) THEN
+ XP=XP+XINC
+ YP=YP+YINC
+ ELSE
+ XP=XLIN(K)
+ YP=YLIN(K)
+ ENDIF
+ IF(MOD(ND,2) .EQ. 1) THEN
+ CALL PLOTT(XP,YP,2)
+ ELSE
+ CALL PLOTT(XP,YP,3)
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 200 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE GETINT(ISW)
+ USE WINTERACTER
+!
+!
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ COMMON /RECOD/ IRECD,TSPC
+
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+ CHARACTER*47 MESOUT,MESS(46)
+
+ DATA MESS /'Enter node to search for',' Enter material type',&
+ 'Enter element to search for ',&
+ 'Enter number of layers ',&
+ 'Enter width ',&
+ 'Click mouse at end of line ',&
+ 'Enter number of nodes in line ',&
+ 'Click at corners of block ',&
+ 'Enter number of elements in x-dir ',&
+ 'Enter number of elements in y-dir ',&
+ 'Click to move boundaries or (q)uit to terminate',&
+ 'Click on elements','Enter starting list number ',&
+ 'Enter bed elevation','Click on node ',&
+ 'Click location of new node','Click at node to move ',&
+ 'Click at node to delete ',&
+ 'Type 1 to use all nodes else type 0 ',&
+ 'Enter element to select','Click location of node',&
+ 'Enter SS1','Enter SS2','Enter STRWID','Enter STORAGE ELEVATION',&
+ 'Click mouse on node','click mouse on next node',&
+ 'ERROR - Midside node selected - Select node again',&
+ 'Plotting a selected cross section',&
+ 'Click two locations to form a cross section',&
+ 'Click to adjust the cross section',&
+ 'Compute cross section parameters',&
+ 'Click a node for the cross section',&
+ 'Click two locations to form the width','Click to adjust the line','Click two locations to form left slope',&
+ 'Click two locations to form right slope','Click a location'&
+ ,'Enter storage elevation','Enter storage slope',&
+ 'Click at two locations to determine distance'&
+ ,'Enter continuity line number. Use 0 to end','Click at location to define register point'&
+ ,'Enter 1-D cross-section bed slope','Enter element frequency for search'&
+ ,'Enter no. of elements to reverse '/
+
+
+ if(irecd .eq. 2) then
+ read(91,'(i7)') isw
+ CALL INTRVL(TA,0)
+ 70 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 70
+ return
+ endif
+
+
+ if(isw .eq. 0) isw=1
+ call wdialogload(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(IDF_STRING1,MESS(NMESS))
+ CALL WDialogPutInteger(IDF_INTEGER1,ISW)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetInteger(IDF_INTEGER1,ISW)
+ RETURN
+ ELSE
+ RETURN
+ ENDIF
+ ENDDO
+
+ RETURN
+ END
+
+ SUBROUTINE GETFPN(FPN)
+ USE WINTERACTER
+!
+!
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ COMMON /RECOD/ IRECD,TSPC
+
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+ CHARACTER*47 MESOUT,MESS(46)
+
+ DATA MESS /'Enter node to search for',' Enter material type',&
+ 'Enter element to search for ',&
+ 'Enter number of layers ',&
+ 'Enter width ',&
+ 'Click mouse at end of line ',&
+ 'Enter number of nodes in line ',&
+ 'Click at corners of block ',&
+ 'Enter number of elements in x-dir ',&
+ 'Enter number of elements in y-dir ',&
+ 'Click to move boundaries or (q)uit to terminate',&
+ 'Click on elements','Enter starting list number ',&
+ 'Enter bed elevation','Click on node ',&
+ 'Click location of new node','Click at node to move ',&
+ 'Click at node to delete ',&
+ 'Type 1 to use all nodes else type 0 ',&
+ 'Enter element to select','Click location of node',&
+ 'Enter SS1','Enter SS2','Enter STRWID','Enter STORAGE ELEVATION',&
+ 'Click mouse on node','click mouse on next node',&
+ 'ERROR - Midside node selected - Select node again',&
+ 'Plotting a selected cross section',&
+ 'Click two locations to form a cross section',&
+ 'Click to adjust the cross section',&
+ 'Compute cross section parameters',&
+ 'Click a node for the cross section',&
+ 'Click two locations to form the width','Click to adjust the line','Click two locations to form left slope',&
+ 'Click two locations to form right slope','Click a location'&
+ ,'Enter storage elevation','Enter storage slope',&
+ 'Click at two locations to determine distance'&
+ ,'Enter continuity line number. Use 0 to end','Click at location to define register point'&
+ ,'Enter 1-D cross-section bed slope','Enter time interval for display of steps'&
+ ,'Enter tolerance for overlapping points'/
+ if(irecd .eq. 2) then
+ read(91,'(f7.2)') fpn
+ CALL INTRVL(TA,0)
+ 70 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 70
+ return
+ endif
+
+ call wdialogload(IDD_GETFPN)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETFPN)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(IDF_STRING1,MESS(NMESS))
+ CALL WDialogPutReal(IDF_REAL1,FPN)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetReal(IDF_REAL1,FPN)
+ RETURN
+ ELSE
+ RETURN
+ ENDIF
+ ENDDO
+
+ RETURN
+ END
+
+ subroutine drawcr(x,y,siz)
+
+! routine to draw x mark
+
+ siz1=0.707/2.*siz
+ x1=x-siz1
+ y1=y-siz1
+ call plott(x1,y1,3)
+ x1=x+siz1
+ y1=y+siz1
+ call plott(x1,y1,2)
+ x1=x-siz1
+ y1=y+siz1
+ call plott(x1,y1,3)
+ x1=x+siz1
+ y1=y-siz1
+ call plott(x1,y1,2)
+ return
+ end
+
+ SUBROUTINE GETREV(ISW,ILMIT)
+ USE WINTERACTER
+!
+!
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ INTEGER ISW,ILMIT
+
+
+
+ call wdialogload(IDD_GETINTR)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINTR)
+ ierr=infoerror(1)
+
+ CALL WDialogPutCheckBox(IDF_check1,ILMIT)
+ CALL WDialogPutInteger(IDF_INTEGER1,ISW)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetCheckBox(IDF_check1,ILMIT)
+ CALL WDialogGetInteger(IDF_INTEGER1,ISW)
+ RETURN
+ ELSE
+ ISW=-1
+ RETURN
+ ENDIF
+ ENDDO
+
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/TXFRM.COM b/src/src83e/TXFRM.COM
new file mode 100644
index 0000000..b564d03
--- /dev/null
+++ b/src/src83e/TXFRM.COM
@@ -0,0 +1,4 @@
+ REAL*8 XS,YS,TXSCAL
+ INTEGER IRGB,IDDSW
+ COMMON /TXFRM/ XS, YS, TXSCAL,IRGB,IDDSW
+
diff --git a/src/src83e/UTIL.F90 b/src/src83e/UTIL.F90
new file mode 100644
index 0000000..bae20fb
--- /dev/null
+++ b/src/src83e/UTIL.F90
@@ -0,0 +1,1269 @@
+!IPK LAST UPDATE SEP 23 2015 ADD TESTING FOR CHNAGED ELEMENTS/NODES
+!ipk last update Jan25 2001 fix when deleting center-mid expand ipsw
+! last change ipk 12 July 1999
+! Last change: IPK 13 Jan 98 10:01 am
+!ipk last update Nov 18 1997
+!ipk last updated Oct 23 1996
+!ipk last updated June 23 1996
+!ipk last updated Oct 25 1995
+ SUBROUTINE GETELM(NEM)
+!
+! Routine to find first free element number
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ DO 200 J=NELAST,NE
+ IF(IMAT(J) .EQ. 0) THEN
+ NEM=J
+ NELAST=J
+ RETURN
+ ENDIF
+ 200 END DO
+ NE=NE+1
+ NELAST=NE
+ NEM=NE
+ RETURN
+ END
+
+!
+ SUBROUTINE GETNOD(NPT)
+!
+! Routine to find first free node number
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ IF(NP .GT. 0) THEN
+ DO 200 J=NPLAST,NP
+ IF(INEW(J) .EQ. 0) THEN
+ NPT=J
+ NPLAST=J
+ RETURN
+ ENDIF
+ 200 END DO
+ ELSE
+ NP=0
+ ENDIF
+ NP=NP+1
+ NPLAST=NP
+ NPT=NP
+ IF(NPT .GT. MAXP) THEN
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Execution terminated, nodal limits exceeded. Backup written','LIMITS EXCEEDED')
+ CALL WRTOUT(0)
+ STOP
+ ENDIF
+!IPK MAY03
+ ICHG=0
+ RETURN
+ END
+!
+!***********************************************************************
+!
+ SUBROUTINE DELETN(J)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+! Search for elements that attach to node J and remove them
+!
+ DO 200 N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ NCN=NCORN(N)
+ DO 180 K=1,NCN
+ IF(NOP(N,K) .EQ. J) THEN
+!IPK APR94
+ IF(IMAT(N) .LT. 901 .OR. IMAT(N) .GT. 903) THEN
+ IF(MOD(K,2) .EQ. 0) THEN
+ IF(NCN .NE. 2) THEN
+ IF(NCN .NE. 5 .OR. K .EQ. 2) THEN
+ NOP(N,K)=0
+ GO TO 200
+ ENDIF
+!IPK APR94 END CHANGES
+ ENDIF
+ ENDIF
+ ENDIF
+ IMAT(N)=0
+ XC(N)=VOID
+ YC(N)=VOID
+ NCORN(N)=0.
+ IF(N .LT. NELAST) NELAST=N
+ DO 170 KK=1,8
+ NOP(N,KK)=0
+ 170 CONTINUE
+ IESKP(N)=1
+ GO TO 200
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 200 END DO
+
+
+!IPK FEB08 TEST FOR LOWERING NE
+ DO N=NE,1,-1
+ IF(IMAT(N) .NE. 0) THEN
+ JJ=N
+ GO TO 225
+ ENDIF
+ ENDDO
+ 225 NE=JJ
+
+!
+! Remove node now
+!
+ CORD(J,1)=VOID
+ CORD(J,2)=VOID
+ XUSR(J) = VOID
+ YUSR(J) = VOID
+ INSKP(J)=1
+ INEW(J) = 0
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ IF(NPLAST .GT. J) NPLAST=J
+!IPK FEB08 TEST FOR LOWERING NE
+ IF(J .EQ. NP) THEN
+ DO N=NP,1,-1
+ IF(INEW(N) .NE. 0) THEN
+ JJ=N
+ GO TO 250
+ ENDIF
+ ENDDO
+ 250 NP=JJ
+ ENDIF
+
+ RETURN
+ END
+!
+!
+!***********************************************************************
+
+ function lenstr(str)
+!
+! Find length of string (position of last non-blank character)
+!
+ character*(*) str
+
+ n = len(str)
+ lenstr = n
+ do 10 i=0,n-1
+ idx = n-i
+ if (str(idx:idx) .ne. ' ') then
+ lenstr = idx
+ return
+ endif
+ 10 continue
+ return
+ END
+!
+!****************************************************************
+!
+ subroutine prox(x,y,npts,xx,yy,ipt,iflag,inskp,ibox)
+! x=array of x node locations
+! y=array of y node location
+! npts= max number of nodes
+! xx=x screen lpcation
+! yy=y screen location
+! iflag=character flag
+! inskp=array telling nodes to skip
+! ibox=any box checked
+ save
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ CHARACTER*1 ALABL(10)
+ CHARACTER*40 MPDUM
+ COMMON /BLKA1/ TITLE,HLABL,ALABL &
+ & ,MPDUM
+!ipk oct 95 lines defining MPDUM added
+!
+!ipk jan01 expand IPSW
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!
+ integer*2 inskp(*)
+!IPK MAY02
+ REAL*8 x(*),y(*)
+ character*1 iflag
+!
+! if(ibox .eq. 0) then
+! nbx=2
+! call boxr(nbx)
+! endif
+!
+! Get location of cursor
+!
+ 10 call xyloc(xscrn,yscrn,iflag,ibox)
+! write(90,*) 'ibox,xscrn,yscrn',ibox,xscrn,yscrn,irmain
+! write(90,7893) iflag
+ 7893 format(' iflag',a2)
+! read(*,*) junk
+ if(irmain .eq. 1) return
+ if(ibox .eq. 10) then
+ iflag = 'q'
+ return
+ elseif(ibox .eq. 9) then
+ iflag = 'r'
+! elseif(ibox .eq. 7) then
+! iflag = 'a'
+ endif
+!
+!
+ if (iflag .eq. 'q') then
+ return
+ elseif(iflag .eq. 'r') then
+ return
+ elseif(iflag .ne. 'c') then
+
+ ibox=0
+ if(iflag .eq. 't') return
+ if(iflag .eq. 'l') return
+ if(iflag .eq. 'f') return
+ if(iflag .eq. 'e') return
+ if(iflag .eq. 'a') return
+ if(iflag .eq. 'j') return
+ if(iflag .eq. 'z') return
+ if(iflag .eq. 'n') return
+ if(iflag .eq. 'g') return
+ if(iflag .eq. 'h') return
+!ipk oct96 add line below
+ if(iflag .eq. 'b') return
+ if(iflag .eq. 'U') return
+!
+ if(iflag .eq. 'm') go to 12
+!ipk jan98 write(*,*) char(7),char(7)
+ go to 10
+ endif
+!
+! Compare to coordinates
+ 12 d = 1.E+20
+ do 20 i=1,npts
+!! write(*,*) 'i,npts',i,npts,inskp(i),x(i),y(i)
+ if(inskp(i) .ne. 0) go to 20
+ dist = sqrt( (xscrn-x(i))**2 + (yscrn-y(i))**2)
+ if (dist .lt. d) then
+ d = dist
+ ipt = i
+ xx = x(i)
+ yy = y(i)
+ endif
+ 20 continue
+ return
+!
+!
+ END
+!***********************************************************
+ subroutine zoom
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+ dimension xot(5),yot(5)
+ character*1 iflag,ans
+!
+!ipk jun96 add zoomj
+ character*36 zoomh,zoomj,IFLAG32
+ character*22 zoomi
+!ipk jan98
+ CHARACTER*80 lind
+ data zoomh/' Zooming, click at diagonal corners'/
+ data zoomi/' Click left if size OK'/
+!ipk jun96 add zoomj
+ data zoomj/' Double click, click second point '/
+!
+!
+ 80 CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,36)
+
+!jan09 xcc = 5.00
+ xcc = 5.00*hsize/10.
+ ycc = 3.5
+!
+ 100 continue
+!
+! Get cursor location
+!
+ CALL XYLOC(xscrn,yscrn,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ if (iflag .eq. 'q') return
+!
+ xp = xmin + xscrn
+ yp = ymin + yscrn
+ if(iflag .eq. 'c') then
+!
+! This option is creating an inset window
+!
+!ipk jun96 add new path
+ 120 continue
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .eq. 'c') then
+!
+! Look for a screen size
+!
+ xsiz=abs(xscrn1-xscrn)
+ ysiz=abs(yscrn1-yscrn)
+!ipk jun96 test for zero sizes
+ if(xsiz .lt. 0.001 .or. ysiz .lt. 0.001) then
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomj,0.,36)
+ go to 120
+ endif
+ if(xscrn1 .lt. xscrn) xscrn=xscrn1
+ if(yscrn1 .lt. yscrn) yscrn=yscrn1
+ fact=HSIZE/xsiz
+!jan09 if(7./ysiz .lt. fact) fact=7./ysiz
+ if(7.5/ysiz .lt. fact) fact=7.5/ysiz
+ xot(1)=xscrn
+ xot(5)=xscrn
+ yot(1)=yscrn
+ yot(5)=yscrn
+ yot(2)=yscrn
+ xot(4)=xscrn
+!jan09 xscrn=xscrn+5./fact
+!jan09 yscrn=yscrn+3.5/fact
+ xscrn=xscrn+xcc/fact
+ yscrn=yscrn+3.75/fact
+!jan09 xot(2)=xscrn+5./fact
+ xot(2)=xscrn+xcc/fact
+ xot(3)=xot(2)
+!jan09 yot(3)=yscrn+3.5/fact
+ yot(3)=yscrn+3.75/fact
+ yot(4)=yot(3)
+ call DASHLN(xot,yot,5,1)
+ xp=xscrn
+ yp=yscrn
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomi,0.,22)
+ CALL XYLOC(xscrn1,yscrn1,iflag,ibox)
+ IF(IRMAIN .EQ. 1) RETURN
+ if(iflag .ne. 'c') go to 80
+ go to 280
+!
+! pan right
+!
+ else if(iflag .eq. 'r') then
+ fact=1.0
+!jan09 xscrn=xscrn+5.0
+ xscrn=xscrn+hsize/2.
+ xp=xscrn
+ yp=yscrn
+!
+! pan left
+!
+ else if(iflag .eq. 'l') then
+ fact=1.0
+!jan09 xscrn=xscrn-5.0
+ xscrn=xscrn-hsize/2.
+ xp=xscrn
+ yp=yscrn
+ endif
+!
+! redraw at half size
+!
+ elseif(iflag .eq. 'r') then
+ fact = 0.500
+!
+! user controlled redraw
+!
+ else
+ call setd(23)
+ write (*,*) ' factor '
+ read(*,*) fact
+ call setd(2)
+ endif
+ do 250 i=1,np
+ if(cord(i,1) .gt. void) then
+ inskp(i)=0
+ endif
+ 250 continue
+ do 270 i=1,ne
+ if(imat(i) .gt. 0) then
+ ieskp(i)=0
+ endif
+ 270 continue
+ 280 continue
+ pscale = pscale/fact
+ xmino=xmin
+ ymino=ymin
+!
+ xmin = xp - (xcc*pscale)
+ ymin = yp - (ycc*pscale)
+!
+ if(iflag .eq. 'c') then
+! CALL PLOTS(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ return
+ elseif(iflag .eq. 'r') then
+! CALL PLOTS(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ return
+ elseif(iflag .eq. 'l') then
+! CALL PLOTS(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ return
+ endif
+ call setd(23)
+ write(lind,*) 'Illegal zoom press return to continue'
+ call symbl &
+ & (1.1,7.1,0.20,LIND,0.0,80)
+ ndig=1
+ CALL GTCHARX(IFLAG32,NDIG,5.0,7.6)
+!ipk jan98 write(*,*) 'O.K. to plot at this scale? (y)es .or. (n)o'
+!ipk jan98 write(*,*) 'Note n means redraw old plot'
+!ipk jan98 read(*,'(a)') ans
+!ipk jan98 call setd(2)
+!ipk jan98 if (ans .eq. 'y') then
+! CALL PLOTS(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ return
+!ipk jan98 endif
+ pscale = pscale * fact
+ xmin=xmino
+ ymin=ymino
+! CALL PLOTS(0)
+!ipk nov97 add (0)
+ CALL PLOTOT(0)
+ return
+ END
+!***********************************************************
+ SUBROUTINE DELETM(ISW)
+!
+ USE BLK1MOD
+
+ INCLUDE 'BFILES.I90'
+! INCLUDE 'BLK1.COM'
+!
+! COMMON /ICN1/ ICN(MAXP)
+ DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
+ & +(CORD(N1,2)-CORD(N2,2))**2)
+ DO 150 J=1,MAXP
+ ICN(J)=0
+ 150 END DO
+ IF(ISW .EQ. 2) GO TO 650
+! First sort out the potential midsides
+! Note that transition elements caues a problem
+! Find these first
+ IRDONE=0
+ DO 200 N=1,NE
+ IF(NCORN(N) .EQ. 5 .AND. IMAT(N) .LT. 901) THEN
+!
+! We have a transition mark node number as if it were corner
+!
+ ICN(NOP(N,3))=1
+ ICN(NOP(N,1))=2
+ ICN(NOP(N,4))=2
+ ICN(NOP(N,5))=2
+ ELSE
+ if(imat(n) .eq. 0) then
+ ncorn(n)=0
+ go to 200
+ endif
+!
+! Store ICN = 2 for corner nodes
+!
+ NCN=NCORN(N)
+!IPKOCT93 IF(IMAT(N) .GT. 900) THEN
+ IF(IMAT(N) .GT. 900 .AND. IMAT(N) .LT. 904) THEN
+ MST=1
+ ELSE
+ MST=2
+ ENDIF
+ DO 180 M=1,NCN,MST
+ ICN(NOP(N,M))=2
+ 180 CONTINUE
+ ENDIF
+ 200 END DO
+!
+! test ISW
+! if isw=0 then delete all midsides except at transition
+! if isw=1 then delete only midsides that are truely in the middle
+!
+ IF(ISW .EQ. 0) THEN
+ DO 400 N=1,NE
+!IPKOCT93 IF(IMAT(N) .LT. 901) THEN
+ IF(IMAT(N) .LT. 901 .OR. IMAT(N) .GT. 903) THEN
+ IF(NCORN(N) .EQ. 5) THEN
+ NCN=3
+ ELSE
+ NCN=NCORN(N)
+ ENDIF
+
+ DO 350 M=2,NCN,2
+ J=NOP(N,M)
+!SEP93 IPK
+ IF(J .EQ. 0) GO TO 350
+!SEP93 IPK
+ IF(ICN(J) .NE. 1) THEN
+ NOP(N,M)=0
+ IF(ICN(J) .EQ. 0) THEN
+!
+! Remove node now
+!
+ CORD(J,1)=VOID
+ CORD(J,2)=VOID
+ XUSR(J) = VOID
+ YUSR(J) = VOID
+ INSKP(J)=1
+ INEW(J) = 0
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+!IPK MAY03
+ ICHG=0
+ IF(NPLAST .GT. J) NPLAST=J
+ ENDIF
+ ENDIF
+ 350 CONTINUE
+ ENDIF
+ 400 CONTINUE
+ ELSE
+ DO 600 N=1,NE
+ IF(IMAT(N) .LT. 901) THEN
+ IF(NCORN(N) .EQ. 5) THEN
+ NCN=3
+ ELSE
+ NCN=NCORN(N)
+ ENDIF
+ DO 550 M=2,NCN,2
+ J1=M-1
+ IF(M .EQ. NCN) THEN
+ J2=1
+ ELSE
+ J2=M+1
+ ENDIF
+ J=NOP(N,M)
+!ipk jul99
+ if(j .gt. 0) then
+!ipk jan01
+ IF(INEW(J) .EQ. 0 .or. inew(j) .eq. 2) THEN
+ inew(j)=0
+ NOP(N,M)=0
+ GO TO 550
+ ENDIF
+ else
+ go to 550
+ endif
+ !
+! Test for distance separation of midside node
+!
+ XMID=(CORD(NOP(N,J1),1)+CORD(NOP(N,J2),1))/2.
+ YMID=(CORD(NOP(N,J1),2)+CORD(NOP(N,J2),2))/2.
+ DM=SQRT((XMID-CORD(J,1))**2+(YMID-CORD(J,2))**2)
+ DL=DIST(J1,J2)
+ IF(DM .LT. 0.005*DL) THEN
+ IF(ICN(J) .NE. 1) THEN
+ NOP(N,M)=0
+ IF(ICN(J) .EQ. 0) THEN
+!
+! Remove node now
+!
+ CORD(J,1)=VOID
+ CORD(J,2)=VOID
+ XUSR(J) = VOID
+ YUSR(J) = VOID
+ INSKP(J)=1
+ INEW(J) = 0
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+!IPK MAY03
+ ICHG=0
+ IF(NPLAST .GT. J) NPLAST=J
+ ENDIF
+ ENDIF
+ ENDIF
+ 550 CONTINUE
+ ENDIF
+ 600 CONTINUE
+ ENDIF
+!IPK FEB08 RESET NP
+
+ DO J=NP,1,-1
+ IF(INEW(J) .NE. 0) THEN
+ JJ=J
+ GO TO 625
+ ENDIF
+ ENDDO
+ 625 CONTINUE
+ NP=JJ
+
+ RETURN
+!-
+!-.....FIND MISSING NODE NUMBERS.....
+!-
+ 650 CONTINUE
+ DO 700 I=1,MAXP
+ 700 ICN(I) = 0
+ DO 725 J = 1, NE
+ IF( IMAT(J) .EQ. 0 ) GO TO 725
+ DO 720 K = 1, 8
+ IF( NOP(J,K) .LE. 0) GOTO 720
+ ICN(NOP(J,K))=999
+ 720 CONTINUE
+ 725 END DO
+!
+! Remove nodes
+!
+ DO 800 J=1,NP
+ IF(ICN(J) .EQ. 0) THEN
+ CORD(J,1)=VOID
+ CORD(J,2)=VOID
+ XUSR(J) = VOID
+ YUSR(J) = VOID
+ INSKP(J)=1
+ INEW(J) = 0
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ IF(NPLAST .GT. J) NPLAST=J
+ !IPK MAY03
+ ICHG=0
+ ENDIF
+ 800 END DO
+
+!IPK FEB08 RESET NP
+
+ DO J=NP,1,-1
+ IF(INEW(J) .NE. 0) THEN
+ JJ=J
+ GO TO 900
+ ENDIF
+ ENDDO
+ 900 CONTINUE
+ NP=JJ
+ RETURN
+ END
+!****************************************************************
+!
+ subroutine prox2(x,y,npts,xx,yy,ipt,xx2,yy2,ipt2,iflag,inskp,ibox)
+ save
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ CHARACTER*1 ALABL(10)
+ CHARACTER*40 MPDUM
+ COMMON /BLKA1/ TITLE,HLABL,ALABL ,MPDUM
+!ipk oct 95 lines defining MPDUM added
+!
+!ipk jan01 expand IPSW
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!
+ integer*2 inskp(*)
+!IPK MAY02
+ REAL*8 x(*),y(*)
+ character*1 iflag
+!
+! if(ibox .eq. 0) then
+! nbx=2
+! call boxr(nbx)
+! endif
+!
+! Get location of cursor
+!
+ 10 call xyloc(xscrn,yscrn,iflag,ibox)
+ if(irmain .eq. 1) return
+ if(ibox .eq. 10) then
+ iflag = 'q'
+ return
+ elseif(ibox .eq. 9) then
+ iflag = 'r'
+ endif
+!
+!
+ if (iflag .eq. 'q') then
+ return
+ elseif(iflag .eq. 'r') then
+ return
+ elseif(iflag .ne. 'c') then
+ ibox=0
+ if(iflag .eq. 't') return
+ if(iflag .eq. 'l') return
+ if(iflag .eq. 'f') return
+ if(iflag .eq. 'e') return
+ if(iflag .eq. 'a') return
+ if(iflag .eq. 'j') return
+ if(iflag .eq. 'z') return
+ if(iflag .eq. 'n') return
+ if(iflag .eq. 'g') return
+ if(iflag .eq. 'h') return
+!
+ if(iflag .eq. 'm') go to 12
+!ipk jan98 write(*,*) char(7),char(7)
+ go to 10
+ endif
+!
+! Compare to coordinates
+!
+ ipt2=0
+ 12 d = 1.E+20
+ do 20 i=1,npts
+ if(inskp(i) .ne. 0) go to 20
+ dist = sqrt( (xscrn-x(i))**2 + (yscrn-y(i))**2)
+ if (dist .lt. d) then
+ if(i .ne. ipt) then
+ xx2=x(i)
+ yy2=y(i)
+ ipt2=i
+ d = dist
+ go to 20
+ endif
+ endif
+ 20 continue
+ return
+!
+ END
+ SUBROUTINE CVF(FPN,IDEC,NUMSTR,NUMC)
+!
+! Routine to convert number to array and prepare for plotting
+!
+ CHARACTER*36 NUMSTR
+ CHARACTER*36 FMT,FMT1
+
+ IF(FPN .NE. 0.) THEN
+ if(idec .eq. 1) then
+ NDIG = ALOG10(ABS(FPN)+0.05)
+ elseif(idec .eq. 2) then
+ NDIG = ALOG10(ABS(FPN)+0.005)
+ elseif(idec .eq. 3) then
+ NDIG = ALOG10(ABS(FPN)+0.0005)
+ else
+ NDIG = ALOG10(ABS(FPN)+0.50005)
+ endif
+ ELSE
+ NDIG = 0
+ ENDIF
+!
+! Check for Numbers than 10
+!
+ IF(NDIG .LE. 0) THEN
+!
+! Check for negative numbers
+!
+ IF(FPN .LT. 0.) THEN
+!
+! Check for integer plot
+!
+ IF(IDEC .LT. 0) THEN
+ NUMC = 2
+ IF(FPN .EQ. 0) NUMC=1
+ ELSE
+!
+! This is a negative number less than 10
+!
+ NUMC = IDEC+3
+ ENDIF
+!
+! Check for integer plot probably a zero
+!
+ ELSEIF(IDEC .LT. 0) THEN
+ NUMC = 1
+ ELSE
+!
+! This is a positive number less than 1
+!
+ NUMC = IDEC+2
+ ENDIF
+!
+! Now check numbers of magnitude greater than 1
+!
+ ELSEIF(FPN .LT. 0.) THEN
+!
+! Check for integer plot. A negative number
+!
+ IF(IDEC .LT. 0) THEN
+ NUMC = NDIG+2
+ ELSE
+!
+! This is a negative number smaller than -1.
+!
+ NUMC = IDEC+NDIG+3
+ ENDIF
+
+!
+! Check for integer plot. A positive number
+!
+ ELSEIF(IDEC .LT. 0) THEN
+ NUMC = NDIG+1
+ ELSE
+!
+! This is a positive number greater than 1.
+!
+ NUMC = IDEC+NDIG+2
+ ENDIF
+ IF(IDEC .LT. 0) THEN
+ IF(FPN .LT. 0.) THEN
+ NUM = FPN-0.5
+ ELSE
+ NUM = FPN+0.5
+ ENDIF
+ WRITE(FMT,97) NUMC
+ WRITE(NUMSTR,FMT) NUM
+ 97 FORMAT('(I',i1,')')
+ ELSE
+!ipk mar95 fix bug that causes error when IDEC >12
+ if(idec .gt. 9) then
+ write(fmt1,99) numc,idec
+ 99 format('(F',i2,'.',i2,')')
+ else
+ WRITE(FMT1,98) NUMC,IDEC
+ 98 FORMAT('(F',i2,'.',i1,')')
+ endif
+ WRITE(NUMSTR,FMT1) FPN
+ ENDIF
+ RETURN
+ END
+!ipk oct96 routines below added
+
+ SUBROUTINE GTCHARX(DATA,NDIG,XLC,YLC)
+ COMMON /RECOD/ IRECD,TSPC
+
+ CHARACTER*32 DATA
+ if(irecd .eq. 2) then
+ read(91,'(A32)') DATA
+ CALL INTRVL(TA,0)
+ 70 CALL INTRVL(TA,1)
+ IF(TA .LT. TSPC) GO TO 70
+ return
+ endif
+
+ 80 CONTINUE
+ DO 90 I=1,NDIG
+ DATA(I:I)=' '
+ 90 END DO
+!
+ I = 1
+ 10 CONTINUE
+ I = I+1
+ call keybrd(key)
+ IF (KEY .EQ. 8) THEN
+ I = I-2
+ xp=XLC+(i+1)*0.20
+ call drblk(xp,YLC+0.23,0.20,0.30,-11)
+ GO TO 10
+ ENDIF
+ IF(KEY .EQ. 13 .OR. I .EQ. ndig+2) GO TO 200
+ if(key .eq. 1072 .or. key .eq. 1075 .or. key .eq. 1077 .or.&
+ & key .eq. 1080) go to 200
+ DATA(I-1:I-1)=CHAR(KEY)
+ xp=XLC+i*0.20
+ call drblk(xp,YLC+0.23,0.20,0.30,-11)
+ call rblue
+ call symbl(xp,YLC,0.20,data(i-1:i-1),0.0,1)
+ 100 CONTINUE
+ GO TO 10
+ 200 CONTINUE
+ NDIG=I-2
+ call rblue
+ RETURN
+!ipk mar94 add
+ END
+ SUBROUTINE DRBLK(XS,YS,XL,YL,ICOL)
+ DIMENSION X(4),Y(4)
+ X(1)=XS
+ X(2)=XS
+ X(3)=XS+XL
+ X(4)=XS+XL
+ Y(1)=YS
+ Y(2)=YS-YL
+ Y(3)=Y(2)
+ Y(4)=YS
+! WRITE(90,*) 'GOING TO POLYFL',X,Y,ICOL
+ CALL POLYFL(X,Y,4,ICOL)
+ call rblue
+ RETURN
+ END
+ SUBROUTINE GTFPNX(FPN,NDEC,NDIG,XLC,YLC)
+ CHARACTER*11 DATA
+ CHARACTER*30 MES
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ DATA MES/'Error reading number, Reenter.'/
+ 80 CONTINUE
+ DO 90 I=1,11
+ DATA(I:I)=' '
+ 90 END DO
+!
+ I = 1
+ NDEC=-2
+ 10 CONTINUE
+ I = I+1
+ call keybrd(key)
+! WRITE(90,*) 'BACK FROMKEYBRD',KEY,I
+ IF (KEY .EQ. 8) THEN
+ I = I-2
+ xp=xlc+(i+1)*0.20
+ call drblk(xp,ylc+0.23,0.20,0.30,13)
+ GO TO 10
+ ENDIF
+ IF(KEY .EQ. 46) THEN
+ NDEC=-1
+ ENDIF
+ IF(KEY .EQ. 13) GO TO 200
+ if(key .eq. 1072 .or. key .eq. 1075 .or. key .eq. 1077 .or.&
+ & key .eq. 1080) go to 200
+ IF(NDEC .GE. -1) NDEC=NDEC+1
+ DATA(I:I)=CHAR(KEY)
+! WRITE(90,'(A)') ' GETTING CHAR',DATA(I:I)
+ xp=xlc+i*0.20
+! WRITE(90,*) 'GOING TO DRBLK',XP,YLC
+ call drblk(xp,ylc+0.23,0.20,0.30,-11)
+! WRITE(90,*) 'BACK FROM DRBLK'
+ call rblue
+ call symbl(xp,ylc,0.20,data(i:i),0.0,1)
+ 100 CONTINUE
+ GO TO 10
+ 200 CONTINUE
+ NDIG=I-2
+ READ(DATA,5000,ERR=300) FPN
+ 5000 FORMAT(1X,F10.0)
+ call rblue
+ RETURN
+ 300 CONTINUE
+ CALL SYMBL(3.0,1.73,0.20,MES,0.0,30)
+ GO TO 80
+ END
+ SUBROUTINE GTINTX(INUM,NDIG,XLC,YLC)
+ CHARACTER*11 DATA
+ CHARACTER*30 MES
+ DATA MES/'Error reading integer, Reenter'/
+ 80 CONTINUE
+ DO 90 I=1,11
+ DATA(I:I)=' '
+ 90 END DO
+!
+ I = 1
+ 10 CONTINUE
+ I = I+1
+ call keybrd(key)
+ IF (KEY .EQ. 8) THEN
+ I = I-2
+ xp=xlc+(i+1)*0.20
+ call drblk(xp,ylc+0.00,0.20,0.32,-11)
+ GO TO 10
+ ENDIF
+ IF(KEY .EQ. 13) GO TO 200
+ if(key .eq. 1072 .or. key .eq. 1075 .or. key .eq. 1077 .or.&
+ & key .eq. 1080) go to 200
+ DATA(I:I)=CHAR(KEY)
+ xp=xlc+i*0.20
+ call drblk(xp,ylc+0.00,0.20,0.32,-11)
+ call rblue
+ call symbl(xp,ylc-0.20,0.20,data(i:i),0.0,1)
+ 100 CONTINUE
+ GO TO 10
+ 200 CONTINUE
+ NDIG=I-2
+ READ(DATA,5000,ERR=300) INUM
+ 5000 FORMAT(1X,I10)
+ call rblue
+ RETURN
+ 300 CONTINUE
+ CALL SYMBL(3.0,1.73,0.20,MES,0.0,30)
+ GO TO 80
+ END
+ SUBROUTINE WRTBOX(IDELV)
+ dimension x(5),y(5)
+ CHARACTER*6 label
+ COMMON /SSIZE/ HSIZE
+ DATA label/'(e)lsw'/
+!
+! Draw box around selections with colour
+!
+ Y(1)=7.5
+ Y(2)=7.5
+ Y(3)=7.995
+ Y(4)=7.995
+ Y(5)=7.5
+ X(1)=6.0*HSIZE/10.
+ X(2)=7.0*HSIZE/10.
+ X(3)=7.0*HSIZE/10.
+ X(4)=6.0*HSIZE/10.
+ X(5)=6.0*HSIZE/10.
+ IF(IDELV .EQ. 1) THEN
+ IBLK=12
+ ELSE
+ IBLK= 8
+ ENDIF
+ CALL POLYFL(X,Y,5,IBLK)
+ CALL RBLACK
+ CALL PLOTT(X(1),Y(1),3)
+ CALL PLOTT(X(2),Y(2),2)
+ CALL PLOTT(X(3),Y(3),2)
+ CALL PLOTT(X(4),Y(4),2)
+ CALL PLOTT(X(1),Y(1),2)
+ call symbl(6.02*hsize/10.,7.6,0.20,label,0.0,6)
+ RETURN
+ END
+
+ SUBROUTINE UNDOACT
+
+ USE BLK1MOD
+! INCLUDE '!BLK1.COM'
+
+! IF(NEUNDO .GT. 0) THEN
+! DO N=1,NEUNDO
+! J=IELDEL(N)
+! CALL DELTEL(J)
+! ENDDO
+! ELSE
+! RETURN
+! ENDIF
+ IF(NPUNDO .GT. 0) THEN
+ DO N=1,NPUNDO
+ J=NODDEL(N)
+ if(j .gt. 0) CALL DELETN(J)
+ ENDDO
+ ENDIF
+ NPUNDO=0
+ NEUNDO=0
+ WRITE(90,*) 'NESAV,NEFSAV',NESAV,NEFSAV,NE,NENTRY
+ IF(NESAV .GT. 0) THEN
+ DO J=1,NESAV
+ DO K=1,8
+ NOP(J,K)=NOPSV(J,K)
+ ENDDO
+ NCN = 2
+ IF (NOP(J,3) .NE. 0) NCN = 3
+ IF (NOP(J,4) .NE. 0) NCN = 4
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .NE. 0) NCN = 5
+ IF (NOP(J,5) .NE. 0 .AND. NOP(J,4) .EQ. 0) NCN = 6
+ IF (NOP(J,6) .NE. 0) NCN = 6
+ IF (NOP(J,7) .NE. 0) NCN = 8
+ NCORN(J) = NCN
+ IESKP(J) = 0
+ IMAT(J)=IMATSV(J)
+ ENDDO
+ NE=NESAV
+ ENDIF
+ NESAV=0
+ IF(NENTRY .GT. NEFSAV) THEN
+ IF(NEFSAV .GT. 0) THEN
+ DO N=1,NEFSAV
+ DO M=1,3
+ NEF(N,M)=NEFSV(N,M)
+ ENDDO
+ ENDDO
+ ENDIF
+ NENTRY=NEFSAV
+ ENDIF
+ NEFSAV=NENTRY
+ CALL PLOTOT(-1)
+ CALL HEDR
+ RETURN
+ END
+
+ SUBROUTINE GETXC
+
+ USE BLK1MOD
+
+ DO J=1,NE
+ XXC=0.
+ YYC=0.
+ IF(IMAT(J) .EQ. 0) GO TO 50
+ NCN = NCORN(J)
+ IF(NCN .EQ. 9) THEN
+ NCNR=8
+ ELSE
+ NCNR=NCN
+ ENDIF
+ DO 25 K=1,NCNR
+ N = NOP(J,K)
+!
+ IF (N .EQ. 0) GO TO 25
+ IF (CORD(N,1) .LT. VDX) GOTO 25
+! !
+ IF (NCN .NE. 5 .OR. K .LT. 5) THEN
+ IF (MOD(K,2) .EQ. 1) THEN
+ XXC = XXC + CORD(N,1)
+ YYC = YYC + CORD(N,2)
+ ENDIF
+ ENDIF
+ 25 END DO
+
+ IF(NCN .LT. 9) THEN
+ XC(J) = 2.*XXC/NCN
+ YC(J) = 2.*YYC/NCN
+ ELSE
+ XC(J)= CORD(NOP(J,9),1)
+ YC(J)= CORD(NOP(J,9),2)
+ ENDIF
+ 50 CONTINUE
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE DELETEM
+ USE WINTERACTER
+ USE BLK1MOD
+ SAVE
+
+! implicit none
+
+ include 'd.inc'
+
+ INCLUDE 'TXFRM.COM'
+
+ INCLUDE 'BFILES.I90'
+
+ CHARACTER*1 IFLAG
+ CHARACTER*24 MESSAG
+ INTEGER NTYPR,ITIMETHRU
+ DATA MESSAG/'GET ELEMENT TYPE NUMBER '/
+
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ call wdialogload(IDD_GETINT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_GETINT)
+ ierr=infoerror(1)
+ NFD=0
+ CALL WDialogPutString(IDF_STRING1,MESSAG)
+ CALL WDialogPutInteger(IDF_INTEGER1,NFD)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+! Branch depending on type of message.
+!
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetInteger(IDF_INTEGER1,NFD)
+ GO TO 200
+ ENDIF
+ ENDDO
+200 CONTINUE
+ IF(NFD .EQ. 0) RETURN
+! ASK FOR ELEMENT NUMBER
+! LOOP ON ELEMENTS DROPPING ELEMENTS OF GIVEN TYPE
+ DO N=1,NE
+ IF(IMAT(N) .EQ. NFD) THEN
+ DO K=1,8
+ NOP(N,K)=0
+ ENDDO
+ IMAT(N)=0
+ NCORN(N)=0
+ ENDIF
+ ENDDO
+ RETURN
+ END
+
+!
+!****************************************************************
+!
+ subroutine proxel(x,y,npts,xx,yy,ipt,iflag,inskp,ibox,neac)
+! x=array of x node locations
+! y=array of y node location
+! npts= max number of nodes
+! xx=x screen lpcation
+! yy=y screen location
+! iflag=character flag
+! inskp=array telling nodes to skip
+! ibox=any box checked
+ save
+ CHARACTER*80 TITLE
+ CHARACTER*24 HLABL
+ CHARACTER*1 ALABL(10)
+ CHARACTER*40 MPDUM
+ COMMON /BLKA1/ TITLE,HLABL,ALABL &
+ & ,MPDUM
+!ipk oct 95 lines defining MPDUM added
+!
+!ipk jan01 expand IPSW
+ COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout
+!
+ integer*2 inskp(*)
+ INTEGER neac(*)
+!IPK MAY02
+ REAL*8 x(*),y(*)
+ character*1 iflag
+!
+! if(ibox .eq. 0) then
+! nbx=2
+! call boxr(nbx)
+! endif
+!
+! Get location of cursor
+!
+ 10 call xyloc(xscrn,yscrn,iflag,ibox)
+! write(90,*) 'ibox,xscrn,yscrn',ibox,xscrn,yscrn,irmain
+! write(90,7893) iflag
+ 7893 format(' iflag',a2)
+! read(*,*) junk
+ if(irmain .eq. 1) return
+ if(ibox .eq. 10) then
+ iflag = 'q'
+ return
+ elseif(ibox .eq. 9) then
+ iflag = 'r'
+! elseif(ibox .eq. 7) then
+! iflag = 'a'
+ endif
+!
+!
+ if (iflag .eq. 'q') then
+ return
+ elseif(iflag .eq. 'r') then
+ return
+ elseif(iflag .ne. 'c') then
+
+ ibox=0
+ if(iflag .eq. 't') return
+ if(iflag .eq. 'l') return
+ if(iflag .eq. 'f') return
+ if(iflag .eq. 'e') return
+ if(iflag .eq. 'a') return
+ if(iflag .eq. 'j') return
+ if(iflag .eq. 'z') return
+ if(iflag .eq. 'n') return
+ if(iflag .eq. 'g') return
+ if(iflag .eq. 'h') return
+!ipk oct96 add line below
+ if(iflag .eq. 'b') return
+ if(iflag .eq. 'U') return
+!
+ if(iflag .eq. 'm') go to 12
+!ipk jan98 write(*,*) char(7),char(7)
+ go to 10
+ endif
+!
+! Compare to coordinates
+ 12 d = 1.E+20
+ do ii=1,8
+ i=neac(ii)
+ if(neac(ii) .eq. 0) cycle
+!! write(*,*) 'i,npts',i,npts,inskp(i),x(i),y(i)
+ if(inskp(i) .ne. 0) cycle
+ dist = sqrt( (xscrn-x(i))**2 + (yscrn-y(i))**2)
+ if (dist .lt. d) then
+ d = dist
+ ipt = i
+ xx = x(i)
+ yy = y(i)
+ endif
+ enddo
+ return
+!
+!
+ END
+
\ No newline at end of file
diff --git a/src/src83e/WINNEW.F90 b/src/src83e/WINNEW.F90
new file mode 100644
index 0000000..4b6ec46
--- /dev/null
+++ b/src/src83e/WINNEW.F90
@@ -0,0 +1,729 @@
+!IPK LAST UPDATE SEP 23 2015 REVISE org NUMBERS
+ SUBROUTINE get_label(dlin,title)
+
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: ITYPE,ierr
+
+ character*40 dlin,title
+ write(90,'(a)') 'dlin',dlin
+ write(90,'(a)') 'lind',title
+
+ call wdialogload(IDD_DIALOG1)
+ ierr=infoerror(1)
+
+ write(90,'(a)') 'dlin-0',dlin
+ write(90,'(a)') 'lind-0',title
+ CALL WDialogPutString(idf_label5,dlin)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG1)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+
+ do
+!! CALL WMessage(ITYPE,MESSAGE)
+!
+! Branch depending on type of message.
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetstring(idf_string24,title)
+ write(90,'(a)') 'dlin-1',dlin
+ write(90,'(a)') 'lind-1',title
+ return
+ endif
+ return
+ enddo
+
+ return
+
+ end
+
+! ----------------------------------------------------------------------------
+
+ subroutine labl(x,y,llen,ht,string)
+ USE WINTERACTER
+ character*(*) string
+ integer llen
+ character*80 outstring
+ data rsclx,rscly/100.,100./
+ DO i=1,llen
+ outstring(i:i)=string(i:i)
+ ENDDO
+
+ ix=x*rsclx
+ iy=y*rscly
+ CALL gim_a_string(ix,iy,ht,outstring,llen)
+ RETURN
+ end
+
+ SUBROUTINE gim_a_string(ix,iy,ht,outstring,lenth)
+ USE WINTERACTER
+ CHARACTER*(*) OUTSTRING
+ CALL WGrTextFont(102,0,ht*0.0133333,ht*0.04)
+! CALL IGrCharSet(' ')
+! CALL IGrCharSize(ht,ht)
+ call WGrTextOrientation(0)
+! CALL IGrCharJustify('L')
+ x=ix/100.
+ y=iy/100.
+ CALL WGrTextString(x,y,outstring(:lenth))
+
+! CALL IGrCharOut(x,y,outstring(:lenth))
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE change_color(icl)
+ USE WINTERACTER
+ DIMENSION ICOLRS(0:16)
+
+ data icolrs/224,0,160,175,159,112,128,96,80,&
+ 48,63,24,16,47,223,7,224/
+! 240
+ ICV=ICOLRS(mod(ICL,16))
+ CALL IGrcolourN(ICV)
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE fill_a_polygon(x,y,npts)
+ USE WINTERACTER
+ dimension x(*),y(*)
+ CALL IGrFillPattern(4,0,0)
+ call IGrPolygonComplex(x,y,npts)
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE gim_a_charac(key,cha,x,y)
+ USE WINTERACTER
+ CHARACTER*(*) cha
+ INTEGER :: ITYPE, KEY
+ INTEGER, PARAMETER :: ID_EXIT = 40002
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ 100 CONTINUE
+
+ CALL WMessage(ITYPE, MESSAGE)
+ SELECT CASE (ITYPE)
+ CASE (KeyDown) ! Key pressed
+ KEY = MESSAGE%VALUE1
+ MOUSEX = MESSAGE%X
+ MOUSEY = MESSAGE%Y
+
+! check key status
+ if(KEY .lt. 127) then
+ cha=char(KEY)
+ go to 250
+ else
+ go to 100
+ endif
+ CASE (MenuSelect) ! Menu item selected
+ SELECT CASE (MESSAGE%VALUE1)
+ CASE (ID_EXIT)
+ call WindowClose
+ END SELECT
+ END SELECT
+ GO TO 100
+ 250 CONTINUE
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE clear_screen
+ USE WINTERACTER
+ INCLUDE 'TXFRM.COM'
+ TYPE (WIN_FONT) :: FONT
+! FONT%IBCOL = TextWhite
+! CALL WindowFont(FONT)
+! IRGB = WRGB(220,220,220)
+ CALL WindowClear(rgb=irgb) ! clear to yellow
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE gim_a_line(ix,iy)
+ USE WINTERACTER
+ x=ix/100.
+ y=iy/100.
+ CALL IGrLineto(x,y)
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE move_da_pointer(ix, iy)
+ USE WINTERACTER
+ x=ix/100.
+ y=iy/100.
+ CALL IGrMoveto(x,y)
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE clear_box
+ USE WINTERACTER
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ dimension x(4),y(4)
+ x(1)=0.
+ x(2)=HSIZE
+ x(3)=HSIZE
+ x(4)=0.
+ y(1)=7.50
+ y(2)=7.50
+ y(3)=8.0
+ y(4)=8.0
+
+ call Rwhite
+
+ call IGrColourN(48)
+
+ CALL IGrFillPattern(4,0,0)
+
+ call IGrPolygonComplex(x,y,4)
+
+ call RBlue
+
+ return
+ END SUBROUTINE
+
+ SUBROUTINE get_rid_window
+ USE WINTERACTER
+ call WindowClose
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE flush_screen
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE RMINFO
+
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ LOGICAL :: OPENED
+ INTEGER :: IERR
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ call wdialogload(IDD_DIALOG09)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG09)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ return
+ endif
+ return
+ enddo
+
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE GETMDIS(nmapf,nsigf,icolsw,rad,colint)
+
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+ CHARACTER(LEN=255) :: FNAME
+ CHARACTER(LEN=3) :: SUB
+ LOGICAL :: OPENED
+ INTEGER :: IERR,NMAPF,NSIGF,icolsw
+ REAL :: RAD,COLINT
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+
+ call wdialogload(IDD_DIALOG10)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_DIALOG10)
+ ierr=infoerror(1)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER1,nsigf)
+
+ CALL WDialogPutINTEGER(IDF_INTEGER2,nmapf)
+
+ CALL WDialogPutReal(IDF_REAL1,rad)
+
+ CALL WDialogPutReal(IDF_REAL2,colint)
+
+ call wdialogputcheckbox(idf_check1,icolsw)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,nsigf)
+
+ CALL WDialogGetINTEGER(IDF_INTEGER2,nmapf)
+
+ call wdialogGetcheckbox(idf_check1,icolsw)
+
+ CALL WDialogGetReal(IDF_REAL1,rad)
+
+ CALL WDialogGetReal(IDF_REAL2,colint)
+
+ return
+ endif
+ return
+ enddo
+
+ RETURN
+ END SUBROUTINE
+
+ SUBROUTINE THICKL
+ CALL IGrLineWidth(2,2,2)
+ RETURN
+ END
+
+ SUBROUTINE THINL
+ CALL IGrLineWidth(1,1,1)
+ RETURN
+ END
+
+ SUBROUTINE OUTORG(FNAME)
+
+ CHARACTER(LEN=255) :: FNAME
+
+ INCLUDE 'TXFRM.COM'
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
+!!! WRITE(104,'(4G16.8)') -XS,-YS,HSIZE*TXSCAL-XS,7.5*TXSCAL-YS
+ WRITE(104,'(4G16.8)') -XS,-YS,HSIZE*TXSCAL-XS,8.0*TXSCAL-YS
+ CLOSE(104)
+ RETURN
+ END
+
+ SUBROUTINE DRAWBK(I,IMZ)
+
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ INCLUDE 'BFILES.I90'
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ IF(IMZ .EQ. -1) THEN
+ VRANGE=7.5
+ ELSE
+ VRANGE=8.0
+ ENDIF
+ XBKMN=((BFMINMAX(I,1)+XS)/TXSCAL)/HSIZE
+ XBKMX=((BFMINMAX(I,3)+XS)/TXSCAL)/HSIZE
+ YBKMN=((BFMINMAX(I,2)+YS)/TXSCAL)/VRANGE
+ YBKMX=((BFMINMAX(I,4)+YS)/TXSCAL)/VRANGE
+! WRITE(90,*) 'BACKGND',XBKMN,XBKMX,YBKMN,YHSIZEBKMX
+ IF(XBKMN .GT. 1.) RETURN
+ IF(XBKMX .LT. 0.) RETURN
+ IF(YBKMN .GT. 1.) RETURN
+ IF(YBKMX .LT. 0.) RETURN
+ XRANGE=XBKMX-XBKMN
+ YRANGE=YBKMX-YBKMN
+ IF(XBKMX .GT. 1.) THEN
+ XGRMX=(1.-XBKMN)/XRANGE
+ XBKMX=1.0
+ ELSE
+ XGRMX=1.
+ ENDIF
+ IF(XBKMN .LT. 0.) THEN
+ XGRMN=-XBKMN/XRANGE
+ XBKMN=0.
+ ELSE
+ XGRMN=0.
+ ENDIF
+ IF(YBKMX .GT. 1.) THEN
+ YGRMX=(1.-YBKMN)/YRANGE
+ YBKMX=1.0
+ ELSE
+ YGRMX=1.
+ ENDIF
+ IF(YBKMN .LT. 0.) THEN
+ YGRMN=-YBKMN/YRANGE
+ YBKMN=0.
+ ELSE
+ YGRMN=0.
+ ENDIF
+! WRITE(90,*) 'BACKGN2',XBKMN,XBKMX,YBKMN,YBKMX
+! WRITE(90,*) 'XGR ',XGRMN,YGRMN,XGRMX,YGRMX
+ CALL IGrArea(XBKMN,YBKMN,XBKMX,YBKMX)
+ CALL IGrReplayArea(XGRMN,YGRMN,XGRMX,YGRMX)
+ call IGrReplay(BFNAME(I))
+ CALL IGrArea(0.0,0.0,1.0,1.0)
+ RETURN
+ END
+
+ SUBROUTINE DRAWBKBM(I,IMZ)
+
+ USE WINTERACTER
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+
+ CHARACTER*1 IFLAG
+ INTEGER, DIMENSION(6) :: INFO
+
+ INCLUDE 'TXFRM.COM'
+!IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL
+
+ INCLUDE 'BFILES.I90'
+! DATA IHAND1,IHAND2/0,0/
+ INTEGER :: iw,ih,ihandle,ient,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
+ common /hands/ ihandle,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
+
+ XBKMN=((BFMINMAX(I,1)+XS)/TXSCAL)
+ XBKMX=((BFMINMAX(I,3)+XS)/TXSCAL)
+ YBKMN=((BFMINMAX(I,2)+YS)/TXSCAL)
+ YBKMX=((BFMINMAX(I,4)+YS)/TXSCAL)
+! WRITE(90,*) 'BACKGND-cm',XBKMN,XBKMX,YBKMN,YBKMX
+ CALL IGrUnitsToPixels(0.,0.,IXPM,IYPM)
+ CALL IGrUnitsToPixels(HSIZE,8.0,IXPXC,IYPXC)
+! WRITE(90,*) 'PIXELS',IXPM,IYPXC-IYPXC,IXPXC,IYPXC-IYPM
+ CALL IGrUnitsToPixels(XBKMN,YBKMN,IXPM,IYPM)
+ CALL IGrUnitsToPixels(XBKMX,YBKMX,IXPX,IYPX)
+ IYPX=IYPXC-IYPX
+ IYPM=IYPXC-IYPM
+! WRITE(90,*) 'PIXELS',IXPM,IYPX,IXPX,IYPM,IXPXC,IYPXC
+ IF(XBKMN .GT. HSIZE) RETURN
+ IF(XBKMX .LT. 0.) RETURN
+ IF(YBKMN .GT. 8.) RETURN
+ IF(YBKMX .LT. 0.) RETURN
+ CALL IGrFileInfo(BFNAME(I),INFO,6)
+! WRITE(90,*)'BITMAP INFO',INFO
+ IF(INFO(1) .EQ. 1 .or. info(1) .eq. 2 .or. info(1) .eq. 15 .or. info(1) .eq. 19) THEN
+ IXPIX=INFO(2)
+ IYPIX=INFO(3)
+ ENDIF
+ XRANGE=IXPX-IXPM
+ YRANGE=IYPM-IYPX
+! WRITE(90,*) 'RANGE',XRANGE,YRANGE
+ FRACX1=0.
+ FRACX2=0.
+ FRACY1=0.
+ FRACY2=0.
+ IF(IXPX .GT. IXPXC) THEN
+ FRACX1=(IXPX-IXPXC)/XRANGE
+ IXPX = IXPXC
+ ENDIF
+ IF(IYPM .GT. IYPXC) THEN
+ FRACY1=(IYPM-IYPXC)/YRANGE
+ IYPM = IYPXC
+ ENDIF
+ IF(IXPM .LT. 0) THEN
+ FRACX2=-IXPM/XRANGE
+ IXPM=0
+ ENDIF
+ IF(IYPX .LT. 0) THEN
+ FRACY2=-IYPX/YRANGE
+ IYPX=0
+ ENDIF
+
+! WRITE(90,*) 'BACKGN2-bm',IXPM,IYPX,IXPX,IYPM
+! WRITE(90,*) 'FRAC-bm ',FRACX1,FRACX2,FRACY1,FRACY2
+ IF(IHAND1 .NE. 0) THEN
+ CALL WBitmapDestroy(IHAND1)
+ CALL WBitmapDestroy(IHAND2)
+ ENDIF
+! WRITE(90,*) 'PIXEL INFO',IXPIX,IYPIX
+ CALL WBitMapCreate(IHAND1,IXPIX,IYPIX)
+ IERR = InfoError(LastError)
+! WRITE(90,*) 'ERROR CREATE', IERR,IHAND1
+ CALL IGrSelect(DrawBitmap,IHAND1)
+ if(ihand1 .eq. 0) then
+ IERR = InfoError(LastError)
+ CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,&
+ 'Too many pixels for image to display correctly '//CHAR(13)//'Image will not register ','IMAGE ERROR')
+ endif
+! WRITE(90,*) 'ERROR SELECT', IERR
+ CALL IGrLoadImage(BFNAME(I),1)
+ IERR = InfoError(LastError)
+! WRITE(90,*) 'ERROR LOAD', IERR
+
+ IX2PIX=IXPIX*(1.-FRACX1-FRACX2)
+ IY2PIX=IYPIX*(1.-FRACY1-FRACY2)
+ IXLPIX=IXPIX*FRACX2
+ IYLPIX=IYPIX*FRACY2
+ IXMPIX=IXPIX*(1.-FRACX1)
+ IYMPIX=IYPIX*(1.-FRACY1)
+! WRITE(90,*) 'HANDL2',IHAND2,IX2PIX,IY2PIX
+! WRITE(90,*) 'LOCAL ',IXLPIX,IYLPIX,IXMPIX,IYMPIX
+ CALL WBitMapCreate(IHAND2,IX2PIX,IY2PIX)
+ CALL IGrSelect(DrawBitmap,IHAND2)
+ CALL WBitMapPutPart(IHAND1,0,IXLPIX,IYLPIX,IXMPIX,IYMPIX)
+ IF(IDDSW .EQ. 1) THEN
+ CALL IGrSelect(DrawWin)
+ ELSE
+ CALL IGrSelect(DrawBitmap,IHANDLE)
+ ENDIF
+ IERR = InfoError(LastError)
+! WRITE(90,*) 'ERROR SELECT DRAW', IERR
+ CALL WBitmapPut(IHAND2,1,1,IXPM,IYPX,IXPX,IYPM)
+! call gim_an_event(ix,iy,iflag)
+
+ RETURN
+ END
+
+ Subroutine panel012(ibkon)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: n,ibkon,IERR
+! real ::
+ character*3 :: sub
+
+ call wdialogload(IDD_DIALOG012)
+ ierr=infoerror(1)
+
+ do n=1,nbkfl
+ CALL WDialogPutString(idf_string1+n-1,BFNAME(n))
+ call wdialogputcheckbox(idf_check1+n-1,iswbkfl(n))
+ enddo
+
+ call wdialogputcheckbox(idf_check11,ibkon)
+
+ CALL WDialogSelect(IDD_DIALOG012)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ do n=1,nbkfl
+ call wdialogGetcheckbox(idf_check1+n-1,iswbkfl(n))
+ CALL GETSUB(BFNAME(n),SUB)
+ if(sub .eq. 'bmp') then
+ if(iswbkfl(n) .eq. 1) iswbkfl(n)=2
+ ELSEIF(SUB .EQ. 'pcx') then
+ if(iswbkfl(n) .eq. 1) ISWBKFL(N) = 2
+ ELSEIF(SUB .EQ. 'png' .or. sub .eq. 'jpg') then
+ if(iswbkfl(n) .eq. 1) ISWBKFL(N) = 2
+ endif
+ enddo
+
+ call wdialogGetcheckbox(idf_check11,ibkon)
+
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE UNDO(IYES)
+
+ USE WINTERACTER
+
+ INCLUDE 'D.INC'
+
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do wish to undo?'//&
+ CHAR(13)//' ','Undo option')
+!
+! If answer 'No', return
+!
+ iyes=1
+ IF (WInfoDialog(4).EQ.2) iyes=0
+ return
+ end
+
+ subroutine frame(xmn,ymn,xmx,ymx)
+
+ CALL PLOTT(xmn,ymn,3)
+ CALL PLOTT(xmx,ymn,2)
+ CALL PLOTT(xmx,ymx,2)
+ CALL PLOTT(xmn,ymx,2)
+ CALL PLOTT(xmn,ymn,2)
+ return
+ end
+
+ SUBROUTINE CIRCLE(CX,CY,rad)
+ dimension x(8),y(8)
+ DO I=1,8
+ ANGLE=FLOAT(I-1)*6.28318/8.
+ X(I)=CX+rad*COS(ANGLE)
+ Y(I)=CY+rad*SIN(ANGLE)
+ ENDDO
+! write(90,*) 'circle',x,y
+ CALL IGrPolygonComplex(x,y,8)
+ return
+ end
+
+ Subroutine GETHDRTYP(IHDSWT)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: IHDSWT,IERR
+
+ call wdialogload(IDD_HEADERTP)
+ ierr=infoerror(1)
+
+ call wdialogputRadioButton(idf_radio1)
+
+ CALL WDialogSelect(IDD_HEADERTP)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,IHDSWT)
+ return
+ endif
+ IHDSWT=1
+ RETURN
+ enddo
+ RETURN
+ END
+
+ Subroutine panelfil
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: n,iflon,IERR
+! real ::
+ character*3 :: sub
+
+ call wdialogload(IDD_SELTFL2)
+ ierr=infoerror(1)
+
+ write(90,*) 'iactvfil,itotfil',iactvfil,itotfil
+ do n=1,itotfil
+ write(90,'(a)') 'file',n,fnameout(n)
+ CALL WDialogPutString(idf_string25+n-1,FNAMEOUT(n))
+ if(n .eq. iactvfil) then
+ call wdialogputradiobutton(idf_radio1+n-1)
+ endif
+ enddo
+ CALL WDialogSelect(IDD_SELTFL2)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ DO
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ call wdialogGetradiobutton(idf_radio1,iactvfil)
+ write(90,*) 'Selected iactvfil', iactvfil
+ RETURN
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ ENDIF
+ ENDDO
+ END
+
+
+
+ subroutine plotcr(x,y,siz)
+
+ CALL PLOTT(x-siz/2.,y,3)
+ CALL PLOTT(x+siz/2,y,2)
+ CALL PLOTT(x,y-siz/2.,3)
+ CALL PLOTT(x,y+siz/2.,2)
+ return
+ end
+
+ SUBROUTINE OUTJPGW(FNAME,INFO)
+
+ CHARACTER(LEN=255) :: FNAME
+ INTEGER INFO(3)
+ INCLUDE 'TXFRM.COM'
+
+ REAL HSIZE
+ COMMON /SSIZE/ HSIZE
+ XR=HSIZE*TXSCAL-XS
+ YT=8.0*TXSCAL-YS
+ XSIZ=HSIZE*TXSCAL/FLOAT(INFO(2))
+ YSIZ=-8*TXSCAL/FLOAT(INFO(3))
+
+ OPEN(104,FILE=FNAME,STATUS ='UNKNOWN', FORM ='FORMATTED')
+ WRITE(104,*) XSIZ
+ WRITE(104,*) ' 0.0'
+ WRITE(104,*) ' 0.0'
+ WRITE(104,*) YSIZ
+ WRITE(104,*) -XS
+ WRITE(104,*) YT
+
+ CLOSE(104)
+
+ RETURN
+ END
+
diff --git a/src/src83e/WINTER.ICO b/src/src83e/WINTER.ICO
new file mode 100644
index 0000000..a29a006
Binary files /dev/null and b/src/src83e/WINTER.ICO differ
diff --git a/src/src83e/WRTBIN.F90 b/src/src83e/WRTBIN.F90
new file mode 100644
index 0000000..9e25a70
--- /dev/null
+++ b/src/src83e/WRTBIN.F90
@@ -0,0 +1,106 @@
+ SUBROUTINE WRTBIN
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ DIMENSION IREC(40),FREC(40)
+
+ CHARACTER*4 IPACKB(1200),IPACKT(77)
+
+ DATA (IREC(I),I=1,40) / 40*0 /
+ DATA (FREC(I),I=1,40) / 40*0. /
+
+! Write GFGEN banners
+
+ IREC(1) = 435
+ MFLG = 100
+ WRITE(IOT1) MFLG,IREC(1),NP,NE
+ IWRT1 = 1200
+ DO I=11,1200
+ IPACKB(I)=' '
+ ENDDO
+ IPACKB(1)='RMA '
+ IPACKB(2)='IMPL'
+ IPACKB(3)='EMEN'
+ IPACKB(4)='TATI'
+ IPACKB(5)='ON O'
+ IPACKB(6)='F SM'
+ IPACKB(7)='S OU'
+ IPACKB(8)='TPUT'
+ IPACKB(9)=' FOR'
+ IPACKB(10)='MAT '
+
+ WRITE (IOT1) IWRT1, (IPACKB(I),I= 1,IWRT1)
+
+ IWRT2 = 40
+ IWRT3 = 40
+ WRITE (IOT1) IWRT2, IWRT3,(IREC(I),I=1, IWRT2), (FREC(I),I=1,IWRT3)
+ DO I=1,77
+ IPACKT(I)=' '
+ IF(I .LT. 73) THEN
+ IPACKT(I)(1:1)=TITLE(I:I)
+ ENDIF
+ ENDDO
+ IWRT4 = 77
+ WRITE (IOT1) IWRT4, (IPACKT(I),I= 1,IWRT4)
+
+ DO J=1,NP
+!IPK FEB05
+ CORDSN(J,1)=XUSR(J)
+ CORDSN(J,2)=YUSR(J)
+ ENDDO
+ DO J=1,NE
+ IMATL(J)=IMAT(J)
+ ENDDO
+ ALPHA=0.
+ WRITE(IOT1) NP,NE,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,NP)&
+ ,((NOP(J,K),K=1,8),IMATL(J),THTA(J),IEM(J),J=1,NE)
+ WRITE(IOT1) (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,NP)
+
+
+ RETURN
+ END
+
+
+ SUBROUTINE RDBIN(IIIN)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ IIN=IIIN
+
+! Read GFGEN banners
+
+ READ(IIN) MFLG,IREC,N,M
+ READ(IIN) IWRT1,(IDUM,I=1,IWRT1)
+ READ(IIN) IWRT2,IWRT3,(IDUM,I=1,IWRT2),(FDUM,I=1,IWRT3)
+ READ(IIN) IWRT4,(IDUM,I=1,IWRT4)
+
+ READ(IIN) N1,M1,((CORDSN(J,K),K=1,2),ALPHA,WD(J),J=1,N1),&
+ ((NOP(J,K),K=1,8),IMATL(J),TH0,I3,J=1,M1)
+ READ(IIN) (WIDTH(J),SS1(J),SS2(J),WIDS(J),J=1,N1)
+
+ DO J=1,N1
+ DO K=1,2
+ CORD(J,K)=CORDSN(J,K)
+ ENDDO
+ XUSR(J)=CORD(J,1)
+ YUSR(J)=CORD(J,2)
+ ENDDO
+
+ DO J=1,M1
+ IMAT(J)=IMATL(J)
+!ipk feb08
+ ncorn(j)=0
+ DO K=1,8
+ if(nop(j,k) .gt. 0) ncorn(j)=k
+ ENDDO
+ ENDDO
+ NP=N1
+ NE=M1
+
+
+ CLOSE(IIN)
+
+ RETURN
+ END
diff --git a/src/src83e/XN.F90 b/src/src83e/XN.F90
new file mode 100644
index 0000000..24a2c34
--- /dev/null
+++ b/src/src83e/XN.F90
@@ -0,0 +1,200 @@
+ DOUBLE PRECISION FUNCTION XN(IT,K,X,Y)
+
+ SAVE
+ DOUBLE PRECISION X,Y
+!
+!......FUNCTION TO DEFINE SHAPE FUNCTION VALUES
+!
+ IF(IT .EQ. 2) THEN
+!
+!......TRIANGULAR ELEMENT
+!
+ GO TO ( 110,120,130,140,150,160),K
+ 110 XN=(1.-2.*X-2.*Y)*(1.-X-Y)
+ RETURN
+ 120 XN=4.*X*(1.-X-Y)
+ RETURN
+ 130 XN=(2.*X-1.)*X
+ RETURN
+ 140 XN=4.*X*Y
+ RETURN
+ 150 XN=(2.*Y-1.)*Y
+ RETURN
+ 160 XN=4.*Y*(1.-X-Y)
+ RETURN
+!
+!......QUADRILATERAL ELEMENT
+!
+ ELSEIF(IT .EQ. 1) THEN
+ GO TO (510,520,530,540,550,560,570,580),K
+ 510 XN=(1.-X)*(1.-Y)*(-X-Y-1.)/4.
+ RETURN
+ 520 XN=(1.-X*X)*(1.-Y)/2.
+ RETURN
+ 530 XN=(1.+X)*(1.-Y)*(X-Y-1.)/4.
+ RETURN
+ 540 XN=(1.+X)*(1.-Y*Y)/2.
+ RETURN
+ 550 XN=(1.+X)*(1.+Y)*(X+Y-1.)/4.
+ RETURN
+ 560 XN=(1.-X*X)*(1.+Y)/2.
+ RETURN
+ 570 XN=(1.-X)*(1.+Y)*(-X+Y-1.)/4.
+ RETURN
+ 580 XN=(1.-X)*(1.-Y*Y)/2.
+ ELSE
+ GO TO (610,620,630,640,650,660,670,680,690),K
+ 610 XN=(1.-X)*(1.-Y)*X*Y/4.
+ RETURN
+ 620 XN=-Y*(1.-X*X)*(1.-Y)/2.
+ RETURN
+ 630 XN=-(1.+X)*(1.-Y)*X*Y/4.
+ RETURN
+ 640 XN=X*(1.+X)*(1.-Y*Y)/2.
+ RETURN
+ 650 XN=(1.+X)*(1.+Y)*X*Y/4.
+ RETURN
+ 660 XN=Y*(1.-X*X)*(1.+Y)/2.
+ RETURN
+ 670 XN=-(1.-X)*(1.+Y)*X*Y/4.
+ RETURN
+ 680 XN=-X*(1.-X)*(1.-Y*Y)/2.
+ RETURN
+ 690 XN=(1.+X)*(1.-X)*(1.+Y)*(1.-Y)
+ RETURN
+ ENDIF
+ END
+ DOUBLE PRECISION FUNCTION DNX(IT,K,X,Y)
+
+ SAVE
+ DOUBLE PRECISION X,Y
+!-
+!......FUNCTION TO DETERMINE X-DERIVATIVE OF SHAPE FUNCTION
+!-
+ IF(IT .EQ. 2) THEN
+!-
+!......TRIANGULAR ELEMENT
+!-
+ GO TO (110,120,130,140,150,160),K
+ 110 DNX=-3. +4.*X+4.*Y
+ RETURN
+ 120 DNX=4.-8.*X-4.*Y
+ RETURN
+ 130 DNX=4.*X-1.
+ RETURN
+ 140 DNX=4.*Y
+ RETURN
+ 150 DNX=0.
+ RETURN
+ 160 DNX=-4.*Y
+ RETURN
+!-
+!......QUADRILATERAL ELEMENT
+!-
+ ELSEIF(IT .EQ. 1) THEN
+ GO TO (510,520,530,540,550,560,570,580),K
+ 510 DNX=-(1.-Y)*(-2.*X-Y)/4.
+ RETURN
+ 520 DNX=-X*(1.-Y)
+ RETURN
+ 530 DNX=(1.-Y)*(2.*X-Y)/4.
+ RETURN
+ 540 DNX=(1.-Y*Y)/2.
+ RETURN
+ 550 DNX=(1.+Y)*(2.*X+Y)/4.
+ RETURN
+ 560 DNX=-X*(1.+Y)
+ RETURN
+ 570 DNX=-(1.+Y)*(-2.*X+Y)/4.
+ RETURN
+ 580 DNX=-(1.-Y*Y)/2.
+ RETURN
+ ELSE
+ GO TO (610,620,630,640,650,660,670,680,690),K
+ 610 DNX=(Y-Y**2)*(1.-2.*X)/4.
+ RETURN
+ 620 DNX= X*(Y-Y**2)
+ RETURN
+ 630 DNX=-(Y-Y**2)*(1.+2.*X)/4.
+ RETURN
+ 640 DNX=(1.-Y*Y)/2.*(1.+2.*X)
+ RETURN
+ 650 DNX=(Y+Y**2)*(1.+2.*X)/4.
+ RETURN
+ 660 DNX=-X*(Y+Y**2)
+ RETURN
+ 670 DNX=-(Y+Y**2)*(1.-2.*X)/4.
+ RETURN
+ 680 DNX=-(1.-Y*Y)/2.*(1.-2.*X)
+ RETURN
+ 690 DNX=-2.*X*(1.-Y**2)
+ RETURN
+ ENDIF
+ END
+ DOUBLE PRECISION FUNCTION DNY(IT,K,X,Y)
+ SAVE
+ DOUBLE PRECISION X,Y
+!-
+!
+!......FUNCTION TO DETERMINE Y-DERIVATIVE OF SHAPE FUNCTION
+!-
+ IF(IT .EQ. 2) THEN
+!-
+!......TRIANGULAR ELEMENT
+!-
+ GO TO (110,120,130,140,150,160),K
+ 110 DNY=-3.+4.*X+4.*Y
+ RETURN
+ 120 DNY=-4.*X
+ RETURN
+ 130 DNY=0.
+ RETURN
+ 140 DNY=4.*X
+ RETURN
+ 150 DNY=4.*Y-1.
+ RETURN
+ 160 DNY=4.-4.*X-8.*Y
+ RETURN
+!-
+!......QUADRILATERAL ELEMENT
+!-
+ ELSEIF(IT .EQ. 1) THEN
+ GO TO (510,520,530,540,550,560,570,580),K
+ 510 DNY=-(1.-X)*(-2.*Y-X)/4.
+ RETURN
+ 520 DNY=-(1.-X*X)/2.
+ RETURN
+ 530 DNY=-(1.+X)*(X-2.*Y)/4.
+ RETURN
+ 540 DNY=-Y*(1.+X)
+ RETURN
+ 550 DNY=(1.+X)*(2.*Y+X)/4.
+ RETURN
+ 560 DNY=(1.-X*X)/2.
+ RETURN
+ 570 DNY=(1.-X)*(2.*Y-X)/4.
+ RETURN
+ 580 DNY=-Y*(1.-X)
+ RETURN
+ ELSE
+ GO TO (610,620,630,640,650,660,670,680,690),K
+ 610 DNY=(X-X**2)*(1.-2.*Y)/4.
+ RETURN
+ 620 DNY=-(1.-X*X)/2.*(1.-2.*Y)
+ RETURN
+ 630 DNY=-(X+X**2)*(1.-2.*Y)/4.
+ RETURN
+ 640 DNY=-Y*(X+X**2)
+ RETURN
+ 650 DNY=(X+X**2)*(1.+2.*Y)/4.
+ RETURN
+ 660 DNY=(1.-X*X)/2.*(1.+2.*Y)
+ RETURN
+ 670 DNY=-(X-X**2)*(1.+2.*Y)/4.
+ RETURN
+ 680 DNY= Y*(X-X**2)
+ RETURN
+ 690 DNY=-2.*Y*(1.-X**2)
+ RETURN
+ ENDIF
+ END
diff --git a/src/src83e/ZOOM.BMP b/src/src83e/ZOOM.BMP
new file mode 100644
index 0000000..27841b8
Binary files /dev/null and b/src/src83e/ZOOM.BMP differ
diff --git a/src/src83e/ZOOMNEW.F90 b/src/src83e/ZOOMNEW.F90
new file mode 100644
index 0000000..a21abf9
--- /dev/null
+++ b/src/src83e/ZOOMNEW.F90
@@ -0,0 +1,104 @@
+!***********************************************************
+ subroutine zoomnew(xscrn,yscrn,xscrn1,yscrn1,iflag)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ character*1 iflag
+!
+!
+!ipk jun96 add zoomj
+ character*43 zoomh,zoomj
+ character*23 zoomi
+!ipk jan98
+ CHARACTER*80 lind
+ data zoomh/' Zooming, click and drag to form rectangle'/
+ data zoomi/' Click right if size OK'/
+!ipk jun96 add zoomj
+ data zoomj/' Double click, click second point '/
+!
+!
+ 80 CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomh,0.,43)
+
+!jan09 xcc = 5.00
+!jan09 xp = 5.00
+ xcc = 5.00*hsize/10.
+ xp = 5.00*hsize/10.
+ ycc = 3.5
+ yp = 3.5
+!
+! Got cursor location
+!
+ if(iflag .eq. 'r') then
+! This option is scaling a window
+!
+!
+! Look for a screen size
+!
+ xsiz=abs(xscrn1-xscrn)
+ ysiz=abs(yscrn1-yscrn)
+!ipk jun96 test for zero sizes
+ if(xsiz .lt. 0.001 .or. ysiz .lt. 0.001) then
+ CALL CLRBOX
+ CALL SYMBL(0.,7.70,0.20,zoomj,0.,43)
+ return
+ endif
+ if(xscrn1 .lt. xscrn) xscrn=xscrn1
+ if(yscrn1 .lt. yscrn) yscrn=yscrn1
+ fact=HSIZE/xsiz
+ if(7.5/ysiz .lt. fact) fact=7.5/ysiz
+!jan09 if(8./ysiz .lt. fact) fact=8./ysiz
+!jan09 xscrn=xscrn+5./fact
+ xscrn=xscrn+xcc/fact
+ yscrn=yscrn+3.5/fact
+ xp=xscrn
+ yp=yscrn
+ CALL CLRBOX
+! CALL SYMBL(0.,7.70,0.20,zoomi,0.,22)
+ go to 250
+ elseif(iflag .eq. 'w') then
+ call rescal
+ return
+ elseif(iflag .eq. 'y')then
+ fact=0.5
+ elseif(iflag .eq. 'x') then
+ fact=0.25
+ elseif(iflag .eq. 'v')then
+ fact=1.0
+ xp=xp-5.
+ elseif(iflag .eq. 'u') then
+ fact=1.0
+ xp=xp+5.
+ elseif(iflag .eq. 't')then
+ fact=1.0
+ yp=yp+3.5
+ elseif(iflag .eq. 's') then
+ fact=1.0
+ yp=yp-3.5
+ elseif(iflag .eq. 'd') then
+ fact=1.0
+ xp=xp-xscrn
+ yp=yp-yscrn
+ endif
+ do i=1,np
+ if(cord(i,1) .gt. void) then
+ inskp(i)=0
+ endif
+ enddo
+ do i=1,ne
+ if(imat(i) .gt. 0) then
+ ieskp(i)=0
+ endif
+ enddo
+ 250 continue
+ pscale = pscale/fact
+ xmino=xmin
+ ymino=ymin
+!
+ xmin = xp - (xcc*pscale)
+ ymin = yp - (ycc*pscale)
+!
+ CALL PLOTOT(0)
+ if(nmess .eq. 11) call pltpt
+ return
+ END
diff --git a/src/src83e/addmap.f90 b/src/src83e/addmap.f90
new file mode 100644
index 0000000..21a5b63
--- /dev/null
+++ b/src/src83e/addmap.f90
@@ -0,0 +1,86 @@
+ SUBROUTINE ADDMAP
+!
+! ROUTINE TO ADD TWO MAPS FILES TOGETHER
+!
+
+ USE WINTERACTER
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+
+ include 'd.inc'
+
+
+ CHARACTER(LEN=255) :: FNAME,FNAMGE,FNAMRM,FNAMEB
+ CHARACTER(LEN=3) :: SUB,SUB1
+
+! FIRST WRITE EXISTING MAP TO SCRATCH
+ close(99)
+ OPEN(99,FORM='BINARY',STATUS='SCRATCH')
+
+
+! SAVE THE CONTROL INFORMATION
+ KEEP1=klint
+ JEEP1=jlint
+
+ CALL WRTMAP(99)
+ REWIND 99
+
+! NEXT READ NEW MAP AND ALSO WRITE TO A SECOND SCRATCH
+! FIRST OPEN A MAP FILE
+ CALL WSelectFile(ID_STRING1,PromptOn,FNAME,'Load Map File')
+
+ IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN
+
+ CALL IlowerCase(FNAME)
+ CALL GETSUB(FNAME,SUB)
+
+ IF(SUB .EQ. 'map') then
+ IMP=9
+ OPEN(9,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'asc' .or. SUB .EQ. 'grd') then
+ IMP=94
+ OPEN(94,FILE=FNAME,STATUS='OLD')
+ ELSEIF(SUB .EQ. 'mpb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='unformatted',action='read')
+ ELSEIF(SUB .EQ. 'mbb') then
+ imp=92
+ OPEN(IMP ,FILE=FNAME,STATUS='OLD',form='binary',action='read')
+ ENDIF
+ ENDIF
+ CALL RDMAP(2,IMP,0,0)
+ NEWMAXK=KEEP1+klint
+ NEWMAXPL=JEEP1+jlint
+ IF(NEWMAXPL .GT. MAXPL) THEN
+!!
+! NOW OPEN THE FILE FOR SAVING
+ OPEN(98,FORM='BINARY',STATUS='SCRATCH')
+
+ CALL WRTMAP(98)
+ REWIND 98
+
+
+! WORK OUT SIZES AND ALLOCATE ARRAYS
+
+
+ deallocate (CMAP,XMAP,YMAP,VAL,imap,NCRS)
+
+ allocate (CMAP(MAXPL,2),XMAP(MAXPL),YMAP(MAXPL),VAL(MAXPL))
+
+ ALLOCATE (imap(maxpl),NCRS(MAXPL))
+
+ CALL RDMAP(2,98,0,0) ! XXXXX
+ CLOSE(98)
+ ENDIF
+! READ IN AND MERGE MAP FILES
+
+ JSTT=JLINT
+ KSTT=KLINT
+ CALL RDMAP(2,99,JSTT,KSTT)
+ CLOSE(99)
+ call PLOTOT(0)
+ CALL HEDR
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/addmesht.f90 b/src/src83e/addmesht.f90
new file mode 100644
index 0000000..2301d0f
--- /dev/null
+++ b/src/src83e/addmesht.f90
@@ -0,0 +1,307 @@
+ SUBROUTINE ADDMESHT
+
+ USE BLK1MOD
+ USE WINTERACTER
+ INCLUDE 'BFILES.I90'
+ INCLUDE 'TXFRM.COM'
+
+ INTEGER OUTPOL,TWO,ZERO,IFILOUT
+ INTEGER NTRIAN(5000,2),ICT
+ REAL XMAP1(5000),YMAP1(5000)
+
+ CHARACTER*1 ANSW(10),ANS
+ CHARACTER(LEN=80) :: DATAIN,OPTIONS
+ CHARACTER(LEN=96) :: LOCDIR
+ LOGICAL EXISTS
+ DATA ANSW/' ',' ',' ',' ',' ','b','n','z','r','q'/
+ do k=1,80
+ options(k:k)=' '
+ enddo
+ TWO=2
+ ZERO=0
+ OUTPOL=23
+ ICT=0
+! add headers
+ NHTPSV=NHTP
+ NMESSSV=NMESS
+ NBRRSV=NBRR
+ NHTP=0
+ NMESS=48
+ NBRR=5
+ call hedr
+! go and get points to form outline
+ 200 CALL xyloc(XTEMP,YTEMP,ans,IBOX)
+ siz=0.1
+ call drawcr(xtemp,ytemp,siz)
+ IF(IRMAIN .EQ. 1) RETURN
+!
+ IF(ANS .EQ. 'c') THEN
+ if(ibox .eq. 0) go to 400
+ I=IBOX
+ ANS=ANSW(I)
+ ENDIF
+ IF(ANS .EQ. 'b') THEN
+ ICT=ICT-1
+ GO TO 200
+ ELSEIF(ANS .EQ. 'n') THEN
+ GO TO 500
+ ELSEIF(ANS .EQ. 'q') THEN
+ RETURN
+ ENDIF
+400 ICT=ICT+1
+ XMAP1(ICT) = XTEMP*TXSCAL - XS
+ YMAP1(ICT) = YTEMP*TXSCAL - YS
+ IF(ICT .GT. 1) THEN
+ NTRIAN(ICT-1,1)=ICT-1
+ NTRIAN(ICT-1,2)=ICT
+ ENDIF
+ GO TO 200
+ 500 CONTINUE
+ NTRIAN(ICT,1)=ICT
+ NTRIAN(ICT,2)=1
+
+! write current data to a scratch file for later addition
+ IFILOUT=IACTVFIL+50
+ CALL WRTFIL(IFILOUT)
+!
+! IF(IACTVFIL .GT. 0) THEN
+! CALL WRTFIL(50)
+! IFILOUT=IACTVFIL+50
+! CALL WRTFIL(IFILOUT)
+! CALL ZEROOUT
+! IACTVFIL=ITOTFIL
+! ELSE
+! IACTVFIL=1
+! ENDIF
+!
+!! clear screen
+! CALL clscrn
+
+! form TRIANG file
+
+ OPEN(OUTPOL,FILE='TEST.POLY', STATUS='UNKNOWN')
+ WRITE(OUTPOL,*) ICT,TWO,ZERO,ZERO
+ DO K=1,ICT
+ WRITE(OUTPOL,*) K,XMAP1(K),YMAP1(K)
+ ENDDO
+ WRITE(OUTPOL,*) ICT,ZERO
+ DO J=1, ICT
+ WRITE(OUTPOL,*) J,ntrian(J,1),ntrian(J,2)
+ ENDDO
+ WRITE(OUTPOL,*) ZERO
+ FLUSH (OUTPOL)
+ REWIND (OUTPOL)
+ CLOSE (OUTPOL)
+
+! OPTIONS = ' -pqa5000V TEST'
+ OPTIONS(1:3) = ' -p'
+ nct=3
+ iswq=1
+ iswy=0
+ id1=100
+ CALL PANELFILLT(ISWQ,ISWY,ID1)
+
+ IF(ISWQ .EQ. 1) THEN
+ NCT=NCT+1
+ OPTIONS(NCT:NCT)='q'
+ ENDIF
+ IF(ISWY .EQ. 1) THEN
+ NCT=NCT+1
+ OPTIONS(NCT:NCT)='q'
+ ENDIF
+ ID1=ID1**2/2
+ WRITE(OPTIONS(NCT+1:NCT+12),'(''a'',I6.6,'' TEST'')') ID1
+! go to TRIANGLE
+ INQUIRE (FILE = 'test.1.ele', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.ele')
+ close(77,status='DELETE')
+ ENDIF
+
+ INQUIRE (FILE = 'test.1.node', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.node')
+ close(77,status='DELETE')
+ ENDIF
+
+ INQUIRE (FILE = 'test.1.poly', EXIST = exists)
+ if(exists) then
+ open(77,file= 'test.1.poly')
+ close(77,status='DELETE')
+ ENDIF
+
+ INQUIRE (FILE = "C:\Program Files\RMA\TRIANGLE.EXE", EXIST = exists)
+ if(.not. exists) then
+ INQUIRE (FILE = "TRIANGLE.EXE", EXIST = exists)
+ if(.not. exists) then
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'TRIANGLE is not available in '//CHAR(13)//&
+ 'C:\Program Files\RMA\ directory'//CHAR(13)//'Do you wish to define directory?'&
+ ,'WARNING TRIANGLE IS NOT AVAILABLE')
+
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) return
+ CALL GETDIR(LOCDIR)
+ else
+ LOCDIR(1:8)='TRIANGLE'
+! WRITE(155,*) LOCDIR
+ RESULT= RUNQQ(LOCDIR, OPTIONS)
+ GO TO 600
+ endif
+ endif
+ RESULT= RUNQQ("C:\Program Files\RMA\TRIANGLE", OPTIONS)
+! RESULT= RUNQQ("TRIANGLE", OPTIONS)
+
+600 IIN=10
+ OPEN(IIN,FILE='TEST.1.ELE', STATUS='OLD')
+
+! write(155,*) 'going to get newfile'
+ CALL GETNEWFIL(IIN,0,-1,-1)
+ !IADD=50+iactvfil+1
+ !CALL RDTOCLIP(IADD)
+ !
+ !IF(IADD .EQ. 51) THEN
+ !write(90,*) 'finished addmesh'
+ !
+ !NHTP=NHTPSV
+ !NMESS=NMESSSV
+ !NBRR=NBRRSV
+ !call hedr
+ !ELSE
+ ! CALL ADDMESH(0)
+ NHTP=NHTPSV
+ NMESS=NMESSSV
+ NBRR=NBRRSV
+ call hedr
+ CALL PLOTOT(0)
+
+! CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to delete unused nodes?'//&
+! CHAR(13)//' ','Delete unused nodes?')
+! !
+!! If answer 'No', return
+!!
+! IF (WInfoDialog(4).EQ.2) return
+!!
+!! Delete all unused nodes
+!!
+! CALL DELETM(2)
+!
+! ENDIF
+
+! get new mesh
+! add meshes together
+ RETURN
+ END
+
+ SUBROUTINE UNDOGEN
+ USE BLK1MOD
+ INCLUDE 'BFILES.I90'
+ ALLOCATABLE NODETRAN(:)
+ DATA VDX9/-9.E9/
+
+! Loop through nodes assigning new number and adding to list
+
+ IF(.NOT. ALLOCATED(NODETRAN)) ALLOCATE (NODETRAN(maxp))
+
+ CALL ZEROOUT
+ IADD=50+IACTVFIL
+ CALL RDTOCLIP(IADD)
+
+ DO N=1,NPSTO(1)
+ IF(XUSRSTO(N,1) .GT. VDX9) THEN
+ CALL GETNOD(J)
+ NODETRAN(N)=J
+ XUSR(J)=XUSRSTO(N,1)
+ YUSR(J)=YUSRSTO(N,1)
+ WD(J)=WDSTO(N,1)
+ WIDTH(J)=WIDTHSTO(N,1)
+ SS1(J)=SS1STO(N,1)
+ SS2(J)=SS2STO(N,1)
+ WIDS(J)=WIDSSTO(N,1)
+ WIDBS(J)=WIDBSSTO(N,1)
+ SSO(J)=SSOSTO(N,1)
+ BS1(J)=BS1STO(N,1)
+ INSKP(J) = 0
+ INEW(J) = 1
+ ENDIF
+ ENDDO
+
+! Loop through elements assigning new number and adding to list
+
+ DO N=1,NESTO(1)
+ IF(IMATSTO(N,1) .GT. 0) THEN
+ CALL GETELM(M)
+ DO K=1,8
+ IF(NOPSTO(N,K,1) .GT. 0) THEN
+ J=NODETRAN(NOPSTO(N,K,1))
+ NOP(M,K)=J
+ ELSE
+ NOP(M,K)=0
+ ENDIF
+ ENDDO
+ IMAT(M)=IMATSTO(N,1)
+ THTA(M)=THTASTO(N,1)
+ IESKP(M)=0
+ NCN = 2
+ IF (NOP(M,3) .NE. 0) NCN = 3
+ IF (NOP(M,4) .NE. 0) NCN = 4
+ IF (NOP(M,5) .NE. 0 .AND. NOP(M,4) .NE. 0) NCN = 5
+ IF (NOP(M,5) .NE. 0 .AND. NOP(M,4) .EQ. 0) NCN = 6
+ IF (NOP(M,6) .NE. 0) NCN = 6
+ IF (NOP(M,7) .NE. 0) NCN = 8
+ NCORN(M) = NCN
+
+ ENDIF
+ ENDDO
+
+! if(iswt .eq. 0) CALL RESCAL
+ CALL RESCAL
+ CALL HEDR
+
+ RETURN
+ END
+ SUBROUTINE GETDIR(LOCDIR)
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+ INCLUDE 'BFILES.I90'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ CHARACTER*96 LOCDIR
+ integer ierr,K,KL
+
+ call wdialogload(IDD_GETFL)
+ ierr=infoerror(1)
+
+ CALL WDialogPutString(idf_string1,locdir)
+! LOCDIR='C:\Users\RMA5440\TRIANGLE\TRIANGLE'
+
+ CALL WDialogSelect(IDD_GETFL)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+ CALL WDialogGetString(idf_string1,locdir)
+ DO K=96,1,-1
+ KL=K
+ IF(LOCDIR(K:K) .NE. ' ') GO TO 200
+ ENDDO
+ LOCDIR(1:8)='TRIANGLE'
+ RETURN
+200 CONTINUE
+ LOCDIR(KL+1:KL+9)='\TRIANGLE'
+ WRITE(90,*) LOCDIR
+ RETURN
+ endif
+ enddo
+ END
\ No newline at end of file
diff --git a/src/src83e/addtomesh.f90 b/src/src83e/addtomesh.f90
new file mode 100644
index 0000000..939703a
--- /dev/null
+++ b/src/src83e/addtomesh.f90
@@ -0,0 +1,628 @@
+!ipk last update sep 20 2013 add more output of progress and flushing of messages
+ SUBROUTINE ADDTOMESH(IADDFIL,ISWT)
+
+! iswt = 0 ADD TO MESH
+! ISWT = 1 MERGE MESHES
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+
+ INCLUDE 'D.INC'
+
+! INCLUDE 'BLK1.COM'
+ INCLUDE 'BFILES.I90'
+
+ IADD=IADDFIL+50
+ CALL RDTOCLIP(IADD)
+
+ IF(ISWT .EQ. 1) THEN
+ CALL OUTLINES(1)
+ ISWT1=0
+! IF(NOUTLST(2) .EQ. 0) THEN
+ ISWT2=1
+! ELSE
+! ISWT2=0
+! ENDIF
+ CALL MERGEMESH1(ISWT1,ISWT2)
+ write(90,*) 'finished mergemesh1'
+ IF(ISWT2 .EQ. 0) CALL MERGEMESH
+! CALL MERGEMESH
+ write(90,*) 'finished mergemesh'
+ flush(90)
+ ENDIF
+
+ CALL ADDMESH(0)
+ write(90,*) 'finished addmesh'
+
+ IF(ISWT .EQ. 1 ) THEN
+ CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to delete unused nodes?'//&
+ CHAR(13)//' ','Delete unused nodes?')
+ !
+! If answer 'No', return
+!
+ IF (WInfoDialog(4).EQ.2) return
+!
+! Delete all unused nodes
+!
+ CALL DELETM(2)
+ ENDIF
+
+ RETURN
+ END
+
+
+ SUBROUTINE RDTOCLIP(IUNIT)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ CHARACTER*80 ALINE
+
+ REWIND IUNIT
+ READ(IUNIT) TITLE,NPSTO(1),NESTO(1)
+ WRITE(90,*) 'IN RDTOCLIP',IUNIT
+ WRITE(90,*) TITLE,NPSTO(1),NESTO(1)
+ READ(IUNIT) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempinc
+ WRITE(90,*) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
+ & ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempinc
+ READ(IUNIT) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ WRITE(90,*) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
+ IF(IPP .GT. 0) READ(IIN) ALINE
+
+ READ(IUNIT) ((NOPSTO(J,K,1),K=1,8),IMATSTO(J,1),THTASTO(J,1),J=1,NESTO(1))
+
+ READ(IUNIT) &
+ & (XUSRSTO(J,1),YUSRSTO(J,1),WDSTO(J,1),WIDTHSTO(J,1),SS1STO(J,1),SS2STO(J,1),WIDSSTO(J,1), &
+ & WIDBSSTO(J,1),SSOSTO(J,1),BS1STO(J,1),J=1,NPSTO(1))
+
+ READ(IUNIT) NLSTSTO(1)
+ IF(NLSTSTO(1) .GT. 0) THEN
+ READ(IUNIT) (LLISTSTO(J,1),J=1,NLSTSTO(1)), &
+ ((ILISTSTO(J,I,1),I=1,LLISTSTO(J,1)),J=1,NLSTSTO(1))
+ ENDIF
+
+ READ(IUNIT) NENTRYC,NLAYDC,NCLMSTO(1)
+ IF(NENTRYC .GT. 0) THEN
+ READ(IUNIT) ((NEFC,J=1,3),I=1,NENTRYC)
+ ENDIF
+ IF(NLAYDC .GT. 0) THEN
+ READ(IUNIT) (LAYC,I=1,NPSTO(1))
+ ENDIF
+ IF(NCLMSTO(1) .GT. 0) THEN
+ READ(IUNIT) ((ICCLNSTO(I,J,1),J=1,350),I=1,NCLMSTO(1))
+ ENDIF
+
+ REWIND IUNIT
+ RETURN
+ END
+
+ SUBROUTINE ADDMESH(ISWT)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+
+ ALLOCATABLE NODETRAN(:)
+ DATA VDX9/-9.E9/
+
+! Loop through nodes assigning new number and adding to list
+
+ IF(.NOT. ALLOCATED(NODETRAN)) ALLOCATE (NODETRAN(maxp))
+
+ IF(ISWT .EQ. 0) THEN
+ DO N=1,NPSTO(1)
+ IF(XUSRSTO(N,1) .GT. VDX9) THEN
+ CALL GETNOD(J)
+ NODETRAN(N)=J
+ XUSR(J)=XUSRSTO(N,1)
+ YUSR(J)=YUSRSTO(N,1)
+ WD(J)=WDSTO(N,1)
+ WIDTH(J)=WIDTHSTO(N,1)
+ SS1(J)=SS1STO(N,1)
+ SS2(J)=SS2STO(N,1)
+ WIDS(J)=WIDSSTO(N,1)
+ WIDBS(J)=WIDBSSTO(N,1)
+ SSO(J)=SSOSTO(N,1)
+ BS1(J)=BS1STO(N,1)
+ INSKP(J) = 0
+ INEW(J) = 1
+ ENDIF
+ ENDDO
+ ELSE
+ DO N=1,NPSTO(1)
+ NODETRAN(N)=N
+ ENDDO
+ ENDIF
+
+! Loop through elements assigning new number and adding to list
+
+ DO N=1,NESTO(1)
+ IF(IMATSTO(N,1) .GT. 0) THEN
+ CALL GETELM(M)
+ DO K=1,8
+ IF(NOPSTO(N,K,1) .GT. 0) THEN
+ J=NODETRAN(NOPSTO(N,K,1))
+ NOP(M,K)=J
+ ELSE
+ NOP(M,K)=0
+ ENDIF
+ ENDDO
+ IMAT(M)=IMATSTO(N,1)
+ THTA(M)=THTASTO(N,1)
+ IESKP(M)=0
+ NCN = 2
+ IF (NOP(M,3) .NE. 0) NCN = 3
+ IF (NOP(M,4) .NE. 0) NCN = 4
+ IF (NOP(M,5) .NE. 0 .AND. NOP(M,4) .NE. 0) NCN = 5
+ IF (NOP(M,5) .NE. 0 .AND. NOP(M,4) .EQ. 0) NCN = 6
+ IF (NOP(M,6) .NE. 0) NCN = 6
+ IF (NOP(M,7) .NE. 0) NCN = 8
+ NCORN(M) = NCN
+
+ ENDIF
+ ENDDO
+
+ if(iswt .eq. 0) CALL RESCAL
+ CALL HEDR
+
+ RETURN
+ END
+
+ SUBROUTINE MERGEMESH1(ISWT1,ISWT2)
+
+ USE BLK1MOD
+ USE BLK2MOD
+ USE WINTERACTER
+
+! INCLUDE 'BLK1.COM'
+
+ REAL*8 ELXMIN,ELXMAX,ELYMIN,ELYMAX,XLC,YLC,XXX,YYY
+ LOGICAL LSTAT
+
+ ALLOCATABLE ELXMIN(:),ELXMAX(:),ELYMIN(:),ELYMAX(:),KEY(:),NKEY(:)
+ DIMENSION XOUT1(1000),YOUT1(1000)
+ IF(.NOT. ALLOCATED(ELXMIN)) &
+ ALLOCATE (ELXMIN(MAXE),ELXMAX(MAXE),ELYMIN(MAXE),ELYMAX(MAXE),KEY(MAXE),NKEY(MAXP))
+
+ IF(ISWT2 .EQ. 0) GO TO 110
+! first eliminate any elements inside outline
+ CALL KCONST(0)
+ NKEP=0
+ DO K=1,10
+ IF(NOUTLST(K) .LE. 0) THEN
+ DO J=1,NPSTO(1)
+ XXXX=XUSRSTO(J,1)
+ YYYY=YUSRSTO(J,1)
+ LSTAT=IGrInsidePolygon(XOUT(1,K),YOUT(1,K),-NOUTLST(K),XXXX,YYYY)
+ IF(LSTAT) THEN
+ NKEP(J)=1
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DO K=1,10
+ IF(NOUTLST(K) .GT. 0) THEN
+ DO J=1,NPSTO(1)
+ IF(NKEP(J) .EQ. 1) CYCLE
+ XXXX=XUSRSTO(J,1)
+ YYYY=YUSRSTO(J,1)
+! WRITE(155,*) J,XXXX,YYYY
+ LSTAT=IGrInsidePolygon(XOUT(1,K),YOUT(1,K),NOUTLST(K),XXXX,YYYY)
+! WRITE(155,*) J,LSTAT
+ IF(LSTAT) THEN
+ DO L=1,NDELM(J)
+ NCAN=NECON(J,L)
+ CALL DELEM(NCAN)
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDIF
+100 CONTINUE
+ ENDDO
+ IF(ISWT2 .EQ. 1) RETURN
+! First sort coordinates for min of element connection
+
+! List all limiting values
+ 110 CONTINUE
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0) THEN
+ ELXMIN(N)=XUSR(NOP(N,1))
+ ELXMAX(N)=XUSR(NOP(N,1))
+ ELYMIN(N)=YUSR(NOP(N,1))
+ ELYMAX(N)=YUSR(NOP(N,1))
+ DO M=2,8
+ IF(NOP(N,M) .NE. 0) THEN
+ ELXMIN(N)=MIN(ELXMIN(N),XUSR(NOP(N,M)))
+ ELXMAX(N)=MAX(ELXMAX(N),XUSR(NOP(N,M)))
+ ELYMIN(N)=MIN(ELYMIN(N),YUSR(NOP(N,M)))
+ ELYMAX(N)=MAX(ELYMAX(N),YUSR(NOP(N,M)))
+ ENDIF
+ ENDDO
+ ELSE
+ ELXMIN(N)=VOID
+ ELXMAX(N)=VOID
+ ELYMIN(N)=VOID
+ ELYMAX(N)=VOID
+ ENDIF
+ ENDDO
+
+ CALL SORTDB(XUSRSTO,NKEY,NPSTO(1))
+
+ CALL SORTDB(ELXMIN,KEY,NE)
+
+! Loop on elements to check for overlap
+
+
+ DO KK=1,NESTO(1)
+ IF (NOPSTO(KK,6,1) .EQ. 0) CYCLE
+ IF(IMATSTO(KK,1) .GT. 0) THEN
+ if(mod(kk,1000) .eq. 0) write(90,*) 'merged',kk
+ flush(90)
+ KL=1
+ 200 CONTINUE
+ IF(ISWT1 .EQ. 0) THEN
+ DO K=KL,8
+ J=NOPSTO(KK,K,1)
+ IF(J .GT. 0) THEN
+ KLL=KL
+ XXX=XUSRSTO(J,1)
+ YYY=YUSRSTO(J,1)
+ GO TO 220
+ ENDIF
+ ENDDO
+ KLL=8
+ GO TO 400
+ 220 CONTINUE
+ ELSE
+ XXX=0.
+ YYY=0.
+ DO K=1,7,2
+ JJ=NOPSTO(KK,K,1)
+ IF(JJ .GT. 0) THEN
+ XXX=XXX+XUSRSTO(JJ,1)
+ YYY=YYY+YUSRSTO(JJ,1)
+ ENDIF
+ ENDDO
+ IF(JJ .EQ. 0) THEN
+ XXX=XXX/3.
+ YYY=YYY/3.
+ ELSE
+ XXX=XXX/4.
+ YYY=YYY/4.
+ ENDIF
+ ENDIF
+! Search on elements to find a startin point
+
+ DO NN=1,NE
+
+ N=KEY(NN)
+ IF(IMAT(N) .GT. 0) THEN
+!-
+!...... DETERMINE ELEMENT TYPE
+!-
+ NCN=8
+ IT=1
+ IF(NOP(N,7) .EQ. 0) THEN
+ NCN=6
+ IT=2
+ ENDIF
+ IF(NOP(N,6) .EQ. 0) THEN
+ GOTO 350
+ ENDIF
+! Test for point inside an element
+
+
+! Test for max and min within
+
+ IF(XXX .GT. ELXMIN(N)) THEN
+ IF(XXX .GT. ELXMAX(N)) GO TO 350
+ IF(YYY .GT. ELYMIN(N)) THEN
+ IF(YYY .GT. ELYMAX(N)) GO TO 350
+
+! Now get local coordinate as final test
+
+ CALL GPTEV(N,XXX,YYY,XLC,YLC,IT,NCN)
+
+ IF(IT .EQ. 2) THEN
+ IF(XLC .LT. 0. .OR. YLC .LT. 0. .OR. XLC+YLC .GT. 1.) THEN
+ GO TO 350
+ ELSE
+ CALL DELEM(KK)
+ GO TO 400
+ ENDIF
+ ELSE
+ IF(XLC .LT. -1. .OR. YLC .LT. -1. .OR. &
+ XLC .GT. 1. .OR. YLC .GT. 1.) THEN
+ GO TO 350
+ ELSE
+ CALL DELEM(KK)
+ GO TO 400
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDIF
+ ENDIF
+ 350 CONTINUE
+ ENDDO
+ KL=KLL+1
+ IF(KL .LT. 8 .AND. ISWT1 .EQ. 0) GO TO 200
+ ENDIF
+
+! Finished test
+
+ 400 CONTINUE
+ ENDDO
+ RETURN
+ END
+
+
+ SUBROUTINE GPTEV(N,XSW,YSW,XG,YG,IT,NCN)
+!-
+!......EVALUATE FUNCTION AT GRID POINTS
+!-
+!- N = ELEMENT NUMBER
+!_ XSW = X COORDINATE OF DESIRED POINT
+!_ YSW = Y COORDINATE OF DESIRED POINT
+! XG = X LOCAL COORDINATE
+! YG = Y LOCAL COORDINATE
+! IT = SWITCH FOR CHOICE BETWEEN LINEAR AND QUADRATIC WEIGHTING
+! = 1 FOR LINEAR
+! = 2 FOR QUADRATIC
+! FROM COMMON
+! NOP = LIST OF NODAL CONNECTIONS AROUND AN ELEMET
+! XUSR = REAL*8 ARRAY OF NODAL COORDINATES
+!
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ REAL*8 XN,DNX,DNY,XSW,YSW
+ DOUBLE PRECISION XG,YG,XK,YK,XP,YP
+!-
+ DIMENSION X(9),Y(9),WGT(8)
+!-
+ DATA TOL/0.01/
+!-
+
+!-
+!......ESTABLISH LOCAL COORDINATES FOR EACH NODE POINT OF ELEMENT
+!-
+ K1=NOP(N,1)
+ X(1)=0.
+ Y(1)=0.
+ DO 300 K=3,NCN,2
+ K2=NOP(N,K)
+ X(K)=XUSR(K2)-XUSR(K1)
+ Y(K)=YUSR(K2)-YUSR(K1)
+ 300 END DO
+ X(2)=X(3)/2.
+ Y(2)=Y(3)/2.
+ X(4)=(X(3)+X(5))/2.
+ Y(4)=(Y(3)+Y(5))/2.
+ IF(IT .EQ. 2) THEN
+ X(6)=X(5)/2.
+ Y(6)=Y(5)/2.
+
+ xminl=min(x(1),x(3),x(5))
+ yminl=min(y(1),y(3),y(5))
+ xmaxl=max(x(1),x(3),x(5))
+ ymaxl=max(y(1),y(3),y(5))
+ ELSE
+ X(6)=(X(5)+X(7))/2.
+ Y(6)=(Y(5)+Y(7))/2.
+ X(8)=X(7)/2.
+ Y(8)=Y(7)/2.
+
+ xminl=min(x(1),x(3),x(5),x(7))
+ yminl=min(y(1),y(3),y(5),y(7))
+ xmaxl=max(x(1),x(3),x(5),x(7))
+ ymaxl=max(y(1),y(3),y(5),y(7))
+ ENDIF
+
+
+!-
+!......ESTABLISH LOCAL COORDINATES OF DESIRED POINT
+!-
+ XP=XSW-XUSR(K1)
+ YP=YSW-YUSR(K1)
+
+ XG=0.
+ YG=0.
+!-
+!......ITERATE TO FIND LOCAL COORDINATE
+!-
+ DO ITER=1,10
+ DXKDX=0.
+ DXKDY=0.
+ DYKDX=0.
+ DYKDY=0.
+ XK=-XP
+ YK=-YP
+ DO K=2,NCN
+ XK=XK+XN(IT,K,XG,YG)*X(K)
+ YK=YK+XN(IT,K,XG,YG)*Y(K)
+ DXKDX=DXKDX+DNX(IT,K,XG,YG)*X(K)
+ DYKDX=DYKDX+DNX(IT,K,XG,YG)*Y(K)
+ DXKDY=DXKDY+DNY(IT,K,XG,YG)*X(K)
+ DYKDY=DYKDY+DNY(IT,K,XG,YG)*Y(K)
+ END DO
+ DET=DXKDX*DYKDY-DXKDY*DYKDX
+ DX=(-DYKDY*XK+DXKDY*YK)/DET
+ DY=( DYKDX*XK-DXKDX*YK)/DET
+ XG=XG+DX
+ YG=YG+DY
+ IF(ABS(DX).LT.TOL .AND. ABS(DY).LT.TOL) GO TO 420
+ END DO
+!-
+!......NOW GET WEIGHTING FUNCTIONS FOR QUAD FUNCTION
+!-
+ 420 CONTINUE
+
+
+ RETURN
+ END
+
+ SUBROUTINE DELEM(J)
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+!
+!-
+!......DELETE ELEMENT
+!
+! Search for elements that attach to node J and remove them
+!
+
+ IMATSTO(J,1)=0
+ DO KK=1,8
+ NOPSTO(J,KK,1)=0
+ ENDDO
+!
+
+ RETURN
+ END
+
+
+ SUBROUTINE MERGEMESH
+
+ USE BLK1MOD
+ LOGICAL LSTAT
+! INCLUDE 'BLK1.COM'
+
+! Loop on element to be added
+
+ DO N=1,NESTO(1)
+
+ IF(IMATSTO(N,1) .NE. 0) THEN
+ if(mod(n,1000) .eq. 0) write(90,*) 'adding',n,nesto(1)
+ flush(90)
+ IF(IMATSTO(N,1) .GT. 900 .AND. IMATSTO(N,1) .LT. 904) THEN
+ X1=XUSRSTO(NOPSTO(N,1,1),1)
+ Y1=YUSRSTO(NOPSTO(N,1,1),1)
+ CALL CHECKIN(X1,Y1,LSTAT)
+ IF(ISTATUS .EQ. 5) THEN
+ CALL DELEM(N)
+ GO TO 400
+ ENDIF
+ GO TO 400
+ ENDIF
+
+! loop on sides
+
+ DO M=1,7,2
+ N1=NOPSTO(N,M,1)
+ IF(M .EQ. 3 .AND. NOPSTO(N,5,1) .EQ. 0) GO TO 400
+ IF(N1 .GT. 0) THEN
+ IF((M .EQ. 5 .AND. NOPSTO(N,7,1) .EQ. 0) .OR. (M .EQ. 7)) THEN
+ N2=NOPSTO(N,1,1)
+ ELSE
+ N2=NOPSTO(N,M+2,1)
+ ENDIF
+ IF(NKEP(N1) .EQ. 1 .AND. NKEP(N2) .EQ. 1) GO TO 380
+
+! Now loop trough existing elements
+
+ DO I=1,NE
+ IF(IMAT(I) .NE. 0) THEN
+ DO J=1,7,2
+ M1=NOP(I,J)
+ IF(J .EQ. 3 .AND. NOP(I,5) .EQ. 0) GO TO 360
+ IF(M1 .GT. 0) THEN
+ IF((J .EQ. 5 .AND. NOP(I,7) .EQ. 0) .OR. (J .EQ. 7)) THEN
+ M2=NOP(I,1)
+ ELSE
+ M2=NOP(I,J+2)
+ ENDIF
+ if(m2 .eq. 0) cycle
+ X1=XUSRSTO(N1,1)
+ X2=XUSRSTO(N2,1)
+ Y1=YUSRSTO(N1,1)
+ Y2=YUSRSTO(N2,1)
+ X3=XUSR(M1)
+ X4=XUSR(M2)
+ Y3=YUSR(M1)
+ Y4=YUSR(M2)
+ CALL IGrIntersectLine(X1,Y1,X2,Y2,X3,Y3,X4,Y4,XINTER,YINTER,ISTATUS)
+ IF(ISTATUS .EQ. 5) THEN
+ CALL DELEM(N)
+ GO TO 400
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+360 CONTINUE
+ ENDDO
+ ENDIF
+380 CONTINUE
+ ENDDO
+ ENDIF
+ 400 CONTINUE
+ ENDDO
+
+ RETURN
+ END
+
+ SUBROUTINE CHECKIN(X1,Y1,LSTAT)
+ USE BLK1MOD
+ LOGICAL LSTAT
+ DIMENSION XP(4),YP(4)
+! Now loop trough existing elements
+
+ DO I=1,NE
+ IF(IMAT(I) .NE. 0) THEN
+ JJ=0
+ DO J=1,7,2
+ INODE=NOP(I,J)
+ IF(INODE .GT. 0) THEN
+ JJ=JJ+1
+ XP(JJ)=XUSR(INODE)
+ YP(JJ)=YUSR(INODE)
+ ENDIF
+ ENDDO
+ LSTAT=IGrInsidePolygon(XP,YP,JJ,X1,Y1)
+ IF(LSTAT) RETURN
+ ENDIF
+ ENDDO
+ RETURN
+ END
+ SUBROUTINE KCONST(isw1)
+!
+! ESTABLISH ELEMENT CONNECTED TO ELEMENT TABLE
+!
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+!
+! INITIALIZE
+!
+ NCM=11
+ DO 200 J=1,NCM
+ DO 200 N=1,NPSTO(1)
+ 200 NECON(N,J)=0
+ DO 230 N=1,NPSTO(1)
+ 230 NDELM(N)=0
+!
+! FORM TABLE OF ELEMENTS CONNECTED TO EACH NODE
+!
+ DO 300 M=1,NESTO(1)
+ IF(IMATSTO(M,1) .EQ. 0) GO TO 300
+ if(isw1 .eq. 1) then
+ if(imat(m) .eq. 999) go to 300
+ endif
+ DO 280 K=1,8
+ N=NOPSTO(M,K,1)
+ IF (N .GT. 0) THEN
+ NDELM(N)=NDELM(N)+1
+ J=NDELM(N)
+ NECON(N,J)=M
+!ipkoct93 ELSE
+!ipkoct93 GO TO 300
+ ENDIF
+ 280 CONTINUE
+ 300 END DO
+ RETURN
+ END
+
\ No newline at end of file
diff --git a/src/src83e/adjustopt.f90 b/src/src83e/adjustopt.f90
new file mode 100644
index 0000000..e9fbd60
--- /dev/null
+++ b/src/src83e/adjustopt.f90
@@ -0,0 +1,49 @@
+!IPK NEW ROUTINE SEP 9 2006
+ SUBROUTINE ADJUSTOPT(NTYP,NLOCC)
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: NTYP,NLOCC
+
+
+ call wdialogload(IDD_SETOPT)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_SETOPT)
+ ierr=infoerror(1)
+
+ IF(NTYP .EQ. 1) THEN
+ call wdialogputRadioButton(idf_radio1)
+ ELSE
+ call wdialogputRadioButton(idf_radio2)
+ ENDIF
+ call wdialogputcheckbox(IDF_check1,NLOCC)
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ntyp)
+
+ call wdialogGetcheckbox(IDF_check1,NLOCC)
+ GO TO 100
+ ENDIF
+
+ enddo
+
+ 100 CONTINUE
+ return
+ end
diff --git a/src/src83e/backc.f90 b/src/src83e/backc.f90
new file mode 100644
index 0000000..f463e5f
--- /dev/null
+++ b/src/src83e/backc.f90
@@ -0,0 +1,40 @@
+ SUBROUTINE backc(ient)
+
+ use winteracter
+
+ implicit none
+
+ include 'd.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: iw,ih,ihandle,ient,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM,IRGB
+ common /hands/ ihandle,IHAND1,IHAND2,IXPM,IYPX,IXPX,IYPM
+ if(ient .eq. 1) then
+ iw=WinfoWindow(WindowWidth)
+ ih=WinfoWindow(WindowHeight)
+ WRITE(90,*) 'IW,IH',IW,IH
+ IF(IHANDLE .EQ. 0) THEN
+ IRGB = WRGB(220,220,220)
+ call WBitmapCreate(ihandle,iw,ih,irgb)
+ call IGrSelect(DrawBitmap,ihandle)
+! CALL WBitmapPut(IHAND2,1,1,IXPM,IYPX,IXPX,IYPM)
+ ELSE
+ call IGrSelect(DrawBitmap,ihandle)
+! CALL WBitmapPut(IHAND2,1,1,IXPM,IYPX,IXPX,IYPM)
+
+ ENDIF
+ return
+ else
+ call IGrSelect(DrawWin)
+ call WBitmapPut(ihandle,0,0)
+ call WBitmapDestroy(ihandle)
+ ihandle=0
+
+ endif
+ return
+ end
diff --git a/src/src83e/blkmap.f90 b/src/src83e/blkmap.f90
new file mode 100644
index 0000000..79c64a5
--- /dev/null
+++ b/src/src83e/blkmap.f90
@@ -0,0 +1,17 @@
+ MODULE BLKMAP
+
+! PARAMETER (MAXPL=500000,MAXELMP=50000)
+
+ REAL*8 XCEN,YCEN,RADS,MAP,XMAP,YMAP,CMAP
+
+ ALLOCATABLE NOPEL(:,:),XCEN(:),YCEN(:)&
+ ,RADS(:) ,NKEY(:),CMAP(:,:)&
+ ,XMAP(:),YMAP(:),VAL(:),CCMAP(:)
+
+ INTEGER IEDGE(15000,2),IGAP(15000),NELFM(15000)
+
+ INTEGER NELTS,MAXPL,MAXELMP
+
+ ALLOCATABLE imap(:),NCRS(:)
+
+ END MODULE
diff --git a/src/src83e/cgen.f90 b/src/src83e/cgen.f90
new file mode 100644
index 0000000..4ac2e45
--- /dev/null
+++ b/src/src83e/cgen.f90
@@ -0,0 +1,151 @@
+ SUBROUTINE CGEN
+
+! Routine to establish contour lines
+
+ USE BLKMAP
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+ DIMENSION XINT(2),YINT(2),CSEL(100)&
+ ,X(5),Y(5),VALC(5)
+ COMMON /CCGEN/ XCLIN(4000,2),YCLIN(4000,2),ALIN(-4000:4000,2),IUSED(4000)
+ COMMON /OPTION/ SWITCH(4),NUMV,CONTUR(99),IQUAL,XCSQ,NUMCOL
+ common itempel(5000)
+
+! Set up contours to be developed
+!
+ CALL TOLMAX(WD,TTMIN,TTMAX)
+
+
+ ISZ=1
+ CALL CSET(TTMIN,TTMAX,isz)
+
+ NCLIN=NUMV
+
+ DO N=1,NUMV
+ CSEL(N)=CONTUR(N)
+ ENDDO
+
+! Loop through each contour then each element
+
+ DO J=1,NCLIN
+
+ ILIN=0
+ DO N=1,NE
+ IF(IMAT(N) .GT. 0 .AND. IMAT(N) .LT. 901 .AND. NCORN(N) .GT. 5) THEN
+ ISWT=0
+ NCNX=NCORN(N)/2
+ DO K=1,3
+ X(K)=XUSR(NOP(N,2*K-1))
+ Y(K)=YUSR(NOP(N,2*K-1))
+ VALC(K)=WD(NOP(N,2*K-1))
+ ENDDO
+ NCNXX=3
+ CALL CGENTR(N,ISWT,NCNXX,X,Y,VALC,CSEL(J),XINT,YINT)
+ IF(ISWT .GT. 0) THEN
+ ILIN=ILIN+1
+ DO K=1,2
+ XCLIN(ILIN,K)=XINT(K)
+ YCLIN(ILIN,K)=YINT(K)
+ ENDDO
+ itempel(ilin)=n
+ ENDIF
+
+ IF(NCNX .EQ. 4) THEN
+ ISWT=0
+ DO K=3,5
+ IF(K .LT. 5) THEN
+ KK=2*K-1
+ ELSE
+ KK=1
+ ENDIF
+ X(K-2)=XUSR(NOP(N,KK))
+ Y(K-2)=YUSR(NOP(N,KK))
+ VALC(K-2)=WD(NOP(N,KK))
+ ENDDO
+ CALL CGENTR(N,ISWT,NCNXX,X,Y,VALC,CSEL(J),XINT,YINT)
+ IF(ISWT .GT. 0) THEN
+ ILIN=ILIN+1
+ DO K=1,2
+ XCLIN(ILIN,K)=XINT(K)
+ YCLIN(ILIN,K)=YINT(K)
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ do k=1,ilin
+ write(199,'(2i5,4f15.3)') k,itempel(k),xclin(k,1),yclin(k,1),xclin(k,2),yclin(k,2)
+ enddo
+
+! Join up points to form contour lines
+
+ IF(ILIN .GT. 0) CALL JLINE(ILIN,CSEL(J))
+
+ ENDDO
+ MAXPTS=MAXPTS+1
+ CMAP(MAXPTS,1) = VOID
+ CMAP(MAXPTS,2) = VOID
+ XMAP(MAXPTS) = VOID
+ YMAP(MAXPTS) = VOID
+
+ RETURN
+
+ END
+
+ SUBROUTINE CGENTR(N,ISWT,NCN,X,Y,VAL,CVAL,XINT,YINT)
+
+! Routine to find line (if it exists) across element N
+
+ DIMENSION X(5),Y(5),VAL(5),XINT(2),YINT(2)
+
+! Get the max and min
+
+ IF(NCN .EQ. 3) THEN
+ CMAX=MAX(VAL(1),VAL(2),VAL(3))
+ CMIN=MIN(VAL(1),VAL(2),VAL(3))
+ ELSE
+ CMAX=MAX(VAL(1),VAL(2),VAL(3),VAL(4))
+ CMIN=MIN(VAL(1),VAL(2),VAL(3),VAL(4))
+ ENDIF
+
+! Test if there is a contour
+
+ IF(CVAL .LT. CMIN .OR. CVAL .GT. CMAX) THEN
+
+! No then return
+
+ ISWT=0
+ RETURN
+ ELSE
+
+! Yes, determine end locations
+
+ ISWT=1
+ ENDIF
+
+! Find the line number that it crosses
+
+ X(NCN+1)=X(1)
+ Y(NCN+1)=Y(1)
+ VAL(NCN+1)=VAL(1)
+
+ DO K=1,NCN
+ IF(CVAL .GE. VAL(K) .AND. CVAL .LT. VAL(K+1)) THEN
+ FRAC=(CVAL-VAL(K))/(VAL(K+1)-VAL(K))
+ XINT(ISWT)=X(K)+FRAC*(X(K+1)-X(K))
+ YINT(ISWT)=Y(K)+FRAC*(Y(K+1)-Y(K))
+ write(199,'(2i5,4f12.4)') n,k,frac,cval,val(k),val(k+1)
+ ISWT=ISWT+1
+ ELSEIF(CVAL .LT. VAL(K) .AND. CVAL .GE. VAL(K+1)) THEN
+ FRAC=(VAL(K)-CVAL)/(VAL(K)-VAL(K+1))
+ XINT(ISWT)=X(K)+FRAC*(X(K+1)-X(K))
+ YINT(ISWT)=Y(K)+FRAC*(Y(K+1)-Y(K))
+ write(199,'(2i5,4f12.4)') n,k,frac,cval,val(k),val(k+1)
+ ISWT=ISWT+1
+ ENDIF
+
+ ENDDO
+
+ RETURN
+ END
+
diff --git a/src/src83e/chck.bmp b/src/src83e/chck.bmp
new file mode 100644
index 0000000..7149d76
Binary files /dev/null and b/src/src83e/chck.bmp differ
diff --git a/src/src83e/deln2.f90 b/src/src83e/deln2.f90
new file mode 100644
index 0000000..baa355f
--- /dev/null
+++ b/src/src83e/deln2.f90
@@ -0,0 +1,239 @@
+ SUBROUTINE DELN2(NVERT,ISWT1)
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ CHARACTER*80 LIND
+ CHARACTER*1 ANS
+ DATA SPAC/0.0/
+ VOID = -1.E10
+ NEDGE=0
+ NINTV=1
+ NGAP=0
+
+! Check options
+
+ IF(ISWT1 .EQ. 0) THEN
+ CALL TRIANOPT(NINTV,SPAC)
+ ELSE
+ NINTV=1
+ SPAC=0
+ ENDIF
+
+! Sort points into ascending x order
+
+ CALL SORTDB(XUSR,NKEY,NVERT)
+
+! Drop points based on spacing
+
+ IF(ISWT1 .NE. 0) THEN
+ IF(NINTV .GT. 1 .OR. SPAC .GT. 0.) THEN
+ CALL DROPPTS(NVERT,NINTV,SPAC)
+ ENDIF
+ ENDIF
+
+! Get location of supertriangle
+
+ iprt=0
+
+ call supert(XUSR,YUSR,NVERT)
+
+ NELTS=1
+
+ NVERTM=NVERT-3
+
+! Loop on the vertices
+
+ DO NN=1,NVERT-3
+
+! process next point
+
+ N=NKEY(NN)
+! Skip out if inactive point
+ IF(N .EQ. 0) GO TO 500
+ IF(LIST(N) .EQ. 0) GO TO 500
+
+ IF(NN .LT. NVERTM) THEN
+ DO KK=NN+1,NVERTM
+ K=NKEY(KK)
+ IF(K .NE. 0) THEN
+ IF(XUSR(N) .EQ. XUSR(K)) THEN
+ IF(YUSR(N) .EQ. YUSR(K)) THEN
+ WRITE(45,*) 'IDENT',N,K
+ NKEY(KK)=0
+ ENDIF
+ ELSE
+ GO TO 200
+ ENDIF
+ ENDIF
+ 200 CONTINUE
+ ENDDO
+ ENDIF
+
+! Set edge buffers to zero
+
+ IF(NEDGE .GT. 0) THEN
+ DO J=1,NEDGE
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ELSE
+ DO J=1,100
+ IEDGE(J,1)=0
+ IEDGE(J,2)=0
+ END DO
+ ENDIF
+ NEDGE=0
+
+! test for point in circumcircle
+
+ if(n .eq. 6) then
+ aa=0
+ endif
+ DO J=1,NELTS
+ CALL INSIDCIRC(XUSR,YUSR,J,N,ISWT)
+ WRITE(156,*) J,N,ISWT
+
+! If inside process edges
+
+ IF(ISWT .EQ. 1) THEN
+ CALL PROCESS(J,NEDGE,NGAP)
+ WRITE(156,*) J,NEDGE,NGAP
+ ENDIF
+ END DO
+
+! Setup to form new triangles
+
+ CALL SETEDG(NEDGE)
+
+! Now form triangles as needed
+
+ DO J=1,NEDGE
+ NELFM(J)=0
+ IF(IEDGE(J,1) .NE. 0) THEN
+ CALL FORMT(XUSR,YUSR,J,N,NGAP,KK,WD)
+ NELFM(J)=KK
+ ENDIF
+ END DO
+
+ DO J=1,NEDGE
+ IF(NELFM(J) .GT. 0) THEN
+ CALL TESTTR(XUSR,YUSR,NELFM(J),WD)
+ ENDIF
+ ENDDO
+
+ NEDGE=0
+ iprt=1
+ if(iprt .eq. 0) go to 500
+ DO J=1,NELTS
+ IF(NOPEL(J,1) .GT. 0) THEN
+ WRITE(155,'(2i5,2i10,19x,''1'')') J,(NOPEL(J,K),K=1,3)
+ ENDIF
+ END DO
+ ninnin=9999
+! write(150+nn,'(i5)') ninnin
+
+! do j=1,nvert
+! write(150+nn,'(i10,f16.6,f20.6,f10.2)') j,xusr(j),yusr(j),val(j)
+! enddo
+! write(150+nn,'(i10)') ninnin
+ 500 continue
+ END DO
+
+! Get rid of elements from super point
+
+ CALL RIDPOINT(NVERT)
+
+ XUSR(NP+1)=VOID
+ XUSR(NP+2)=VOID
+ XUSR(NP+3)=VOID
+ YUSR(NP+1)=VOID
+ YUSR(NP+2)=VOID
+ YUSR(NP+3)=VOID
+ DO J=1,NELTS
+ DO K=1,3
+ NOPSTO(J,2*K-1,1)=NOPEL(J,K)
+ NOPSTO(J,2*K,1)=0
+ ENDDO
+ NOPSTO(J,7,1)=0
+ NOPSTO(J,8,1)=0
+ IMATSTO(J,1)=1
+ THTASTO(J,1)=0.
+ ENDDO
+ NP=NP-3
+ NPSTO(1)=NP
+ NESTO(1)=NELTS
+
+! Get edge nodes for later filling
+
+! IF(ISWT1 .EQ. 0) THEN
+! CALL GETEDG
+! ENDIF
+ if(iswt1 .eq. 2) then
+ do j=1,np
+ xusrsto(j,1)=xusr(j)
+ yusrsto(j,1)=yusr(j)
+ enddo
+ call mergemesh1(1)
+! call mergemesh
+ endif
+ CALL ADDMESH(1)
+
+ RETURN
+ END SUBROUTINE
+
+
+ SUBROUTINE GETEDG
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+! Look for edges that are duplicates
+
+ DO N=1,NESTO(1)
+ DO NN=1,3
+ N1=NOPEL(N,NN)
+ IF(NN .EQ. 3) THEN
+ N2=NOPEL(N,1)
+ ELSE
+ N2=NOPEL(N,NN+1)
+ ENDIF
+
+ DO M=1,NESTO(1)
+ DO MM=1,3
+ M1=NOPEL(M,MM)
+ IF(M1 .EQ. N2) THEN
+
+! Keep looking for match
+
+ IF(MM .EQ. 3) THEN
+ M2=NOPEL(M,1)
+ ELSE
+ M2=NOPEL(M,MM+1)
+ ENDIF
+ IF(M2 .EQ. N1) THEN
+
+! We have a match, this is no edge skip out to next side
+
+ GO TO 400
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+! No match these nodes are on an edge
+
+ NINC(N1)=1
+ NINC(N2)=1
+
+ 400 CONTINUE
+ ENDDO
+ ENDDO
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/disp.bmp b/src/src83e/disp.bmp
new file mode 100644
index 0000000..f2c35ee
Binary files /dev/null and b/src/src83e/disp.bmp differ
diff --git a/src/src83e/droppts.f90 b/src/src83e/droppts.f90
new file mode 100644
index 0000000..f013402
--- /dev/null
+++ b/src/src83e/droppts.f90
@@ -0,0 +1,41 @@
+ SUBROUTINE DROPPTS(NVERT,NINTV,SPAC)
+
+ USE BLKMAP
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+
+ NN=0
+ DO NM=1,NVERT
+ N=NKEY(NM)
+ IF(LIST(N) .EQ. 1) THEN
+ NN=NN+1
+ IF(MOD(NN-1,NINTV) .EQ. 0) THEN
+ LIST(N)=1
+ ELSE
+ LIST(N)=0
+ ENDIF
+ ENDIF
+ ENDDO
+
+ IF(SPAC .GT. 0.) THEN
+ DO NM=1,NVERT
+ N=NKEY(NM)
+ IF(LIST(N) .EQ. 1) THEN
+ IF(N .LT. NVERT) THEN
+ DO M=N+1,NVERT
+ IF(LIST(M) .EQ. 1) THEN
+ DISQ=(XUSR(M)-XUSR(N))**2+(XUSR(M)-XUSR(N))**2
+ IF(DISQ .LT. SPAC**2) THEN
+ LIST(M)=0
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+
+ RETURN
+ END
diff --git a/src/src83e/form999.f90 b/src/src83e/form999.f90
new file mode 100644
index 0000000..95fd482
--- /dev/null
+++ b/src/src83e/form999.f90
@@ -0,0 +1,421 @@
+!IPK NEW ROUTINE SEP 9 2006
+ SUBROUTINE FORM999(ISWT9,iswtw,NELC)
+!
+! Generate continuity lines
+!
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'TXFRM.COM'
+ CHARACTER*1 IFLAG
+ DIMENSION DIRL(5000),IPROCES(MAXE)
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+
+ DATA SPAC/10./,ieltyp/1/,ielsw/1/,iensw/0/
+
+! DIST(N1,N2)=SQRT((CORD(N1,1)-CORD(N2,1))**2 &
+! & +(CORD(N1,2)-CORD(N2,2))**2)
+! PROJ(N1,N2,DR)= (CORD(N2,1)-CORD(N1,1))*COS(DR)+(CORD(N2,2)-CORD(N1,2))*SIN(DR)
+!
+! WRITE(150,*) 'IN FORM999',ISWT9,iswtw,NELC
+! FLUSH(150)
+ if(iswtw .eq. 1) THEN
+ IFRMEL=0
+ IGTWEL=0
+ CALL ADD999(ISWT9,NELC)
+ RETURN
+ ENDIF
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D elements already formed?','1-D ELEMENTS')
+
+! If answer 'Yes' set ifrmel to 0
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+ IFRMEL=1
+!NO
+! WRITE(150,*) 'GOING TO FROM1DEL'
+! FLUSH(150)
+ CALL FORM1DEL
+! WRITE(150,*) 'BACK FROM FROM1DEL'
+! FLUSH(150)
+
+ ELSE
+!YES
+ IFRMEL=0
+
+
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA')
+
+! If answer 'Yes' set igtwel to 0
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+!NO
+ IGTWEL=1
+ CALL SETWID
+! WRITE(150,*) 'BACK FROM SETWID'
+! FLUSH(150)
+ ELSE
+!YES
+ IGTWEL=0
+! CALL CCLINE(2)
+! WRITE(150,*) 'GOING TO ADD999'
+! FLUSH(150)
+ CALL ADD999(ISWT9,NELC)
+! WRITE(150,*) 'BACK FROM ADD999'
+! FLUSH(150)
+ CALL HEDR
+ RETURN
+ ENDIF
+
+100 CONTINUE
+
+ ENDIF
+
+! GET NODAL CONNECTIONS
+! WRITE(150,*) 'ABOUT TO GO TO NDNECON'
+! FLUSH(150)
+ IERR=0
+ CALL NDNECON(IERR)
+
+! START ALONG LINE OF ELEMENTS
+
+ DO N=1,NTRAC
+
+ N1=ITRAC(N)
+ IF(N .GT. 1) THEN
+ N0=ITRAC(N-1)
+ ENDIF
+ IF(N .LT. NTRAC) THEN
+ N2=ITRAC(N+1)
+ ENDIF
+
+! Get direction
+
+ IF(N .EQ. 1) THEN
+ DIRX=XUSR(N2)-XUSR(N1)
+ DIRY=YUSR(N2)-YUSR(N1)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ELSEIF(N .EQ. NTRAC) THEN
+ DIRX=XUSR(N1)-XUSR(N0)
+ DIRY=YUSR(N1)-YUSR(N0)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ELSE
+ DIRX=XUSR(N2)-XUSR(N0)
+ DIRY=YUSR(N2)-YUSR(N0)
+ DIRL(N)=ATAN2(DIRX,-DIRY)
+ ENDIF
+ ENDDO
+
+! Move nodes apart adding new numbers
+
+ DO N=1,NTRAC
+! WRITE(150,*) 'STARTING NTRAC ITRAC',N,ITRAC(N)
+ N1=ITRAC(N)
+ CALL GETNOD(J)
+ JTRAC(N)=J
+! XUSR(J)=XUSR(N1)-WIDTHD(N1)/2.*COS(DIRL(N))
+! YUSR(J)=YUSR(N1)-WIDTHD(N1)/2.*SIN(DIRL(N))
+ XUSR(J)=XUSR(N1)-WIDTH(N1)/2.*COS(DIRL(N))
+ YUSR(J)=YUSR(N1)-WIDTH(N1)/2.*SIN(DIRL(N))
+ CORD(J,1)=(XUSR(J)+XS)/TXSCAL
+ CORD(J,2)=(YUSR(J)+YS)/TXSCAL
+ INEW(J)=1
+ INSKP(J) = 0
+ WD(J)=-9999.
+ WIDTH(J)=0.
+ SS1(J)=0.
+ SS2(J)=0.
+ WIDS(J)=0.
+ WIDBS(J)=0.
+ SSO(J)=0.
+
+ CALL GETNOD(J1)
+ KTRAC(N)=J1
+! XUSR(J1)=XUSR(N1)+WIDTHD(N1)/2.*COS(DIRL(N))
+! YUSR(J1)=YUSR(N1)+WIDTHD(N1)/2.*SIN(DIRL(N))
+ XUSR(J1)=XUSR(N1)+WIDTH(N1)/2.*COS(DIRL(N))
+ YUSR(J1)=YUSR(N1)+WIDTH(N1)/2.*SIN(DIRL(N))
+ CORD(J1,1)=(XUSR(J1)+XS)/TXSCAL
+ CORD(J1,2)=(YUSR(J1)+YS)/TXSCAL
+ INEW(J1)=1
+ INSKP(J1) = 0
+ WD(J1)=-9999.
+ WIDTH(J1)=0.
+ SS1(J1)=0.
+ SS2(J1)=0.
+ WIDS(J1)=0.
+ WIDBS(J1)=0.
+ SSO(J1)=0.
+ ENDDO
+ DO N=1,NTRAC-1
+ CALL GETELM(J)
+ NOP(J,1)=ITRAC(N+1)
+ NOP(J,3)=ITRAC(N)
+ NOP(J,5)=JTRAC(N)
+ NOP(J,7)=JTRAC(N+1)
+ NOP(J,2)=0
+ NOP(J,4)=0
+ NOP(J,6)=0
+ NOP(J,8)=0
+ IMAT(J)=999
+ NCORN(J) = 8
+ IESKP(J) = 0
+ CALL GETELM(J)
+ NOP(J,1)=ITRAC(N)
+ NOP(J,3)=ITRAC(N+1)
+ NOP(J,5)=KTRAC(N+1)
+ NOP(J,7)=KTRAC(N)
+ NOP(J,2)=0
+ NOP(J,4)=0
+ NOP(J,6)=0
+ NOP(J,8)=0
+ IMAT(J)=999
+ NCORN(J) = 8
+ IESKP(J) = 0
+ NE = MAX(J,NE)
+ ENDDO
+ NE = MAX(J,NE)
+
+
+ RETURN
+ END
+
+ SUBROUTINE FORM1DEL
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'TXFRM.COM'
+ CHARACTER*1 IFLAG
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Are 1-D nodes already defined?','FORM 1-D ELEMENTS')
+
+! If answer 'Yes' set ifrmel to 0
+!
+ IF (WInfoDialog(4) .ne. 2) then
+
+! yes
+ CALL FRMEL(1)
+ ELSE
+! no
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D ELEMENTS')
+
+! If answer 'Yes' set IGWID=1
+!
+ IF (WInfoDialog(4) .ne. 2) then
+
+! yes
+ IGWID=1
+ ELSE
+ IGWID=0
+! no
+ ENDIF
+
+ CALL WMessageBox(OKCancel, 4, 1,'Click on each node to form elements?'//CHAR(13)// &
+ 'Then click quit to continue','FORM 1-D ELEMENTS')
+ JREF=0
+ NTRAC=0
+ NHTP=0
+ NBRR=3
+ NMESS=15
+ CALL HEDR
+
+ 100 CONTINUE
+ CALL XYLOC(XX,YY,IFLAG,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ GO TO 200
+ ENDIF
+!
+ IF (IFLAG .EQ. 'c') THEN
+!
+ call getnod(j)
+ NTRAC=NTRAC+1
+ ITRAC(NTRAC)=J
+ INSKP(J)=0
+ CORD(J,1) = XX
+ CORD(J,2) = YY
+ INEW(J) = 1
+!
+ XUSR(J) = XX*TXSCAL - XS
+ YUSR(J) = YY*TXSCAL - YS
+ IF (J .GT. NP) NP = J
+ call pltnod(j,1)
+ IF(JREF .EQ.0) THEN
+ WIDTH(J)=50.
+ call nodedisp(j)
+ ELSE
+ WIDTH(J)=WIDTH(J1)
+ WD(J)=WD(J1)
+ SS1(J)=SS1(J1)
+ SS2(J)=SS2(J1)
+ WIDS(J)=WIDS(J1)
+ WIDBS(J)=WIDBS(J1)
+ SSO(J)=SSO(J1)
+ BS1(J)=BS1(J1)
+ IF(IGWID .EQ. 0) THEN
+ call nodedisp(j)
+ ENDIF
+ CALL PLTNOD(J,0)
+ call getelm(k)
+ NOP(K,1)=J1
+ NOP(K,2)=0
+ NOP(K,3)=J
+ NCORN(K)=3
+ IMAT(K)=1
+ IESKP(K) = 0
+ NE = MAX(K,NE)
+ IERC=0
+ CALL PLTELM(K,IERC)
+
+ ENDIF
+ J1=J
+ JREF=1
+ GO TO 100
+ ENDIF
+ ENDIF
+
+ 200 CONTINUE
+ call clscrn
+ CALL PLOTOT(1)
+ NHTP=1
+ NMESS=0
+ NBRR=0
+ CALL HEDR
+ RETURN
+ END
+
+ SUBROUTINE SETWID
+
+ CALL FRMEL(0)
+ RETURN
+ END
+
+ SUBROUTINE FRMEL(ISW)
+
+ USE WINTERACTER
+ USE BLK1MOD
+ USE BLK2MOD
+ include 'd.inc'
+
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'TXFRM.COM'
+ CHARACTER*1 IFLAG
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+
+ integer :: N1,N2,N3,IERR
+
+ NHTP=0
+ NBRR=3
+ NMESS=15
+ CALL HEDR
+
+ IF(ISW .EQ. 1) THEN
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Is width data available?','WIDTH DATA')
+
+! If answer 'Yes' set igtwel to 0
+!
+ IF (WInfoDialog(4) .EQ. 2) then
+!NO
+ IGTWEL=1
+ ELSE
+!YES
+ IGTWEL=0
+ ENDIF
+ ELSE
+
+ IGTWEL=1
+ ENDIF
+
+ IF(IGTWEL .EQ. 1) THEN
+ CALL WMessageBox(YesNo, QuestionIcon, 1,'Use same width etc properties ?','FORM 1-D ELEMENTS')
+
+! If answer 'Yes' set IGWID=1
+!
+ IF (WInfoDialog(4) .ne. 2) then
+
+! yes
+ IGWID=1
+ ELSE
+ IGWID=0
+! no
+ ENDIF
+ ENDIF
+ NTRAC=0
+ 100 CONTINUE
+ CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,J,IFLAG,INSKP,IBOX)
+ IF(IRMAIN .EQ. 1) RETURN
+ IF(IFLAG .EQ. 'q' .OR. (IFLAG .EQ. 'c' .AND. IBOX .EQ. 10))THEN
+ GO TO 200
+ ENDIF
+!
+ IF (IFLAG .EQ. 'c') THEN
+!
+ IF(IGTWEL .EQ. 1) THEN
+ IF(NTRAC .EQ. 0) THEN
+ call nodedisp(j)
+ ELSE
+ WIDTH(J)=WIDTH(J1)
+ WD(J)=WD(J1)
+ SS1(J)=SS1(J1)
+ SS2(J)=SS2(J1)
+ WIDS(J)=WIDS(J1)
+ WIDBS(J)=WIDBS(J1)
+ SSO(J)=SSO(J1)
+ BS1(J)=BS1(J1)
+ IF(IGWID .EQ. 0) THEN
+ call nodedisp(j)
+ ENDIF
+ ENDIF
+ ENDIF
+ CALL PLTNOD(J,0)
+! IF(ISW .EQ. 1) THEN
+ if(ntrac .ne. 0) then
+ call getelm(k)
+ NOP(K,1)=J1
+ NOP(K,2)=0
+ NOP(K,3)=J
+ NCORN(K)=3
+ IMAT(K)=1
+ IESKP(K) = 0
+ NE = MAX(K,NE)
+ IERC=0
+ CALL PLTELM(K,IERC)
+ ENDIF
+ J1=J
+ NTRAC=NTRAC+1
+ ITRAC(NTRAC)=J
+ GO TO 100
+ ENDIF
+ 200 CONTINUE
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/formlinel.f90 b/src/src83e/formlinel.f90
new file mode 100644
index 0000000..a8c5955
--- /dev/null
+++ b/src/src83e/formlinel.f90
@@ -0,0 +1,265 @@
+ SUBROUTINE FORMLINEL(I1D,I2D,JST,JEND,JKP,XLENGTH,ITYPB,ICTT)
+!
+! Routine to create a form series of nodes along a line
+!
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ INCLUDE 'TXFRM.COM'
+! COMPUTE OVERALL LENGTH
+ REAL*8 XNEXT,YNEXT,FRAC,XCUR,YCUR,ZNEXT(3),ZCUR(3)
+ REAL*8 EMB
+ EMB=5.
+ TOTLEN=0.
+ DO J=JST,JEND-1
+ TOTLEN=TOTLEN+SQRT((ALXX(J+1)-ALXX(J))**2+(ALYY(J+1)-ALYY(J))**2)
+ ENDDO
+! ESTIMATE NUMBER OF ELEMENTS
+ NELTS=TOTLEN*TXSCAL/XLENGTH+1
+ if(ictt .ne. 0) then
+ nelts=nelts+2
+ if(ictt .eq. 1) then
+ XLENGTH=TOTLEN*TXSCAL/(NELTS-2)
+ else
+ XLENGTH=(TOTLEN*TXSCAL-EMB*2)/(NELTS-2)
+ ENDIF
+ ELSE
+ XLENGTH=TOTLEN*TXSCAL/NELTS
+ ENDIF
+! GET NEW NODE LOCATIONS AND CREAT ELEMENT
+! JFIST=0
+ IF(JKP .EQ. 0) THEN
+! JFIST=1
+ CALL GETNOD(J)
+ JKP=J
+!
+! Store ALXX and ALYY into it
+!
+
+ CORD(J,1) = ALXX(1)
+ CORD(J,2) = ALYY(1)
+ WD(J)=HMID(J)
+ HSET(J,1)=HLEFT(1)
+ HSET(J,2)=HMID(1)
+ HSET(J,3)=HRIGHT(1)
+ IF(ALWD(1).GT. 0.) THEN
+ WIDTHD(J)=ALWD(1)
+ ENDIF
+ INEW(J) = 1
+ INSKP(J) = 0
+!
+ XUSR(J) = ALXX(1)*TXSCAL - XS
+ YUSR(J) = ALYY(1)*TXSCAL - YS
+!
+! Display point
+!
+ ENDIF
+ CALL PLTNOD(JKP,1)
+ JPTC=JST+1
+ XLENGTHR=XLENGTH/TXSCAL
+ XCUR=ALXX(JST)
+ YCUR=ALYY(JST)
+ DO N=1,NELTS
+ IF(NELTS .EQ. 1) THEN
+ XNEXT=ALXX(JEND)
+ YNEXT=ALYY(JEND)
+ if(ictt .eq. 0) then
+ ZNEXT(1)=HLEFT(JEND)
+ ZNEXT(2)=HMID(JEND)
+ ZNEXT(3)=HRIGHT(JEND)
+ else
+ ZNEXT(1)=HLEFT(JST)
+ ZNEXT(2)=HMID(JST)
+ ZNEXT(3)=HRIGHT(JST)
+ endif
+ CALL GETNOD(J)
+
+ IF(ALWD(J).GT. 0.) THEN
+ WIDTHD(J)=ALWD(JEND)
+ ENDIF
+ ELSEIF(N .EQ. 1 .AND. ICTT .NE. 0) THEN
+ IF(ICTT .EQ. 1) THEN
+ XNEXT=XCUR
+ YNEXT=YCUR
+ ZCUR(1)=HLEFT(JST)
+ ZCUR(2)=HMID(JST)
+ ZCUR(3)=HRIGHT(JST)
+ ZNEXT(1)=HLEFT(JST)
+ ZNEXT(2)=HMID(JST)
+ ZNEXT(3)=HRIGHT(JST)
+ ELSE
+ ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
+ XNEXT=XCUR+EMB/TXSCAL*COS(ANGLEL)
+ YNEXT=YCUR+EMB/TXSCAL*SIN(ANGLEL)
+ ZCUR(1)=HLEFT(JST)
+ ZCUR(2)=HMID(JST)
+ ZCUR(3)=HRIGHT(JST)
+ ENDIF
+ CALL GETNOD(J)
+ IF(ALWD(J).GT. 0.) THEN
+ WIDTHD(J)=ALWD(JST)
+ ENDIF
+! ELSEIF(N .EQ. 1 .AND. ICTT .EQ. 0) THEN
+! ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
+! XNEXT=XCUR+EMB/TXSCAL*COS(ANGLEL)
+! YNEXT=YCUR+EMB/TXSCAL*SIN(ANGLEL)
+! ZCUR(1)=HLEFT(JST+1)
+! ZCUR(2)=HMID(JST+1)
+! ZCUR(3)=HRIGHT(JST+1)
+! CALL GETNOD(J)
+! IF(ALWD(J).GT. 0.) THEN
+! WIDTHD(J)=ALWD(JST+1)
+! ENDIF
+ ELSEIF(N .EQ. NELTS .AND. ICTT .NE. 0) THEN
+ IF(ICTT .EQ. 1) THEN
+ XNEXT=ALXX(JEND)
+ YNEXT=ALYY(JEND)
+ ZCUR(1)=HLEFT(JEND)
+ ZCUR(2)=HMID(JEND)
+ ZCUR(3)=HRIGHT(JEND)
+ ZNEXT(1)=ZCUR(1)
+ ZNEXT(2)=ZCUR(2)
+ ZNEXT(3)=ZCUR(3)
+ ELSE
+ XNEXT=ALXX(JEND)
+ YNEXT=ALYY(JEND)
+ ZCUR(1)=HLEFT(JEND)
+ ZCUR(2)=HMID(JEND)
+ ZCUR(3)=HRIGHT(JEND)
+ ENDIF
+ CALL GETNOD(J)
+ IF(ALWD(J).GT. 0.) THEN
+ WIDTHD(J)=ALWD(JST)
+ ENDIF
+ ELSE
+ 500 ANGLEL=ATAN2(ALYY(JPTC)-ALYY(JPTC-1),ALXX(JPTC)-ALXX(JPTC-1))
+ XNEXT=XCUR+XLENGTHR*COS(ANGLEL)
+ YNEXT=YCUR+XLENGTHR*SIN(ANGLEL)
+ IF(ALXX(JPTC)-ALXX(JPTC-1) .NE. 0.) THEN
+ FRAC=(XNEXT-ALXX(JPTC-1))/(ALXX(JPTC)-ALXX(JPTC-1))
+ ELSEIF(ALYY(JPTC)-ALYY(JPTC-1) .NE. 0.) THEN
+ FRAC=(YNEXT-ALYY(JPTC-1))/(ALYY(JPTC)-ALYY(JPTC-1))
+ ELSE
+ FRAC=1.5
+ ENDIF
+
+ IF(FRAC .GT. 1.00001 .AND. JPTC .LT. JEND) THEN
+ XLENGTHR=XLENGTHR-SQRT((ALXX(JPTC)-XCUR)**2+(ALYY(JPTC)-YCUR)**2)
+ XCUR=ALXX(JPTC)
+ YCUR=ALYY(JPTC)
+ ZCUR(1)=HLEFT(JPTC)
+ ZCUR(2)=HMID(JPTC)
+ ZCUR(3)=HRIGHT(JPTC)
+ JPTC=JPTC+1
+ GO TO 500
+ ENDIF
+ if(n .eq. nelts .and. ictt .eq. 0) then
+ ZNEXT(1)=HLEFT(JPTC-1)
+ ZNEXT(2)=HMID(JPTC-1)
+ ZNEXT(3)=HRIGHT(JPTC-1)
+ else
+ ZNEXT(1)=HLEFT(JPTC-1)+FRAC*(HLEFT(JPTC)-HLEFT(JPTC-1))
+ ZNEXT(2)=HMID(JPTC-1)+FRAC*(HMID(JPTC)-HMID(JPTC-1))
+ ZNEXT(3)=HRIGHT(JPTC-1)+FRAC*(HRIGHT(JPTC)-HRIGHT(JPTC-1))
+ endif
+ if(ictt .eq. 2) then
+ ZNEXT(1)=-9999.
+ ZNEXT(2)=-9999.
+ ZNEXT(3)=-9999.
+ endif
+! GET NEW LOCATION
+
+ CALL GETNOD(J)
+
+ IF(ALWD(1).GT. 0.) THEN
+ WIDTHD(J)=ALWD(JPTC-1)+FRAC*(ALWD(JPTC)-ALWD(JPTC-1))
+ ENDIF
+ ENDIF
+!
+! Store GRIDX and GRIDY into it
+!
+ CORD(J,1) = XNEXT
+ CORD(J,2) = YNEXT
+ WD(J)=ZNEXT(2)
+ HSET(J,1)=ZNEXT(1)
+ HSET(J,2)=ZNEXT(2)
+ HSET(J,3)=ZNEXT(3)
+ INEW(J) = 1
+ INSKP(J) = 0
+!
+ XUSR(J) = XNEXT*TXSCAL - XS
+ YUSR(J) = YNEXT*TXSCAL - YS
+!
+! Display point
+!
+ CALL PLTNOD(J,1)
+ XCUR=XNEXT
+ YCUR=YNEXT
+ XLENGTHR=XLENGTH/TXSCAL
+
+ IF(I1D .EQ. 1 .OR. I2D .EQ. 1) THEN
+ IF(N .EQ. 1) THEN
+ J1=JKP
+ IF(ALWD(1) .NE. 0.) GO TO 600
+ call nodedisp(jKP)
+ ENDIF
+ IF(ALWD(1) .NE. 0.) GO TO 600
+ WIDTHD(J)=WIDTHD(J1)
+ WD(J)=WD(J1)
+ SS1(J)=SS1(J1)
+ SS2(J)=SS2(J1)
+ WIDS(J)=WIDS(J1)
+ WIDBS(J)=WIDBS(J1)
+ SSO(J)=SSO(J1)
+ BS1(J)=BS1(J1)
+600 CONTINUE
+! IF(N .EQ. 1 .AND. ICTT .EQ. 1) THEN
+! J1=J
+! CYCLE
+! ELSEIF(N .EQ. NELTS .AND. ICTT .EQ. 1) THEN
+ IF(N .EQ. NELTS .AND. ICTT .EQ. 1) THEN
+ WIDTHD(J1)=WIDTHD(J)
+ WD(J1)=WD(J)
+ SS1(J1)=SS1(J)
+ SS2(J1)=SS2(J)
+ WIDS(J1)=WIDS(J)
+ WIDBS(J1)=WIDBS(J)
+ SSO(J1)=SSO(J)
+ BS1(J1)=BS1(J)
+ XUSR(J1)=XUSR(J)
+ YUSR(J1)=YUSR(J)
+ CORD(J1,1)=CORD(J,1)
+ CORD(J1,2)=CORD(J,2)
+ HSET(J1,1)=HSET(J,1)
+ HSET(J1,2)=HSET(J,2)
+ HSET(J1,3)=HSET(J,3)
+ ENDIF
+ call getelm(k)
+ if(n .eq. 1 .and. ictt .eq. 0 .and. jst .ne. 1) then
+ wd(j1)=wd(j)
+ hset(j1,1)=hset(j,1)
+ hset(j1,2)=hset(j,2)
+ hset(j1,3)=hset(j,3)
+ endif
+ NOP(K,1)=J1
+ NOP(K,2)=0
+ NOP(K,3)=J
+ NCORN(K)=3
+ IMAT(K)=ITYPB
+ if(ictt .eq. 1) then
+ if(n .eq. 1) imat(k)= 2000
+ if(n .eq. nelts) imat(k)= 2001
+ endif
+ IESKP(K) = 0
+ NE = MAX(K,NE)
+ IERC=0
+ CALL PLTELM(K,IERC)
+ J1=J
+ ENDIF
+
+ ENDDO
+ JKP=J
+ RETURN
+ END
+
+
\ No newline at end of file
diff --git a/src/src83e/frmnodt.f90 b/src/src83e/frmnodt.f90
new file mode 100644
index 0000000..6874960
--- /dev/null
+++ b/src/src83e/frmnodt.f90
@@ -0,0 +1,58 @@
+ SUBROUTINE FRMNODT(X1,Y1,X2,Y2,X3,Y3,NPTS)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+! X1,X2,X3 AND Y1,Y2,Y3 are vertices of triangle
+! NPTS is the nominal number of elements on each side
+
+
+! Work along first side AND backwards along second line
+
+ DO N=1,NPTS-1
+ RATIO=FLOAT(N)/FLOAT(NPTS)
+ X12=X1+RATIO*(X2-X1)
+ Y12=Y1+RATIO*(Y2-Y1)
+ X32=X3+RATIO*(X2-X3)
+ Y32=Y3+RATIO*(Y2-Y3)
+
+! Now get interior points
+
+ NINT=NPTS-N
+ DO M=1,NINT-1
+ RATIO=FLOAT(M)/FLOAT(NINT)
+ XNEW=X12+RATIO*(X32-X12)
+ YNEW=Y12+RATIO*(Y32-Y12)
+ CALL DEFNOD(XNEW,YNEW)
+ ENDDO
+ ENDDO
+ RETURN
+ END
+
+ SUBROUTINE DEFNOD(XNEW,YNEW)
+
+ USE BLK1MOD
+ USE BLK2MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'BLK2.COM'
+ INCLUDE 'TXFRM.COM'
+
+ CALL GETNOD(N2)
+ CORD(N2,1) = XNEW
+ CORD(N2,2) = YNEW
+ WD(N2)=-9999.
+ WIDTH(N2) = 0.
+ SS1(N2)=0.
+ SS2(N2)=0.
+ WIDS(N2)=0.
+ BS1(N2)=0.
+ INSKP(N2)=0
+ INEW(N2) = 1
+!
+ XUSR(N2) = CORD(N2,1)*TXSCAL - XS
+ YUSR(N2) = CORD(N2,2)*TXSCAL - YS
+ LIST(N2)=1
+ CALL PLTNOD(N2,1)
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/getlaydat.f90 b/src/src83e/getlaydat.f90
new file mode 100644
index 0000000..831f520
--- /dev/null
+++ b/src/src83e/getlaydat.f90
@@ -0,0 +1,58 @@
+ SUBROUTINE GETLAYDAT(NLAY,ipos,rlay)
+
+ use winteracter
+
+ implicit none
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IPOS,NLAY,I
+ INTEGER :: JNK,ierr
+ REAL :: rlay(9)
+
+ call wdialogload(IDD_LAY)
+ ierr=infoerror(1)
+
+
+ IF(IPOS .EQ. 1) THEN
+ call wdialogputRadioButton(idf_radio1)
+ ELSE
+ call wdialogputRadioButton(idf_radio2)
+ ENDIF
+ CALL WDialogPutINTEGER(IDF_INTEGER1,NLAY)
+ do i=1,7
+ CALL WGridPutCellReal(IDF_GRID1,i,1,rlay(i))
+ enddo
+
+
+ CALL WDialogSelect(IDD_LAY)
+ ierr=infoerror(1)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+
+ do
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+ call wdialoggetradiobutton(idf_radio1,ipos)
+
+ CALL WDialogGetINTEGER(IDF_INTEGER1,NLAY)
+ do i=1,7
+ CALL WGridGetCellReal(IDF_GRID1,i,1,rlay(i))
+ enddo
+ return
+ ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
+ RETURN
+ endif
+!IPK SEP02
+ return
+ enddo
+ RETURN
+ END
diff --git a/src/src83e/interpelv.f90 b/src/src83e/interpelv.f90
new file mode 100644
index 0000000..1b393e4
--- /dev/null
+++ b/src/src83e/interpelv.f90
@@ -0,0 +1,78 @@
+ SUBROUTINE INTERPWLV(NODE1,H,ARIV,WRIV,DWRIV)
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+
+ NLSEC11=NRIVCR1(node1)
+ IF(NRIVL(NLSEC11) .EQ. 0) THEN
+ IF(WTRIVCR1(node1) .gt. 0.) THEN
+ ARIV=0.
+ WRIV=0.
+ RETURN
+ ELSE
+ A11=0.
+ W11=0.
+ DW11=0.
+ GO TO 272
+ ENDIF
+ ENDIF
+ DO K=2,NRIVL(NLSEC11)
+ DEPL=CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,1,1)
+ IF(DEPL .GT. H) THEN
+ FRAC= (H+CRSDAT(NLSEC11,1,1)-CRSDAT(NLSEC11,K-1,1))/&
+ (CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,K-1,1))
+ A11=CRSDAT(NLSEC11,K-1,2)*(1.-FRAC) +&
+ CRSDAT(NLSEC11,K,2)*FRAC
+ W11=CRSDAT(NLSEC11,K-1,3)*(1.-FRAC) +&
+ CRSDAT(NLSEC11,K,3)*FRAC
+ DW11=(CRSDAT(NLSEC11,K,3)-CRSDAT(NLSEC11,K-1,3))/&
+ (CRSDAT(NLSEC11,K,1)-CRSDAT(NLSEC11,K-1,1))
+ GO TO 272
+ ENDIF
+ ENDDO
+
+!IPK MAY04 ALLOW FOR LEVEL ABOVE HIGHEST LAYER
+
+ W11=CRSDAT(NLSEC11,NRIVL(NLSEC11),3)
+ DW11=0.
+ A11=CRSDAT(NLSEC11,NRIVL(NLSEC11),2)+W11*(H-DEPL)
+
+ 272 CONTINUE
+ NLSEC12=NRIVCR2(node1)
+ IF(NRIVL(NLSEC12) .EQ. 0) THEN
+ IF(WTRIVCR2(node1) .gt. 0.) THEN
+ ARIV=0.
+ WRIV=0.
+ RETURN
+ ELSE
+ A12=0.
+ W12=0.
+ DW12=0.
+ GO TO 274
+ ENDIF
+ ENDIF
+ DO K=2,NRIVL(NLSEC12)
+ DEPL=CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,1,1)
+ IF(DEPL .GT. H) THEN
+ FRAC= (H+CRSDAT(NLSEC12,1,1)-CRSDAT(NLSEC12,K-1,1))/&
+ (CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,K-1,1))
+ A12=CRSDAT(NLSEC12,K-1,2)*(1.-FRAC) +&
+ CRSDAT(NLSEC12,K,2)*FRAC
+ W12=CRSDAT(NLSEC12,K-1,3)*(1.-FRAC) +&
+ CRSDAT(NLSEC12,K,3)*FRAC
+ DW12=(CRSDAT(NLSEC12,K,3)-CRSDAT(NLSEC12,K-1,3))/&
+ (CRSDAT(NLSEC12,K,1)-CRSDAT(NLSEC12,K-1,1))
+ GO TO 274
+ ENDIF
+ ENDDO
+!IPK MAY04 ALLOW FOR LEVEL ABOVE HIGHEST LAYER
+ W12=CRSDAT(NLSEC12,NRIVL(NLSEC12),3)
+ DW12=0.
+ A12=CRSDAT(NLSEC12,NRIVL(NLSEC12),2)+W12*(H-DEPL)
+ 274 CONTINUE
+ ARIV=WTRIVCR1(node1)*A11+WTRIVCR2(node1)*A12
+ WRIV=WTRIVCR1(node1)*W11+WTRIVCR2(node1)*W12
+ DWRIV=WTRIVCR1(node1)*DW11+WTRIVCR2(node1)*DW12
+
+ 300 RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/resource.fd b/src/src83e/resource.fd
new file mode 100644
index 0000000..c22a66d
--- /dev/null
+++ b/src/src83e/resource.fd
@@ -0,0 +1,276 @@
+!MS$FREEFORM
+! Microsoft Developer Studio generated include file.
+! Used by rmagen73f.RC
+!
+ integer, parameter :: IDD_DIALOG1 = 101
+ integer, parameter :: IDD_DIALOG02 = 102
+ integer, parameter :: IDD_DIALOG05 = 103
+ integer, parameter :: IDD_DIALOG04 = 104
+ integer, parameter :: IDD_DIALOG006 = 105
+ integer, parameter :: IDD_DIALOG07 = 106
+ integer, parameter :: IDD_DIALOG08 = 107
+ integer, parameter :: IDD_DIALOG09 = 108
+ integer, parameter :: IDD_DIALOG10 = 109
+ integer, parameter :: IDD_DIALOG010 = 110
+ integer, parameter :: IDD_DIALOG001 = 111
+ integer, parameter :: IDD_REGST = 112
+ integer, parameter :: IDD_DIALOG012 = 113
+ integer, parameter :: IDD_SLRGNO = 114
+ integer, parameter :: IDD_CONFIRM = 115
+ integer, parameter :: IDD_nodedata = 116
+ integer, parameter :: IDD_eltdata = 117
+ integer, parameter :: IDD_SELNODE = 118
+ integer, parameter :: IDD_SELELT = 119
+ integer, parameter :: IDD_ELTERR = 120
+ integer, parameter :: IDD_headertp = 121
+ integer, parameter :: IDD_TRIAN = 122
+ integer, parameter :: IDD_NODERR = 123
+ integer, parameter :: IDD_TRIANG = 124
+ integer, parameter :: IDD_QUAD = 125
+ integer, parameter :: IDD_DIALOG06 = 126
+ integer, parameter :: IDD_CSLOC = 127
+ integer, parameter :: IDD_CREATM = 128
+ integer, parameter :: IDD_TEMPLATE001 = 129
+ integer, parameter :: IDD_CREATM1 = 130
+ integer, parameter :: IDD_ORDEROUT = 131
+ integer, parameter :: IDD_TEMPLATE002 = 132
+ integer, parameter :: IDD_selcrsec = 133
+ integer, parameter :: IDD_TEMPLATE003 = 134
+ integer, parameter :: IDD_LIMITS = 135
+ integer, parameter :: IDD_lAY = 136
+ integer, parameter :: IDD_TEMPLATE004 = 137
+ integer, parameter :: IDD_SELTFL2 = 148
+ integer, parameter :: IDD_GETINT = 153
+ integer, parameter :: IDD_GETFPN = 154
+ integer, parameter :: IDD_GETINTP = 160
+ integer, parameter :: IDF_LABEL1 = 1001
+ integer, parameter :: IDF_LABEL2 = 1002
+ integer, parameter :: IDF_LABEL3 = 1003
+ integer, parameter :: IDF_LABEL4 = 1004
+ integer, parameter :: IDF_CMAP8 = 1005
+ integer, parameter :: IDF_LABEL6 = 1005
+ integer, parameter :: IDF_CMAP9 = 1006
+ integer, parameter :: IDF_LABEL8 = 1006
+ integer, parameter :: IDF_CMAP0 = 1007
+ integer, parameter :: IDF_LABEL9 = 1007
+ integer, parameter :: IDF_CMAP1 = 1008
+ integer, parameter :: IDF_LABEL10 = 1008
+ integer, parameter :: IDF_CMAP2 = 1009
+ integer, parameter :: IDF_LABEL12 = 1009
+ integer, parameter :: IDF_CMAP10 = 1010
+ integer, parameter :: IDF_CMAP11 = 1011
+ integer, parameter :: IDF_CMAP3 = 1012
+ integer, parameter :: IDF_STRING1 = 1013
+ integer, parameter :: IDF_STRING2 = 1014
+ integer, parameter :: IDF_STRING3 = 1015
+ integer, parameter :: IDF_STRING4 = 1016
+ integer, parameter :: IDF_STRING5 = 1017
+ integer, parameter :: IDF_STRING6 = 1018
+ integer, parameter :: IDF_STRING7 = 1019
+ integer, parameter :: IDF_STRING8 = 1020
+ integer, parameter :: IDF_STRING9 = 1021
+ integer, parameter :: IDF_STRING10 = 1022
+ integer, parameter :: IDF_STRING11 = 1023
+ integer, parameter :: IDF_STRING12 = 1024
+ integer, parameter :: IDF_STRING13 = 1025
+ integer, parameter :: IDF_STRING14 = 1026
+ integer, parameter :: IDF_STRING15 = 1027
+ integer, parameter :: IDF_STRING16 = 1028
+ integer, parameter :: IDF_STRING17 = 1029
+ integer, parameter :: IDF_STRING18 = 1030
+ integer, parameter :: IDF_STRING19 = 1031
+ integer, parameter :: IDF_STRING20 = 1032
+ integer, parameter :: IDF_STRING21 = 1033
+ integer, parameter :: IDF_STRING22 = 1034
+ integer, parameter :: IDF_STRING23 = 1035
+ integer, parameter :: IDF_CHECK1 = 1036
+ integer, parameter :: IDF_CHECK2 = 1037
+ integer, parameter :: IDF_CHECK3 = 1038
+ integer, parameter :: IDF_CHECK4 = 1039
+ integer, parameter :: IDF_CHECK5 = 1040
+ integer, parameter :: IDF_STRING24 = 1041
+ integer, parameter :: IDF_CHECK6 = 1041
+ integer, parameter :: IDF_LABEL5 = 1042
+ integer, parameter :: IDF_CHECK7 = 1042
+ integer, parameter :: IDF_STRING35 = 1042
+ integer, parameter :: IDF_CMAP4 = 1043
+ integer, parameter :: IDF_CHECK8 = 1043
+ integer, parameter :: IDF_LABEL11 = 1043
+ integer, parameter :: IDF_CMAP5 = 1044
+ integer, parameter :: IDF_CHECK9 = 1044
+ integer, parameter :: IDF_CMAP6 = 1045
+ integer, parameter :: IDF_CHECK10 = 1045
+ integer, parameter :: IDF_CMAP7 = 1046
+ integer, parameter :: IDF_RADIO1 = 1047
+ integer, parameter :: IDF_RADIO2 = 1048
+ integer, parameter :: IDF_RADIO3 = 1049
+ integer, parameter :: IDF_RADIO4 = 1050
+ integer, parameter :: IDF_RADIO5 = 1051
+ integer, parameter :: IDF_RADIO6 = 1052
+ integer, parameter :: IDF_RADIO7 = 1053
+ integer, parameter :: IDF_RADIO8 = 1054
+ integer, parameter :: IDF_RADIO9 = 1055
+ integer, parameter :: IDF_LABEL7 = 1056
+ integer, parameter :: IDF_RADIO10 = 1056
+ integer, parameter :: IDF_INTEGER1 = 1057
+ integer, parameter :: IDF_RADIO11 = 1057
+ integer, parameter :: IDF_INTEGER2 = 1058
+ integer, parameter :: IDF_RADIO12 = 1058
+ integer, parameter :: IDF_CHECK11 = 1059
+ integer, parameter :: IDF_INTEGER3 = 1059
+ integer, parameter :: IDF_RADIO17 = 1059
+ integer, parameter :: IDF_REAL1 = 1060
+ integer, parameter :: IDF_INTEGER4 = 1060
+ integer, parameter :: IDF_REAL2 = 1061
+ integer, parameter :: IDF_INTEGER5 = 1061
+ integer, parameter :: IDF_REAL3 = 1062
+ integer, parameter :: IDF_INTEGER6 = 1062
+ integer, parameter :: IDF_RADIO18 = 1062
+ integer, parameter :: IDF_REAL4 = 1063
+ integer, parameter :: IDF_INTEGER7 = 1063
+ integer, parameter :: IDF_REAL5 = 1064
+ integer, parameter :: IDF_INTEGER8 = 1064
+ integer, parameter :: IDF_REAL6 = 1065
+ integer, parameter :: IDF_REAL7 = 1066
+ integer, parameter :: IDF_REAL8 = 1067
+ integer, parameter :: IDADJUST = 1068
+ integer, parameter :: IDF_REAL9 = 1068
+ integer, parameter :: IDFSWITCH = 1069
+ integer, parameter :: IDF_REAL10 = 1069
+ integer, parameter :: IDF_INTEGER9 = 1070
+ integer, parameter :: IDF_INTEGER10 = 1071
+ integer, parameter :: IDNEXT = 1072
+ integer, parameter :: IDF_Delete = 1073
+ integer, parameter :: IDFROTATE = 1074
+ integer, parameter :: IDF_GRID1 = 1075
+ integer, parameter :: IDF_RADIO13 = 1076
+ integer, parameter :: ISS1 = 1077
+ integer, parameter :: ISS2 = 1078
+ integer, parameter :: ISS3 = 1079
+ integer, parameter :: IDF_RADIO14 = 1080
+ integer, parameter :: IDF_RADIO15 = 1081
+ integer, parameter :: IDF_RADIO16 = 1082
+ integer, parameter :: ISS4 = 1083
+ integer, parameter :: ISS5 = 1084
+ integer, parameter :: ISS6 = 1085
+ integer, parameter :: ISS7 = 1086
+ integer, parameter :: IDF_STRING25 = 1106
+ integer, parameter :: IDF_STRING26 = 1107
+ integer, parameter :: IDF_STRING27 = 1108
+ integer, parameter :: IDF_STRING28 = 1109
+ integer, parameter :: IDF_STRING29 = 1110
+ integer, parameter :: IDF_STRING30 = 1111
+ integer, parameter :: IDF_STRING31 = 1112
+ integer, parameter :: IDF_STRING32 = 1113
+ integer, parameter :: IDF_STRING33 = 1114
+ integer, parameter :: IDF_STRING34 = 1115
+ integer, parameter :: id_chck = 2001
+ integer, parameter :: id_chk = 2002
+ integer, parameter :: idchk = 2003
+ integer, parameter :: IDC_BUTTON2 = 20001
+ integer, parameter :: IDR_MENU1 = 30001
+ integer, parameter :: ID_TOOLBAR1 = 30101
+ integer, parameter :: ID_FILE = 40001
+ integer, parameter :: ID_EXIT = 40002
+ integer, parameter :: ID_NODE = 40003
+ integer, parameter :: ID_ELTS = 40004
+ integer, parameter :: ID_ORDRT = 40005
+ integer, parameter :: ID_CCLN = 40006
+ integer, parameter :: ID_CSEC1 = 40007
+ integer, parameter :: ID_ZOOM = 40008
+ integer, parameter :: ID_DRAW = 40009
+ integer, parameter :: ID_HELP = 40010
+ integer, parameter :: ID_ITEM11 = 40011
+ integer, parameter :: ID_ITEM12 = 40012
+ integer, parameter :: ID_ITEM13 = 40013
+ integer, parameter :: ID_ITEM14 = 40014
+ integer, parameter :: ID_ITEM15 = 40015
+ integer, parameter :: ID_ITEM16 = 40016
+ integer, parameter :: ID_ITEM17 = 40017
+ integer, parameter :: ID_ITEM18 = 40018
+ integer, parameter :: ID_ITEM19 = 40019
+ integer, parameter :: ID_Clip = 40020
+ integer, parameter :: ID_ITEM20 = 40021
+ integer, parameter :: ID_ITEM73 = 40022
+ integer, parameter :: ID_ITEM23 = 40023
+ integer, parameter :: ID_ITEM24 = 40024
+ integer, parameter :: ID_ZIN = 40025
+ integer, parameter :: ID_ZOUT = 40026
+ integer, parameter :: ID_OUT2 = 40027
+ integer, parameter :: ID_OUT4 = 40028
+ integer, parameter :: ID_RSET = 40029
+ integer, parameter :: ID_UNDOM = 40030
+ integer, parameter :: ID_PLEFT = 40031
+ integer, parameter :: ID_PRIGHT = 40032
+ integer, parameter :: ID_PUP = 40033
+ integer, parameter :: ID_PDOWN = 40034
+ integer, parameter :: ID_IDRWT = 40035
+ integer, parameter :: ID_BSEL = 40036
+ integer, parameter :: ID_REGST = 40037
+ integer, parameter :: ID_network = 40038
+ integer, parameter :: ID_TYPD = 40039
+ integer, parameter :: ID_Help1 = 40040
+ integer, parameter :: ID_DRAWD = 40041
+ integer, parameter :: ID_MAPOPD = 40042
+ integer, parameter :: ID_MMAP = 40043
+ integer, parameter :: ID_Help2 = 40044
+ integer, parameter :: ID_NMAP = 40045
+ integer, parameter :: ID_LAYFL = 40046
+ integer, parameter :: ID_BKF = 40047
+ integer, parameter :: ID_ITEM56 = 40048
+ integer, parameter :: ID_Nodedata = 40049
+ integer, parameter :: ID_BACGD = 40050
+ integer, parameter :: ID_Eltdata = 40051
+ integer, parameter :: ID_DRAG = 40052
+ integer, parameter :: ID_GETELM = 40053
+ integer, parameter :: ID_mapm = 40054
+ integer, parameter :: ID_map = 40055
+ integer, parameter :: ID_DCONTR = 40056
+ integer, parameter :: ID_SBIN = 40057
+ integer, parameter :: ID_TRIAN = 40058
+ integer, parameter :: ID_SWMAP = 40059
+ integer, parameter :: ID_CONTR = 40060
+ integer, parameter :: ID_CONTOPT = 40061
+ integer, parameter :: ID_SWRM1 = 40062
+ integer, parameter :: ID_LOADRM1 = 40063
+ integer, parameter :: ID_ITYPN = 40064
+ integer, parameter :: ID_ITYPC = 40065
+ integer, parameter :: ID_cdata = 40066
+ integer, parameter :: ID_ICOPY = 40067
+ integer, parameter :: ID_SELRM1 = 40068
+ integer, parameter :: ID_addmesh = 40069
+ integer, parameter :: ID_MRGMESH = 40070
+ integer, parameter :: ID_ITEM26 = 40071
+ integer, parameter :: ID_ITEM22 = 40072
+ integer, parameter :: ID_ALLNODES = 40073
+ integer, parameter :: ID_UNUSNODES = 40074
+ integer, parameter :: ID_TRIANG = 40075
+ integer, parameter :: ID_QUAD = 40076
+ integer, parameter :: ID_CSEC = 40077
+ integer, parameter :: ID_CRSCAL = 40078
+ integer, parameter :: ID_SAVCRS = 40079
+ integer, parameter :: ID_crsf = 40080
+ integer, parameter :: ID_CSLOC = 40081
+ integer, parameter :: ID_UNDO = 40082
+ integer, parameter :: ID_UNDOS = 40083
+ integer, parameter :: ID_CREATM = 40084
+ integer, parameter :: ID_CGEN = 40085
+ integer, parameter :: ID_selarea = 40086
+ integer, parameter :: ID_crsect = 40087
+ integer, parameter :: ID_EDLAY = 40088
+ integer, parameter :: ID_ORDR = 40089
+ integer, parameter :: ID_ORDR1 = 40090
+ integer, parameter :: ID_FILL = 40102
+ integer, parameter :: ID_DELM = 40103
+ integer, parameter :: ID_JOIN = 40104
+ integer, parameter :: ID_STRING1 = 50001
+ integer, parameter :: ID_STRING2 = 50002
+ integer, parameter :: ID_STRING3 = 50003
+ integer, parameter :: ID_STRING4 = 50004
+ integer, parameter :: ID_STRING5 = 50005
+ integer, parameter :: ID_STRING6 = 50006
+ integer, parameter :: ID_STRING7 = 50007
+ integer, parameter :: ID_STRING8 = 50008
+ integer, parameter :: ID_STRING9 = 50009
+ integer, parameter :: ID_STRING10 = 50010
+ integer, parameter :: ID_STRING11 = 50011
diff --git a/src/src83e/resource.h b/src/src83e/resource.h
new file mode 100644
index 0000000..a06556d
--- /dev/null
+++ b/src/src83e/resource.h
@@ -0,0 +1,424 @@
+//{{NO_DEPENDENCIES}}
+// Microsoft Visual C++ generated include file.
+// Used by AC.rc
+//
+#define TCS_TABS 0x0000
+#define TCS_SINGLELINE 0x0000
+#define TCS_RIGHTJUSTIFY 0x0000
+#define TBS_HORZ 0x0000
+#define TBS_BOTTOM 0x0000
+#define TBS_RIGHT 0x0000
+#define IDOK 1
+#define TBS_AUTOTICKS 0x0001
+#define TVS_HASBUTTONS 0x0001
+#define VK_LBUTTON 0x01
+#define IDCANCEL 2
+#define TBS_VERT 0x0002
+#define TVS_HASLINES 0x0002
+#define VK_RBUTTON 0x02
+#define IDABORT 3
+#define VK_CANCEL 0x03
+#define IDRETRY 4
+#define TBS_TOP 0x0004
+#define TBS_LEFT 0x0004
+#define TVS_LINESATROOT 0x0004
+#define VK_MBUTTON 0x04
+#define IDIGNORE 5
+#define IDYES 6
+#define IDNO 7
+#define IDCLOSE 8
+#define TBS_BOTH 0x0008
+#define TVS_EDITLABELS 0x0008
+#define VK_BACK 0x08
+#define IDHELP 9
+#define VK_TAB 0x09
+#define VK_CLEAR 0x0C
+#define VK_RETURN 0x0D
+#define TBS_NOTICKS 0x0010
+#define TVS_DISABLEDRAGDROP 0x0010
+#define VK_SHIFT 0x10
+#define VK_CONTROL 0x11
+#define VK_MENU 0x12
+#define VK_PAUSE 0x13
+#define VK_CAPITAL 0x14
+#define VK_ESCAPE 0x1B
+#define TBS_ENABLESELRANGE 0x0020
+#define TVS_SHOWSELALWAYS 0x0020
+#define VK_SPACE 0x20
+#define VK_PRIOR 0x21
+#define VK_NEXT 0x22
+#define VK_END 0x23
+#define VK_HOME 0x24
+#define VK_LEFT 0x25
+#define VK_UP 0x26
+#define VK_RIGHT 0x27
+#define VK_DOWN 0x28
+#define VK_SELECT 0x29
+#define VK_PRINT 0x2A
+#define VK_EXECUTE 0x2B
+#define VK_SNAPSHOT 0x2C
+#define VK_INSERT 0x2D
+#define VK_DELETE 0x2E
+#define VK_HELP 0x2F
+#define TBS_FIXEDLENGTH 0x0040
+#define VK_NUMPAD0 0x60
+#define VK_NUMPAD1 0x61
+#define VK_NUMPAD2 0x62
+#define VK_NUMPAD3 0x63
+#define VK_NUMPAD4 0x64
+#define VK_NUMPAD5 0x65
+#define IDD_DIALOG1 101
+#define VK_NUMPAD6 0x66
+#define IDD_DIALOG02 102
+#define VK_NUMPAD7 0x67
+#define IDD_DIALOG05 103
+#define VK_NUMPAD8 0x68
+#define IDD_DIALOG04 104
+#define VK_NUMPAD9 0x69
+#define IDD_DIALOG006 105
+#define VK_MULTIPLY 0x6A
+#define IDD_DIALOG07 106
+#define VK_ADD 0x6B
+#define IDD_DIALOG08 107
+#define VK_SEPARATOR 0x6C
+#define IDD_DIALOG09 108
+#define VK_SUBTRACT 0x6D
+#define IDD_DIALOG10 109
+#define VK_DECIMAL 0x6E
+#define IDD_DIALOG010 110
+#define VK_DIVIDE 0x6F
+#define IDD_DIALOG001 111
+#define VK_F1 0x70
+#define IDD_REGST 112
+#define VK_F2 0x71
+#define IDD_DIALOG012 113
+#define VK_F3 0x72
+#define IDD_SLRGNO 114
+#define VK_F4 0x73
+#define IDD_CONFIRM 115
+#define VK_F5 0x74
+#define IDD_nodedata 116
+#define VK_F6 0x75
+#define IDD_eltdata 117
+#define VK_F7 0x76
+#define IDD_SELNODE 118
+#define VK_F8 0x77
+#define IDD_SELELT 119
+#define VK_F9 0x78
+#define IDD_ELTERR 120
+#define VK_F10 0x79
+#define IDD_headertp 121
+#define VK_F11 0x7A
+#define IDD_TRIAN 122
+#define VK_F12 0x7B
+#define IDD_NODERR 123
+#define VK_F13 0x7C
+#define IDD_TRIANG 124
+#define VK_F14 0x7D
+#define IDD_QUAD 125
+#define VK_F15 0x7E
+#define IDD_DIALOG06 126
+#define VK_F16 0x7F
+#define IDD_CSLOC 127
+#define TBS_NOTHUMB 0x0080
+#define VK_F17 0x80
+#define IDD_CREATM 128
+#define VK_F18 0x81
+#define IDD_TEMPLATE001 129
+#define VK_F19 0x82
+#define IDD_CREATM1 130
+#define VK_F20 0x83
+#define IDD_ORDEROUT 131
+#define VK_F21 0x84
+#define IDD_TEMPLATE002 132
+#define VK_F22 0x85
+#define IDD_selcrsec 133
+#define VK_F23 0x86
+#define IDD_TEMPLATE003 134
+#define VK_F24 0x87
+#define IDD_LIMITS 135
+#define IDD_lAY 136
+#define IDD_TEMPLATE004 137
+#define IDD_DISPLIT 138
+#define IDD_DIRSPLIT 139
+#define IDD_SETOPT 140
+#define IDD_SETMAXMAP 141
+#define VK_NUMLOCK 0x90
+#define VK_SCROLL 0x91
+#define IDD_SELTFL2 148
+#define IDD_GETINT 153
+#define IDD_GETFPN 154
+#define VK_LSHIFT 0xA0
+#define IDD_GETINTP 160
+#define VK_RSHIFT 0xA1
+#define VK_LCONTROL 0xA2
+#define VK_RCONTROL 0xA3
+#define VK_LMENU 0xA4
+#define VK_RMENU 0xA5
+#define VK_ATTN 0xF6
+#define VK_CRSEL 0xF7
+#define VK_EXSEL 0xF8
+#define VK_EREOF 0xF9
+#define VK_PLAY 0xFA
+#define VK_ZOOM 0xFB
+#define VK_NONAME 0xFC
+#define VK_PA1 0xFD
+#define VK_OEM_CLEAR 0xFE
+#define TCS_BUTTONS 0x0100
+#define TCS_MULTILINE 0x0200
+#define IDF_LABEL1 1001
+#define IDF_LABEL2 1002
+#define IDF_LABEL3 1003
+#define IDF_LABEL4 1004
+#define IDF_CMAP8 1005
+#define IDF_LABEL6 1005
+#define IDF_CMAP9 1006
+#define IDF_LABEL8 1006
+#define IDF_CMAP0 1007
+#define IDF_LABEL9 1007
+#define IDF_CMAP1 1008
+#define IDF_LABEL10 1008
+#define IDF_CMAP2 1009
+#define IDF_LABEL12 1009
+#define IDF_CMAP10 1010
+#define IDF_CMAP11 1011
+#define IDF_CMAP3 1012
+#define IDF_STRING1 1013
+#define IDF_STRING2 1014
+#define IDF_STRING3 1015
+#define IDF_STRING4 1016
+#define IDF_STRING5 1017
+#define IDF_STRING6 1018
+#define IDF_STRING7 1019
+#define IDF_STRING8 1020
+#define IDF_STRING9 1021
+#define IDF_STRING10 1022
+#define IDF_STRING11 1023
+#define TCS_FIXEDWIDTH 0x0400
+#define IDF_STRING12 1024
+#define IDF_STRING13 1025
+#define IDF_STRING14 1026
+#define IDF_STRING15 1027
+#define IDF_STRING16 1028
+#define IDF_STRING17 1029
+#define IDF_STRING18 1030
+#define IDF_STRING19 1031
+#define IDF_STRING20 1032
+#define IDF_STRING21 1033
+#define IDF_STRING22 1034
+#define IDF_STRING23 1035
+#define IDF_CHECK1 1036
+#define IDF_CHECK2 1037
+#define IDF_CHECK3 1038
+#define IDF_CHECK4 1039
+#define IDF_CHECK5 1040
+#define IDF_STRING24 1041
+#define IDF_CHECK6 1041
+#define IDF_LABEL5 1042
+#define IDF_CHECK7 1042
+#define IDF_STRING35 1042
+#define IDF_CMAP4 1043
+#define IDF_CHECK8 1043
+#define IDF_LABEL11 1043
+#define IDF_CMAP5 1044
+#define IDF_CHECK9 1044
+#define IDF_CMAP6 1045
+#define IDF_CHECK10 1045
+#define IDF_CMAP7 1046
+#define IDF_RADIO1 1047
+#define IDF_RADIO2 1048
+#define IDF_RADIO3 1049
+#define IDF_RADIO4 1050
+#define IDF_RADIO5 1051
+#define IDF_RADIO6 1052
+#define IDF_RADIO7 1053
+#define IDF_RADIO8 1054
+#define IDF_RADIO9 1055
+#define IDF_LABEL7 1056
+#define IDF_RADIO10 1056
+#define IDF_INTEGER1 1057
+#define IDF_RADIO11 1057
+#define IDF_INTEGER2 1058
+#define IDF_RADIO12 1058
+#define IDF_CHECK11 1059
+#define IDF_INTEGER3 1059
+#define IDF_RADIO17 1059
+#define IDF_REAL1 1060
+#define IDF_INTEGER4 1060
+#define IDF_REAL2 1061
+#define IDF_INTEGER5 1061
+#define IDF_REAL3 1062
+#define IDF_INTEGER6 1062
+#define IDF_RADIO18 1062
+#define IDF_REAL4 1063
+#define IDF_INTEGER7 1063
+#define IDF_REAL5 1064
+#define IDF_INTEGER8 1064
+#define IDF_REAL6 1065
+#define IDF_REAL7 1066
+#define IDF_REAL8 1067
+#define IDADJUST 1068
+#define IDF_REAL9 1068
+#define IDFSWITCH 1069
+#define IDF_REAL10 1069
+#define IDF_INTEGER9 1070
+#define IDF_INTEGER10 1071
+#define IDNEXT 1072
+#define IDF_Delete 1073
+#define IDFROTATE 1074
+#define IDF_GRID1 1075
+#define IDF_RADIO13 1076
+#define ISS1 1077
+#define ISS2 1078
+#define ISS3 1079
+#define IDF_RADIO14 1080
+#define IDF_RADIO15 1081
+#define IDF_RADIO16 1082
+#define ISS4 1083
+#define ISS5 1084
+#define ISS6 1085
+#define ISS7 1086
+#define IDF_STRING25 1106
+#define IDF_STRING26 1107
+#define IDF_STRING27 1108
+#define IDF_STRING28 1109
+#define IDF_STRING29 1110
+#define IDF_STRING30 1111
+#define IDF_STRING31 1112
+#define IDF_STRING32 1113
+#define IDF_STRING33 1114
+#define IDF_STRING34 1115
+#define id_chck 2001
+#define id_chk 2002
+#define idchk 2003
+#define TCS_RAGGEDRIGHT 0x0800
+#define TCS_FOCUSONBUTTONDOWN 0x1000
+#define IDC_BUTTON2 20001
+#define IDR_MENU1 30001
+#define ID_TOOLBAR1 30101
+#define TCS_FOCUSNEVER 0x8000
+#define ID_FILE 40001
+#define ID_Menu 40001
+#define ID_EXIT 40002
+#define ID_RESET 40002
+#define ID_NODE 40003
+#define ID_ELTS 40004
+#define ID_ORDRT 40005
+#define ID_CCLNA 40006
+#define ID_CSEC1 40007
+#define ID_ZOOM 40008
+#define ID_DRAW 40009
+#define ID_HELP 40010
+#define ID_ITEM11 40011
+#define ID_ITEM12 40012
+#define ID_ITEM13 40013
+#define ID_ITEM14 40014
+#define ID_ITEM15 40015
+#define ID_ITEM16 40016
+#define ID_ITEM17 40017
+#define ID_ITEM18 40018
+#define ID_ITEM19 40019
+#define ID_Clip 40020
+#define ID_ITEM20 40021
+#define ID_ITEM73 40022
+#define ID_ITEM23 40023
+#define ID_ITEM24 40024
+#define ID_ZIN 40025
+#define ID_ZOUT 40026
+#define ID_OUT2 40027
+#define ID_OUT4 40028
+#define ID_RSET 40029
+#define ID_UNDOM 40030
+#define ID_PLEFT 40031
+#define ID_PRIGHT 40032
+#define ID_PUP 40033
+#define ID_PDOWN 40034
+#define ID_IDRWT 40035
+#define ID_BSEL 40036
+#define ID_REGST 40037
+#define ID_network 40038
+#define ID_TYPD 40039
+#define ID_Help1 40040
+#define ID_DRAWD 40041
+#define ID_MAPOPD 40042
+#define ID_MMAP 40043
+#define ID_Help2 40044
+#define ID_NMAP 40045
+#define ID_LAYFL 40046
+#define ID_BKF 40047
+#define ID_ITEM56 40048
+#define ID_Nodedata 40049
+#define ID_BACGD 40050
+#define ID_Eltdata 40051
+#define ID_DRAG 40052
+#define ID_GETELM 40053
+#define ID_mapm 40054
+#define ID_map 40055
+#define ID_DCONTR 40056
+#define ID_SBIN 40057
+#define ID_TRIAN 40058
+#define ID_SWMAP 40059
+#define ID_CONTR 40060
+#define ID_CONTOPT 40061
+#define ID_SWRM1 40062
+#define ID_LOADRM1 40063
+#define ID_ITYPN 40064
+#define ID_ITYPC 40065
+#define ID_cdata 40066
+#define ID_ICOPY 40067
+#define ID_SELRM1 40068
+#define ID_addmesh 40069
+#define ID_MRGMESH 40070
+#define ID_ITEM26 40071
+#define ID_ITEM22 40072
+#define ID_ALLNODES 40073
+#define ID_UNUSNODES 40074
+#define ID_TRIANG 40075
+#define ID_QUAD 40076
+#define ID_CSEC 40077
+#define ID_CRSCAL 40078
+#define ID_SAVCRS 40079
+#define ID_crsf 40080
+#define ID_CSLOC 40081
+#define ID_UNDO 40082
+#define ID_UNDOS 40083
+#define ID_CREATM 40084
+#define ID_CGEN 40085
+#define ID_selarea 40086
+#define ID_crsect 40087
+#define ID_EDLAY 40088
+#define ID_ORDR 40089
+#define ID_ORDR1 40090
+#define ID_SPLITN 40091
+#define ID_FORM999 40092
+#define ID_OUTLAY 40093
+#define ID_g1d 40094
+#define ID_CCLN 40095
+#define ID_CHKCCLN 40096
+#define ID_GOUTLIN 40097
+#define ID_XOUTLIN 40098
+#define ID_FILL 40102
+#define ID_DELM 40103
+#define ID_JOIN 40104
+#define ID_STRING1 50001
+#define ID_STRING2 50002
+#define ID_STRING3 50003
+#define ID_STRING4 50004
+#define ID_STRING5 50005
+#define ID_STRING6 50006
+#define ID_STRING7 50007
+#define ID_STRING8 50008
+#define ID_STRING9 50009
+#define ID_STRING10 50010
+#define ID_STRING11 50011
+
+// Next default values for new objects
+//
+#ifdef APSTUDIO_INVOKED
+#ifndef APSTUDIO_READONLY_SYMBOLS
+#define _APS_NEXT_RESOURCE_VALUE 101
+#define _APS_NEXT_COMMAND_VALUE 40003
+#define _APS_NEXT_CONTROL_VALUE 1000
+#define _APS_NEXT_SYMED_VALUE 101
+#endif
+#endif
diff --git a/src/src83e/rotate.bmp b/src/src83e/rotate.bmp
new file mode 100644
index 0000000..87a06ef
Binary files /dev/null and b/src/src83e/rotate.bmp differ
diff --git a/src/src83e/setangle.f90 b/src/src83e/setangle.f90
new file mode 100644
index 0000000..5594250
--- /dev/null
+++ b/src/src83e/setangle.f90
@@ -0,0 +1,91 @@
+ SUBROUTINE SETANGLE
+!
+! THIS ROUTINE SETS THE ANGLES FOR 3-F VIEWS
+!
+ use winteracter
+! USE BLKV1
+! USE BLKV2
+! USE BLK
+
+ USE BLK1MOD
+! INCLUDE 'BLK1.COM'
+! INCLUDE 'TXFRM.COM'
+!-
+
+ include 'D.inc'
+
+!
+! Declare window-type and message variables
+!
+ TYPE(WIN_STYLE) :: WINDOW
+
+ TYPE(WIN_MESSAGE) :: MESSAGE
+ INTEGER :: IERR
+ DATA ITIM/0/
+
+ IF(ITIM .EQ. 0) THEN
+ HANG=0.
+ VANG=90.
+ VRTSCAL=100.0
+ VRTORIG=0.
+ ITIM=1
+ IASPCT=0
+ IASPCTOLD=0
+ ENDIF
+
+ VANGOLD=VANG
+ HANGOLD=HANG
+
+ call wdialogload(IDD_VIEWANG)
+ ierr=infoerror(1)
+
+ CALL WDialogSelect(IDD_VIEWANG)
+ ierr=infoerror(1)
+
+ 100 continue
+ CALL WDialogPutREAL(IDF_REAL1,HANG)
+ CALL WDialogPutREAL(IDF_REAL2,VANG)
+ CALL WDialogPutREAL(IDF_REAL3,VRTSCAL)
+ CALL WDialogPutREAL(IDF_REAL4,VRTORIG)
+ CALL WDialogPutCheckBox(IDF_check1,IASPCT)
+
+ CALL WDialogShow(-1,-1,0,Modal)
+ ierr=infoerror(1)
+
+ do
+!
+ IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
+
+
+ CALL WDialogGetREAL(IDF_REAL1,HANG)
+ CALL WDialogGetREAL(IDF_REAL2,VANG)
+ CALL WDialogGetREAL(IDF_REAL3,VRTSCAL)
+ CALL WDialogGetREAL(IDF_REAL4,VRTORIG)
+ CALL WDialogGetCheckBox(IDF_check1,IASPCT)
+ GO TO 200
+! else
+! HANG=0.
+! VANG=90.
+! VRTSCAL=100.
+ endif
+
+ enddo
+
+ 200 CONTINUE
+ RETURN
+ END
+
+ SUBROUTINE adjustang(hrad,vrad)
+
+ USE BLK1MOD
+
+ VANGOLD=VANG
+ HANGOLD=HANG
+
+ VANG=VANG+VRAD*57.
+ HANG=HANG+HRAD*57.
+
+ CALL PLOTOT(0)
+
+ RETURN
+ END
\ No newline at end of file
diff --git a/src/src83e/winparam.h b/src/src83e/winparam.h
new file mode 100644
index 0000000..6dbd884
--- /dev/null
+++ b/src/src83e/winparam.h
@@ -0,0 +1,235 @@
+#define IDOK 1
+#define IDCANCEL 2
+#define IDABORT 3
+#define IDRETRY 4
+#define IDIGNORE 5
+#define IDYES 6
+#define IDNO 7
+#define IDCLOSE 8
+#define IDHELP 9
+#define WS_OVERLAPPED 0x00000000L
+#define WS_POPUP 0x80000000L
+#define WS_CHILD 0x40000000L
+#define WS_MINIMIZE 0x20000000L
+#define WS_VISIBLE 0x10000000L
+#define WS_DISABLED 0x08000000L
+#define WS_CLIPSIBLINGS 0x04000000L
+#define WS_CLIPCHILDREN 0x02000000L
+#define WS_MAXIMIZE 0x01000000L
+#define WS_CAPTION 0x00C00000L
+#define WS_BORDER 0x00800000L
+#define WS_DLGFRAME 0x00400000L
+#define WS_VSCROLL 0x00200000L
+#define WS_HSCROLL 0x00100000L
+#define WS_SYSMENU 0x00080000L
+#define WS_THICKFRAME 0x00040000L
+#define WS_GROUP 0x00020000L
+#define WS_TABSTOP 0x00010000L
+#define WS_MINIMIZEBOX 0x00020000L
+#define WS_MAXIMIZEBOX 0x00010000L
+#define ES_LEFT 0x00000000L
+#define ES_CENTER 0x00000001L
+#define ES_RIGHT 0x00000002L
+#define ES_MULTILINE 0x00000004L
+#define ES_UPPERCASE 0x00000008L
+#define ES_LOWERCASE 0x00000010L
+#define ES_PASSWORD 0x00000020L
+#define ES_AUTOVSCROLL 0x00000040L
+#define ES_AUTOHSCROLL 0x00000080L
+#define ES_READONLY 0x00000800L
+#define ES_WANTRETURN 0x00001000L
+#define BS_PUSHBUTTON 0x00000000L
+#define BS_DEFPUSHBUTTON 0x00000001L
+#define BS_AUTOCHECKBOX 0x00000003L
+#define BS_GROUPBOX 0x00000007L
+#define BS_USERBUTTON 0x00000008L
+#define BS_AUTORADIOBUTTON 0x00000009L
+#define BS_OWNERDRAW 0x0000000BL
+#define BS_LEFTTEXT 0x00000020L
+#define BS_TEXT 0x00000000L
+#define BS_ICON 0x00000040L
+#define BS_BITMAP 0x00000080L
+#define BS_LEFT 0x00000100L
+#define BS_RIGHT 0x00000200L
+#define BS_CENTER 0x00000300L
+#define BS_TOP 0x00000400L
+#define BS_BOTTOM 0x00000800L
+#define BS_VCENTER 0x00000C00L
+#define BS_PUSHLIKE 0x00001000L
+#define BS_MULTILINE 0x00002000L
+#define BS_FLAT 0x00008000L
+#define SS_LEFT 0x00000000L
+#define SS_CENTER 0x00000001L
+#define SS_RIGHT 0x00000002L
+#define SS_ICON 0x00000003L
+#define SS_BLACKRECT 0x00000004L
+#define SS_GRAYRECT 0x00000005L
+#define SS_WHITERECT 0x00000006L
+#define SS_BLACKFRAME 0x00000007L
+#define SS_GRAYFRAME 0x00000008L
+#define SS_WHITEFRAME 0x00000009L
+#define SS_SIMPLE 0x0000000BL
+#define SS_LEFTNOWORDWRAP 0x0000000CL
+#define SS_NOPREFIX 0x00000080L
+#define SS_BITMAP 0x0000000EL
+#define SS_ETCHEDHORZ 0x00000010L
+#define SS_ETCHEDVERT 0x00000011L
+#define SS_ETCHEDFRAME 0x00000012L
+#define SS_NOTIFY 0x00000100L
+#define SS_CENTERIMAGE 0x00000200L
+#define SS_RIGHTJUST 0x00000400L
+#define SS_REALSIZEIMAGE 0x00000800L
+#define SS_SUNKEN 0x00001000L
+#define DS_SYSMODAL 0x00000002L
+#define DS_3DLOOK 0x00000004L
+#define DS_SETFONT 0x00000040L
+#define DS_MODALFRAME 0x00000080L
+#define DS_CONTROL 0x00000400L
+#define LBS_NOTIFY 0x00000001L
+#define LBS_MULTIPLESEL 0x00000008L
+#define LBS_HASSTRINGS 0x00000040L
+#define LBS_USETABSTOPS 0x00000080L
+#define LBS_NOINTEGRALHEIGHT 0x00000100L
+#define LBS_MULTICOLUMN 0x00000200L
+#define LBS_EXTENDEDSEL 0x00000800L
+#define LBS_DISABLENOSCROLL 0x00001000L
+#define LBS_NOSEL 0x00004000L
+#define CBS_SIMPLE 0x00000001L
+#define CBS_DROPDOWN 0x00000002L
+#define CBS_DROPDOWNLIST 0x00000003L
+#define CBS_OWNERDRAWFIXED 0x00000010L
+#define CBS_AUTOHSCROLL 0x00000040L
+#define CBS_SORT 0x00000100L
+#define CBS_HASSTRINGS 0x00000200L
+#define CBS_DISABLENOSCROLL 0x00000800L
+#define CBS_UPPERCASE 0x00002000L
+#define CBS_LOWERCASE 0x00004000L
+#define WS_EX_DLGMODALFRAME 0x00000001L
+#define WS_EX_WINDOWEDGE 0x00000100L
+#define WS_EX_CLIENTEDGE 0x00000200L
+#define WS_EX_LEFTSCROLLBAR 0x00004000L
+#define WS_EX_STATICEDGE 0x00020000L
+#define TCS_TABS 0x0000
+#define TCS_BUTTONS 0x0100
+#define TCS_SINGLELINE 0x0000
+#define TCS_MULTILINE 0x0200
+#define TCS_RIGHTJUSTIFY 0x0000
+#define TCS_FIXEDWIDTH 0x0400
+#define TCS_RAGGEDRIGHT 0x0800
+#define TCS_FOCUSONBUTTONDOWN 0x1000
+#define TCS_FOCUSNEVER 0x8000
+#define GS_REPCUTPASTE 0x00000040L
+#define GS_DEFROWLABELS 0x00000080L
+#define GS_NOINTEGRALHEIGHT 0x00000100L
+#define GS_COLUMNLABELS 0x00000200L
+#define GS_ROWLABELS 0x00000400L
+#define GS_READONLY 0x00000800L
+#define GS_WANTRETURN 0x00001000L
+#define GS_RESIZECOLUMNS 0x00002000L
+#define GS_WANTTAB 0x00004000L
+#define GS_WRAP 0x00008000L
+#define TBS_AUTOTICKS 0x0001
+#define TBS_VERT 0x0002
+#define TBS_HORZ 0x0000
+#define TBS_TOP 0x0004
+#define TBS_BOTTOM 0x0000
+#define TBS_LEFT 0x0004
+#define TBS_RIGHT 0x0000
+#define TBS_BOTH 0x0008
+#define TBS_NOTICKS 0x0010
+#define TBS_ENABLESELRANGE 0x0020
+#define TBS_FIXEDLENGTH 0x0040
+#define TBS_NOTHUMB 0x0080
+#define TVS_HASBUTTONS 0x0001
+#define TVS_HASLINES 0x0002
+#define TVS_LINESATROOT 0x0004
+#define TVS_EDITLABELS 0x0008
+#define TVS_DISABLEDRAGDROP 0x0010
+#define TVS_SHOWSELALWAYS 0x0020
+#define VK_LBUTTON 0x01
+#define VK_RBUTTON 0x02
+#define VK_CANCEL 0x03
+#define VK_MBUTTON 0x04
+#define VK_BACK 0x08
+#define VK_TAB 0x09
+#define VK_CLEAR 0x0C
+#define VK_RETURN 0x0D
+#define VK_SHIFT 0x10
+#define VK_CONTROL 0x11
+#define VK_MENU 0x12
+#define VK_PAUSE 0x13
+#define VK_CAPITAL 0x14
+#define VK_ESCAPE 0x1B
+#define VK_SPACE 0x20
+#define VK_PRIOR 0x21
+#define VK_NEXT 0x22
+#define VK_END 0x23
+#define VK_HOME 0x24
+#define VK_LEFT 0x25
+#define VK_UP 0x26
+#define VK_RIGHT 0x27
+#define VK_DOWN 0x28
+#define VK_SELECT 0x29
+#define VK_PRINT 0x2A
+#define VK_EXECUTE 0x2B
+#define VK_SNAPSHOT 0x2C
+#define VK_INSERT 0x2D
+#define VK_DELETE 0x2E
+#define VK_HELP 0x2F
+#define VK_NUMPAD0 0x60
+#define VK_NUMPAD1 0x61
+#define VK_NUMPAD2 0x62
+#define VK_NUMPAD3 0x63
+#define VK_NUMPAD4 0x64
+#define VK_NUMPAD5 0x65
+#define VK_NUMPAD6 0x66
+#define VK_NUMPAD7 0x67
+#define VK_NUMPAD8 0x68
+#define VK_NUMPAD9 0x69
+#define VK_MULTIPLY 0x6A
+#define VK_ADD 0x6B
+#define VK_SEPARATOR 0x6C
+#define VK_SUBTRACT 0x6D
+#define VK_DECIMAL 0x6E
+#define VK_DIVIDE 0x6F
+#define VK_F1 0x70
+#define VK_F2 0x71
+#define VK_F3 0x72
+#define VK_F4 0x73
+#define VK_F5 0x74
+#define VK_F6 0x75
+#define VK_F7 0x76
+#define VK_F8 0x77
+#define VK_F9 0x78
+#define VK_F10 0x79
+#define VK_F11 0x7A
+#define VK_F12 0x7B
+#define VK_F13 0x7C
+#define VK_F14 0x7D
+#define VK_F15 0x7E
+#define VK_F16 0x7F
+#define VK_F17 0x80
+#define VK_F18 0x81
+#define VK_F19 0x82
+#define VK_F20 0x83
+#define VK_F21 0x84
+#define VK_F22 0x85
+#define VK_F23 0x86
+#define VK_F24 0x87
+#define VK_NUMLOCK 0x90
+#define VK_SCROLL 0x91
+#define VK_LSHIFT 0xA0
+#define VK_RSHIFT 0xA1
+#define VK_LCONTROL 0xA2
+#define VK_RCONTROL 0xA3
+#define VK_LMENU 0xA4
+#define VK_RMENU 0xA5
+#define VK_ATTN 0xF6
+#define VK_CRSEL 0xF7
+#define VK_EXSEL 0xF8
+#define VK_EREOF 0xF9
+#define VK_PLAY 0xFA
+#define VK_ZOOM 0xFB
+#define VK_NONAME 0xFC
+#define VK_PA1 0xFD
+#define VK_OEM_CLEAR 0xFE
diff --git a/src/src83e/winteracter.mod b/src/src83e/winteracter.mod
new file mode 100644
index 0000000..d471d09
Binary files /dev/null and b/src/src83e/winteracter.mod differ
diff --git a/src/src83e/winttypes.mod b/src/src83e/winttypes.mod
new file mode 100644
index 0000000..450edd4
Binary files /dev/null and b/src/src83e/winttypes.mod differ
diff --git a/src/srcrmagen83e.zip b/src/srcrmagen83e.zip
new file mode 100644
index 0000000..51e3d71
Binary files /dev/null and b/src/srcrmagen83e.zip differ
diff --git a/src/srcrmagen83f.zip b/src/srcrmagen83f.zip
new file mode 100644
index 0000000..5d3dc15
Binary files /dev/null and b/src/srcrmagen83f.zip differ
diff --git a/src/srcrmagen83f2.zip b/src/srcrmagen83f2.zip
new file mode 100644
index 0000000..7d02335
Binary files /dev/null and b/src/srcrmagen83f2.zip differ
+
\r\n \r\n