module Global USE DFWin, ONLY : long, handle ! only 2 specific items (both INTEGERS; probably == 4 or ==8) ! from the MODULE of INTERFACES for the Digital Fortran Windows library ! (which is distinct from the QuickWin library, and much more powerful). ! ! To prevent crashes due to the bug(s) associated with !"WRITE(msg," or "READ(msg," when msg is a local subroutine variable, ! declare msg here to be a large permanent vector: ! character(255) msg ! Note: At one time, this was the longest string supported. character(255) windowHeightString ! ! Input file ! character(255) dig_inp, feg_inp, feg_sav character(255) title_string logical(4) gridLoaded ! loading status of F-E Grid logical(4) baseLoaded ! loading status of F-E Base ! ! Associated with F-E Grid ! character(80) :: old_FEG_title_line = " ", new_FEG_title_line = "[grid title line]" integer(4) numnod, nRealN, nFaken, n1000 ! note: mxnode, mxel, mxfel larger than numnod,numel,nfl ! for adding or deleting node/element/fault integer(4) mxnode, mxel, mxfel integer, parameter:: MXBN = 10000 ! maximum boundary node # integer(4) NODCON(MXBN) ! boundary node list logical brief integer(4) numEl, nFl real FIPoint(4)/.125, .375,.625, .875/ ! points for plotting fault dips real shallow, steep ! fault dip angle in degree real, allocatable:: nodeABG(:,:), EQCM(:,:) ! node, nodal data (elevation, heat-flow, crust, mantle-lithosphere) real, allocatable:: fdip(:,:),offset(:) ! fault integer(4), allocatable:: nodes(:,:), nodeF(:,:) ! element, fault nodes (topological definitions) integer(4), allocatable:: continuum_LRi(:), fault_LRi(:) ! element, fault Lithospheric Rheology indeces (for Shells v5.0+ mode) integer(2), allocatable:: NMemo(:) ! status of node integer(2), allocatable:: EMemo(:) ! flipped status of element real, allocatable:: element_data(:,:) ! per-element data (for Restore3+): young element_mu_, mu_switch (age in Ma), old element_mu_ REAL(8) :: lowest_mu = 0.0D0 ! bounds on range of mu_element, to be found when a grid is read, REAL(8) :: highest_mu = 0.0D0 ! or else defaulting to standard range. Used when deciding on color of element-center squares. ! ! Following is used in Restore3+ editing, so that deleted element properties (mu_1, switching_time_Ma, mu_2) can be applied to replacement elements: real :: deleted_element_data(3) = (/ 0.0, 0.0, 0.0 /) ! ! Following 3 arrays used in Perimeter/Area test ! These three are allocated and deallocated only in routine PATest ! integer, allocatable:: Nflags(:,:) !Nflags(2,NUMNOD), 1-- already known; 2 -- exterior node integer, allocatable:: fSide(:,:) !fSide(2,NFL), 1-2: side 1-2 integer, allocatable:: eSide(:,:) !eSide(3,NUMEL), 1-3: side 1-3 ! ! Associated with Basemap ! type :: point real:: alpha, beta, gamma type(point), pointer :: next_point end type type(point), pointer :: phead, ptail ! ! Transformation ! real winRight(3), winOut(3), winUp(3) real scales(2,2) real unscale(2,2) real cart2(3,3) ! 2nd origin transformation integer(4) hiRow, hiCol, Lines ! physical dimension of pixels along x, y axes real windowHeight real winLat, winLon real R2C real tolerance ! distance for finding cloest node, element ! ! Micellaneous ! real nettempvec(3) ! (alpha, beta, gamma) of center point of the .feg or .dig (when first loaded). integer zcol,zrow ! (zcol,zrow) used in selectpoint_zoom ! ! Associated with Tile region with grid ! integer nSlice ! in GTdialog, Isosahedron integer oldSlice ! in GTdialog integer nPoly integer, parameter:: nPoly_maxSize = 100 ! maximum vertice point # of polygon integer vertCol(nPoly_maxSize), vertRow(nPoly_maxSize) real normals(3, nPoly_maxSize) ! ! Logical switches ! LOGICAL grayLRMenu ! If appType /= 1 (i.e., /= "Shells") logical grayMenu ! If no dimensions are known for node/element/fault arrays, gray-out some menus. logical doIcon ! Put triangle at the center of element. logical showNodes ! Display node location with circle. logical addDropNode_checked logical adjustNode_checked logical addDeleteElement_checked logical cutHealFault_checked logical fInclination_checked logical fHeading_checked logical eqcmDraw_checked LOGICAL LRDraw_checked logical blockSetValue_checked LOGICAL blockSetLR_checked logical zoomInOut_checked logical using2ndOrigin logical tileGrid_checked logical viewGap_checked logical orbData5 ! signals 6 real variables per node in SHELLS .feg files (not just 4) LOGICAL plot_eleCenter_icons ! set in Redraw, and used in DrawElements ! ! Other switches ! integer appType ! specify application type: 1 = thin-shell, 2 = Restore2, 3 = Restore3 ! ! color table ! integer drawtype integer(4) colorpick integer(4) ifrontcolor integer(4) ibackcolor integer(4) ibasecolor integer(4) inodecolor integer(4) ifaultcolor integer(4) ifaultcolor2 integer(4) ielecolor integer(4) redValue DATA redValue /0/ integer(4) greenValue DATA greenValue /0/ integer(4) blueValue DATA blueValue /0/ INTEGER(4), DIMENSION(3, 6):: rgb_int_of_IDC_LIST_line !(i = 1,2,3 = R, G, B; each 0...255); !(j = 1, ... ,6 = Outer Circle, Basemap, Node, Element, Fault, Background) DATA rgb_int_of_IDC_LIST_line / 0,255,255, 255,255,255, 0,0,255, 0,255,0, 255,0,0, 0,0,0/ CHARACTER*1 :: redByte, greenByte, blueByte INTEGER(1) :: redInt1, greenInt1, blueInt1 EQUIVALENCE (redByte, redInt1) EQUIVALENCE (greenByte, greenInt1) EQUIVALENCE (blueByte, blueInt1) ! ! contour map ! integer(4):: hiColor = 15 ! highest color index # (highest subscript of colorArray); ! note that 1 == gray; and 2~15 are used to create ColorBar. integer iData, oldIData ! 0: continuum element LR#; 1~6: nodal data index LOGICAL contour ! color-in element areas? Or, not? integer colorIn ! used in View Gaps/Overlaps, switch in DrawElement real botF, topF, oldBotF, oldTopF, dFC integer(4) colorArray(15) ! store 15 colors as [R, G, B] triplets logical logs ! ! Adjusting node, element etc. ! integer nItsOn, eItsOn, fItsOn integer jip ! used for adding/deleting element integer(4) nOn(1000), eOn(1000), fOn(1000) integer colOld, rowOld, colNew, rowNew integer click integer col_mouseClick, row_mouseClick integer col11, row11 real xOld, yOld real fixUp real oldHead, heading real last_val ! used in setEQCM ! ! editing counter for autosaving ! integer(4) editingCounter ! ! file unit number associated with debug.log ! open in SUBR initialization ! integer:: iUnitD = 1000 !------------------------------------------------------------------------------------------ ! ! Toolbar & Statusbar ! ! Note that handle = 4 on IA-32, but = 8 on x64! (It comes from "USE DFWin, ONLY: handle" above in this file.) INTEGER(handle) :: hFrame, & !Handle of the frame window (with the command menu, and minimize/maximize/close buttons) hGraphics, & !Handle of the child graphics window {Oddly, this handle never seems to needed under QuickWin methods!} hInst, & !Instance handle hMDI, & !Handle of the MDI client window {which I *GUESS* to be a sub-window of Frame, and the parent of Graphics}. hStatus, & !Status bar handle hToolbar, & !Toolbar handle lpfnOldFrameProc !Address (pointer to a function) of the QuickWin-provided default MDI windows procedure. INTEGER, PARAMETER :: WM_CREATETOOLBAR = #0500 ! Define our own message for toolbar creation. !Should be > WM_USER = #0400 INTEGER, PARAMETER :: WM_CREATESTATUS = #0600 ! TYPE T_MENUITEMINFO INTEGER(4) cbSize INTEGER(4) fMask INTEGER(4) fType INTEGER(4) fState INTEGER(4) wID INTEGER(4) hSubMenu INTEGER(4) hbmpChecked INTEGER(4) hbmpUnchecked INTEGER(4) dwItemData INTEGER(4) dwTypeData INTEGER(4) cch END TYPE T_MENUITEMINFO !--------------- important utility subroutine ----------------- CONTAINS SUBROUTINE Repair_String(string_from_C) ! ! Repairs a character-string variable which was defined ! in Fortran, but which got its present value from any ! C++ routine (e.g., path-filenames from Windows API ! Open-File or Save-File menus). ! Apparently, the default is that Fortran's hidden !"length" integer is set to the allocated length, ! and the string is padded with nulls (CHAR(0)). ! Such a string cannot be correctly processed by ! either TRIM() or LEN_TRIM(), and when output it may ! cause I/O problems due to the unexpected nulls. ! This routine determines the correct length by ! searching for the first null byte, then tries to ! set the Fortran length integer by copying the string. ! This should also guarantee that the string is properly ! padded by spaces (CHAR(32)), not nulls. ! ! by Peter Bird, UCLA, 2005.04.12 ! IMPLICIT NONE CHARACTER*(*), INTENT(INOUT) :: string_from_C CHARACTER*(255) :: temporary_string INTEGER :: i, length, content_length, apparent_LEN_TRIM, test SAVE ! all local variables apparent_LEN_TRIM = LEN_TRIM(string_from_C) ! may be too large in some cases length = LEN(string_from_C) ! allocated-memory length, not length of contents content_length = MIN(apparent_LEN_TRIM, length) ! unless reduced by loops below... scanning: DO i = 1, content_length IF (string_from_C(i:i) == CHAR(0)) THEN content_length = i - 1 EXIT scanning END IF END DO scanning IF (content_length > 0) THEN content_length = MIN(content_length, 255) ! so as not to overflow temporary_string temporary_string = string_from_C(1:content_length) content_length = MIN(content_length, length) ! so as not to overflow string_from_C string_from_C = temporary_string(1:content_length) ELSE string_from_C = ' ' END IF test = LEN_TRIM(string_from_C) test = test -1 + 1 ! put breakpoint here END SUBROUTINE Repair_String ! end module Global