DIRECT MEMORY ACCESS FROM PC FORTRANS
No assembly required
This article contains the following executables: CPTPUT.ARC
Kenneth G. Hamilton
Ken has a PhD in physics from the University of California at San Diego and has been involved in solid-state theory, atomic and molecular calculations, numerical hydrodynamics, exploration geophysics, and signal processing. He can be contacted at Garjak Research, 5330 Carroll Canyon Road, Suite 100, San Diego, CA 92121 or on CompuServe at 72727,177.
The Fortran language has traditionally been used on large systems where multiuser protection is an issue. Under these conditions, it has never been tolerable for user programs to access pure physical addresses, because they would then be able to interfere with other concurrent programs. As a result, no direct memory-access capabilities have ever been built into standard Fortran that would be comparable to, say, Basic's PEEK and POKE. However, because DOS is a single-user, nonprotected environment, there is no one else to interfere with. In addition, DOS does not provide an operating-system control library as, for example, VAX/VMS does. Therefore, it is often up to the individual programmer to figure out how to get at the bells and whistles of the machine.
Most PC Fortrans now provide a routine for calling DOS and BIOS interrupts, leaving them with one major deficiency: the inability to access memory using absolute addresses to get at places such as the BIOS data area and the memory-mapped video. This article remedies that by describing how to perform direct memory access using some of the better-known PC Fortrans, including the Microsoft, Watcom, and Lahey compilers.
Microsoft Fortran
Microsoft's real-mode Fortran compiler normally passes all arguments by reference: Before jumping to a subroutine, a calling routine pushes the segment: offset address of each argument onto the stack. Ordinarily, the compiler and linker control the numerical values of these addresses, but now we want to bypass this mechanism and specify an address ourselves. The approach is to construct a 4-byte address, define the argument as a 4-byte integer, and pass the argument by value rather than by reference. The calling routine will then push this number (rather than a pointer to it) onto the stack. The subroutine below it will pop that value off and treat it as though it were the address of a normal variable somewhere in RAM.
For example, suppose that you want to POKE into a particular location. This can be easily done by passing two arguments: a 4-byte address sent by value (but received by reference); and an (conventional) argument that has the value to store into the indicated location. The called subroutine then merely copies from the second argument to the first, unaware of the fact that one of those addresses is artificial. You, of course, can make the first address point anywhere you want.
As a concrete example, the INTERFACE block in Listing One, page 102, references the PEEKBO subroutine. The INTERFACE block specifies the passing protocol for each argument. Arguments can be individually specified as [REFERENCE] or [VALUE]. Any argument whose passing method is not explicitly declared is by default passed by [REFERENCE]. Therefore, PEEKB0 requires that its first argument be passed by value and its second by reference. However, PEEKBO (see Listing Two, page 102) knows nothing of this pass-by-value business. PEEKB0 expects the addresses of two ordinary INTEGER*1 variables and should copy the first into the second. In this case, the second argument points to a byte in the BIOS data area. This byte, at address 449h, contains a value that indicates the video mode. Monochrome text is mode 7, and all others are color modes.
Listing One declares a second subroutine, CRTPUT, to pass its first argument by value and its other four arguments by reference. In the main body of Listing One, that first argument icrt is given the value B8000000h (B0000000h, in the case of monochrome) and then passed to CRTPUT. This subroutine (see Listing Two) thinks it is being sent the segmented address B800:0000 (or B000:0000) and maps the screen array into that location. Of course, this causes screen to be located exactly where the video adapter is sitting, and so the messages appear on the screen in the rows and columns indicated. It should be noted that the screen memory consists of both characters and video attributes. The first, third, fifth, and so on bytes are the characters to be displayed, starting from the upper-left corner; the second, fourth, sixth, and so on bytes are the attributes that go with each of those characters. We have defined the screen array so that the first subscript indicates character vs. attribute, the second subscript is the column number, and the third subscript is the line number. This effectively trivializes the offset calculation within the display adapter.
The Microsoft compiler is smart enough to know that we are trying to trick it, and will issue a diagnostic message if both the calling program (CRT_WRITE_MSF) and the subroutines (PEEKB0 and CRTPUT) are compiled from the same source file. While the generated code works, you can avoid these spurious errors by placing the caller and callee in different source files and compiling them as separate modules.
Protected Mode
Microsoft's 32-bit protected-mode compiler, Fortran PowerStation 1.0, takes advantage of the Phar Lap DOS extender. Unfortunately, there appears to be no direct way of carrying out a corresponding trick using this compiler and extender. In a protected-mode environment, an address is not a simple segment and offset. Rather, it involves a pointer to a selector in a memory-allocation table. The Phar Lap loader prevents user programs from accessing memory areas that do not belong to them. There is a selector that points to the screen in that environment, but it is necessary to use assembly code in order to work with it.
For those willing to tackle some assembly language, I've included a module for screen-writing from Fortran PowerStation (see "Availability," page 7). The example writes to the screen. If you need to access some other area of memory, you'll need to find a selector that points to that region. Also note that the PowerStation compiler expects entry-point names to be in the "decorated" format, with a leading underscore character and the list of the number of bytes of each argument after the root name. This routine was written to be assembled by MASM 6.0. (The new MASM 6.1 is able to automatically decorate names.)
Lahey Fortran
Lahey Computer Systems' real-mode compiler, F77L, ordinarily passes numeric data by pushing the segment and offset onto the stack, just like the Microsoft compiler. Fortunately, F77L includes a %VAL() function that allows you to pass by value. %OVAL(), which was syntactically copied from VAX Fortran, can only be used in the argument list of a CALL statement or function invocation.
As an example, Listing Three (page 102) makes calls to the very same PEEKB0 and CRTPUT routines (in Listing Two) as Listing One. In fact, both PEEKB0 and CRTPUT can be used unmodified with each of the compilers discussed--all of the compiler-specific code is contained in the calling routine. F77L does not require the two routines to be separately compiled.
Note, when comparing the Lahey and Microsoft versions, that the format of the hexadecimal numbers is different. Unfortunately, the ANSI Fortran-77 standard did not include an official definition for hex numbers, but the new Fortran-90 standard will finally provide one. Thus, this compatibility nuisance will eventually go away.
Lahey also has a 32-bit compiler, F77-EM/32, which is sold with a version of the Phar Lap extender. Just as is the case with the Microsoft PowerStation, access to absolute addresses requires assembly code. This is certainly feasible, but will not be considered in this article. A sample output module is available, which writes through the screen selector, 1C(hex).
Watcom Fortran
Watcom provides a c$pragma mechanism similar to Microsoft's INTERFACE block. The c$pragma declaration specifies how each argument is passed. If the subroutine is called with more arguments than the c$pragma has defined, the attribute of the last position in the declaration is applied to all of the additional arguments. For example, Figure 1 shows a c$pragma declaration. If the subroutine has more than two arguments, then the reference attribute will be applied to the third, fourth, and so on arguments. Note again that the pass-by-value address must always be declared as value*4 even if it is the address of an integer*1, integer*2, real*4, or whatever. (This is because addresses are always 32 bits in length.) Finally, it is necessary to compile the calling routine separately from the called one, or else the value attribute becomes known to the callee, which then proceeds to receive by value.
Figure 1: Syntax for the c$pragma declaration.
c$pragma aux <routinename> parm
(value*4, reference)
With Watcom, it is possible to access absolute addresses even when using the 32-bit protected-mode compiler. Watcom conveniently defines a conditional compilation variable, __386__, which allows you to have one compiler-specific module that works in either real or protected mode. Listing Four, page 102, shows how to write to and read from the screen using either Watcom's real-mode compiler, F77, or their protected-mode F77/386. A pair of c$pragma directives is being used in order to specify that the first argument to PEEKBO and CRTPUT must be passed by value, and that the remaining ones should go by reference. The conditional compilation directives in Listing Four can be seen to be automatically selecting the appropriate address format for real or protected mode, so that the same source code can be used with either of the Watcom compilers.
Watcom has a clever feature for absolute addressing already built into their compilers. If a program allocates an array, an optional location=loc clause can be used to place the resulting array at a specified place in memory. As an example, we could specify allocate (screen(2,80,25), location='B8000000') and then use the screen array to access the video adapter. This is a wonderfully seamless capability: The only drawback is that none of the other compilers have it. This could make a multicompiler program somewhat awkward, as the screen array should be allocated in the main program, rather than in a compiler-specific interface module. (We wouldn't want to allocate and deallocate for each video I/O call.)
The protected-mode compiler also allows the use of the location=loc clause in an allocate statement, although the location specified needs to reflect the flat addressing format, rather than the segment-offset manner of the real-memory version.
Silicon Valley Software Fortran
SVS only sells a protected-mode Fortran. Like the Lahey implementation, SVS has a VAX-like %VAL() function for defining a hexadecimal value using a dollar sign. The sample program for use with this compiler is shown in Listing Five, page 102. Note that the format of the video address must be changed to reflect the 32-bit flat memory layout, just as when using the Watcom protected-mode compiler.
Text Graphics
Other applications in which this capability can come in handy involve reports of executing program status in static boxes on the screen, along with character graphics. To demonstrate the latter case, Listing Six (page 102) presents a mocked-up, one-dimensional hydrodynamics program that computes the propagation of a shock wave, as pressure (P) vs. distance (X). Both of these working arrays are located in a common block--a typical practice in large simulations. (In fact, the real guts of this program are missing, replaced by a simple analytical expression in the CALCULATION subroutine.)
The portions of the program dependent on Microsoft's implementation of the compiler have been isolated into an interface module (SCR_INIT and its alternate entry points) that serves as an interface to a plot-drawing routine, VIDEO. This drawing routine (see Listing Seven, page 103) makes a profile of pressure vs. distance at each time step, and can also display additional information about the progress of the calculation. The particular operation performed depends on the value of the switch variable IFUNC. VIDEO scales the axes to match the data being plotted, but this particular scaling routine expects only positive values. If you want to use it to plot points with both positive and negative values, some modifications will be necessary.
The progress of the calculation can then be assessed by simply watching the screen, even though (in a real computation) the major part of the output, composed of mass quantities of numbers, would be going to a disk file. The problem time and time-step number, along with other selected data, are written to fixed positions on the screen and are also updated every cycle.
The screen shows something called the "Courant zone," named after the mathematician Richard Courant who, in 1928, showed that the solution of a partial differential equation can be approximated by the solution of a difference equation, and defined the conditions for numerical stability. In a real simulation of this kind, the Courant condition requires that the time steps be small enough that a sound wave not be able to cross any of the zones during a single step. This involves computing a local sound speed in each zone (sound speed goes up with increasing pressure in any real material), computing the thickness of each zone, and identifying the zone with the shortest travel time. This is the Courant zone, and it is normally in the area of greatest compression at the shock front; the next time step is taken as a fraction (typically 0.3-0.9) of its traversal time. In this demonstration, we are stepping the Courant zone forward at one full zone per cycle in order to have a parameter to use in the calculation of the pressure pulse.
Direct-memory Access
Direct-memory access from PC Fortrans is relatively simple to code and fast to execute. And while the examples in this article deal primarily with video I/O, the method can be used in a wider range. For example, the machine ID byte at address FFFF:000E (in the bootstrap segment of the ROM BIOS chip) is easily accessible and can provide a program with useful information about the hardware it is running on. In my experience, the most maintainable method of using this in a large program is to write one primary video-output subroutine that, when called, is passed the screen address and a switch variable that tells the routine which part of the display to update. Internally, the switch variable can be used to direct the flow of control to the proper section. The general structure of a program that does direct memory operations is shown in Figure 2.
Conclusion
It's unfortunate that absolute data addressing has never been adequately dealt with by any of the Fortran standards committees. The capability to declare a POINTER variable is now included in Fortran-90, but there is really no reason why a named COMMON block cannot be given an "absolute" attribute and a starting location. This could, in fact, be done entirely in a linker without any changes to the associated compiler. If that capability were available, locations of scalars would be completely resolved prior to execution time, with addresses being present in instructions as immediate data, thus allowing the fastest possible access in real-time control situations. By comparison, the PEEK and POKE of Basic require a subprogram call, and the pointer mechanism of C or Fortran-90 constitute indirect addressing, both of which are slightly slower.
While we are waiting for Fortran-90, however, we can still go ahead and access memory with most PC Fortrans, with all compiler-dependent code contained in one source file and no machine-dependent "contamination" in the major part of a program.
Acknowledgments
I'd like to thank Blair Learn of Lahey Computer plus John Norwood and Bruce McKinney of Microsoft for advice on getting around the Phar Lap extender used with their respective protected-mode compilers.
_DIRECT MEMORY ACCESS FROM PC FORTRANS_ by Kenneth G. Hamilton[LISTING ONE]
<a name="0132_000f">
INTERFACE TO SUBROUTINE PEEKB0(L,I)
integer*4 L [VALUE]
integer*1 I
end
INTERFACE TO SUBROUTINE CRTPUT(L,I1,I2,I3,C)
integer*4 l [VALUE]
integer*2 i1, i2, i3
character*1 c
end
PROGRAM CRT_WRITE_MSF
integer*4 laddr/#00000449/ ! Address of video mode byte
integer*1 ividmod ! Value at that location
integer*4 imono/#B0000000/ ! B&W adapter address
integer*4 ivga /#B8000000/ ! Color adapter address
integer*4 icrt ! Adapter in use
integer*2 iat1, iat2, iat3 ! Video attributes
c
c Program to demonstrate direct memory access using Microsoft Fortran
c Kenneth G. Hamilton
c
call peekb0(laddr,ividmod) ! First, get the video mode
c
if (ividmod.eq.7) then ! Mono is video mode 7
icrt = imono
iat1 = #07 ! Normal video
iat2 = #0F ! Bold
iat3 = #87 ! Blinking
else ! All other modes are color
icrt = ivga
iat1 = #07 ! Normal white-on-black
iat2 = #1F ! Bold white on blue
iat3 = #9E ! Flashing yellow on blue
endif
c
call crtput(icrt, 17, 21, iat1,
& 'Message from Microsoft Fortran Follows')
call crtput(icrt, 18, 21, iat2, 'HOW''S ')
call crtput(icrt, 18, 27, iat3, 'THIS?')
c
stop
end
<a name="0132_0010">
<a name="0132_0011">[LISTING TWO]<a name="0132_0011">
* Listing 2 - Direct Memory Access - K. G. Hamilton
SUBROUTINE PEEKB0(I,IBYTE)
integer*1 i,ibyte
ibyte = i ! Get what's there
return
end
SUBROUTINE CRTPUT(SCREEN,ILIN,JCOL,IATT,A)
character*(*) a
integer*1 screen(2,80,25),ic1
integer*2 ilin, jcol, iatt
c
c This routine puts a character string to the screen with a
c video attribute.
c
c Input: screen = array mapped to the screen
c ilin = line number
c jcol = starting column number
c iatt = video attribute
c a = string to write
c
la=len(a) ! Length of message
c
do 20 j=1,la
ic=ichar(a(j:j))
ic1=iand(ic,255)
screen(1,jcol+j-1,ilin)=ic1 ! Character
20 screen(2,jcol+j-1,ilin)=iand(iatt,255) ! Attribute
c
return
end
<a name="0132_0012">
<a name="0132_0013">[LISTING THREE]<a name="0132_0013">
PROGRAM CRT_WRITE_F77L
integer*4 laddr/z'00000449'/ ! Address of video mode byte
integer*1 ividmod ! Value at that location
integer*4 imono/z'B0000000'/ ! B&W adapter address
integer*4 ivga /z'B8000000'/ ! Color adapter address
integer*4 icrt ! Adapter in use
integer*2 iat1, iat2, iat3 ! Video attributes
c
c Program to demonstrate direct memory access using Lahey F77L
c Kenneth G. Hamilton
c
call peekb0(%val(laddr),ividmod) ! First, get the video mode
c
if (ividmod.eq.7) then ! Mono is video mode 7
icrt = imono
iat1 = 7 ! Normal video
iat2 = 15 ! Bold
iat3 = 8*16+7 ! Blinking
else ! All other modes are color
icrt = ivga
iat1 = 7 ! Normal white-on-black
iat2 = 1*16+15 ! Bold white on blue
iat3 = 9*16+14 ! Flashing yellow on blue
endif
c
call crtput(%val(icrt), 17, 21, iat1,
& 'Message from Lahey F77L Follows')
call crtput(%val(icrt), 18, 21, iat2, 'HOW''S ')
call crtput(%val(icrt), 18, 27, iat3, 'THIS?')
c
stop
end
<a name="0132_0014">
<a name="0132_0015">[LISTING FOUR]<a name="0132_0015">
PROGRAM CRT_WRITE_WATCOM
c$pragma aux peekb0 parm (value*4, reference)
c$pragma aux crtput parm (value*4, reference)
integer*4 laddr/z00000449/ ! Address of video mode byte
integer*1 ividmod ! Value at that location
c$ifdef __386__ ! Use flat memory addresses
integer*4 imono /z000B0000/ ! Monochrome adapter
integer*4 ivga /z000B8000/ ! Color adapter
c$else ! Use segmented memory addresses
integer*4 imono /zB0000000/ ! Monochrome adapter
integer*4 ivga /zB8000000/ ! Color adapter
c$endif
integer*4 icrt ! Adapter in use
integer*2 iat1, iat2, iat3 ! Video attributes
c
c Program to demonstrate direct memory access using either
c Watcom F77 or F77/386.
c Kenneth G. Hamilton
c
call peekb0(laddr,ividmod) ! First, get the video mode
c
if (ividmod.eq.7) then ! Mono is video mode 7
icrt = imono
iat1 = 7 ! Normal video
iat2 = 15 ! Bold
iat3 = 8*16+7 ! Blinking
else ! All other modes are color
icrt = ivga
iat1 = 7 ! Normal white-on-black
iat2 = 1*16+15 ! Bold white on blue
iat3 = 9*16+14 ! Flashing yellow on blue
endif
c
c$ifdef __386__
call crtput(icrt, 17, 21, iat1,
& 'Message from Watcom F77/386 Follows')
c$else
call crtput(icrt, 17, 21, iat1,
& 'Message from Watcom F77 Follows')
c$endif
call crtput(icrt, 18, 21, iat2, 'HOW''S ')
call crtput(icrt, 18, 27, iat3, 'THIS?')
c
stop
end
<a name="0132_0016">
<a name="0132_0017">[LISTING FIVE]<a name="0132_0017">
PROGRAM CRT_WRITE_SVS
integer*4 laddr/$00000449/ ! Address of video mode byte
integer*1 ividmod ! Value at that location
integer*4 imono/$000B0000/ ! B&W adapter address
integer*4 ivga /$000B8000/ ! Color adapter address
integer*4 icrt ! Adapter in use
integer*2 iat1, iat2, iat3 ! Video attributes
c
c Program to demonstrate direct memory access using SVS Fortran
c Kenneth G. Hamilton
c
call peekb0(%val(laddr),ividmod) ! First, get the video mode
c
if (ividmod.eq.7) then ! Mono is video mode 7
icrt = imono
iat1 = $07 ! Normal video
iat2 = $0F ! Bold
iat3 = $87 ! Blinking
else ! All other modes are color
icrt = ivga
iat1 = $07 ! Normal white-on-black
iat2 = $1F ! Bold white on blue
iat3 = $9E ! Flashing yellow on blue
endif
c
call crtput(%val(icrt), 17, 21, iat1,
& 'Message from SVS Fortran Follows')
call crtput(%val(icrt), 18, 21, iat2, 'HOW''S ')
call crtput(%val(icrt), 18, 27, iat3, 'THIS?')
c
stop
end
<a name="0132_0018">
<a name="0132_0019">[LISTING SIX]<a name="0132_0019">
PROGRAM PLOT_DEMO_WITH_MSF
common /ctl/ ividmod, ncycle, maxcyl, time, maxz, iactz, icourn
common /ctl/ istatus
common /probvars/ x(1000), p(1000)
c
c Demonstration of screen text graphics
c This program is intended to look like a one-dimensional
c finite-difference calculation of shock wave propagation.
c Kenneth G. Hamilton
c
maxz = 1000 ! Maximum number of zones
ncycle = 1 ! Initialize cycle number
maxcyl = 800 ! Maximum number of cycles to run
c
call scr_init ! Initialize the plot
istatus = 1 ! Status is "running"
call scr_status ! Show status
c
c Main problem loop
c
100 call calculation ! Hydrodynamics done here
call scr_draw ! Draw the data
call time_step ! Move to next cycle
if (ncycle.le.maxcyl .and. iactz.le.maxz) go to 100
c
c Display completion message and
c wait for key press before exiting
c
istatus = 2 ! Status is "done"
call scr_status ! Show status
call press_any_key
c
return
end
SUBROUTINE CALCULATION
common /ctl/ ividmod, ncycle, maxcyl, time, maxz, iactz, icourn
common /ctl/ istatus
common /probvars/ x(1000), p(1000)
integer*4 itime/0/, itime0/0/
save itime, itime0, amp
c
c This is where a program would normally compute the
c pressures, velocities, positions, etc., using a finite
c difference scheme.
c We're just faking it here, for this demonstration.
c
if (ncycle.eq.1) then ! Perform some initialization
amp = 500. ! Original amplitude of shock
icourn = 15 ! Fake the Courant zone number
iactz = icourn + 5 ! Number of active zones
else
amp = 0.995 * amp ! Let the peak decay a bit
endif
c
do i=1,iactz ! For all active zones
x(i)=0.1*float(i) ! This is the zone position
if (i.gt.icourn) then ! Front of shock
p(i) = amp*float(iactz-i)/float(iactz-icourn)
else ! Decaying coda
p(i) = amp*exp(-0.01*float(iactz-i))
endif
enddo
c
c This delay loop is intended to mimic the main part of the program.
c You can set INC=0 to get maximum speed, or a larger value
c in order to slow things down for better visibility of the plot.
c INC is the time delay in 1/100ths of a second, between
c consecutive cycles.
c
c inc=10
inc = 0
do while (itime .le. itime0+inc)
call gettim(ih,im,is,ic)
itime = int4(ic) + 100*(int4(is) + 60*(int4(im) + 60*int4(ih)))
enddo
itime0 = itime
c
return
end
SUBROUTINE TIME_STEP
common /ctl/ ividmod, ncycle, maxcyl, time, maxz, iactz, icourn
common /ctl/ istatus
c
c This is where the time would normally be incremented, based
c sound speed and some characteristic times and lengths.
c
ncycle = ncycle + 1
time = time + 1.5E-3
icourn = icourn + 1
iactz = icourn + 5
c
return
end
* Microsoft-specific portion follows
INTERFACE TO SUBROUTINE PEEKB0(L,I)
integer*4 L [VALUE]
integer*1 I
end
INTERFACE TO SUBROUTINE VIDEO(L,I1)
integer*4 l [VALUE]
integer*2 i1
end
INTERFACE TO SUBROUTINE INTDOS [C] (ir1,ir2)
integer*2 ir1 [REFERENCE] ! Regs into INTDOS
integer*2 ir2 [REFERENCE] ! Regs returned
end
SUBROUTINE SCR_INIT
integer*4 laddr/#00000449/ ! Address of video mode byte
integer*1 ividmod ! Value at that location
integer*4 imono/#B0000000/ ! B&W adapter address
integer*4 ivga /#B8000000/ ! Color adapter address
integer*4 icrt ! Adapter in use
integer*2 iregs(7) ! For INTDOS
save icrt
c
c Microsoft-specific screen interface routine
c Kenneth G. Hamilton
c
call peekb0(laddr,ividmod) ! First, get the video mode
if (ividmod.eq.7) then ! Mono is video mode 7
icrt = imono
else ! All other text modes are color
icrt = ivga
endif
call video(icrt,1) ! Set up frame on screen
return
c
ENTRY SCR_DRAW ! Draw the data
call video(icrt,2)
return
c
ENTRY SCR_STATUS ! Report status
call video(icrt,3)
return
c
ENTRY PRESS_ANY_KEY ! Wait for key press
iregs(1) = #0800 ! Load into AX register
call intdos(iregs,iregs) ! Read from CON, no echo
return
c
end
<a name="0132_001a">
<a name="0132_001b">[LISTING SEVEN]<a name="0132_001b">
SUBROUTINE VIDEO(SCREEN,IFUNC)
common /ctl/ ividmod, ncycle, maxcyl, time, maxz, iactz, icourn
common /ctl/ istatus
common /probvars/ x(1000), p(1000)
integer*1 screen(2,80,25)
integer*2 iat1, iat2, iat3
character buf*80
integer*1 kblank /32/ ! ' '
integer*1 kstar /42/ ! '*'
integer*1 kuplf /-38/ ! 'Z'
integer*1 klort /-39/ ! 'Y'
integer*1 khorz /-60/ ! 'D'
integer*1 ktlft /-61/ ! 'C'
integer*1 kttop /-62/ ! 'B'
integer*1 ktbot /-63/ ! 'A'
integer*1 klolf /-64/ ! '@'
integer*1 kuprt /-65/ ! '?'
integer*1 ktrgt /-76/ ! '4'
integer*1 kvert /-77/ ! '3'
save paxis0, xaxis0, iat1, iat2, iat3
c
c Screen text graphics routine
c Kenneth G. Hamilton
c
go to (100,200,300) ifunc
c
100 if (ividmod.eq.7) then ! Monochrome mode
iat1 = #07 ! Normal video
iat2 = #70 ! Reverse video
iat3 = #F0 ! Flashing reverse video
else ! Color modes
iat1 = #1F ! Bold white on blue
iat2 = #2F ! Bold white on green
iat3 = #4F ! Bold white on red
endif
c
do ilin=1,25 ! Clear the entire screen
do jcol=1,80
screen(1,jcol,ilin) = kblank
screen(2,jcol,ilin) = iand(iat1,255)
enddo
enddo
c
screen(1,73,25) = ichar('X') ! Label the X-axis
screen(1, 3, 6) = ichar('P') ! Label the Y-axis
c
do il=2,3 ! Draw left and right sides
screen(1, 1,il) = kvert ! Left side of top box
screen(1,80,il) = kvert ! Right side of top box
enddo
do il=5,23
screen(1, 5,il) = kvert ! Left side of main box
screen(1,80,il) = kvert ! Right side of main box
enddo
c
do il=8,20,4 ! Put tick marks on L & R
screen(1, 5,il) = ktlft ! Left side
screen(1,80,il) = ktrgt ! Right side
enddo
c
do jc=2,79 ! Draw horizontals
screen(1,jc, 1) = khorz ! Top line
screen(1,jc, 4) = khorz ! Division between boxes
enddo
do jc=6,79
screen(1,jc,24) = khorz ! Bottom line
enddo
c
do jc=21,66,15 ! Put tick marks on T & B
screen(1,jc, 4) = kttop
screen(1,jc,24) = ktbot
enddo
c
screen(1, 1, 1) = kuplf ! Mark the corners
screen(1,80, 1) = kuprt
screen(1, 1, 4) = klolf
screen(1, 5, 4) = kttop
screen(1,80, 4) = ktrgt
screen(1, 5,24) = klolf
screen(1,80,24) = klort
c
call crtput(screen,1,34,iat1,' BOGUS CODE ')
call crtput(screen,2,60,iat1,'Status: ')
return
c
200 write (buf,110) ncycle,maxcyl,time
110 format ('Cycle',i5,' of ',i5,', Time:',1PE12.4)
call crtput(screen, 2, 3, iat1, buf(:38))
write (buf,120) icourn,iactz
120 format ('Courant Zone :',i5,', Active Zones:',i5)
call crtput(screen, 3, 3, iat1, buf(:39))
if (iactz.le.0) then
xmax=x(maxz)
else
xmax=x(iactz)
endif
c
pmax = 0
do i = 1, iactz
pmax = max(pmax,p(i))
enddo
c
write (buf,130) xmax,pmax
130 format ('Max X:',1PE11.3,' Max P:',1PE11.3)
call crtput(screen,3,44,iat1,buf(:35))
if (xmax.le.0 .or. pmax.le.0) return
c
if (ncycle.eq.1) then
paxis0=0.
xaxis0=0.
endif
c
c Scale vertical axis
c
call plot_scale(pmax,ppower,paxis,*190)
c
if (paxis.ne.paxis0) then ! Rewrite p-axis labels
do i=0,4 ! There are five labels
il=24-4*i ! These are their line numbers
ptemp = paxis*float(i) ! This is the a label
write (buf,140) ptemp ! Put it into the buffer
140 format (F4.1)
call crtput(screen,il,1,iat1,buf(:4)) ! Write to screen
enddo
endif
c
c Scale horizontal axis
c
call plot_scale(xmax,xpower,xaxis,*190)
c
if (xaxis.ne.xaxis0) then ! Rewrite x-axis labels
do i=0,5
ir=5+15*i
xtemp=xaxis*float(i)
write (buf,140) xtemp
call crtput(screen,25,ir-3,iat1,buf(:4))
enddo
endif
c
do jc=6,79 ! Redraw bottom line
screen(1,jc,24) = khorz ! to eliminate old stars
enddo
do jc=21,66,15
screen(1,jc,24) = ktbot
enddo
c
do ilin=5,23 ! Blank the rest of the screen
do jcol=6,79
screen(1,jcol,ilin) = kblank
enddo
enddo
c
do 180 iz=1,iactz ! Plot the data points
xtemp=x(iz)
if (xtemp.le.0) go to 180
ix=nint((75.*xtemp)/(5.*xaxis*xpower))
if (ix.le.0) go to 180
ptemp=p(iz)
if (ptemp.le.0) go to 180
ip=nint((20.*ptemp)/(5.*paxis*ppower))
if (ip.le.0) go to 180
il=24-ip
ir=5+ix
screen(1, ir, il) = kstar ! Plot that point
180 continue
c
paxis0=paxis
xaxis0=xaxis
190 return
c
300 if (istatus.eq.1) then
call crtput(screen,2,68,iat2,' Running ')
else if (istatus.eq.2) then
call crtput(screen,2,68,iat3,' * Done * ')
endif
return
c
end
SUBROUTINE PLOT_SCALE(TMAX,TPOWER,TAXIS,*)
c
c Scaling routine for positive axes
c Kenneth G. Hamilton
c Parameters:
c tmax =
c tpower =
c taxis =
c
if (tmax.le.0) return 1 ! Max is zero - error
tscale=tmax
c
tpower=1.0
do while (tscale .lt. 2.4) ! If we're dealing with small
tscale=10.*tscale ! numbers, scale up
tpower=0.1*tpower
enddo
do while (tscale .gt. 24.) ! If they're big numbers,
tscale=0.1*tscale ! then scale down
tpower=10.*tpower
enddo
if (tscale.lt.4.8) then ! Set the whole-number
taxis=1. ! increment to display
else if (tscale.lt.9.0) then ! in the axis labels
taxis=2.
else if (tscale.lt.14.0) then
taxis=3.
else if (tscale.lt.19.0) then
taxis=4.
else
taxis=5.
endif
c
return
end
Copyright © 1993, Dr. Dobb's Journal
