next up previous contents
Next: What to put in Up: DASH: A Data Analysis Previous: Terminology

How to write a DASH module

First, choose a name for your module. Second, write FORTRAN ``subroutines'' for each entrypoint you wish to use; the subroutines should have no arguments. The subroutines will access event data either through common blocks or ZEBRA banks.

I put ``subroutines'' in quotes, because I prefer to use the FORTRAN ENTRY statement. Let me tell you how it works: you write a single subroutine (with one END statement), but inside it are several ENTRY statements, each with a RETURN statement. You call (actually, you tell DASH to call) the ENTRY statements. The convenience is that the value of variables used in the subroutine are available to all of the entrypoints without a common block.

Here is an example, using all of the DASH entrypoints:

      SUBROUTINE EXAMPLE                   ! Never actually called
      IMPLICIT NONE                        ! You should always use this
      INCLUDE 'MUA93_COMMON.INC'           ! The event data lives here
      INTEGER LEN
      CHARACTER*8 VERB
      REAL CUT1, CUT2
      
      ENTRY EXAMPLE_INIT                   ! Called when the program starts
      CALL LOAD_MY_CONSTANTS
      RETURN

      ENTRY EXAMPLE_BEGINRUN               ! Called for a new run number
      NPASSED = 0
      RETURN
      
      ENTRY EXAMPLE_EVENT                  ! Called for each event
      CALL HFILL(1000,XYZ,0.,1.)
      IF (XYZ .GT. CUT1) THEN
         NPASSED = NPASSED + 1
      END IF
      RETURN
      
      ENTRY EXAMPLE_ENDRUN                 ! Called at end of run
      WRITE(*,*) ' N passed = ',NPASSED
      RETURN
      
      ENTRY EXAMPLE_BOOK                   ! c.l.i. command BOOK EXAMPLE
      CALL HBOOK1(1000,'The XYZ variable',
     &            100,0.,10.,0.)
      RETURN
      
      ENTRY EXAMPLE_TALK                   ! DASH> TALK EXAMPLE CUT1 1.5
      CALL KUGETC(VERB,LEN)
      IF (VERB(1:4) .EQ. 'CUT1') THEN
         CALL KUGETR(CUT1)
      ELSE IF (VERB(1:4) .EQ. 'HELP') THEN
         WRITE(*,*) ' Valid commands are: '
         WRITE(*,*) ' CUT1 '
      END IF
      RETURN
      
      ENTRY EXAMPLE_FINISH                 ! Called when program ends
      WRITE(*,*) ' I love DASH! '
      RETURN
      
      END

So, in a FORTRAN program, when the line CALL EXAMPLE_BEGINRUN occurs, the subroutine EXAMPLE begins with the line NPASSED = 0. You could replace every ENTRY with SUBROUTINE, but then you would have to declare the local variables separately and pass them around somehow. If you are more comfortable with explicit subroutine statements, go ahead and do it this way; it will work just the same.





ETK