Standard Fortran has never supported direct memory access because large multiuser systems had to worry about conflicting , concurrent programs. With single-user, DOS-based PCs, however, this isn't a problem. Ken examines the issues involved in performing direct memory access using PC Fortran compilers from Microsoft, Watcom, Lahey, and SVS.
May 01, 1993
URL:http://www.drdobbs.com/database/direct-memory-access-from-pc-fortrans/184408998
This article contains the following executables: CPTPUT.ARC
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'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.
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 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 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.
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.
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.
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 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.
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.
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]
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[LISTING TWO]
* 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[LISTING THREE]
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[LISTING FOUR]
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[LISTING FIVE]
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[LISTING SIX]
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[LISTING SEVEN]
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
Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.