Writing a Daphne CUH (Callable User-Histogram) Routine Page 1 Introduction 30 April 1992 1 Introduction Daphne User-Histogram ("UH") routines allow a user to access Daphne histograms from within Fortran subroutines as though they were simple arrays and to perform the operations listed below: - Arithmetic operations on histograms - Use existing Daphne graphics routines to display histograms - Use existing Daphne graphics routines to get cross-hair position and keyboard input from graphics terminals - Read and modify Daphne FIX and FLT variables A Daphne CUH ("Callable UH") program allows a user familiar with Fortran programming to combine many separate UH routines into a single program customized to a user's needs. It replaces the $UH command's special purpose main program with a main program written by a user. In general, anything that can be accomplished with a CUH program can be accomplished by a series of $UH commands (but perhaps less efficiently and in a less convenient fashion). A "UH routine" is a Fortran subroutine, written by a user, which is linked to create a "shareable image". The shareable image is combined with a main program to create a complete program. To find out how to create a UH routine see the text file DAPHLP:UH.MEM. A "$UH command" is DCL command which is entered by a user to run a single UH routine. When the $UH command is executed it merges a UH routine shareable image written by a user with a special purpose main program written by a Daphne developer to create a complete program. This document describes how to write a CUH program. It assumes the reader is already familiar with UH routines. Writing a Daphne CUH (Callable User-Histogram) Routine Page 2 Introduction 30 April 1992 1.1 Equivalents for $UH Command Parameters Before showing some of the special features available to CUH programs, let me show some $UH commands and their equivalent CUH function calls. Please note that two consecutive commas (",,") serve to separate groups of arguments in the examples. $ UH SUM1D A status=uh ('SUM1D',,A) $ UH DISPLAY1D A1,A2,A3,A4,A5 status=uh ('DISPLAY1D',,'A1','A2','A3','A4','A5') $ UH SUB1D A B status=uh ('SUB1D',,A,,B) $ UH ADDMANY1D A1,A2,A3,A4,A5 B status=uh ('ADDMANY1D',,'A1','A2','A3','A4','A5',,B) $ UH COPYMANY A1,A2 A1COPY,A2COPY status=uh ('COPYMANY',,'A1','A2',,'A1COPY',A2COPY') Writing a Daphne CUH (Callable User-Histogram) Routine Page 3 Introduction 30 April 1992 1.2 Equivalents for $UH Command Qualifiers There are subroutine equivalents for most of the $UH command line qualifiers: $ UH SUM1D ... /HELP call uhPrintHelp ('SUM1D') $ UH DISPLAY1D ... /SECOND call uhSetDisplayNumber (2) $ UH SUM1D ... /USERDATA=("Data available to uhGetUserData") character*80 string data string /'Data available to uhGetUserData'/ call uhSetUserData (string) $ UH SUM1D ... /LOGFILE=SUM1DLOGFILE call uhSetLogFileName ('SUM1DLOGFILE') $ UH SUM1D ... /HEADER call uhSetOutputHeaders (.true.) $ UH SUM1D ... /NOHEADER call uhSetOutputHeaders (.false.) Writing a Daphne CUH (Callable User-Histogram) Routine Page 4 Introduction 30 April 1992 1.3 $UH Command Qualifiers With No Equivalents For some $UH command qualifiers there are no equivalent CUH routines. Sometimes the same effect can be achieved using conventional Fortran programming: $ UH ... /INPUT=ABC open (unit=5,name='ABC',status='old',readonly) or use the DCL command: $ DEFINE FOR005 ABC $ UH ... /OUTPUT=XYZ open (unit=6,name='XYZ',status='new') or use the DCL command: $ DEFINE FOR006 XYZ $ UH ... /DEBUG Use the /DEBUG qualifier during compilation and linking of your CUH program: $ FORTRAN/DEBUG/NOOP MYPROGRAM $ @DAPEXE:DAPCUH.LNK MYPROGRAM /DEBUG There is nothing equivalent to the little used $UH command qualifiers listed below: $ UH ... /FLAGS Displays diagnostic information about the operation of the $UH command. $ UH ... /PARM=(...) A feature, never implemented in $UH, to allow the passing of additional arguments to a user's UH routine. Actually, it has been implemented in CUH and is now not supported in exactly the same manner as in the $UH command. (Joke) Writing a Daphne CUH (Callable User-Histogram) Routine Page 5 Calling the CUH Subroutine 30 April 1992 2 Calling the CUH Subroutine I will use the name "CUH function" (callable UH function) to distinguish between user-written UH routines and that subroutine named "UH" which a user calls from a CUH program to invoke a UH routine. 2.1 Argument Groups The calling sequence for the CUH function was designed to resemble the $UH command. There are four groups of arguments: - Group 1 - The filename of the UH routine This corresponds to the first parameter in the $UH command. This is actually a trivial group with only one element. Additional arguments may be added in the future. This is a required argument. - Group 2 - A list of "input" histograms This corresponds to the first list of histograms in the $UH command. Under normal circumstances there will be at lest one input histogram. It is possible to omit the input argument list and still code arguments from group 3 or group 4 by coding a histogram name of all blanks. - Group 3 - A list of "output" histograms This corresponds to the second list of histograms in the $UH command. This set of arguments is optional. If you want to omit it but supply an argument for group 4 then code a histogram name composed of all blanks. - Group 4 - A list of additional arguments These are arguments which are passed, unchanged, to the user-written UH routine. The arguments can be of any Fortran supported type, array, or record. Whatever form the argument, it is the responsibility of the user to make sure it matches what the user-written UH routine expects. These "extra" arguments appear in the UH routine argument list immediately following all histogram related arguments. Writing a Daphne CUH (Callable User-Histogram) Routine Page 6 Calling the CUH Subroutine 30 April 1992 Optional groups which are not present need not be coded at all: Groups 1 and 2: status=uh ('MY_UH_SUB',,'A') A simple CUH call with a single input histogram. Groups 1 and 2: status=uh ('MY_UH_SUB',,'A1','A2','A3') A CUH call with a group of three input histograms. Groups 1, 2 and 3: status=uh ('MY_UH_SUB',,'A1','A2','A3',,'B') A CUH call with a group of three input histograms and a single output histogram in group 3. Groups 1, 2, 3, and 4: status=uh ('MY_UH_SUB',,'A',,'B',,1,2,3,4) Note use of double commas to separate groups Groups 1, 2, and 4: status=uh ('MY_UH_SUB',,'A',,' ',,1,2,3,4) Note use of a blank argument as a substitue for a histogram name in group 3. Groups 1, 3, and 4: status=uh ('MY_UH_SUB',,' ',,'MONTE_CARLO',,1,2,3,4) Note use of a blank argument as a substitute for a histogram name in group 2. Writing a Daphne CUH (Callable User-Histogram) Routine Page 7 Calling the CUH Subroutine 30 April 1992 2.2 Interpretation of Status Value The CUH function returns a standard VMS status code. An odd value indicates success while an even value indicates some kind of error or unexpected condition. The CUH function has been carefully written to give the CUH caller a great deal of control over the handling of error messages. Unfortunately, control is dependent on the programmer understanding the VAX/VMS condition handler mechanism, which is somewht complicated. For a programmer who wishes to gain some control over the handling of error messages, there are two choices at the moment: - Use the routine "uhSuppressMsg" to suppress all error message and write ones own routines to give appropriate error messages. Since the CUH function returns a status code which indicates the error, this is not too difficult, although some information which is part of the message will be lost. For instance, if the status code is "RMS$_FNF, file not found" the file name will not be available, as it would be were the error signalled. - Use "DAPUH:uhSuppressMsg.for" or "DAPUH:uhHandler.for" as a model to compose ones own condition handler. Listings of these two condition handlers appear later in this document. In general, most programmers will choose to let the errors be signalled and to simply skip sections of code when there is an error: +------------------------------------------------+ | subroutine xyz (a,b,c) | | implicit none | | ... | | logical*4 uhError | | integer*4 uh | | integer*4 status | | | | ... | | status=uh(...) | -> | if (uhError(status)) then | | goto 99 | | endif | | | | 99 return | | end | +------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 8 Calling the CUH Subroutine 30 April 1992 If you wish to be more selective one can use the following method: +---------------------------------------------------------+ | ... | | include '($LIBDEF)' | | include 'dapexe:uhMsg.inc' | | ... | | integer*4 status | | integer*4 uh | | ... | | character*128 filename | | status=uh(filename,...) | | if (status .eq. uh_noMatch) then | | call uhPrintHelp (filename) | | else if (status .eq. lib$_actImage) then | | write (6,*) 'Can''t load UH routine '//filename | | else | | call uhStopIfError (status) | | endif | | ... | +---------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 9 Calling the CUH Subroutine 30 April 1992 2.3 Histogram Names Histogram names which are part of a group 3 or group 4 argument list obey much the same rules that apply to histogram names appearing in $UH commands: - The STRING "0" stands for the histogram displayed on the currently selected display device. Do NOT use the NUMBER zero. - The STRING "-1" stands for the histogram displayed on the primary graphics device. Do NOT use the NUMBER (-1). - The STRING "-2" stands for the histogram displayed on the secondary graphics device. Do NOT use the NUMBER (-2). - Appending the string "/1D" to a histogram name forces the name to be interpreted as a 1D histogram. This is useful when both a 1D and a 2D histogram are given the same name. - Appending the string "/2D" to a histogram name forces the name to be interpreted as a 2D histogram. - In cases where both "/1D" and "/2D" are appended to the histogram name (e.g. "XYZ/1D/2D") the qualifier which appears first is used and any additional qualifiers are ignored without any indication of error. It may turn out that this is the wrong choice. Perhaps it would be wiser to use the LAST rather than the FIRST qualifier. I would be interested in hearing which convention is easier for users. - A histogram name which is entirely blank is ignored, except as a "place holder" for a group which has been omitted. Writing a Daphne CUH (Callable User-Histogram) Routine Page 10 Calling the CUH Subroutine 30 April 1992 - As with the $UH command, a user may code a histogram number anyplace a histogram name would be allowed. For instance: status=uh ('MY_UH_SUB',,'12','14','16') Note that the numbers are coded as strings, not integers. status=uh ('MY_UH_SUB',,12,14,16) *** THIS IS WRONG *** To convert from a number to the character string representing that number use the "intToString" subroutine (described in a later section) which will convert from an integer to the equivalent string. - Histogram names are always translated to uppercase and have embedded space characters and leading space characters removed before they are used. Trailing spaces are ignored, of course. Writing a Daphne CUH (Callable User-Histogram) Routine Page 11 Linking a CUH Program 30 April 1992 3 Linking a CUH Program To link a CUH program use the following command procedure: $ @DAPEXE:DAPCUH.LNK MYPROGRAM If you have "traditional" Fortran subroutines that you want to include with your main program: $ @DAPEXE:DAPCUH.LNK MYPROGRAM,MYSUB1,MYSUB2 The first argument to the command procedure is a list of .OBJ files to be linked. The second, optional, argument is a list of linker options: $ @DAPEXE:DAPCUH.LNK MYPROGRAM /DEBUG Unlike UH routines, there are no special requirements for using COMMON blocks. That is, there is NO need for an OPTIONS file to override PSECT attributes of COMMON blocks. NOTE COMMON blocks which are shared with a UH routine are a special case which wil be discussed at some future time. Writing a Daphne CUH (Callable User-Histogram) Routine Page 12 Service Routines 30 April 1992 4 Service Routines Aside from the CUH subroutine itself, there are a number of routines available to help the programmer of a CUH program: 4.1 Service Routine uhPrintHelp Subroutine uhPrintHelp calls the "printHelp" routine of a UH routine. +---------------------------------------------------------------+ | subroutine uhPrintHelp (UHfilename) | | | | fileName - input/character string | | file containing a UH routine | +---------------------------------------------------------------+ If the user has not written a "printHelp" subroutine the message "No HELP available" will be output to Fortran unit 6. 4.2 Service Routine uhFindImageSymbol This routine is of interest mainly to programmers who want to add additional entry points to their UH routine and are willing to modify the UH transfer vector in DAPEXE:UHTRANSFER.MAR. +-----------------------------------------------------------------+ | integer*4 function uhFindImageSymbol (UHfilename, | | symbol, | | entryPointAddress) | | | | function value - output/integer*4 | | standard VMS status code | | | | UHfilename - input/character string | | file containing a UH routine or | | a shareable image | | | | symbol - input/character string | | name of the entry point, function, or | | subroutine | | | | entryPointAddress - output/integer*4 | | address of the entry/subroutine/function | | named by symbol once the shareable | | image has been loaded into memory | +-----------------------------------------------------------------+ This routine calls the VAX/VMS supplied routine LIB$FIND_IMAGE_SYMBOL to load the shareable image given by "UHfilename" into memory and to then locate the address of a subroutine/function named by "symbol". Writing a Daphne CUH (Callable User-Histogram) Routine Page 13 Service Routines 30 April 1992 If the shareable image has been previously loaded by LIB$FIND_IMAGE_SYMBOL then the original copy is used. This means that all UH routines used with a CUH program must be "serially reusable". The address of the subroutine/function is returned in the variable "entryPointAddress". The function can then be called using either the routine uhCall or the VAX/VMS supplied routine LIB$CALLG. Here is an example of uhFindImageSymbol and uhCall together: +-------------------------------------------------------------+ | program printHelp | | implicit none | | | | integer*4 code | | character*128 filename | | integer*4 printHelpSub | | integer*4 uhFindImageSymbol | |c | | write (6,*) 'Enter filename of UH shareable image: ' | | read (5,1000) filename | | 1000 format (a) | | code=uhFindImageSymbol (filename,'printHelp', | | * printHelpSub) | | call uhStopIfError (code) | | call uhCall (printHelpSub) | | call exit | | end | +-------------------------------------------------------------+ Please note that the calling sequeunces for uhCall and LIB$CALLG are different. With uhCall the subroutine/function address is the first argument and it is passed in the traditional Fortran manner. With LIB$CALLG the subroutine/function address is the second argument and it is passed using the %VAL pseudo function. Writing a Daphne CUH (Callable User-Histogram) Routine Page 14 Service Routines 30 April 1992 4.3 Service Routine uhCall Routine uhCall will invoke the specified routine with the specified arguments (arg1, arg2, arg3,...). The "extra" arguments may be of any type or number as long as they are compatible with the expectations of the called subroutine/function. The function value returned by uhCall is whatever function value is returned by the routine specified by the user. b +--------------------------------------------------------------------+ | integer*4 function uhCall (entryPointAddress,arg1,arg2,arg3,...) | | | | function value - output/integer*4 | | whatever function value is returned by | | the routine at "entryPointAddress" | | | | entryPointAddress - input/integer*4 | | the address of a subroutine/function | | typically supplied by uhFindImageSymbol | | | | arg1, arg2, arg3, ... - input or output/arbitrary arguments | | can be any kind of argument as long | | as it matches what the called | | subroutine/function expects | +--------------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 15 Service Routines 30 April 1992 Example of uhFindImageSymbol and uhCall together: +-----------------------------------------------------+ | ... | | code=uhFindImageSymbol (filename,'evaluate', | |* evaluateSubr) | | call uhStopIfError (code) | -> | call uhCall (evaluateSubr) | | ... | +-----------------------------------------------------+ +-----------------------------------------------------+ | ... | | external evaluate | | integer*4 evaluateAddr | | ... | -> | evaluateAddr=%loc(evaluate) | | call uhCall (evaluateAddr,'MINIMIZE',100,3.14159) | | ... | +-----------------------------------------------------+ +-----------------------------------------------------+ | subroutine evaluate (options,iterations,guess) | | implicit none | | | | character*(*) options | | integer*4 iterations | | real*4 guess | | ... | +-----------------------------------------------------+ Please note that the examples above show that slightly different calling sequences are required depending on how the subroutine/function address is computed. If the address is supplied by uhFindImage then it can be passed to uhCall as though it were just another INTEGER*4 argument. If the subroutine/function address is supplied by the VAX/VMS linker by means of the Fortran EXTERNAL declaration then the user must apply the %LOC pseudo-function to compute the value to pass to uhCall. Writing a Daphne CUH (Callable User-Histogram) Routine Page 16 Service Routines 30 April 1992 4.4 Service Routine nArg() This returns as the function value the number of calling arguments its caller had (NOT the number of arguments to nArg). For instance: +---------------------------------------------------------+ | call XYZ (a,b,c) | +---------------------------------------------------------+ +---------------------------------------------------------+ | subroutine XYZ (a,b,c,d,e,f,g,h,i) | | implicit none | | integer*4 a,b,c,d,e,f,g,h,i | | integer*4 nArgs | | integer*4 nArg | -> | nArgs=nArg() | | if (nArgs .ge. 1) call process (a) | | if (nArgs .ge. 2) call process (b) | | ... | | if (nArgs .ge. 9) call process (i) | | ... | | return | | end | +---------------------------------------------------------+ Note: There are existing (assembler) language routines which will change and argument list into a vector of arguments. +---------------------------------------------------------+ | subroutine PQR (something,unit) | | implicit none | | integer*4 something | | integer*4 unit | | integer*4 nArg | | | | ... | -> | if (nArg() .eq. 2) then | | write (unit,1000) something | | endif | | ... | | return | | end | +---------------------------------------------------------+ +---------------------------------------------------------+ | integer*4 function nArg () | | | | function value - output/integer*4 | | number of arguments supplied | | by its caller's caller | +---------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 17 Service Routines 30 April 1992 4.5 Service Routine uhSetDisplayNumber (displayNumber) This routine selects the graphics device used by graphics routines in UH routines. +-------------------------------------------------------------+ | subroutine uhSetDisplayNumber (newDisplay) | | | | newDisplay - input/integer*4 | | 0 => use primary if exists, | | otherwise use secondary | | 1 => use primary | | 2 => use secondary | +-------------------------------------------------------------+ 4.6 Service Routine uhGetDisplayNumber (displayNumber) This routine returns the number of the graphics device used by graphics related subroutine calls in UH routines. +-------------------------------------------------------------+ | subroutine uhGetDisplayNumber (currentDisplay) | | | | currentDisplay - output/integer*4 | | 0 => use primary if exists, | | otherwise use secondary | | 1 => use primary | | 2 => use secondary | +-------------------------------------------------------------+ If there has been no previous call to uhSetDisplayNumber then the value returned will be zero. Writing a Daphne CUH (Callable User-Histogram) Routine Page 18 Service Routines 30 April 1992 4.7 Service Routine uhSetLogFileName (filename) This is equivalent to the /LOG qualifier of the $UH command. This routine changes the name of the log file that will be used by UH routines which append information to a user specified log file. A UH routine gets the name of the log file by calling uhGetLogFileName. Please note that this is merely a "suggested" log file name. There is nothing which compels a UH routine which supports log files to put information in this particular file. If the user specifies an incomplete filename a default extension of ".LOG" will be supplied. +-------------------------------------------------------------+ | subroutine uhSetLogFileName (fileName) | | | | filename - input/character string | | name of new log file | +-------------------------------------------------------------+ This is a "persistent" parameter which is not reset by calling a new UH routine. Writing a Daphne CUH (Callable User-Histogram) Routine Page 19 Service Routines 30 April 1992 4.8 Service Routine uhSetOutputHeaders (onOffFlag) This is equivalent to the /HEADERS qualifier of the $UH command. Sometimes it is convenient to have a UH routine support two different output formats: one designed to be easy for people to read and a second designed to be easy for other programs to read. This flag is a suggestion to the UH routine about which format is preferred. +-------------------------------------------------------------+ | subroutine uhSetOutputHeaders (onOffFlag) | | | | onOffFlag - input/logical*4 | | .true. => | | UH routine should supply | | headers to make it easy | | for people to read output | | .false. => | | UH routine should choose a | | format that is easy for | | programs to read | +-------------------------------------------------------------+ This is a "persistent" parameter which is not reset by calling a new UH routine. 4.9 Service Routine uhGetOutputHeaders (onOffFlag) This returns the current setting of the "outputHeaders" flag, which is equivalent of the /HEADERS qualifier of the $UH command. +----------------------------------------------------------------+ | subroutine uhGetOutputHeaders (onOffFlag) | | | | onOffFlag - output/logical*4 | | .true. => UH routine should supply headers | | to make it easy for people to read | | .false. => UH routine should choose a format | | that is easy for programs to read | +----------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 20 Service Routines 30 April 1992 4.10 Service Routine uhSetUserData This is the equivalent of the $UH command qualifier /USERDATA. Sometimes it is convenient to pass some information from the $UH command line to the UH routine (e.g. the name of a data file). Before the CUH subroutine was written this was the only way to pass non-histogram data into a UH routine from a command line. $ UH FILL_2D_HIST_WITH_DATA XY /USERDATA="SIMULATION.DAT" This service routine is provided so that a CUH program can utilize existing UH routines which depend on /USERDATA. +-------------------------------------------------------------+ | subroutine uhSetUserData (string) | | | | string - input/character string | | string to be supplied when UH routine | | calls uhGetUserData | +-------------------------------------------------------------+ This is a "persistent" parameter which retains its value until explicitly cleared by a call such as the following: call uhSetUserData (' ') Writing a Daphne CUH (Callable User-Histogram) Routine Page 21 Service Routines 30 April 1992 4.11 Service Routine uhError (status) This subroutine is provided as a convenience for users who don't want to have to write the code to repeatedly test return status. +------------------------------------------------------------------+ | logical*4 function uhError (status) | | | | function value - output/logical*4 | | when error (even status code) => .true. | | return immediately to caller | | when no error (odd status code) => .false. | | return immediately to caller | +------------------------------------------------------------------+ This routine simply tests the status code to see if it is odd or even. An odd status code indicates success. An even status code indicates an error of unexpected condition. This routine is cast as a logical function to make it easy to include in the body of an IF statement: +--------------------------------------------+ | status=uh ('XYZ',,'histA',,'histB') | | if (uhError(status)) then | | | | endif | +--------------------------------------------+ This routine does not issue any messages. 4.12 Service Routine uhStopIfError (status) This subroutine is provided as a convenience for users who don't want to bother recovering from any errors discovered by the CUH function. If the VMS status code indicates an error the subroutine simply calls the Fortran EXIT routine: +---------------------------------------------------------------+ | subroutne uhStopIfError (status) | | | | status - input/integer*4 | | standard VMS status code | | no error (even status code) => immediate return | | an error (odd status code) => immediate exit | +---------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 22 Service Routines 30 April 1992 4.13 Service Routine uhWarnIfError (status) This subroutine is provided as a convenience for users who don't want to have to write the code to repeatedly test return status and then issue the appropriate error messages, if necessary. Under normal circumstances the CUH function will issue appropriate error messages automatically, so this routine would be unnecessary. However if the user has established a condition handler (such as uhSuppressMsg) which suppresses normal messages then this routine allows one to force the printing of the message associated with the status code returned by the CUH function. +-------------------------------------------------------------+ | logical*4 function uhWarnIfError (status) | | | | function value - output/logical*4 | | when error (even status code) => | | issue message for status code | | return to caller | | when no error (odd status code) => | | return immediately to caller | +-------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 23 Service Routines 30 April 1992 4.14 Condition Handler uhSuppressMsg Under normal circumstances the CUH function will issue its own error messages via signalling and return a status code to its caller which indicates the error. For example, suppose the program had the wrong directory for a UH routine so that the file cannot be found. The user might see on the terminal the message: %LIB-E-ACTIMAGE, error activating image ANPH06$DUA0:[DAPHNE]SUMWINDOW1D.EXE; -RMS-E-FNF, file not found Using the uhSuppressMsg routine the programmer can suppress the message while still receiving the status code LIB$_ACTIMAGE and issue a different message or recover in a manner invisible to the user. (To be entirely accurate, the status value returned will be "RMS$_FNF, file not found" which is, of course, not "LIB$_ACTIMAGE, error activating image".) Only lib$_imageAct and UH related error messages will be suppressed. +-------------------------------------------------------------+ | program suppressExample | | implicit none | | c | | character*20 imageName | | integer*4 status | | integer*4 uh | | external uhSuppressMsg | | integer*4 uhError | | c | | 10 write (6,1000) 'Enter filename: ' | | 1000 format (1x,$,a) | | read (5,1010) imagename | | 1010 format (a) | | c | -> | call lib$establish (uhSuppressMsg) | | status=uh (imageName,,' ') | -> | call lib$revert | | write (6,1020) status | | 1020 format (1x,'Status returned by UH: ',z8.8,' (hex)')| | if (uhError(status)) then | | write (6,1030) 'This from uhWarnIfError:' | | 1030 format (1x,a) | | call uhWarnIfError (status) | | endif | | goto 10 | | c | | 999 call exit | | end | +-------------------------------------------------------------+ The VAX/VMS routine LIB$ESTABLISH stores a pointer to a condition handling routine in the caller's stack frame. The VAX/VMS routine LIB$REVERT zeroes the pointer to the condition handler, thereby cancelling the condition handler. Both these routines are described in the VAX/VMS manual on library routines. Writing a Daphne CUH (Callable User-Histogram) Routine Page 24 Service Routines 30 April 1992 4.15 Service Routine uhGetFacility (status) This routine is used in condition handlers to determine the "facility" which generate a signal. A message of the form SYS$_xxx is from the SYSTEM (facility number: 0). A message of the form RMS$_xxx is from Record Management Services (facility number: 1). Since all UH messages have the same facility code it is easy to check for a signal generated by UH. See the section on Condition Handlers for examples of the use of uhGetFacility. +------------------------------------------------------+ | integer*4 function uhGetFacility (status) | | | | function value - output/integer*4 | | facility number field of | | "status" | | 0 => SYSTEM | | 1 => RMS | | 15 => Library | | | | status - input/integer | | standard VMS status code | | facility number field described | | by subfield STS$_FAC_NO | +------------------------------------------------------+ 4.16 Library Routine LIB$CALLG The CUH function has a very rigid format for its calling sequence which may not be appropriate for some CUH programs. For instance it assumes a fixed (or at least a limited number) of input histograms, output histograms, and "extra" arguments. The VAX/VMS library routine LIB$CALLG allows a programmer to construct an argument list as a vector and to use it to call another routine. +-------------------------------------------------------------+ | integer*4 function LIB$CALLG (argVector,entryPoint) | | | | function value - output/integer*4 | | status value returned by caller | | | | argVector - input/integer*4 | | an array of elements to be passed to | | subroutine/function at "entryPoint" | | | | argVector(1) is number of arguments | | (not including itself) | | argVector(2) is 1st argument | | argVector(3) is 2nd argument | | etc. | | | | entryPoint - input/subroutine/function address | | function/subroutne declared EXTERNAL | | or returned by uhFindImageSymbol | +-------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 25 Service Routines 30 April 1992 The following demonstrates how to create a variable length argument list for use with LIB$CALLG. +-------------------------------------------------------------+ | program ExampleCALLG | | implicit none | | c | | integer*4 lib$callg | | c | | integer*4 vector (0:10) | | integer*4 descriptor (2,10) | | c | | integer*4 status | | external uh | | c | | 10 vector(0)=6 | | call buildCharDesc (descriptor(1,1),'SUM1D') | | vector(1)=%loc(descriptor(1,1)) | | vector(2)=0 | | call buildCharDesc (descriptor(1,2),'A') | | vector(3)=%loc(descriptor(1,2)) | | call buildCharDesc (descriptor(1,3),'B') | | vector(4)=%loc(descriptor(1,3)) | | vector(5)=0 | | call buildCharDesc (descriptor(1,4),'C') | | vector(6)=%loc(descriptor(1,4)) | | status=lib$callg (vector,uh) | | call uhWarnIfError (status) | | call exit | | end | +-------------------------------------------------------------+ +-------------------------------------------------------------+ | subroutine buildCharDesc (desc,string) | | implicit none | | c | | c Will not work on dynamically allocated strings created | | c on the stack. For instance concatenate expressions | | c such as: | | c | | c call buildCharDesc (desc(1,1),ABC//PQR//XYZ) | | c | | integer*4 desc(2) | | character*(*) string | | c | | desc(1)=len(string) | | desc(2)=%loc(string) | | c | | return | | end | +-------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 26 Service Routines 30 April 1992 The equivalent call using a conventional argument list is: +-------------------------------------------------------------+ | program standardCall | | implicit none | | c | | integer*4 uh | | integer*4 status | | c | | status=uh ('SUM1D',,'A','B',,'C') | | call uhWarnIfError (status) | | call exit | | end | +-------------------------------------------------------------+ 4.17 Service Routine intToString (int,string) This routine converts an INTEGER*4 number to a string representing that number. +------------------------------------------------+ | subroutine inToString (int,string) | | | | int - input/integer*4 | | number to be converted | | | | string - output/character string | | string representing the | | number "int" | +------------------------------------------------+ If "string" is too small to hold "int" then it is filled with asterisks ("*") and an exception is signalled. Writing a Daphne CUH (Callable User-Histogram) Routine Page 27 Additional UH Entry Point userUHextend 30 April 1992 5 Additional UH Entry Point userUHextend The user can add subroutines/functions to a UH routine which can be called from a CUH program, although there is no way to call them with a $UH command. The "userUHextend" routines were added to provide optional entry-points to a UH routine so that a CUH program could exchange information with a UH routine without having to pretend it was passing a histogram. In other words, this is similar to a traditional subroutine call, except that the subrutine to be called is located in the same shareable image as a UH routine. These routines are entirely optional. Please look in the examples section for programs which contrasts two methods of computing the sum of counts within a window for a 1D histogram. +----------------------------------------------------------------+ | integer*4 function userUHextend (UHfilename,arg1,arg2,...) | | integer*4 function userUHextend1 (UHfilename,arg1,arg2,...) | | integer*4 function userUHextend2 (UHfilename,arg1,arg2,...) | | .... | | integer*4 function userUHextend9 (UHfilename,arg1,arg2,...) | | | | function value - output/integer*4 | | standard VMS status code | | | | UHfilename - input/character*(*) | | file containing UH routine | | shareable image | | | | arg1,arg2,arg3,... - input/output arbitrary | | optional additional arguments | | these optional arguments may be of | | any type or number as long as they | | are compatible with the expecta- | | tions of the called subroutine. | +----------------------------------------------------------------+ There is a reason these routines are named "userUHextend" rather than "UHuserExtend". Only routines supplied by the developer have the prefix "UH". Only routines which are supplied by a user begin "user". In this case these are user-supplied routines for UH. Writing a Daphne CUH (Callable User-Histogram) Routine Page 28 Condition Handlers 30 April 1992 6 Condition Handlers A description of VAX/VMS condition handlers is beyond the scope of this document. However I will include the two condition handlers used in CUH as examples. The condition handler DAPUH:UHHANDLER.FOR intercepts all CUH related messages (not handled by a user's condition handler) and (a) prints them out on the terminal using the VAX/VMS system routine SYS$PUTMSG and (b) resumes operation of the routine which originally issued the signal by returning the function value SS$_CONTINUE. All other messages are ignored (such as SS$_ACCVIO, access violation) and passed back to VMS for processing by returning the function value SS$_RESIGNAL. The purpose of uhHandler is to alter the default VMS handling of UH signals. The default action would cause a traceback to be printed out on the terminal. In general, users don't want a traceback for trivial errors, such as misspelling a filename. Writing a Daphne CUH (Callable User-Histogram) Routine Page 29 Condition Handlers 30 April 1992 +--------------------------------------------------------------+ | integer*4 function uhHandler (sigArgs,mechArgs) | | implicit none | | c | | integer*4 sigArgs (*) | | integer*4 mechArgs (*) | | c | | include '($LIBDEF)' | | include '($SSDEF)' | | include 'dapexe:uhMsg.inc' | | c | | integer*4 status | | integer*4 code | | c | | integer*4 count | | integer*4 i | | integer*4 match | | integer*4 thisFacility | | integer*4 uhFacility | | c | | integer*4 lib$match_cond | | integer*4 uhGetFacility | | integer*4 sys$PutMsg | | c | | count=sigArgs(1) | | status=sigArgs(2) | | c | | c is this a message generated by UH or one of the few | | c expected system messages that UH will handle | | c compare facility numbers to see if a UH message | | c | | thisFacility=uhGetFacility (status) | | uhFacility=uhGetFacility (uh_noMatch) | | c | | c compare with a list of non UH error messages | | c | | match=lib$match_cond (status,lib$_actImage) | | if (match .ne. 0 .or. | | * thisFacility .eq. uhFacility) then | | sigArgs(1)=count-2 | | code=sys$putMsg (sigArgs) | | sigArgs(1)=count | | code=ss$_continue | | else | | code=ss$_resignal | | endif | | 99 uhHandler=code | | return | | end | +--------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 30 Condition Handlers 30 April 1992 The use and purpose of uhSuppressMsg has been described already. +--------------------------------------------------------------+ | integer*4 function uhSuppressMsg (sigArgs,mechArgs) | | implicit none | | c | | integer*4 sigArgs (*) | | integer*4 mechArgs (*) | | c | | include '($LIBDEF)' | | include '($SSDEF)' | | include 'dapexe:uhMsg.inc' | | c | | integer*4 status | | integer*4 code | | c | | integer*4 count | | integer*4 i | | integer*4 match | | integer*4 thisFacility | | integer*4 uhFacility | | c | | integer*4 lib$match_cond | | integer*4 uhGetFacility | | integer*4 sys$PutMsg | | c | | count=sigArgs(1) | | status=sigArgs(2) | | c | | c is this a message generated by UH or one of the few | | c expected system messages that UH will handle | | c compare facility numbers to see if a UH message | | c | | thisFacility=uhGetFacility (status) | | uhFacility=uhGetFacility (uh_noMatch) | | c | | c compare with a list of non UH error messages | | c | | match=lib$match_cond (status,lib$_actImage) | | if (match .ne. 0 .or. | | * thisFacility .eq. uhFacility) then | | code=ss$_continue | | else | | code=ss$_resignal | | endif | | 99 uhSuppressMsg=code | | return | | end | +--------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 31 Serial Reusability 30 April 1992 7 Serial Reusability A routine is "serially reusable" if it will give the same result when it is called with the same inputs multiple times. When a UH routine could only be called via the $UH command it was acceptable for UH routines to not be serially reusable: they could be called only once. With the CUH program a UH routine can be called several times. Two easy errors which may occur with UH routines called multiple times from a CUH program are (a) failure to reinitialize certain variables and (b) failure to release Fortran logical units by executing a Fortran CLOSE statement for files which were opened in the UH routine. The following subroutine is NOT serially reusable because variable SUM will not be reinitialized to zero the second time the subroutine is called: +--------------------------------------------------+ | integer*4 function sum (n,array) | | implicit none | | | | integer*4 n | | integer*4 array (n) | | | | integer*4 sum | | data sum /0/ | | | | integer*4 i | | | | do i=1,n | | sum=sum+a(i) | | end do | | | | return | | end | +--------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 32 Using the VAX/VMS Symbolic Debugger 30 April 1992 8 Using the VAX/VMS Symbolic Debugger This example shows how to use the VAX/VMS symbolic debugger with a CUH program and a UH routine. The procedure differs slightly from the procedure used to debug a UH routine called from a $UH command. More comprehensive information can be obtained by using a version of the CUH function with the full debug symbol table (DAPEXE:DAPCUHDEBUG.EXE). To use the "/DEBUG" version of the CUH function issue the following command: $ DEFINE/JOB DAPCUH DAPEXE:DAPCUHDEBUG.EXE To undo the logical name redefinition: $ DEASSIGN/JOB DAPCUH It should not normally be necessary to issue such a command. Both examples below were run with the standard ("/NODEBUG") version of DAPCUH. +-------------------------------------------------------------------------+ |$ dap/noban tma | |$ h1 1000/name=example1 | |$ h2 256/name=example2 | a |$ fortran/debug/noop/list fill_2d | b |$ @dapexe:dapuh.lnk fill_2d /debug | c |$ fortran/debug/noop/list fill_2d_test | d |$ @dapexe:dapcuh.lnk fill_2d_test /debug | |$ run fill_2d_test | | | | VAX DEBUG Version V5.4-019 | | | |%DEBUG-I-INITIAL, language is FORTRAN, module set to FILL_2D_TEST | |%DEBUG-I-NOTATMAIN, type GO to get to start of main program | | | e |DBG> go | |break at routine FILL_2D_TEST | | 8: write (6,1000) 'Enter name of Histogram: ' | f |DBG> call debugOn | |value returned is 1 | |DBG> go | |Enter name of Histogram: | |example2 | h |%DEBUG-I-DYNIMGSET, setting image FILL_2D | |%DEBUG-I-DYNMODSET, setting module OK_TO_SET_BREAKPOINTS_NOW | i |DBG> set module userhist | j |DBG> set break userhist | | | |DBG> show module | |module name symbols language size | | | |BADPOLICY no FORTRAN 448 | |DEFINEUHCALLBACK no MACRO 4888 | | | Writing a Daphne CUH (Callable User-Histogram) Routine Page 33 Using the VAX/VMS Symbolic Debugger 30 April 1992 | | |NOTIMPLEMENTED no FORTRAN 500 | |OK_TO_SET_BREAKPOINTS_NOW yes FORTRAN 548 | |POLICY no MACRO 252 | |PRINTHELP no FORTRAN 436 | |UHSIGNALDEBUG no FORTRAN 464 | |UHTRANSFER no MACRO 744 | |UH_2D no FORTRAN 7396 | |UH_2D_INIT no FORTRAN 436 | |USERHIST yes FORTRAN 1128 | |USERHISTINIT no FORTRAN 452 | |USERUHEXTEND no FORTRAN 540 | |USERUHEXTEND1 no FORTRAN 548 | |USERUHEXTEND2 no FORTRAN 548 | |USERUHEXTEND9 no FORTRAN 548 | | | |total modules: 22. bytes allocated: 137920. | |DBG> show break | |breakpoint at routine USERHIST | k |DBG> go | |break at routine USERHIST | | 6: integer*2 array (0:nx-1,0:ny-1) | l |DBG> Step | |stepped to USERHIST\%LINE 16 | | 16: count=0 | |DBG> Step | |stepped to USERHIST\%LINE 17 | | 17: outside=0 | m |DBG> type 25:50 | |module USERHIST | | | 40: 100 read (10,*,end=99) ix,iy | | 41: count=count+1 | | 42: if ( (ix .lt. 0 .or. ix .gt. nx-1) .or. | | 43: * (iy .lt. 0 .or. iy .gt. ny-1) ) then | | n |DBG> set break %line 41 | |DBG> go | |Do you wish to zero histogram EXAMPLE2 first ? [Y/N] | |y | |break at USERHIST\%LINE 41 | | 41: count=count+1 | |DBG> Step | |stepped to USERHIST\%LINE 42 | | 42: if ( (ix .lt. 0 .or. ix .gt. nx-1) .or. | |DBG> Step | |stepped to USERHIST\%LINE 47 | | 47: array (ix,iy)=array(ix,iy)+1 | | o |DBG> cancel break/all | |DBG> go | |Number of points read: 21 | |%DEBUG-I-EXITSTATUS, is '%SYSTEM-S-NORMAL, normal successful completion' | |DBG> exit | +-------------------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 34 Using the VAX/VMS Symbolic Debugger 30 April 1992 a. Compile the UH routine with the /DEBUG qualifier. Only necessary when debugging a UH routine too. b. Link the UH routine with DAPEXE:DAPUH.LNK and /DEBUG qualifier. Only necessary when debugging a UH routine too. c. Compile the CUH program with the /DEBUG qualifier. d. Link the CUH program with DAPEXE:DAPCUH.LNK and /DEBUG qualifier. e. The CUH program has been loaded and control transferred to the debugger. The initialization routines have not yet executed. To execute the initialization routines and get to the first line of the user's program enter "DBG> go". f. Execution has reached the first line of the user's program and execution has been suspended so that debugging commands can be entered. g. The "DBG> call debugOn" sets a debugger breakpoint which is tripped after the user's UH routine has been loaded but before the userHistInit or userHist routines have been called. Without this command it is difficult to set breakpoints in the user-function, since in most cases the UH routine will not yet have been loaded into memory. To turn off this breakpoint trap use the command: "DBG> debugOff". There is no significance to the "return value" of debugOn and debugOff. h. The breakpoint has been tripped. i. Loads the symbol table of the module USERHIST, the usual name of the user's UH routine. j. Sets a breakpoint at the beginning of subroutine userHist. k. Resume execution. l. Single step Fortran code line by line. m. TYPE statement lists part of UH routine. n. Set breakpoint using source statement line number. o. Cancel breakpoints so execution can proceed without interruption. Writing a Daphne CUH (Callable User-Histogram) Routine Page 35 Using the VAX/VMS Symbolic Debugger 30 April 1992 This example shows how to intercept signals from the CUH function and to locate the origin of the CUH function call in the user's program. +-------------------------------------------------------------------------+ a |$ run fill_2d_test | | | | VAX DEBUG Version V5.4-019 | | | b |%DEBUG-I-INITIAL, language is FORTRAN, module set to FILL_2D_TEST | |%DEBUG-I-NOTATMAIN, type GO to get to start of main program | | | c |DBG> call debugOn | |value returned is 1 | d |DBG> call interceptOn | |value returned is 1 | |DBG> go | e |break at routine FILL_2D_TEST | | 8: write (6,1000) 'Enter name of Histogram: ' | |DBG> go | |Enter name of Histogram: | |example | |%DEBUG-I-DYNIMGSET, setting image FILL_2D | f |%DEBUG-I-DYNMODSET, setting module OK_TO_SET_BREAKPOINTS_NOW | |DBG> go | |%DEBUG-I-DYNIMGSET, setting image FILL_2D_TEST | g |%DEBUG-I-DYNMODSET, setting module INTERCEPT_UH_SIGNAL | h |DBG> show scope | |scope: | | * 0 [ = INTERCEPT_UH_SIGNAL ], | | 1, | | 2, | | 3, | | 4, | | 5, | | 6, | ->| 7 [ = FILL_2D_TEST ], | | 8, | | 9, | | 10 | i |DBG> set scope 7 | | | Writing a Daphne CUH (Callable User-Histogram) Routine Page 36 Using the VAX/VMS Symbolic Debugger 30 April 1992 | | j |DBG> show calls | | module name routine name line rel PC abs PC | |*INTERCEPT_UH_SIGNAL | | INTERCEPT_UH_SIGNAL 10 00000010 000006F8 | | SHARE$DAPCUH 00000000 0002442A | | SHARE$DAPCUH 00000000 0002C4B8 | |----- above condition handler called with exception 08A9800A: | |%UH-E-NOSUCHHIST, histogram EXAMPLE does not exist | |----- end of exception message | | SHARE$DAPCUH 00000000 00025FA5 | | SHARE$DAPCUH 00000000 000297A1 | | SHARE$DAPCUH 00000000 0002440A | | SHARE$DAPCUH 00000000 000297C9 | ->|*FILL_2D_TEST FILL_2D_TEST 12 00000051 00000661 | | LIB$INITIALIZE 00000054 0000074D | | UHINITCUHVECTOR UHINITCUHHANDLER 0000000D 0000060D | | LIB$INITIALIZE 0000002F 00000728 | k |DBG> type 12 | |module FILL_2D_TEST | | 12: status=uh ('DAPUH:FILL_2D',,histogram) | |DBG> exam histogram | |FILL_2D_TEST\HISTOGRAM: 'example ' | |DBG> type | |module FILL_2D_TEST | | 13: call uhStopIfError (status) | |DBG> set break %line 13 | |DBG> go | l |%UH-E-NOSUCHHIST, histogram EXAMPLE does not exist | |break at FILL_2D_TEST\%LINE 13 | | 13: call uhStopIfError (status) | |DBG> go | m |%UH-E-NOSUCHHIST, histogram !AS does not exist | |%DEBUG-I-EXITSTATUS, is '%SYSTEM-S-NORMAL, normal successful completion' | |DBG> exit | +-------------------------------------------------------------------------+ Writing a Daphne CUH (Callable User-Histogram) Routine Page 37 Using the VAX/VMS Symbolic Debugger 30 April 1992 a. Compile the CUH program with the /DEBUG qualifier. Link the CUH program with DAPEXE:DAPCUH.LNK and /DEBUG qualifier. b. The CUH program has been loaded and control transferred to the debugger. The initialization routines have not yet executed. To execute the initialization routines and get to the first line of the user's program enter "DBG> go". c. The "DBG> call debugOn" sets a debugger breakpoint which is tripped after the user's UH routine has been loaded but before the userHistInit or userHist routines have been called. Without this command it is difficult to set breakpoints in the user-function, since in most cases the UH routine will not yet have been loaded into memory. To turn off this breakpoint trap use the command: "DBG> debugOff". There is no significance to the "return value" of debugOn and debugOff. d. The "DBG> call interceptOn" sets a debugger breakpoint in a routine which is called only when the UH condition handler intercepts a UH related signal. This makes it easy to find out what statement within a CUH program is generating a UH related signal. To turn off this breakpoint trap use the command: "DBG> interceptOff". e. Execution has reached the first line of the user's program and execution has been suspended so that debugging commands can be entered. f. The userHist breakpoint has been tripped. However this example is meant to demonstrate how to intercept signals. Ignore the breakpoint and continue execution. g. The signal intercept breakpoint has been tripped. h. The "DBG> SHOW SCOPE" is like an abbreviated from of "DBG> SHOW CALLS". The list shows that two modules have symbol tables loaded: INTERCEPT_UH_SIGNAL and FILL_2D_TEST. i. The SCOPE command selects a "default" subroutine/function for TYPE and EXAMINE statements. In this case we select FILL_2D_TEST (Number 7). j. SHOW CALLS gives a traceback showing a call from line 12 of FILL_2D_TEST. k. TYPE lists the source code at line 12. l. Resume execution. Notice that the full error message appears, including the histogram name. Writing a Daphne CUH (Callable User-Histogram) Routine Page 38 Using the VAX/VMS Symbolic Debugger 30 April 1992 m. Resume execution again. Notice that with uhStopIfError only the status code itself appears. The histogram name is absent because the status code is only one word and does not include a pointer to the name of the histogram. Writing a Daphne CUH (Callable User-Histogram) Routine Page 39 Some Examples 30 April 1992 9 Some Examples 9.1 Example 1 - SumWindow1D with Extra Calling Arguments program sumWindow1D implicit none c character*20 histname integer*4 status integer*4 uh integer*4 wLow integer*4 wHigh c 10 write (6,1000) 'Enter Histogram name: ' 1000 format (1x,$,a) read (5,1010,end=999) histName 1010 format (a) write (6,1000) 'Enter Window lower and upper bounds: ' read (5,*,end=999) wLow,wHigh c status=uh ('sumWindow1D',,histName,,' ',,wLow,wHigh,sum) c write (6,*) 'Sum: ',sum goto 10 c 999 call exit end Writing a Daphne CUH (Callable User-Histogram) Routine Page 40 Example 1 - SumWindow1D with Extra Calling Arguments 30 April 1992 subroutine userhist (nChan,h,low,high,sum) implicit none c++ c Sums INTEGER*4 1D histogram c c nChan - input/integer*4 c number of channels numbered (0 to nChan-1) c c h - input/integer*4 vector c the histogram itself c c low/high - input/integer*4 c lower and upper window limits c c sum - output/integer*4 c sum within window of histogram c-- integer*4 nChan integer*4 h (0:nChan-1) integer*4 low integer*4 high integer*4 sum c integer*4 i integer*4 myLow integer*4 myHigh c call checkWindow (low,high,myLow,myHigh,nChan) c sum=0 c do i=myLow,myHigh sum=sum+h(i) end do c return end c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine userHistInit call uh_1d_init return end Writing a Daphne CUH (Callable User-Histogram) Routine Page 41 Example 1 - SumWindow1D with Extra Calling Arguments 30 April 1992 9.2 Example 2 - SumWindow1D using userUHextend The same thing can be accomplished without passing two extra parameters when calling SUM1D via UH. This might be the preferred method under some circumstances. For instance, this would make it possible to call SumWindow1D (without use of the window limits) from the command line using $UH because it is no longer necessary to pass additional parameters. The user must judge for himself whether this feature is worth the added complexity. program sumWindow1D implicit none c character*20 histname integer*4 sum integer*4 status integer*4 uh integer*4 wLow integer*4 wHigh c 10 write (6,1000) 'Enter Histogram name: ' 1000 format (1x,$,a) read (5,1010,end=999) histName 1010 format (a) write (6,1000) 'Enter Window lower and upper bounds: ' read (5,*,end=999) wLow,wHigh c call userUHextend1 ('sumWindow1dA',wLow,wHigh) status=uh ('sumwindow1dA',,histName) call userUHextend2 ('sumwindow1dA',sum) write (6,*) 'Sum: ',sum goto 10 c 999 call exit end Writing a Daphne CUH (Callable User-Histogram) Routine Page 42 Example 2 - SumWindow1D using userUHextend 30 April 1992 subroutine userhist (nChan,h) implicit none c++ c Sums INTEGER*4 1D histogram c c nChan - input/integer*4 c number of channels numbered (0 to nChan-1) c c h - input/integer*4 vector c the histogram itself c-- integer*4 nChan integer*4 h (0:nChan-1) integer*4 low data low /0/ integer*4 high data high /100000/ c integer*4 i integer*4 myLow integer*4 myHigh integer*4 newLow integer*4 newHigh integer*4 sum integer*4 sumOut c call checkWindow (low,high,myLow,myHigh,nChan) c sum=0 c do i=myLow,myHigh sum=sum+h(i) end do c return c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c entry userHistInit call uh_1d_init return c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c entry userUHextend1 (newLow,newHigh) low=newLow high=newHigh return c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c entry userUHextend2 (sumOut) sumOut=sum return c end Writing a Daphne CUH (Callable User-Histogram) Routine Page 43 Example 2 - SumWindow1D using userUHextend 30 April 1992 9.3 Example 3 - Simple Command Language Program Example implicit none c include 'dapexe:uhMsg.inc' c character*128 command !Name of UH routine character*128 datafile !Name of file with commands character*20 operand !command/histogram name just read character*20 inputHist(3) !list of "input" histograms data inputHist /3*' '/ character*20 outputHist(3) !list of "output" histograms data outputHist /3*' '/ integer*4 number(3) !list of integer*4 arguments integer*4 inputX !index to array of input histograms integer*4 outputX !index to array of output histogram integer*4 numberX !index to array of integer*4 args integer*4 status !return status from UH function c integer*4 uh !UH function declaration c write (6,1010) 'Enter Name of datafile: ' read (5,1020) datafile open (unit=10,name=datafile,status='old',readonly) c 10 inputX=0 outputX=0 numberX=0 read (10,1020,end=99) command read (10,1020,end=99) operand c c make program insensitive to upper/lower case c 20 call str$upcase (operand,operand) c c .OUTPUT followed on subsequent lines by output histograms c .NUMBER followed on subsequent lines by numeric arguments c . no more arguments - call UH routine c if (operand .eq. '.OUTPUT') goto 200 if (operand .eq. '.NUMBER') goto 300 if (operand .eq. '.') goto 400 Writing a Daphne CUH (Callable User-Histogram) Routine Page 44 Example 3 - Simple Command Language 30 April 1992 c c assume first operand is of type .INPUT c 100 inputX=inputX+1 inputHist(inputX)=operand read (10,1020,end=99) operand if (operand (1:1) .eq. '.') goto 20 goto 100 c 200 read (10,1020,end=99) operand 210 outputX=outputX+1 outputHist(outputX)=operand read (10,1020,end=99) operand if (operand (1:1) .eq. '.') goto 20 goto 210 c 300 read (10,1020,end=99) operand 310 numberX=numberX+1 read (operand,320) number(numberX) 320 format (i) read (10,1020,end=99) operand if (operand (1:1) .eq. '.') goto 20 goto 310 c 400 status=uh (command,, * inputHist(1),inputHist(2),inputHist(3),, * outputHist(1),outputHist(2),outputHist(3),, * number(1),number(2),number(3)) if (status .eq. uh_noMatch) then call uhPrintHelp (command) endif +-----------------------+ goto 10 | Sample Data File | c +-----------------------+ 1010 format (1x,$,a) | ADD1D | 1020 format (a) | A | c | B | 99 call exit | .OUTPUT | end | C | | . | | SUB1D | | B | | C | | .OUTPUT | | A | | . | | SUMWINDOW1D | | A | | .NUMBER | | 40 | | 60 | | . | +-----------------------+