...... The SIMDEM package

An Open Source package of binaries, documentation, and source codes, available from https://simfit.org.uk, that allows programmers to build free standing Windows executables linked to the SIMFIT GUI DLLs for generating dynamic run-time menus and graphics.

- Using Fortran to write Windows programs
- Description of the Simdem package
- Technical details
- Programs: Brief descriptions
- Programs: Source codes in numerical order
- Programs: Source codes in subject order
- Subroutines: Descriptions in numerical order
- Subroutines: Descriptions in subject order
- Subroutines: Descriptions in alphabetical order
- 64-bit Simdem: Description

## 64-bit Simdem: Description

32-bit programs must be linked to w_clearwin.dll, w_graphics.dll, and w_menus.dll.
These, in turn, are linked to salflibc.dll, the Silverfrost 32-bit run-time system.
However 64-bit programs must not be linked to these 32-bit DLLs but must be linked instead to the corresponding 64-bit DLLs, as follows.

    x64_clearwin.dll ... equivalent to w_clearwin.dll
    x64_menus.dll    ... equivalent to w_menus.dll
    x64_graphics.dll ... equivalent to w_graphics.dll

These, in turn, are linked to clearwin64.dll, the Silverfrost 64-bit Clearwin system.
However, note that from Version 7.4.0 these three dlls are replaced by single dlls called simdem32.dll and simdem64.dll in the FTN95 distribution of Simdem.
In other words:

    simdem64.dll = x64_clearwin.dll + x64_graphics.dll + x64_menus.dll
    simdem32.dll =   w_clearwin.dll +   w_graphics.dll +   w_menus.dll

Another issue concerns cross-compiler compatibility.

Because open, close, read, write, inquire, etc. refer to units that are compiler dependent, 32-bit Simdem provides a set of routines to make sure that units can be defined in w_menus.dll.
However, in the 64-bit version these routines refer to units defined in x64_menus.dll.
So, in the case where the 64-bit executable and x64_simdem DLLs are all compiled by the same compiler, this ambiguity will not arise, and some of these routines will not be required.
However, in general, all subroutines calling the Simdem GUI with a pre-defined unit or returning a unit are involved, particularly the following ones.

- CLOSER ... close a unit
- GETNOU ... return an unopened unit
- ISFCON ... is a file connected
- ISUCON ... is a unit connected
- MATOUT ... matrix output
- MATTIN ... matrix input
- MAT2IN ... matrix input
- MAT3IN ... matrix input
- OFILES ... open a file
- OPENER ... open a unit
- READER ... read from a unit
- REVPRO ... review progress of calculations
- VEC1IN ... vector input
- WRITER ... write to a unit

This is demonstrated in the test programs simdem15.f95, simdem16.f95, and simdem43.f95.

Back to Menu

## Using Fortran to write Windows programs

In order to write programs that create menus and graphs on screen, and use other aspects of Windows functionality, it is necessary for executables to call the Windows API. The usual way to do this is to rely on Visual Basic, Visual C++, or similar commercial packages, which offer users forms to design menus and displays, so insulating users from having to know anything about the inner workings of the Windows operating system. This can be a restriction for programmers wishing to write Open Source number crunching programs, like Simfit, which use the enormous number of excellent public domain codes that exist specifically for this purpose. Simfit provides an Open Source package called Simdem which demonstrates how to use Simfit to bridge this gap. It has been created using the Clearwin+ system, and this would not have been possible without the help of the Salford Software expert programmers, David Bailey, Paul Laidler, Ivan Lucas, and Richard Putman. Essentially, it makes available to Fortran programmers all the necessary interface to the Windows operating system that was created in the first place for the Simfit package. From the Simfit website you can download and install the Simdem package to create your own Windows executables, using only standard Fortran programming techniques, with no direct calls to the Windows API.

- The program simdem.exe

  This is a driver program which shows you the source codes and also runs the 70 demonstration programs called simdem01, simdem02, ..., simdem70, each demonstrating a different aspect of the way Windows features can be called. You can toggle between viewing the source code and executing the programs. There are simple demonstrations of most of the controls Simfit uses for input/output and graphics. The source code for the DLLs can also be browsed to appreciate that there are many more user-callable functions than are demonstrated by the simdem package. However users must download the version that is consistent with their compiler.

- The three versions of the simdem package

  The file simdem_setup_x.zip will install the standard version of the simdem package for users of Salford-Software/Silverfrost FTN95. The binaries conform either to the cdecl calling convention (x = c), or the stdcall calling convention (x = s).

  The file NAG_simdem_setup.zip will install an alternative version where w_clearwin.dll has been compiled using Salford FTN95 with the /f_stdcall option so as to be consistent with the STDCALL calling convention. The other binaries have been compiled using the NAGfor compiler with the -f77 option, but without the -unsharedrts option.

- The source codes

  Each of the 70 source codes is available for study and development, and each is fully commented to explain the argument lists. The codes are written in standard fixed format Fortran and use no non-standard compiler extensions. Users are completely isolated from any direct interaction with the Win32 operating system. The full set of source codes for the dynamic link libraries used by the simdem package can be extracted from the source codes for the Simfit package. Note that any Simfit source code that calls the Windows operating system has a w_ prefix. For instance, patch1 is in standard Fortran but it passes the argument list on to w_patch1, which uses non-standard calls.

- The documentation

  A file called simdem.chm summarises the package, and this should be read in conjunction with the file source.pdf, also available from the Simfit website, that explains how to compile the Simfit package.

- Make files

  Two batch files are distributed with the package to illustrate how to compile and link the programs using either the Salford-Software/Silverfrost FTN95 compiler, or the NAGfor compiler. It should be straightforward to use any Fortran compiler, and anybody wishing to develop the Simfit package would be well advised to start by compiling the Simdem package.

- The NAG Fortran Builder

  The Simdem package is also integrated into the NAG Fortran Builder, an IDE for developing Fortran programs that can be compiled and linked using the NAGfor compiler, creating programs that can call the NAG library DLLs for numerical analysis. By also linking in the Simdem package, stand-alone Windows type executables can be created with menus, tables, edit boxes, and graphics, etc.

- Plato

  The Simdem package is also distributed as part of the Silverfrost FTN95 package, so Plato users do not need to download Simdem.

Back to Menu

## Description of the Simdem package

Simdem: A Simfit package of Open Source codes, documentation and executables for demonstration programs designed to show programmers using NAGfor, Salford/Silverfrost FTN95, or other Fortran compilers, how to port Fortran programs into MS Windows.

The Simdem executables generate menus and graphics by calling input/output/graphics/file-handling routines in the public domain dynamic link libraries w_menus.dll, and w_graphics.dll. These call w_clearwin.dll which in turn calls the the Salford run-time library salflibc.dll. Using the techniques demonstrated in the simdem package you can make your own executables with Windows-type input/output, and extensive graph plotting, and data handling controls. All that is required is that the dlls are either in the same folder as your executables or on the path.

The stand alone Simdem example programs will serve as an introduction but, for more extensive controls, the source code for w_menus.dll, and w_graphics.dll should be consulted. This can be downloaded from the Simfit site at

https://simfit.org.uk

Send queries and comments to w.g.bardsley@gmail.com

To appreciate the full scope of Simdem graph plotting and to understand the functionality of the file selection controls, the Simfit reference manual (w_manual.pdf) should be consulted. This can be downloaded from the Simfit website.

The simdem package now comes with two make-type batch files:

1. Using the Salford/Silverfrost FTN95 compiler

   make_SILVERFROST_simdem.bat (requires FTN95)

   You can use FTN95 with or without the /f_stdcall option but the executables and dlls must all be compiled either with or without the /f_stdcall compiler option. FTN95 object code with /f_stdcall is inconsistent with object code without /f_stdcall. To call the NAG library dlls from FTN95 programs you should use the /f_stdcall option.

2. Using the NAGfor compiler

   make_NAG_simdem.bat (requires NAGfor)

   The w_clearwin.dll must be created using FTN95 with the /f_stdcall option, other DLLs using NAGfor with the -f77 switch.

These can be used to compile and link the package and they can serve as models to create your own executables.

There is also a utility for2f95 to convert fixed format *.for source into a special fixed/free format or free *.f95 code. However, example code is supplied in both fixed and free format.

The Simdem package has been updated as follows:

- Release 1: simdem01 to simdem20
- Release 2: simdem21 to simdem30
- Release 3: simdem31 to simdem40
- Release 4: simdem41 to simdem45
- Release 5: Added /f_stdcall version
- Release 6: simdem46 to simdem50 and added F95 version
- Release 7: simdem51 to simdem65
- Release 8: simdem66 to simdem70
- Release 9: Now linked to w_clearwin.dll
- Release 10: Comprehensive driver simdem.exe
- Release 11: w_clearwin.dll now free-standing
- Release 12: 64-bit upgrade provided

Back to Menu

## Technical details

1. Introduction
2. The Simfit package
3. Salford-Software/Silverfrost Win32 compilers and Clearwin+
4. The aim of the Smdem programs
5. How to use the Simdem programs
6. Printing and viewing PostScript files
7. The Simfit calling convention
8. Input/Output/File-access across different compilers
9. The Simfit data file format

1) Introduction

Simdem programs are self contained items designed to show users of the Salford-Software/Silverfrost Win32 compilers how to call subroutines from the Simfit dynamic link libraries. Fortran programmers wanting to port legacy code to Windows can use the stand-alone interface for input/output and graphics from the Simfit DLLs. The program simdem.for is a driver program to explore the series.

To use the Simfit GUI from other compilers such as NAGfor the STDCALL calling convention is now used. In other words, the Simfit binaries are compiled using the /f_stdcall switch. Also, for cross-compiler use, section 8 should be noted.

2) The Simfit package

This can obtained, free of charge, from

https://simfit.org.uk

and you should download and install the package to find out the possibilities. There are eight dynamic link libraries supplied with the package as follows:

     w_numbers.dll  :third party number crunchers (AS, blas, linpack,
                     lapack, dvode, minpack, lbfgsb, slatec, ACMTOMS)
     w_maths.dll    :numerical analysis library with calling sequences
                     and arguments similar to the NAG library
                     There is also a dummy version calling the actual
                     NAG library routines for those who have the NAG DLLs.
     w_menus.dll    :routines for input and output of data, file
                     handling and data editing
     w_graphics.dll :plotting graphs, contours, space curves, surfaces,
                     etc. and generating professional quality PostScript
     w_simfit.dll   :statistical analysis, data reduction and special
                     functions used by Simfit
     w_models.dll   :library of mathematical models and code to check
                     and interpret user defined models.
     w_help.dll     :compiled HTML help scripts
     w_clearwin.dll :interface to the Windows API via salflibc.dll

The Simdem programs will show programmers how to call some of these routines. In particular, the menu and plotting routines can greatly simplify development of Fortran programs using the Windows API. The Simfit package is compiled using FTN95, and the Windows interface was created using Clearwin+. I am very grateful to David Bailey, Paul Laidler, Ivan Lucas, and Richard Putman of Salford-Software for helping me to develop this interface.

3) Salford-Software/Silverfrost Win32 compilers and Clearwin+

The FTN77, FTN90 and FTN95 compilers can all call Clearwin+ to interact with the Windows API. Clearwin+ is a superb interface, a sort of Fortran equivalent of Visual Basic, but there are some rather formidable problems facing traditional Fortran users. Not only has the formatting convention got to be learned, but many serious problems arise due to the nonintuitive way that Clearwin+ created controls behave when embedded in subroutines, especially it seems to me in dynamic link libraries.

4) The aim of the Simdem programs

The Simdem programs each illustrate one or more Simfit subroutines which can be called from Standard Fortran programs without knowing anything about Clearwin+, or the Windows API. For instance, font size and window size are calculated internally by the routines. All call backs required for the controls are in the Simfit dlls and you can create many windows dynamically without ever needing to call the Clearwin+ function winio@ yourself.

The idea is to take each issue of input/output/graphics one at a time, starting at a very simple level, and to show you how to call some of the Simfit routines from the DLLs using standard Fortran. Once your code is running, you can always learn how to use Clearwin+ to make your own dedicated controls, or you can get the argument list for the Simfit subroutines and functions, since it is very likely that what you want is already in the Simfit libraries.

5) How to use the Simdem programs

The Simdem programs are most easily installed by executing the installation program simdem_setup.exe which you can get from https://simfit.org.uk Start by installing the whole of the Simdem package in a Simdem folder, say C:\Program Files\Simdem, and then executing simdem.exe, the driver program. You may wish to compile the code yourself, and you only need the Simdem DLLs to do this, not the Simfit package. Use the batch files supplied to compile the package, then imitate to create your own executables. However, make sure that the libraries are on the path or local to the executables, otherwise the programs will not execute.

A word of warning is required. The subroutines are very, very fussy about argument lists. Keep the originals so you can always have examples that work. It is absolutely vital that all arrays are initialised and dimensioned correctly, otherwise the windows you generate will break up and become unpredictable. Warnings are issued for some common problems. For instance, numpos(i) must be the position of the hot key in option(i), and hot keys cannot be duplicated in a given menu. However, not all errors are trapped like this particular one. Note that, if you set numdec to a particular value that will be the default option when the menu is created, e.g., in the list box routines.

6) Printing and viewing PostScript files

Some of the Simdem examples allow you to generate hardcopy, etc. If you want to print, view PostScript, transform ps to pdf, jpg, etc. you must install the GSview and Ghostscript packages and you will have to configure the folder where you execute code using the Simfit configuration file w_simfit.cfg, created from the Simfit driver. A simdem example (simdem40) will show you how to call the configuration subroutine from your own code, but the routines will create default configuration files such as w_simfit.cfg which you can easily edit yourself if required.

7) The simfit calling convention

The example routines tend to be simple interfaces to far more comprehensive routines with more extensive argument lists. If you want more control over size, position, font, colour, etc. you will have to get the calling sequence for the comprehensive subroutines. To help you understand the way the routines are called and to help you improvise or avoid type errors just note the following rule:- (In general) Simfit routines always have the sequence, integers, doubles, characters, logicals and, within each type, the arguments are in alphabetical order. Here, for example, is the graphics call from simdem10 to the Simfit GKS interface:

     call gks004 (l1, l2, l3, l4, &         !line types  ... (integers)
                  m1, m2, m3, m4, &         !symbol types... (integers)
                  n1, n2, n3, n4, &         !dimensions  ... (integers)
                  x1, x2, x3, x4, &         !x           ... (doubles)
                  y1, y2, y3, y4, &         !y           ... (doubles)
                  ptitle, xtitle, ytitle, & !legends     ... (characters)
                  axes, gsave)              !controls    ... (logicals)

All variables to simfit subroutines are of standard word length. There are no short integers or short logicals, and all real-types are double precision. There are no single precision variables at all in simfit. Programmers should however note that inside the subroutines there are some truncations to short integers and single precision reals, determined by the arguments to the Salford @-type routines. For this reason you should never compile the DLL code using /dreal, /xreal or /ints, etc.

You should note that some of the routines have dummy arguments that may be switched off by the DLLs, depending on the version you are using. For example, axes and gsave in the above example have no effect in the present version, since plots always have axes and you are always given the option to save hardcopy. However, they must be set as .true. and may be activated again in a future version.

8) Input/Output/File-access across different compilers

The next information can be ignored if you use the same compiler for both your executables and also w_menus.dll and w_graphics.dll. Note that w_clearwin.dll is always compiled using FTN95 and it is designed so that it cannot cause any cross-compiler problems.

However, this is a serious problem if you compile your executables using any compiler except FTN95, but if you intend to write code that will read from or write to files using the Simfit DLLs you should observe the following details.

The fortran open, close, write, read, backspace, rewind, and inquire procedures do not work reliably between binaries compiled using different compilers. To avoid this, Simfit has code to ensure that all input/output, etc. required by executables can be called from w_menus.dll as follows.

     call opener (ios, nunit, fname) ... instead of
     open (unit = nunit, file = fname, iostat = ios)

     call closer (nunit) ... instead of
     close (unit = nunit)

     call writer (ios, nlines, nunit, text) ... instead of
     do i = 1, nlines
        write (nunit, '(a)', iostat = ios) text(i)
     enddo

     call reader (ios, nlines, nunit, text) ... instead of
     do i = 1, nlines
        read (nunit, '(a)', iostat = ios) text(i)
     enddo

     call attrib (fname, there, read_only) ... returns
     there = .true. if fname exists and read_only = .true.
     if fname exists and has the read only attribute

     op = isfcon (fname) ... instead of
     inquire (file = fname, opened = op)

     op = isucon (nunit) ... instead of
     inquire (unit = nunit, opened = op)

     Variables are:
     integer   ios, nlines, nunit
     character fname*(*), text(nlines)*(*)
     logical   op, read_only, there

If files are all expected to be local to your application you can of course use open, inquire, close, write, read, etc., as usual. However, if you want to to use the Simfit codes for file opening, etc. then you must use opener, closer, attrib, reader, etc. as files opened for reading/writing in your application may not be equivalent to the filenames and units recognised by the Simfit DLLs.

9) The Simfit data file format

Programmers may wish to use the extensive source codes in the w_menus.dll for transferring data to and from files or the clipboard and, to do this successfully, the strict Simfit data file format must be understood.

These are the rules.

1. Data files conform to the ASCII text file convention
2. Line 1 must be a title up to 80 characters wide
3. Line 2 must have two integers, i.e. n rows and m columns
4. Lines 3 to n + 2 must contain the n data values in m columns However, note that if n and m are specifed the input file can have any succession of values as long as they are in row major format. Simfit will, for instance, write using wrap round for wide matrices. As an extreme example, there are not necessarily n data lines with m columns, e.g., there can be only one column of length n*m. The program simdem66 illustrates this feature.
5. Line n + 3 may optionally be k if k extra lines are to be used
6. If k is greater than 0 then lines n + 4 to n + 3 + k may be added, e.g. for labels
7. Within the data matrix, values can be in any valid format, e.g. integers, floats, scientific, etc. and spaces or commas can serve as delimiters. The Simfit package comes with a full set of test files which can be used as examples. Within w_menus.dll there are many subroutines to check for special formats such as columns in increasing order, columns nonnegative, columns as successive integers, etc. as required by the Simfit package, and there are dedicated subroutines to analyse sets of data files in library files or project archives, to facilitate the handling of data sets with multiple files, e.g., for plotting.

The only way to understand all this is to browse the Simfit source codes searching for key words. Note that data matrices are always treated as double precision arrays, not integers so, if you want integers, you will have to do real to integer conversions, etc in your code.

Back to Menu

## Programs: Brief descriptions

simdem: the driver

The driver and individual programs are supplied as source code and as executables. Just run for2f95 to generate fixed/free format *.f95 versions of the fixed format *.for source codes. Run the driver to enable you to explore all the sources and observe the action. Note that the driver has an icon to aid identification, so you can create a desk-top shortcut.

simdem01: Output text lines

     putadv      ... put an advisory message on screen
     putcau      ... put a cautionary message on screen
     putwar      ... put a warning message on screen
     putfat      ... put a fatal error message on screen
     puttxt      ... put a text string on screen
     putmes      ... put a message text array on screen
     images      ... display typical plotting styles
     help_simdem ... provide help

simdem02: Input double precision values

     getr01 ... get 1 value from the user
     getr02 ... get 2 values from the user
     getr03 ... get 3 values from the user
     getrm1 ... get 1 value in the middle of two extreme values
     getd01 ... get 1 value               (must be initialised)
     getd02 ... get 2 values              (must be initialised)
     getd03 ... get 3 values              (must be initialised)
     getdge ... get 1 lower limited value (must be initialised)
     getdle ... get 1 upper limited value (must be initialised)
     getdg2 ... get x =< y                (must be initialised)
     getdg3 ... get x =< y =< z           (must be initialised)
     getdm1 ... get 1 limited value       (must be initialised)

simdem03: Input integer values

     geti01 ... get 1 integer from the user
     getigt ... get 1 integer greater than a lower limit from the user
     getilt ... get 1 integer less than an upper limit from the user
     getim1 ... get 1 integer in the middle of two extreme values
     getj01 ... get 1 integer           (must be initialised)
     getjge ... get j >= i              (must be initialised)
     getjle ... get j =< i              (must be initialised)
     getjm1 ... get j where i =< j =< k (must be initialised)

simdem04: Input text strings

     getstr ... get a text string from the user (default supplied)
     gettxt ... get a text string from the user (default = ?)

simdem05: Input a logical variable

     getl01 ... get a logical value from the user

simdem06: Dynamic creation of a list box

     listbx ... get a decision from a primitive list box (with tabbing)

simdem07: Dynamic scrolling output

     list01 ... scroll text used as arguments to list01

simdem08: Simple table in a window

     table1 ... create a table from text supplied to table1

simdem09: Create a x,y plot

     gks001 ... the plot can be printed or output as PostScript, etc.

simdem10: Create up to 4 x,y plots

     gks004 ... the plot can be printed or output as PostScript, etc.

simdem11: Double precision editing

     editd1 ... edit a double precision array

simdem12: Integer editing

     editi1 ... edit an integer array

simdem13: Text editing

     edittx ... edit a text array

simdem14: Viewing data values

     viewit ... scrolled viewing of double precision or integer arrays

simdem15: Review progress of results

     revpro ... review progress on a results file at arbitrary intervals
     gettmp ... generate a new temporary file name
     deleet ... delete a file
     opener ... open a file using w_menus.dll
     closer ... close a file opened by w_menus.dll
     writer ... write to a file opend by w_menus.dll

simdem16: Viewing text files

     viewer ... view a supplied file or view a file selected by browsing

simdem17: Create text pages

     patch1 ... display a patch of text (comprehensive interface)
     patch2 ... display a patch of text (simplified interface)

simdem18: Create a title page and menu

     title1 ... display a title and menu

simdem19: Create a question and answer window

     answer ... display text and a summary question

simdem20: Create a tabbing list box window

     tbox01 ... tab above, inside and below a list box

simdem21: Create/transform up to 4 x,y plots

     gkst04 ... plotting with interactive linearising transformations

simdem22: Plot surfaces and contours

     surd2s .. surfaces, contours, projections and skyscrapers

simdem23: Plot curves in space

     space0 .. x(t), y(t), z(t) parametric curve in 3D space

simdem24: Plot vector field

     gksvf1 ... plot a vector flow field of arrows

simdem25: Plot error bars

     gkseb4 ... up to two sets of data/error bars plus two best fit curves

simdem26: Display/file a matrix

     dsplay ... display a matrix but also write to results file if required

simdem27: Create a coloured table

     table2 ... use colours for a individual letters in a table

simdem28: Create a background window

     window ... plant code inside a background window

simdem29: Return a text string

     linein ... plant a text edit box inside a window

simdem30: Title page and tutorial

     titles ... Display a title with menu
     tutor1 ... Display a tutorial

simdem31: Get n integers

     geti0n ... input n integers then return n edited values

simdem32: Get n double precisions

     getr0n ... input n double precision variables then retrun n edited values

simdem33: Get n character strings

     gets0n ... input n character strings then return n edited values

simdem34: Get n logical variables

     getl0n ... input n logical variables then return n edited values

simdem35: Get n variables of any types

     get00n ... input n variables of any type then return n edited values

simdem36: Button boxes

     bbox01 ... split style
     vbox01 ... vertical
     hbox01 ... horizontal

simdem37: Ganged radio/tick boxes

     rbox01 ... ganged radio or tick boxes

simdem38: Planting a function call in a window

     table4 ... interactive calculations in real time

simdem39: Wait ... calculations in progress

     waiter ... inform users when a slow process is taking place

simdem40: Configure the Simfit DLLs

     config ... show users how to configure the Simdem environment

simdem41: Use vec1in to get a vector from the user

     vec1in ... read in a vector from console, clipboard or file

simdem42: Use mattin to get a matrix from the user

     mattin ... read in a matrix from console, clipboard or file

simdem43: Get a data matrix from the clipboard

     mattin ... read in a matrix from console, clipboard or file
     attrib ... does a file exist and have the read_only attribute
     getnou ... get an unconnected unit

simdem44: The Simfit file selection control

     ofiles ... open a file for input/output
     getfil ... simple Windows file selection control
     fserch ... search for a file
     infofl ... display the status of a file

simdem45: Print a text file

     fprint ... print a text file

simdem46: Plot n data sets

     smplot ... overlay n graphs
     deltmp ... delete Simfit temporary files

simdem47: Create a pie chart

     pcplot ... plot a vector as a pie chart

simdem48: Create a bar chart

     bcplot ... plot a matrix as a bar chart

simdem49: Create a box and whisker plot

     bwplot ... plot a vector as a box and whisker plot

simdem50: Plot as bars or symbols plus error bars

     ebplot ... plot a vector as a bar chart with error bars

simdem51: Retrieve current DLL signatures

     scclib ... signature for salflibc.dll
     dllmen ... signature for w_menus.dll
     dllgra ... signature for w_graphics.dll
     dllclr ... signature for w_clearwin.dll

simdem52: Retrieve a colour number from the palette

     palett ... edit or retrieve the Simfit colours

simdem53: 2D scatter plot with labels

     lbplot ... plot symbols with labels

simdem54: Plot sample cumulative and best-fit cdf

     cdplot ... display best-fit cdf on sample cumulative distribution

simdem55: Plot sample histogram and best-fit pdf

     pdplot ... display best fit pdf on sample histogram

simdem56: Plot histogram with error bars

     hist01 ... display a histogram with error bars

simdem57: Plot a dendrogram

     dgplot ... display a dendrogram with a threshold

simdem58: Scrolling check boxes

     chkbox ... toggle tick boxes

simdem59: Multiple file selection

     mfiles ... select a set of files

simdem60: Comprehensive list box

     lstbox ... list box with header and trailer

simdem61: Half normal and normal scores plots

     hnplot ... plot a vector as half or normal scores

simdem62: Bivariate normal contour ellipses

     g02cafg ... fit a straight line
     elips1  ... data and mean 95% confidence region

simdem63: Plot rows and columns from a matrix

     mtplot ... interpret rows or columns as x,y coordinates

simdem64: Plot parameteric curve r = r(theta)

     rtplot ... interpret r(theta) in x,y space
     x01aafg ... pi

simdem65: Select files for viewing or opening

     vuopen ... choose a file from a list to view or open

simdem66: Matrices ... read/write procedures

     mat2in ... read in a matrix from a Simfit data file
     isitmf ... check if a file is a Simfit matrix file
     matout ... write a matrix to a file

simdem67: Matrices ... editing and transforming

     mattrn ... input then edit and/or transform a matrix

simdem68: Matrices ... defaults of arbitrary size

     mat3in ... try to open an arbitrary data file
     mat4in ... get a matrix from a known file or return for a new matrix

simdem69: Plot a vector field with labels, e.g. a biplot

     gksvf3 ... display a vector field with arbitrary arrows and labels

simdem70: Comprehensive list of Simfit plotting styles

     Demonstrate all user-friendly front-ends to w_graphics.dll

Back to Menu or Programs: Brief description

## Programs: Source codes in numerical order

simdem01: Output text lines
simdem02: Input double precision values
simdem03: Input integer values
simdem04: Input text strings
simdem05: Input a logical variable
simdem06: Dynamic creation of a list box
simdem07: Dynamic scrolling output
simdem08: Simple table in a window
simdem09: Create a x,y plot
simdem10: Create up to 4 x,y plots
simdem11: Double precision editing
simdem12: Integer editing
simdem13: Text editing
simdem14: Viewing data values
simdem15: Review progress of results
simdem16: Viewing text files
simdem17: Create text pages
simdem18: Create a title page and menu
simdem19: Create a question and answer window
simdem20: Create a tabbing list box window
simdem21: Create/transform up to 4 x,y plots
simdem22: Plot surfaces and contours
simdem23: Plot curves in space
simdem24: Plot vector field
simdem25: Plot error bars
simdem26: Display/file a matrix
simdem27: Create a coloured table
simdem28: Create a background window
simdem29: Return a text string
simdem30: Title page and tutorial
simdem31: Get n integers
simdem32: Get n double precisions
simdem33: Get n character strings
simdem34: Get n character strings
simdem35: Get n variables of any types
simdem36: Button boxes
simdem37: Ganged radio/tick boxes
simdem38: Planting a function call in a window
simdem39: Wait ... calculations in progress
simdem40: Configure the Simfit DLLs
simdem41: Use vec1in to get a vector from the user
simdem42: Use mattin to get a matrix from the user
simdem43: Get a data matrix from the clipboard
simdem44: The Simfit file selection control
simdem45: Print a text file
simdem46: Plot n data sets
simdem47: Create a pie chart
simdem48: Create a bar chart
simdem49: Create a box and whisker plot
simdem50: Plot as bars or symbols plus error bars
simdem51: Retrieve current DLL signatures
simdem52: Retrieve a colour number from the palette
simdem53: 2D scatter plot with labels
simdem54: Plot sample cumulative and best-fit cdf
simdem55: Plot sample histogram and best-fit pdf
simdem56: Plot histogram with error bars
simdem57: Plot a dendrogram
simdem58: Scrolling check boxes
simdem59: Multiple file selection
simdem60: Comprehensive list box
simdem61: Half normal and normal scores plots
simdem62: Bivariate normal contour ellipses
simdem63: Plot rows and columns from a matrix
simdem64: Plot parameteric curve r = r(theta)
simdem65: Select files for viewing or opening
simdem66: Matrices ... read/write procedures
simdem67: Matrices ... editing and transforming
simdem68: Matrices ... defaults of arbitrary size
simdem69: Plot a vector field with labels, e.g. a biplot
simdem70: Comprehensive list of Simfit plotting styles

Back to Menu or Programs: Source codes in numerical order

## Programs: Source codes in subject order

simdem01: Display ... messages
simdem07: Display ... sequential calculations
simdem08: Display ... a simple table
simdem14: Display ... data values
simdem15: Display ... progress of calculations
simdem16: Display ... ASCII text files
simdem17: Display ... text pages
simdem26: Display ... or file a matrix
simdem27: Display ... a coloured table
simdem28: Display ... a background window
simdem30: Display ... title page and tutorial
simdem38: Display ... interactive calculations
simdem39: Display ... Wait ... Calculations in progress
simdem29: Get ... a text string
simdem31: Get ... n integers
simdem32: Get ... n doubles
simdem33: Get ... n strings
simdem34: Get ... n logicals
simdem35: Get ... n variables (any type)
simdem02: Get ... double precision values
simdem03: Get ... integer values
simdem04: Get ... text strings
simdem05: Get ... a logical variable
simdem41: Get ... a vector from the user
simdem42: Get ... a matrix from the user
simdem43: Get ... a matrix from the clipboard
simdem51: Get ... DLL signatures
simdem52: Get ... a colour from the palette
simdem06: Select ... from a simple list box
simdem18: Select ... from a title page and menu
simdem19: Select ... from a question and answer window
simdem20: Select ... from a tabbing list box
simdem36: Select ... from button boxes
simdem37: Select ... from ganged radio/tick boxes
simdem58: Select ... from a scrolling check box
simdem59: Select ... one or multiple files
simdem60: Select ... from a comprehensive list box
simdem65: Select ... files to view/open/copy/paste
simdem44: Select ... from simfit file selection control
simdem11: Editing ... double precision variables
simdem12: Editing ... integers
simdem13: Editing ... text
simdem09: Plot ... 1 function
simdem10: Plot ... 4 functions
simdem21: Plot ... 4 (x,y) transforms
simdem22: Plot ... surfaces and contours
simdem23: Plot ... curves in space
simdem24: Plot ... a vector field
simdem25: Plot ... error bars
simdem46: Plot ... n data sets
simdem47: Plot ... a pie chart
simdem48: Plot ... a bar chart
simdem49: Plot ... as boxes and whiskers
simdem50: Plot ... as bars/symbols plus error bars
simdem53: Plot ... a 2D scatter plus labels
simdem54: Plot ... sample cumulative plus best-fit cdf
simdem55: Plot ... sample histogram plus best-fit pdf
simdem56: Plot ... a histogram with error bars
simdem57: Plot ... a dendrogram
simdem61: Plot ... half-normal and normal scores
simdem62: Plot ... bivariate normal confidence ellipses
simdem63: Plot ... rows and columns from a matrix
simdem64: Plot ... parametric curve r = r(theta)
simdem69: Plot ... vector field with labels
simdem70: Plot ... SUMMARY of subroutines
simdem40: Configure ... the Simfit DLLs
simdem45: Print ... a text file
simdem66: Matrices ... read/write procedures
simdem67: Matrices ... editing and transforming
simdem68: Matrices ... defaults of arbitrary size

Back to Menu or Programs: Source codes in subject order

    !
    ! simdem01: using put routines for very simple text output
    ! ========================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutines called
    ! ------------------
    ! putadv      ... put an advisory message on screen
    ! putcau      ... put a cautionary message on screen
    ! putwar      ... put a warning message on screen
    ! putfat      ... put a fatal error message on screen
    ! puttxt      ... put a text string on screen
    ! putmes      ... put a message text array on screen
    ! images      ... display typical plotting styles
    ! help_simdem ... call the compiled html help file
    ! listbx      ... list box described in simdem06
    !
    ! arguments
    ! ---------
    ! putadv, putcau, putwar, putfat, and puttxt take one intent (in) text
    ! string, while putmes takes one intent (in) n-line text array where
    ! n is the intent (in) number of lines supplied to putmes.
    ! images takes an intent (in) integer to the page required, or 0 for all pages.
    ! help_simdem takes an intent (in) character string for the full help
    ! using 'simdem' or help for the particular subroutine required.
    !
          program    main
          implicit   none
          integer    n, numdec
          integer    mode, nmax, numopt
          parameter (mode = 0, nmax = 20, numopt = 10)
          character  line*100, text(nmax)*100
          logical    repeet
          external   putadv, putcau, putwar, putfat, puttxt, putmes, &
                     images, help_simdem, listbx
          repeet = .true.
          do while (repeet)
    !
    ! create the menu
    !
             write (text,1000)
             numdec = numopt - 1
    !
    ! display the menu
    !
             call listbx (numdec, numopt, &
                          text)
    !
    ! activate the option selected
    !
             if (numdec.eq.1) then

                call putadv ('This is a typical advisory message')

             elseif (numdec.eq.2) then

                call putcau ('This is a typical cautionary message')

             elseif (numdec.eq.3) then

                call putwar ('This is a typical warning message')

             elseif (numdec.eq.4) then

                call putfat ('This is a typical fatal error message')

             elseif (numdec.eq.5) then

                write (line,100) nmax
                call puttxt (line)

             elseif (numdec.eq.6) then

                write (text,200)
                n = 7
                call putmes (n, text)

             elseif (numdec.eq.7) then

                call images (mode)

             elseif (numdec.eq.8) then

                call help_simdem ('simdem01')

             elseif (numdec.eq.9) then

                call help_simdem ('simdem')

             elseif (numdec.eq.numopt) then

                repeet = .false.

             endif
          enddo
      100 format ('Maximum dimension in this program =',I4)
      200 format ( &
           'About the simdem programs' &
          / &
          /'These programs illustrate how to call SIMFIT subroutines' &
          /'and functions from your own programs written in standard' &
          /'Fortran without any direct calls to the Windows API.' &
          / &
          /'For more details read simdem.chm or simdem.html.')
     1000 format ( &
           'putadv     `display a typical advisory message' &
          /'putcau     `display a typical cautionary message' &
          /'putwar     `display a typical warning message' &
          /'putfat     `display a typical fatal error message' &
          /'puttxt     `display a character string' &
          /'putmes     `display a structured message' &
          /'images     `display examples of plotting styles' &
          /'help_simdem`provide help for a selected procedure' &
          /'help_simdem`provide help for the whole simdem package' &
          /'Cancel     `')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem02: using get routines for very simple double precision retrieval
    ! =======================================================================
    ! For details read simdem.chm or simdem.html
    ! Values can have up to 15 significant digits (not including decimal points
    ! and signs) and output is using the character (len = 25) function form25
    ! which returns left justified values with trailing zeros removed after the
    ! first significant decimal digit.
    ! Arguments for list box routine listbx are described in simdem06.
    !
    ! subroutines
    ! -----------
    ! getr01 (x, text)       ... get 1 unrestricted value
    ! getr02 (x, y, text)    ... get 2 unrestricted values
    ! getr03 (x, y, z, text) ... get 3 unrestricted values
    ! getrm1 (A, x, B, text) ... get x where A =< x =< B   (A and B must be initialised)
    ! getd01 (x, text)       ... get 1 unrestricted value  (must be initialised)
    ! getd02 (x, y, text)    ... get 2 unrestricted values (must be initialised)
    ! getd03 (x, y, z, text  ... get 3 unrestricted values (must be initialised)
    ! getdge (x, A, text)    ... get x where x >= A        (must be initialised)
    ! getdle (x, A, text)    ... get x where x =< A        (must be initialised)
    ! getdg2 (x, y, text)    ... get x =< y                (must be initialised)
    ! getdg3 (x, y, z, text) ... get x =< y =< z           (must be initialised)
    ! getdm1 (A, x, B, text) ... get x where A =< x =< B   (must be initialised)
    ! form25 (x)             ... write x as a left justified character string
    !                            with up to 15 significant figures and trailing
    !                            zeros suppressed
    !
    ! arguments (xbot =< xmid =< xtop)
    ! -------------------------------
    !     line: intent (in) message
    !  x, y, z: intent (inout)
    !     xbot: intent (in) smallest value
    !     xmid: intent (inout) value returned
    !     xtop: intent (in) largest value
    !     xlim: intent (in) arbitrary upper or lower limit
    !
          program    main
          implicit   none
          integer    l1, l2, l3, l4
          parameter (l1 = 1)
          integer    numdec, numopt
          parameter (numopt = 13)
          double precision x, xbot, xlim, xmid, xtop, y, z
          double precision zero, one, ten
          parameter (zero = 0.0d+00, one = 1.0d+00, ten = 10.0d+00)
          character  line*100, text(numopt)*80
          character (len = 25) form25, x25, y25, z25, xbot25, xmid25, xtop25
          logical    repeet
          external   getr01, getr02, getr03, getrm1
          external   getd01, getd02, getd03, getdge, getdle, getdg2, getdg3, &
                     getdm1
          external   putadv, form25, listbx
          intrinsic  len_trim
    !
    ! create the menu
    !
          write (text,1000)
          repeet = .true.
          do while (repeet)
             numdec = 1
    !
    ! display the menu
    !
             call listbx (numdec, numopt, &
                          text)
    !
    ! execute the procedure selected
    !
            if (numdec.eq.1) then
    !
    ! examples not requiring initialisation
    !
                call getr01 (x, 'A real number')
                x25 = form25(x)
                write (line,100) x25
                call putadv (line)

             elseif (numdec.eq.2) then

                call getr02 (x, y, 'Two real numbers')
                x25 = form25(x)
                y25 = form25(y)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                write (line,200) x25(l1:l2), y25(l1:l3)
                call putadv (line)

             elseif (numdec.eq.3) then

                call getr03 (x, y, z, 'Three real numbers)')
                x25 = form25(x)
                y25 = form25(y)
                z25 = form25(z)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                l4 = len_trim(z25)
                write (line,300) x25(l1:l2), y25(l1:l3), z25(l1:l4)
                call putadv (line)

             elseif (numdec.eq.4) then

                write (line,400)
                xbot = zero
                xtop = ten
                call getrm1 (xbot, xmid, xtop, line)
                xbot25 = form25(xbot)
                xmid25 = form25(xmid)
                xtop25 = form25(xtop)
                l2 = len_trim(xbot25)
                l3 = len_trim(xmid25)
                l4 = len_trim(xtop25)
                write (line,500) xbot25(l1:l2), xmid25(l1:l3), xtop25(l1:l4)
                call putadv (line)

             elseif (numdec.eq.5) then
    !
    ! examples requiring initialisation
    !
                x = one
                call getd01 (x, 'A real number')
                x25 = form25(x)
                write (line,100) x25
                call putadv (line)

             elseif (numdec.eq.6) then

                x = zero
                y = one
                call getd02 (x, y, 'Two real numbers')
                x25 = form25(x)
                y25 = form25(y)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                write (line,200) x25(l1:l2), y25(l1:l3)
                call putadv (line)

             elseif (numdec.eq.7) then

                x = zero
                y = one
                z = y + one
                call getd03 (x, y, z, 'Three real numbers)')
                x25 = form25(x)
                y25 = form25(y)
                z25 = form25(z)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                l4 = len_trim(z25)
                write (line,300) x25(l1:l2), y25(l1:l3), z25(l1:l4)
                call putadv (line)

             elseif (numdec.eq.8) then

                x = one
                xlim = zero
                call getdge (x, xlim, 'Any value <= 0')
                x25 = form25(x)
                write (line,100) x25
                call putadv (line)

             elseif (numdec.eq.9) then

                x = zero
                xlim = one
                call getdle (x, xlim, 'Any value =< 1')
                x25 = form25(x)
                write (line,100) x25
                call putadv (line)

             elseif (numdec.eq.10) then

                x = zero
                y = one
                call getdg2 (x, y, 'Any values x, y such that y >= x')
                x25 = form25(x)
                y25 = form25(y)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                write (line,200) x25(l1:l2), y25(l1:l3)
                call putadv (line)

             elseif (numdec.eq.11) then

                x = zero
                y = one
                z = y + one
                call getdg3 (x, y, z, &
                            'Any values x, y, z such that z >= y >= x'
                x25 = form25(x)
                y25 = form25(y)
                z25 = form25(z)
                l2 = len_trim(x25)
                l3 = len_trim(y25)
                l4 = len_trim(z25)
                write (line,300) x25(l1:l2), y25(l1:l3), z25(l1:l4)
                call putadv (line)

             elseif (numdec.eq.12) then

                write (line,400)
                xbot = zero
                xmid = one
                xtop = ten
                call getdm1 (xbot, xmid, xtop, line)
                xbot25 = form25(xbot)
                xmid25 = form25(xmid)
                xtop25 = form25(xtop)
                l2 = len_trim(xbot25)
                l3 = len_trim(xmid25)
                l4 = len_trim(xtop25)
                write (line,500) xbot25(l1:l2), xmid25(l1:l3), xtop25(l1:l4)
                call putadv (line)

             elseif (numdec.eq.numopt) then

                repeet = .false.

             endif
          enddo
      100 format ('Value input =',1x,a)
      200 format ('Values input =',1x,a,',',1x,a)
      300 format ('Values input =',1x,a,',',1x,a,',',1x,a)
      400 format ('A real number within the assigned limits')
      500 format ('Lower limit =',1x,a,', Value =',1x,a, &
          ', Upper limit =',1x,a)
     1000 format ( &
           'getr01`get 1 unrestricted value   `not initialised' &
          /'getr02`get 2 unrestricted values  `not initialised' &
          /'getr03`get 3 unrestricted values  `not initialised' &
          /'getrm1`get x where A =< x =< B    `A and B initialised' &
          /'getd01`get 1 unrestricted value   `must be initialised' &
          /'getd02`get 2 unrestricted values  `must be initialised' &
          /'getd03`get 3 unrestricted values  `must be initialised' &
          /'getdge`get x where x >= A         `must be initialised' &
          /'getdle`get x where x =< A         `must be initialised' &
          /'getdg2`get x,y where x =< y       `must be initialised' &
          /'getdg3`get x,y,z where x =< y =< z`must be initialised' &
          /'getdm1`get x where A =< x =< B    `must be initialised' &
          /'Cancel`                           `  ')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem03 using get routines for very simple integer input
    ! =========================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutines
    ! -----------
    ! geti01 ... get 1 integer i
    ! getigt ... get 1 integer i > A
    ! getilt ... get 1 integer i < A
    ! getim1 ... get 1 integer A =< i =< B
    ! getj01 ... get 1 integer i           (must be initialised)
    ! getjge ... get 1 integer i >= A      (must be initialised)
    ! getjle ... get 1 integer i =< A      (must be initialised)
    ! getjm1 ... get 1 integer A =< i =< B (must be initialised)
    !
    ! arguments (ibot =< imid =< itop)
    ! ---------
    ! line: intent (in) message
    ! ibot: intent (in) smallest value
    ! imid: intent (inout) value returned
    ! itop: intent (in) largest value
    ! ilim: intent (in) arbitrary limit
    !
    ! subroutine listbx is described in simdem06
    !
          program    main
          implicit   none
          integer    ibot, ilim, imid, itop
          integer    l1, l2, l3
          parameter (l1 = 1)
          integer    numdec, numopt
          parameter (numopt = 9)
          character  line*100, text(numopt)*80
          character  word12*12, zbot*12, zmid*12, ztop*12
          logical    repeet
          external   geti01, getigt, getilt, getim1
          external   getj01, getjge, getjle, getjm1
          external   putadv, listbx
          intrinsic  adjustl, len_trim
    !
    ! create the menu
    !
          write (text,1000)
          repeet = .true.
          do while (repeet)
             numdec = 1
    !
    ! display the menu
    !
             call listbx (numdec, numopt, text)
    !
    ! execute the procedure selected
    !
             if (numdec.eq.1) then
    !
    ! examples not requiring initialisation, blank string is displayed
    !
                call geti01 (imid, 'An integer')
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.2) then

                ibot = 0
                write (word12,'(i12)') ibot
                write (line,200) adjustl(word12)
                call getigt (imid, ibot, line)
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.3) then

                itop = 100
                write (word12,'(i12)') itop
                write (line,300) adjustl(word12)
                call getilt (imid, itop, line)
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.4) then

                write (line,400)
                ibot = 0
                itop = 10
                call getim1 (ibot, imid, itop, line)
                write (zbot,'(i12)') ibot
                write (zmid,'(i12)') imid
                write (ztop,'(i12)') itop
                zbot = adjustl(zbot)
                zmid = adjustl(zmid)
                ztop = adjustl(ztop)
                l2 = len_trim(zbot)
                l3 = len_trim(zmid)
                write (line, 500) zbot(l1:l2), zmid(l1:l3), ztop
                call putadv (line)

             elseif (numdec.eq.5) then
    !
    ! examples requiring initialisation, initial value is displayed
    !
                imid = 1
                call getj01 (imid, 'An integer')
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.6) then

                ilim = 0
                write (word12,'(i12)') ilim
                write (line,200) adjustl(word12)
                imid = ilim + 1
                call getjge (imid, ilim, line)
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.7) then

                ilim = 0
                imid = ilim - 1
                write (word12,'(i12)') ilim
                write (line,300) adjustl(word12)
                call getjle (imid, ilim, line)
                write (word12,'(i12)') imid
                write (line,100) adjustl(word12)
                call putadv (line)

             elseif (numdec.eq.8) then

                write (line,400)
                ibot = 0
                imid = 5
                itop = 10
                call getjm1 (ibot, imid, itop, line)
                write (zbot,'(i12)') ibot
                write (zmid,'(i12)') imid
                write (ztop,'(i12)') itop
                zbot = adjustl(zbot)
                zmid = adjustl(zmid)
                ztop = adjustl(ztop)
                l2 = len_trim(zbot)
                l3 = len_trim(zmid)
                write (line, 500) zbot(l1:l2), zmid(l1:l3), ztop
                call putadv (line)

             elseif (numdec.eq.numopt) then

                repeet = .false.

             endif
          enddo
      100 format ('Value input =',1x,a)
      200 format ('An integer >',1x,a)
      300 format ('An integer <',1x,a)
      400 format ('An integer within the assigned limits')
      500 format ('Lower limit =',1x,a,', Value =',1x,a, &
          ', Upper limit =',1x,a)
     1000 format ( &
           'geti01`get 1 integer i          ` ' &
          /'getigt`get 1 integer i < A      ` ' &
          /'getilt`get 1 integer i > A      ` ' &
          /'getim1`get 1 integer A =< i =< B`A and B initialised' &
          /'getj01`get 1 integer i          `must be initialised' &
          /'getjge`get 1 integer i >= A     `must be initialised' &
          /'getjle`get 1 integer i =< A     `must be initialised' &
          /'getjm1`get 1 integer A =< i =< B`must be initialised' &
          /'Cancel`                         `  ')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem04: using get routines for very simple text input
    ! =======================================================
    !
    ! subroutines
    ! -----------
    ! getstr ... get a text string from the user (default supplied)
    ! gettxt ... get a text string from the user (default = ?)
    !
    ! arguments
    ! ---------
    ! question: intent (in) request for input
    !   answer: intent (inout) response
    !
          program    main
          implicit   none
          character  answer*80, question*80
          external   getstr, gettxt, puttxt
          answer = 'anything'
          question = 'Please type something in'
          call gettxt (question, answer)
          call puttxt (answer)
          answer = 'Default text string supplied'
          call getstr (question, answer)
          call puttxt (answer)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem05: using get routines for very simple logical input
    ! ==========================================================
    !
    ! subroutine
    ! ----------
    ! getl01 ... get a logical value from the user
    !
    ! arguments
    ! ---------
    ! question: intent (in) request for input
    !    yesno: intent (inout) response (default =  value as supplied)
    !
          program    main
          implicit   none
          character  question*80
          logical    yesno
          external   getl01, putadv
          question = 'Please answer yes or no'
          yesno = .true.
          call getl01 (question, yesno)
          if (yesno) then
             call putadv ('Yes was selected')
          else
             call putadv ('No was selected')
          endif
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem06: using listbx for very simple tabbing list box selection
    ! =================================================================
    !
    ! subroutine
    ! ----------
    ! listbx ... get a decision from a primitive list box (with tabbing)
    !
    ! arguments
    ! ---------
    ! numdec: intent (inout) number of decision (initialises the list box, numdec >= 1)
    ! numopt: intent (in) number of options  (1 =< numdec =< numopt)
    ! option: intent (in) array of options
    !
          program    main
          implicit   none
          integer    numdec, numopt
          integer    nmax
          parameter (nmax = 20)
          character  line*80, option(nmax)*80
          external   putadv, listbx
    !
    ! The options required are written as a character array
    !
          write (option,100)
    !
    ! Specify the default starting option
    !
          numdec = 1
    !
    ! Specify the number of options
    !
          numopt = 4
    !
    ! Call the list box routine
    !
          call listbx (numdec, numopt, option)
          write (line,200) numdec
          call putadv (line)
    !
    ! The grave character (`) causes tabbing into columns inside the list box.
    ! Note: this feature may not work accurately on all displays since it
    ! depends in a rather complicated way on the current user font set-up scheme.
    !
          write (option,300)
          numopt = 5
          numdec = numopt
          call listbx (numdec, numopt, option)
          write (line,200) numdec
          call putadv (line)
      100 format ( &
           'Apples' &
          /'Oranges' &
          /'Pears' &
          /'Grapes')
      200 format ('Item number',I3,' was selected')
      300 format ( &
           'Row 1/Col 1`Column 2 `Column 3' &
          /'Row 2      `Item(2,2)`Item(2,3)' &
          /'Row 3      `Item(3,2)`Item(3,3)' &
          /'Row 4      `Item(4,2)`Item(4,3)' &
          /'Cancel')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem07: using list01 to output a simple scrolling list in a window (text)
    ! ===========================================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! list01 ... scroll text used as arguments to list01
    !
    ! arguments
    ! ---------
    ! line: intent (inout) character string as follows:
    !
    ! if (line = 'OPEN') then
    !    ... open a window for output
    ! elseif (line = 'CLOSE') then
    !    ... close down the window
    ! else
    !  ... the line is displayed in the window with scrolling if required
    ! endif
    !
    ! If the user closes the widow during output, line is returned as 'CLOSE'.
    ! For this reason line must be a intent (inout) variable, and not an
    ! intent (in) parameter, and the value returned must be checked to see if
    ! the user wants to close down the output.
    !
          program   main
          implicit  none
          integer   i
          double precision delay
          parameter (delay = 0.25d+00)
          character line*80
          external  list01, putadv, sleep1
    !
    ! Set line = 'OPEN' then call list01 to open the window
    !
          line = 'OPEN'
          call list01 (line)
    !
    ! Output the text strings until the window is closed or the loop completed
    !
          do i = 1, 25
             if (line.ne.'CLOSE') then
                write (line,100) i
                call list01 (line)
                call sleep1 (delay)
             endif
          enddo
    !
    ! Note: line must be tested on exit since, if the window output has been,
    !       completed, the close down must be interrupted.
    !
          if (line.ne.'CLOSE') then
             call putadv ('Output is completed')
             line = 'CLOSE'
             call list01 (line)
          endif
      100 format ('This is line number',I4)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem08: using table1 to output a simple table in a window (text)
    ! ==================================================================
    !
    ! subroutine
    ! ----------
    ! table1 ... create a table from text supplied to table1
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) text or background colour as follows:
    !         icolor = 0(black), 1(blue), 4(red), 15(white), etc. (VGA type)
    !   line: intent (in) character string as follows:
    !         if (line = 'OPEN') then
    !            ... open a window,
    !         elseif (line = 'CLOSE') then
    !             ... close the window
    !         else
    !             ... the line is displayed in the window.
    !         endif
    !
    ! If the user closes the widow during output, the calculation will not be
    ! interrupted but there will be no further output. The subroutine will scroll
    ! back through the intermediate or total output.

    !
          program    main
          implicit   none
          integer    i, icolor, imax
          parameter (imax = 85)
          character  line*80
          external   table1
    !
    ! Set line = 'OPEN' to open the window and set the background colour
    !
          icolor = 15
          call table1 (icolor, 'OPEN')
    !
    ! Output the coloured text strings
    !
          do i = 1, imax
             if (i.le.20) then
                icolor = 1
             elseif (i.le.50) then
                icolor = 4
             else
                icolor = 0
             endif
             write (line,100) i
             call table1 (icolor, line)
          enddo
    !
    ! Close down the table
    !
          call table1 (icolor,'CLOSE')
      100 format ('This is line number',I4)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem09: gks001, a very simple plotting subroutine
    ! ===================================================
    !
    ! subroutine
    ! ----------
    ! gks001 ... the plot can be printed or output as PostScript, etc.
    !
    ! arguments
    ! ---------
    !      l: intent (in) line type, e.g. 0 = none, 1 = solid, 2 = dashed, 3 = dotted, etc
    !      m: intent (in) symbol type, e.g. 0 = none, 5 = circle, 8 = triangle, 11 = square, etc.
    !      n: intent (in) number of points plotted
    !      x: intent (in) x-values
    !      y: intent (in) y-values
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend subtitle
    ! ytitle: intent (in) y legend subtitle
    !
          program    main
          implicit   none
          integer    i, l, m, n
          integer    nmax
          parameter (nmax = 100)
          double precision x(nmax), y(nmax)
          character  ptitle*8, xtitle*1, ytitle*1
          external   gks001
    !
    ! Define line and symbol types then number of points and data
    !
          l = 1
          m = 5
          n = 10
          do i = 1, n
             x(i) = i
             y(i) = i
          enddo
    !
    ! Define title and legends
    !
          ptitle = 'y = f(x)'
          xtitle = 'x'
          ytitle = 'y'
    !
    ! Plot the graph
    !
          call gks001 (l, m, n, x, y, ptitle, xtitle, ytitle)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem10: gks004, a simple plotting subroutine (up to 4 graphs)
    ! ===============================================================
    !
    ! subroutine
    ! ----------
    ! gks004 ... the plots can be printed or output as PostScript, etc.
    !
    ! arguments
    ! ---------
    !      l: intent (in) line type, e.g. 0 = none, 1 = solid, 2 = dashed, 3 = dotted, etc
    !      m: intent (in) symbol type, e.g. 0 = none, 5 = circle, 8 = triangle, 11 = square, etc.
    !      n: intent (in) number of points to be plotted
    !      x: intent (in) x-values
    !      y: intent (in) y-values
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend subtitle
    ! ytitle: intent (in) y legend subtitle
    !   axes: intent (in) = .true. (option to plot axes ... may not be referenced in this version)
    !  gsave: intent (in) = .true. (option to save hard-copy ... may not be referenced in this version)
    !
    !
          program    main
          implicit   none
          integer    i, n
          integer    nmax
          parameter (nmax = 100)
          integer    l1, l2, l3, l4, m1, m2, m3, m4, n1, n2, n3, n4
          double precision x1(nmax), x2(nmax), x3(nmax), x4(nmax)
          double precision y1(nmax), y2(nmax), y3(nmax), y4(nmax)
          double precision cosi, delta, sini, t(nmax)
          double precision a, b, c, d, pi2, zero, one
          parameter (a = 1.0d+00, b = 2.0d+00, c = 3.0d+00, d = 4.0d+00, &
                     pi2 = 6.2831853, zero = 0.0d+00, one = 1.0d+00)
          character  ptitle*8, xtitle*1, ytitle*1
          logical    axes, gsave
          parameter (axes = .true., gsave = .true.)
          external   gks004
          intrinsic  sin, cos, dble
    !
    ! Define line and symbol types and number of points
    !
          l1 = 1
          l2 = 2
          l3 = 3
          l4 = 4
          m1 = 5
          m2 = 8
          m3 = 11
          m4 = 14
          n = nmax/2
          n1 = n
          n2 = n
          n3 = n
          n4 = n
    !
    ! Define the data
    !
          delta = pi2/(dble(n) - one)
          t(1) = zero
          do i = 2, n - 1
             t(i) = t(i - 1) + delta
          enddo
          t(n) = pi2
          do i = 1, n
             cosi = cos(t(i))
             sini = sin(t(i))
             x1(i) = a*cosi
             x2(i) = b*cosi
             x3(i) = c*cosi
             x4(i) = d*cosi
             y1(i) = a*sini
             y2(i) = b*sini
             y3(i) = c*sini
             y4(i) = d*sini
          enddo
    !
    ! Define the title and legends
    !
          ptitle = 'y = f(x)'
          xtitle = 'x'
          ytitle = 'y'
    !
    ! Plot the graphs
    !
          call gks004 (l1, l2, l3, l4, &
                       m1, m2, m3, m4, &
                       n1, n2, n3, n4, &
                       x1, x2, x3, x4, &
                       y1, y2, y3, y4, &
                       ptitle, xtitle, ytitle, &
                       axes, gsave)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem11: editd1, a simple double precision editor
    ! ==================================================
    !
    ! subroutine
    ! ----------
    ! editd1 ... edit a double precision array
    !
    ! arguments
    ! ---------
    ! isend: intent (in) flag as follows:
    !        isend = 1: view but no editing
    !        isend = 2: edit a full matrix
    !          isend = 3: input to a blank matrix
    ! ncols: intent (in) number of columns
    ! nrmax: intent (in) leading array dimension
    ! nrows: intent (in) number of rows
    !     a: intent (inout) matrix
    ! title: intent (in) title of matrix
    !
    !
          program    main
          implicit   none
          integer    i, isend, j, ncols, nrows
          integer    nrmax, ncmax
          parameter (nrmax = 50, ncmax = 10)
          double precision a(nrmax,ncmax)
          double precision tenth, ten
          parameter (ten = 10.0d+00)
          character  title*20
          external   editd1
          intrinsic  dble
    !
    ! Fill in the matrix
    !
          ncols = 4
          nrows = 5
          do j = 1, ncols
             tenth = dble(j)/ten
             do i = 1, nrows
                a(i,j) = dble(i) + tenth
             enddo
          enddo
    !
    ! isend = 1: viewing mode
    !
          isend = 1
          title = 'Default data'
          call editd1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 2: editing mode
    !
          isend = 2
          title = 'Data for editing'
          ncols = ncols - 1
          nrows = nrows - 1
          call editd1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 3: data input mode
    !
          isend = 3
          title = 'Input some data'
          ncols = ncols - 1
          nrows = nrows - 1
          call editd1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 1: confirm the data input
    !
          isend = 1
          title = 'Your values'
          call editd1 (isend, ncols, nrmax, nrows, a, title)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem12: editi1, a simple integer editor
    ! =========================================
    !
    ! subroutine
    ! ----------
    ! editi1 ... edit an integer array
    !
    ! arguments
    ! ---------
    ! isend: intent (in) flag as follows:
    !        isend = 1: view but no editing
    !        isend = 2: edit a full matrix
    !        isend = 3: input to a blank matrix
    ! ncols: intent (in) number of columns
    ! nrmax: intent (in) leading array dimension
    ! nrows: intent (in) number of rows
    !     a: intent (inout) matrix (doubles transformed to integers on entry)
    ! title: intent (in) title of matrix
    !
    !
          program    main
          implicit   none
          integer    i, isend, j, ncols, nrows
          integer    nrmax, ncmax
          parameter (nrmax = 50, ncmax = 10)
          double precision a(nrmax,ncmax)
          double precision dj, ten
          parameter (ten = 10.0d+00)
          character  title*20
          external   editi1
          intrinsic  dble
    !
    ! Fill in the matrix
    !
          ncols = 4
          nrows = 5
          do j = 1, ncols
             dj = dble(j)
             do i = 1, nrows
                a(i,j) = ten*dble(i) + dj
             enddo
          enddo
    !
    ! isend = 1: viewing mode
    !
          isend = 1
          title = 'Default data'
          call editi1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 2: editing mode
    !
          isend = 2
          title = 'Data for editing'
          ncols = ncols - 1
          nrows = nrows - 1
          call editi1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 3: data input mode
    !
          isend = 3
          title = 'Input some data'
          ncols = ncols - 1
          nrows = nrows - 1
          call editi1 (isend, ncols, nrmax, nrows, a, title)
    !
    ! isend = 1: display data matrix
    !
          isend = 1
          title = 'Your values'
          call editi1 (isend, ncols, nrmax, nrows, a, title)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem13: edittx, a simple text editor
    ! ======================================
    !
    ! subroutine
    ! ----------
    ! edittx ... edit a text array
    !
    ! arguments
    ! ---------
    !  nhigh: intent (in) number of lines in text buffer
    ! nlines: intent (out) length of edited buffer
    !  nwide: intent (in) width of edited buffer
    !   text: intent (inout) buffer
    !
    !
          program    main
          implicit   none
          integer    i, nlines
          integer    nhigh, nwide
          parameter (nhigh = 50, nwide = 80)
          character  text(nhigh)*(nwide)
          character  blank*1
          parameter (blank = ' ')
          external   edittx, putmes
    !
    ! Initialise the text
    !
          do i = 1, nhigh
             text(i) = blank
          enddo
    !
    ! Edit the text
    !
          text(1) = 'Demonstrating a simple text editor'
          text(3) = 'This is some arbitrary text'
          text(5) = 'Make changes and see what happens'
          call edittx (nhigh, nlines, nwide, text)
    !
    ! Display the result
    !
          call putmes (nlines, text)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem14: viewit, a simple data viewer (also copies to the clipboard)
    ! =====================================================================
    !
    ! subroutine
    ! ----------
    ! viewit ... scrolled viewing of double precision or integer arrays
    !
    ! arguments
    ! ---------
    ! ncols: intent (in) number of columns
    ! nrmax: intent (in) leading dimension of array
    ! nrows: intent (in) number of rows
    ! ntype: intent (in) flag as follows:
    !        ntype = 1: i format (integers)
    !        ntype = 2: f format (floats)
    !        ntype = 3: e format (large/small)
    !
          program    main
          implicit   none
          integer    i, j
          integer    ncmax, ncol, nrmax, nrow, ntype
          parameter (nrmax = 20, ncmax = 10)
          double precision a(nrmax,ncmax), dj
          double precision ten
          parameter (ten = 10.0d+00)
          character  title*20
          external   viewit
          intrinsic  dble
    !
    ! Initialise a
    !
          do j = 1, ncmax
             dj = dble(j)
             do i = 1, nrmax
                a(i,j) = ten*dble(i) + dj
             enddo
          enddo
    !
    ! i format
    !
          ncol = 9
          nrow = 9
          title = 'i format'
          ntype = 1
          call viewit (ncol, nrmax, nrow, ntype, a, title)
    !
    ! f format
    !
          ncol = ncol - 1
          nrow = nrow - 1
          do j = 1, ncol
             do i = 1, nrow
                a(i,j) = a(i,j)/ten
             enddo
          enddo
          title = 'f format'
          ntype = 2
          call viewit (ncol, nrmax, nrow, ntype, a, title)
    !
    ! e format
    !
          ncol = ncol - 1
          nrow = nrow - 1
          do j = 1, ncol
             do i = 1, nrow
                a(i,j) = a(i,j)/ten
             enddo
          enddo
          title = 'e format'
          ntype = 3
          call viewit (ncol, nrmax, nrow, ntype, a, title)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem15: revpro, review progress so far (also copies to the clipboard)
    ! =======================================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! revpro ... review progress on a results file at arbitrary intervals
    ! gettmp ... generate a new temporary file name in the %TEMP% folder
    ! deleet ... delete a file
    ! opener ... open a file using w_menus.dll
    ! closer ... close a file opened by w_menus.dll
    ! writer ... write to a file opened by w_menus.dll
    !
    ! arguments
    ! ---------
    ! revpro ... nout: intent (in) unit for file connection
    ! gettmp ... error_code: intent (out) flag (0 = success)
    !                  temp: intent (out) temporary file name
    !                        If len(temp) is large enough a file name will be
    !                        created in the user %TEMP% folder but otherwise
    !                        a local file name will be created
    ! opener ...  ios: intent (out) iostat value from open in w_menus.dll
    !            nout: intent (in) unit for file opening in w_menus.dll
    !            temp: intent (in) file name for opening in w_menus.dll
    ! writer ...    ios: intent (out) iostat value from writing
    !            nlines: intent (in) number of lines to be written to temp
    !              nout: intent (in) unit for file opening
    !              line: intent (in) text array for writing
    ! closer ... nout: intent (in) unit for closing in w_menus.dll
    ! deleet ...  temp: intent (in) filename for deleting
    !            askif: intent (in) flag to request confirm before deleting
    !            there: intent (out) .true. if temp was not deleted
    !
          program    main
          implicit   none
          integer    i, j
          integer    ios, nlines
          parameter (nlines = 1)
          integer    ncmax, nrmax, nout
          parameter (ncmax = 25, nrmax = 25, nout = 4)
          integer    ncr(0:nrmax,0:ncmax)
          integer    error_code
          character  line(1)*208, temp*1024
          logical    askif, there, yesno
          external   revpro, getl01
          external   deleet, gettmp
          external   opener, closer, writer
    !
    ! Initialise ncr
    !
          do j = 0, ncmax
             do i = 0, nrmax
                ncr(i,j) = 1
             enddo
          enddo
    !
    ! Connect a temporary file to unit = nout
    !
          call gettmp (error_code, temp)
          call opener (ios, nout, temp)
    !
    ! Create the table
    !
          write (line(1),'(a)') 'Binomial Coefficients'
          call writer (ios, nlines, nout, line)
          line(1) = ' '
          call writer (ios, nlines, nout, line)
          do i = 0, nrmax
             if (i.gt.1) then
                do j = 1, i - 1
                  ncr(i,j) = ncr(i - 1,j - 1) + ncr(i - 1, j)
                enddo
             endif
             write (line(1),'(26i8)') (ncr(i,j), j = 0, i)
             call writer (ios, nlines, nout, line)
             if (i.eq.5 .or. i.eq.10 .or. i.eq.20) then
    !
    ! Intermediate viewing of results
    !
                yesno = .true.
                call getl01 ('Review progress so far', yesno)
                if (yesno) call revpro (nout)
             endif
          enddo
    !
    ! Final viewing of results then close down
    !
          call getl01 ('View the finished table', yesno)
          if (yesno) call revpro (nout)
          call closer (nout)
    !
    ! Delete the temporary file
    !
          askif = .false.
          call deleet (temp, askif, there)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem16: viewer, view a file contents (also copies to the clipboard)
    ! =====================================================================
    !
    ! subroutine
    ! ----------
    ! viewer ... view a supplied file or view a file selected by browsing
    !
    ! arguments
    ! ---------
    !   isend: intent (in) flag as follows:
    !          isend = 1: view temp
    !          isend = 2: browse, using path and pattern for wildcard
    !    temp: intent (in) filename (used only if isend = 1)
    !    path: intent (in) search path
    ! pattern: intent (in) search pattern
    !
    ! Note: opener, closer, and writer are just being used for illustration
    !
          program    main
          implicit   none
          integer    i, isend, j
          integer    ios, nlines
          parameter (nlines = 1)
          integer    ncmax, nrmax, nout
          parameter (ncmax = 10, nrmax = 10, nout = 4)
          integer    ncr(0:nrmax,0:ncmax)
          integer    error_code
          character  file*1024, pattern*1024, path*1024, temp*20
          character  line(1)*208
          logical    askif, there
          external   viewer
          external   deleet, gettmp, putadv
          external   opener, closer, writer
    !
    ! Initialise ncr
    !
          do j = 0, ncmax
             do i = 0, nrmax
                ncr(i,j) = 1
             enddo
          enddo
    !
    ! Connect a temporary file to unit = nout
    !
          call gettmp (error_code, temp)
          call opener (ios, nout, temp)
    !
    ! Create the table
    !
          write (line(1),'(a)') 'Binomial Coefficients'
          call writer (ios, nlines, nout, line)
          write (line(1),'(a)') ' '
          call writer (ios, nlines, nout, line)
          do i = 0, nrmax
             if (i.gt.1) then
                do j = 1, i - 1
                  ncr(i,j) = ncr(i - 1,j - 1) + ncr(i - 1, j)
                enddo
             endif
             write (line(1),'(26i8)') (ncr(i,j), j = 0, i)
             call writer (ios, nlines, nout, line)
          enddo
    !
    ! close the output unit
    !
          call closer (nout)
    !
    ! isend = 1: view temp, path and pattern not used
    !
          write (line,100) temp
          call putadv (line(1))
          isend = 1
          file = ' '
          path = ' '
          pattern = ' '
          call viewer (isend, temp, path, pattern)
    !
    ! isend = 2: use path and pattern to browse, file not used
    !
          write (line(1),200)
          call putadv (line(1))
          isend = 2
          path = 'c:\temp'
          pattern = '*.*'
          call viewer (isend, file, path, pattern)
    !
    ! Delete temp
    !
          askif = .false.
          call deleet (temp, askif, there)
      100 format ('First view the newly created file',1x,a)
      200 format ('Now view any ASCII text file')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem17: patch1, and patch2, displaying text
    ! =============================================
    !
    ! subroutines
    ! -----------
    ! patch1 ... display a patch of text (comprehensive interface)
    ! patch2 ... display a patch of text (simplified interface)
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) 1 = blue, 4 = red, 9 = white, o/w grey
    ! ix, iy: intent (in) position down from top left hand in average characters
    !         may be disabled in some versions and is always disabled when ixl or iyl =< 0
    ! lshade: intent (in) may be disabled in some versions (0 = no shading, 1 = shading)
    ! numbld: intent (in) 1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !         odd number = normal, even number = highlighted
    ! numtxt: intent (in) text dimension
    ! text  : intent (in) text array
    ! fixed : intent (in) .true. = Courier, .false. = Times Roman
    !
    ! Note that a grave accent can be used for tabbing and also that
    ! patch2 is a cut down version using defaults for icolor, ix, iy,
    ! lshade, and fixed.
    !
    !
          program    main
          implicit   none
          integer    i, icolor, ix, iy, lshade, numtxt
          parameter (icolor = 9, ix = 4, iy = 4, lshade = 0)
          integer    numbld(20)
          character  text(20)*80
          logical    fixed
          parameter (fixed = .false.)
          external   patch1, patch2
          do i = 1, 20
             numbld(i) = 0
          enddo
    !
    ! Typical text window
    !
          write (text,100)
          numbld(1) = 1
          numbld(10) = 1
          numbld(16) = 1
          numtxt = 19
          call patch1 (icolor, ix, iy, lshade, numbld, numtxt, text, fixed)
          numbld(10) = 0
          numbld(16) = 0
    !
    ! Illustrating grave character for tabbing
    !
          write (text,200)
          numtxt = 9
          call patch2 (numbld, numtxt, text)
    !
    ! Illustrating numbld
    !
          write (text,300)
          numtxt = 10
          do i = 3, 10
             numbld(i) = i - 3
          enddo
          call patch2 (numbld, numtxt, text)

      100 format ( &
           'Demonstrating the use of subroutine patch1' &
          / &
          /'This subroutine creates a text window which you can control' &
          /'in many ways to display information.' &
          /'For instance, you can control the position and select the' &
          /'font required for each line of text, e.g. to make headings.' &
          /'You can also tab if you wish and you can tab to create' &
          /'simple tables. However table1 is better for this purpose.' &
          / &
          /'About tabbing' &
          / &
          /'A grave character is used to indicate the tabbing positions.' &
          /'The primitive version of patch1 allows one tab per line, but' &
          /'the advanced version allows multiple tabbing.' &
          / &
          /'About the font selection' &
          / &
          /'Setting fixed = .true. forces use of Courier New, otherwise' &
          /'Standard Font is used. Array numbld controls font details.')
      200 format ( &
           'Arguments for subroutine patch1' &
          / &
          /'icolor `: background colour' &
          /'ix, iy `: position (may be disabled)' &
          /'lshade `: shading (may be disabled)' &
          /'numbld `: controls text font' &
          /'numtxt `: number of text lines' &
          /'text   `: text to be displayed' &
          /'fixed  `: selects Courier or Standard Font')
      300 format ( &
           'The effect of numbld(i) = j on line i' &
          / &
          /'j = 0. Normal' &
          /'j = 1. Highlighted' &
          /'j = 2. Italic' &
          /'j = 3. Highlighted italic' &
          /'j = 4. Bold' &
          /'j = 5. Bold highlighted' &
          /'j = 6. Bold italic' &
          /'j = 7. Bold italic highlighted')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem18: title1, display a title/selection
    ! ===========================================
    !
    ! subroutine
    ! ----------
    ! title1 ... display a title and menu
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) 1 = blue, 4 = red, 9 = white, o/w grey
    ! numbld: intent (in) 1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !                    odd number = normal, even number = highlighted
    ! numdec: intent (inout) decision (must be set on entry = default selection)
    ! numhdr: intent (in) number of header lines
    ! numopt: intent (in) number of options
    ! numpos: intent (in) position of hot-key in option string
    ! header: intent (in) header text
    ! option: intent (in) options text
    !
    ! Note that a grave accent can be used for tabbing
    !
    !
          program    main
          implicit   none
          integer    i, icolor, numdec, numhdr, numopt
          parameter (icolor = 7)
          integer    numbld(20), numpos(20)
          character  header(20)*60, option(20)*20, line*80
          external   title1, putadv
          do i = 1, 20
             numbld(i) = 0
             numpos(i) = 1
             header(i) = ' '
             option(i) = ' '
          enddo
    !
    ! Typical title
    !
          write (header,100)
          write (option,200)
          numhdr = 9
          numopt = 5
          do i = 1, numopt
             numpos(i) =  8
          enddo
          numbld(1) = 1
          numdec = 1
          call title1 (icolor, numbld, numdec, numhdr, numopt, numpos, &
                       header, option)
          write (line,300) numdec
          call putadv (line)
      100 format ('Demonstrating subroutine title1' &
          /' ' &
          /'This subroutine creates a window' &
          /'to display the text array header.' &
          /'It then displays the text array' &
          /'option in buttons. You can tab' &
          /'using grave characters, alter text' &
          /'attributes using numbld and set hot' &
          /'keys using numpos.')
      200 format ('Option A' &
          /'Option B' &
          /'Option C' &
          /'Option D' &
          /'Option E')
      300 format ('Option',i2,' was selected')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem19: answer, display text/yesno
    ! ====================================
    !
    ! subroutine
    ! ----------
    ! answer ... display text and a summary question
    !
    ! Meaning of the arguments
    ! ========================
    ! icolor: intent (in) 1 = blue, 4 = red, 9 = white, o/w grey
    ! numbld: intent (in) 1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !                     odd number = normal, even number = highlighted
    ! numhdr: intent (in) number of header lines
    ! header: intent (in) header text
    ! option: intent (in) that is the question
    ! yesno : intent (inout) logical selected (input value sets the default)
    !
    ! Note that a grave accent can be used for tabbing
    !
    !
          program    main
          implicit   none
          integer    i, icolor, numhdr
          parameter (icolor = 7)
          integer    numbld(20)
          character  header(20)*80, option*80
          logical    yesno
          external   answer, putadv
          do i = 1, 20
             numbld(i) = 0
             header(i) = ' '
          enddo
    !
    ! Typical answer dialogue
    !
          write (header,100)
          option = 'Select yes or no'
          numhdr = 8
          numbld(1) = 1
          yesno = .true.
          call answer (icolor, numbld, numhdr, header, option, yesno)
          if (yesno) then
             call putadv ('You selected Yes')
          else
             call putadv ('You selected No')
          endif
      100 format ('Demonstrating subroutine answer' &
          /' ' &
          /'This subroutine creates a window in which' &
          /'to display the text array header.' &
          /'It then displays the option on a new line,' &
          /'followed by a Y/N?. You can tab using grave' &
          /'characters, and you can set text attributes' &
          /'using integer array numbld.')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem20: tbox01, display text/list box
    ! =======================================
    !
    ! subroutine
    ! ----------
    ! tbox01 ... tab above, inside and below a list box
    !
    ! Meaning of the arguments
    ! ========================
    ! icolor: intent (in) may be disabled
    ! ix, iy: intent (in) position down from top left hand in average characters
    !         may be disabled and always is for ix or iy =< 0
    ! lshade: intent (in) may be disabled (0 = no shading, 1 = shading)
    ! numbld: intent (in) 1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !                     odd number = normal, even number = highlighted
    ! numdec: intent (inout) decision (pre-set to default before entry)
    ! numopt: intent (in) number of options
    ! numpos: intent (in) not used in this version but must be set
    ! nstart: intent (in) starting line for list box in text array
    ! numtxt: intent (in) text dimension
    !   text: intent (in) text array
    ! tabtop: intent (in) tab header (at grave characters)
    ! tabmid: intent (in) tab list box items (at grave characters)
    ! tabbot: intent (in) tab trailer (at grave characters)
    !
    !
          program    main
          implicit   none
          integer    i, icolor, ix, iy, lshade, numdec, numopt, nstart, &
                     numtxt
          parameter (icolor = 9, ix = 4, iy = 4, lshade = 1)
          integer    numbld(20), numpos(20)
          character  line*80, text(20)*80
          logical    tabtop, tabmid, tabbot
          parameter (tabtop = .true., tabmid = .true., tabbot = .true.)
          external   tbox01, putadv
          do i = 1, 20
             numbld(i) = 0
             numpos(i) = 1
          enddo
    !
    ! Typical text/list-box window
    !
          write (text,100)
          numbld(1) = 1
          numtxt = 15
          nstart = 9
          numopt = 4
          numdec = 1
          call tbox01 (icolor, ix, iy, lshade, numbld, numdec, numopt, &
                       numpos, nstart, numtxt, text, tabtop, tabmid, &
                       tabbot)
          write (line,200) numdec
          call putadv (line)
      100 format ('Demonstrating subroutine tbox01' &
          /' ' &
          /'This subroutine creates a text window to' &
          /'display information and a list box.' &
          /'You can control the position and select a' &
          /'font for each line of text for headings.' &
          /'You can tab using the grave character.' &
          /'... ' &
          /'Input `Option A `Get more data' &
          /'Graph `Option B `Plot now' &
          /'Table `Option C `Print a table' &
          /'End   `Option D `Cancel' &
          /'Note that currently`x = 4' &
          /'while we have set  `y = 7' &
          /'and used a value of`z = 3')
      200 format ('List box item number',I2,' was selected')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem21: gkst04, a simple plotting subroutine (plus transformations)
    ! =====================================================================
    !
    ! subroutine
    ! ----------
    ! gkst04 ... plotting with interactive linearising transformations
    !
    ! transformations
    ! ---------------
    ! The data can be transformed automatically into various linearising spaces.
    ! Note that asymp = asymptote must be set for a Hill plot to be possible, which
    ! only makes sense for the Michaelis-Menten and Hill functions (Example 1).
    ! y-semilog space linearises the single exponential component (Example 2).
    !
    ! arguments
    ! ---------
    !      l: intent (in) line type, e.g. 0 = none, 1 = solid, 2 = dashed, 3 = dotted, etc
    !      m: intent (in) symbol type, e.g. 0 = none,
    !          5 = empty circle,    6 = half filled circle,    7 = filled circle,
    !          8 = empty triangle,  9 = half filled triangle, 10 = filled triangle,
    !         11 = empty square,   12 = half filled square,   13 = filled square,
    !         14 = empty diamond,  15 = half filled diamond,  16 = filled diamond, etc.
    !      n: intent (in) number of points to be plotted
    !  asymp: positive asymptote for Hill plot
    ! x1..x4: intent (in) x data
    ! y1..y4: intent (in) y data
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend subtitle
    ! ytitle: intent (in) y legend subtitle
    !   axes: intent (in) .true.
    !  gsave: intent (in) .true.
    ! ===========================================================================
    !
    !
          program    main
          implicit   none
          integer    i, n
          integer    nmax
          parameter (nmax = 100)
          integer    l1, l2, l3, l4, m1, m2, m3, m4, n1, n2, n3, n4
          double precision x1(nmax), x2(nmax), x3(nmax), x4(nmax)
          double precision y1(nmax), y2(nmax), y3(nmax), y4(nmax)
          double precision asymp, delta
          double precision one, two, ten, xbot, xtop
          parameter (one = 1.0d+00, two = 2.0d+00, ten = 10.0d+00, &
                     xbot = one/ten**2, xtop = ten)
          character  ptitle*22, xtitle*1, ytitle*1
          logical    axes, gsave
          parameter (axes = .true., gsave = .true.)
          external   gkst04, putadv
          intrinsic  exp, dble, log
    !
    ! Define the line types (li), plotting symbols (mi), no. of points (ni)
    !
          l1 = 0
          l2 = 1
          l3 = 0
          l4 = 2
          m1 = 6
          m2 = 0
          m3 = 12
          m4 = 0
          n = nmax/10
          n1 = n
          n3 = n
    !
    ! Generate log spaced plotting points and function values
    !
          x1(1) = log(xbot)
          x1(n) = log(xtop)
          delta = (x1(n) - x1(1))/(dble(n) - one)
          do i = 2, n - 1
             x1(i) = x1(i - 1) + delta
          enddo
          do i = 1, n
             x1(i) = exp(x1(i))
             x3(i) = x1(i)
             y1(i) = x1(i)/(one + x1(i))
             y3(i) = x3(i)**2/(two + x3(i)**2)
          enddo
          n = nmax
          n2 = n
          n4 = n
          x2(1) = log(xbot)
          x2(n) = log(xtop)
          delta = (x2(n) - x2(1))/(dble(n) - one)
          do i = 2, n - 1
             x2(i) = x2(i - 1) + delta
          enddo
          do i = 1, n
             x2(i) = exp(x2(i))
             x4(i) = x2(i)
             y2(i) = x2(i)/(one + x2(i))
             y4(i) = x4(i)**2/(two + x4(i)**2)
          enddo
    !
    ! Example 1: Plot rational functions and transforms
    !
          ptitle = 'Rational Functions'
          xtitle = 'x'
          ytitle = 'y'
          asymp = one
          call gkst04 (l1, l2, l3, l4, &
                       m1, m2, m3, m4, &
                       n1, n2, n3, n4, &
                       asymp, &
                       x1, x2, x3, x4, &
                       y1, y2, y3, y4, &
                       ptitle, xtitle, ytitle, &
                       axes, gsave)
    !
    ! Generate exponential data
    !
          do i = 1, n1
             y1(i) = exp(-x1(i))
             y3(i) = (exp(-x3(i)/ten) + y1(i))/two
          enddo
          do i = 1, n2
             y2(i) = exp(-x2(i))
             y4(i) = (exp(-x4(i)/ten) + y2(i))/two
          enddo
    !
    ! Example 2: Plot exponential functions and transforms
    !
          call putadv ('Now exponential functions')
          m1 = 12
          m3 = 15
          ptitle = 'Exponential Functions'
          xtitle = 'x'
          ytitle = 'y'
          asymp = - one
          call gkst04 (l1, l2, l3, l4, &
                       m1, m2, m3, m4, &
                       n1, n2, n3, n4, &
                       asymp, &
                       x1, x2, x3, x4, &
                       y1, y2, y3, y4, &
                       ptitle, xtitle, ytitle, &
                       axes, gsave)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem22: surd2s: plotting surfaces, contours and projections
    ! ==============================================================
    !
    ! subroutine
    ! ----------
    ! surd2s .. surfaces, contours, projections and skyscrapers
    !
    ! arguments
    ! ---------
    ! The arguments for surd2s$ depend on exactly how the routine is to be called.
    ! It can be called to plot a supplied model, to read data from a file
    ! (like surface.tf1, etc), to plot data generated as a vector, or to plot
    ! data supplied as a matrix at equally spaced coordinates.
    ! This example demonstrates this last (simplest) case.
    !
    !  isend: intent (in) flag as follows:
    !         isend = 1: supply model, calculate then plot
    !         isend = 2: read vector from file, then plot
    !         isend = 3: supply vector, then plot
    !         isend = 4: supply z(i,j), then plot
    !   nmax: intent (in) leading dimension.
    !         This MUST be exactly 100 in this particular version.
    !     nx: intent (in) number of x divisions =< nmax
    !     ny: intent (in) number of y divisions =< nmax
    ! vector: intent (inout) supplies data when isend = 3, not used when isend = 4
    !         vector MUST have dimension at least nmax**2 + 6 in this version
    !   xmax: intent (inout) range
    !   xmin: intent (inout) range
    !   ymax: intent (inout) range
    !   xmax: intent (inout) range
    !   ymin: intent (inout) range
    !      z: intent (inout) data when isend = 4, not used when isend = 3
    ! unused: intent (inout) logical array used by the contouring routine
    ! ===========================================================================
    !
    !
          program    main
          implicit   none
          integer    i, j, nx, ny
          integer    isend, nmax
          parameter (isend = 4, nmax = 100)
          double precision x(nmax), y(nmax)
          double precision xmax, xmin, ymax, ymin
          double precision vector(nmax**2 + 6), z(nmax,nmax)
          double precision delta
          double precision one
          parameter (one = 1.0d+00)
          logical    unused(nmax,nmax)
          external   surd2s
          intrinsic  dble
    !
    ! Define x and y
    !
          nx = 20
          ny = 20
          x(1) = - one
          x(nx) = one
          delta = (x(nx) - x(1))/(dble(nx) - one)
          do i = 2, nx - 1
             x(i) = x(i - 1) + delta
          enddo
          y(1) = - one
          y(ny) = one
          delta = (y(ny) - y(1))/(dble(ny) - one)
          do j = 2, ny - 1
             y(j) = y(j - 1) + delta
          enddo
    !
    ! Define z = f(x,y) and the ranges (xmin,xmax), (ymin,ymax)
    !
          do j = 1, ny
             do i = 1, nx
                z(i,j) = x(i)**2 - y(j)**2
             enddo
          enddo
          xmax = x(nx)
          xmin = x(1)
          ymax = y(ny)
          ymin = y(1)
    !
    ! Display the surface, contours, projection, skyscraper blocks, etc.
    !
          call surd2s (isend, nmax, nx, ny, &
                       vector, xmax, xmin, ymax, ymin, z, &
                       unused)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem23: space0: plot x(t),y(t),z(t) 3D-parametric space curve
    ! ================================================================
    !
    ! subroutine
    ! ----------
    ! space0 .. x(t), y(t), z(t) parametric curve in 3D space
    !
    ! This routine simply plots points joined up by a line, but therafter the
    ! plot can be edited to change titles, etc.
    !
    ! arguments
    ! ---------
    !     n: intent (in) dimension
    !  nmax: intent (in) leading dimension >= n
    !     x: intent (in) x(t)
    ! xtemp: intent (inout) workspace
    !     y: intent (in) y(t)
    ! ytemp: intent (inout) workspace
    !     z: intent (in) z(t)
    ! ===========================================================================
    !
    !
          program    main
          implicit   none
          integer    i, n
          integer    nmax
          parameter (nmax = 200)
          double precision x(nmax), y(nmax), z(nmax)
          double precision xtemp(nmax), ytemp(nmax)
          double precision t(nmax)
          double precision delta
          double precision pi
          parameter (pi = 3.1415927d+00)
          double precision one, two, zero
          parameter (one = 1.0d+00, two = 2.0d+00, zero = 0.0d+00)
          external   space0
          intrinsic  cos, dble, sin
    !
    ! Define t
    !
          n = nmax/2
          t(1) = zero
          t(n) = two*pi
          delta = (t(n) - t(1))/(dble(n) - one)
          do i = 2, n - 1
             t(i) = t(i - 1) + delta
          enddo
    !
    ! Define x, y, z as a helix
    !
          x(1) = one
          y(1) = zero
          z(1) = one
          do i = 2, n - 1
             delta = two*t(i)
             x(i) = cos(delta)
             y(i) = sin(delta)
             z(i) = dble(i)
          enddo
          x(n) = x(1)
          y(n) = y(1)
          z(n) = dble(n)
    !
    ! Display the space curve
    !
          call space0 (n, nmax, &
                       x, xtemp, y, ytemp, z)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem24: gksvf1: plot a vector field of arrows
    ! ================================================
    !
    ! subroutine
    ! ----------
    ! gksvf1 ... plot a vector flow field of arrows
    !
    ! This routine simply plots arrows to indicate the direction in a vector
    ! flow field. This version has all the arrows the same modulus since,
    ! with differential equation portraits it can be difficult to detect
    ! singularities if the modulus is varied to indicate size.
    !
    ! arguments
    ! ---------
    ! This example is taken from a Simfit routine which draws a vector field
    ! for an autonomous system of differential equations. So the code is over
    ! complicated as it stands. The original has extra code for colouring
    ! differing quadrants, varying ranges, changing arrow size and type,
    ! and so on, and it will be obvious where this has been deleted.
    !
    ! iarrow: intent (in) arrow type, use 1
    ! ikolor: intent (in) arrow colour
    ! jarrow: intent (in) grid size
    ! lcolor: intent (in) background colour
    !   ngks: intent (in) gks transformation number, use 0
    !   head: intent (in) size of arrow head
    !     x1: intent (in) head position
    !     x2: intent (in) tail position
    !     y1: intent (in) head position
    !     y2: intent (in) tail position
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend
    ! ytitle: intent (in) y legend
    !   axes: intent (in) use .true.
    !  gsave: intent (in) use .true.
    ! ===========================================================================
    !
    !
          PROGRAM    MAIN
          IMPLICIT   NONE
          INTEGER    NEQN, NMAX, NMAX2, NPMAX
          PARAMETER (NEQN = 2, NMAX = 20, NMAX2 = NMAX**2, NPMAX = 4)
          INTEGER    IARROW(NMAX2), IKOLOR(NMAX2)
          INTEGER    LCOLOR, NGRID, NGKS
          PARAMETER (LCOLOR = 15, NGKS = 0)
          INTEGER    I, J, JARROW, K
          DOUBLE PRECISION P(NPMAX)
          DOUBLE PRECISION F(NEQN), Y(NEQN), THETA
          DOUBLE PRECISION HEAD(NMAX2), X1(NMAX2), X2(NMAX2), Y1(NMAX2), &
                           Y2(NMAX2)
          DOUBLE PRECISION FACTOR, XDELTA, XSTART, XSTOP, YDELTA, &
                           YSTART, YSTOP
          DOUBLE PRECISION ZERO, ONE, TWO, HSIZE, RTOL
          PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00, &
                     TWO = 2.0D+00, HSIZE = 0.005D+00, RTOL = 1.0D-300)
          CHARACTER  PTITLE*15, XTITLE*4, YTITLE*4
          PARAMETER (PTITLE = 'Phase Portrait', &
                     XTITLE = 'y(2)', &
                     YTITLE = 'y(1)')
          LOGICAL    AXES, GSAVE
          PARAMETER (AXES = .TRUE., GSAVE = .TRUE.)
          EXTERNAL   GKSVF1
          INTRINSIC  ABS, DBLE, ATAN, SIN, COS
          DATA       NGRID / 20 /
          DATA       FACTOR / ONE /
          DATA       P / ONE, ONE, ONE, ONE /
          DATA       XSTART, XSTOP / ZERO, TWO /
          DATA       YSTART, YSTOP / ZERO, TWO /
    !
    ! Initialise grid size and arrow colours
    !
          JARROW = NGRID*NGRID
          DO I = 1, NMAX2
             IKOLOR(I) = 0
          ENDDO
    !
    ! Initialise the arrow types (changed at singularities) and head sizes
    !
          DO I = 1, JARROW
             IARROW(I) = 1
             HEAD(I) = FACTOR*HSIZE
          ENDDO
    !
    ! Define the mesh of grid points Y(1) and Y(2)
    !
          XDELTA = (XSTOP - XSTART)/(DBLE(NGRID) - ONE)
          YDELTA = (YSTOP - YSTART)/(DBLE(NGRID) - ONE)
          K = 0
          DO I = 1, NGRID
             IF (I.EQ.1) THEN
                Y(1) = YSTART
             ELSEIF (I.EQ.NMAX) THEN
                Y(1) = YSTOP
             ELSE
                Y(1) = Y(1) + YDELTA
             ENDIF
             DO J = 1, NGRID
                IF (J.EQ.1) THEN
                   Y(2) = XSTART
                ELSEIF (J.EQ.NMAX) THEN
                   Y(2) = XSTOP
                ELSE
                   Y(2) = Y(2) + XDELTA
                ENDIF
    !
    ! Call the differential equation routines to evaluate the RHS of dy(i)/dx = F(i)
    !
                f(1) = p(1)*y(1) - p(2)*y(1)*y(2)
                f(2) = p(3)*y(2) - p(4)*y(1)*y(2)
    !
    ! Increment K then assign angles and arrows ... First the arrow bases
    !
                K = K + 1
                X2(K) = Y(2)
                Y2(K) = Y(1)
    !
    ! Now the arrow heads depending on F(i)
    !
                IF (F(1).GT.RTOL .AND. F(2).GT.RTOL) THEN
    !
    ! 1st quadrant
    !
                   THETA = ATAN(F(1)/F(2))
                   X1(K) = X2(K) + XDELTA*COS(THETA)/TWO
                   Y1(K) = Y2(K) + YDELTA*SIN(THETA)/TWO
                ELSEIF (F(1).GT.RTOL .AND. F(2).LT. - RTOL) THEN
    !
    ! 2nd quadrant
    !
                   THETA = ATAN( - F(1)/F(2))
                   X1(K) = X2(K) - XDELTA*COS(THETA)/TWO
                   Y1(K) = Y2(K) + YDELTA*SIN(THETA)/TWO
                ELSEIF (F(1).LT. - RTOL .AND. F(2).LT. - RTOL) THEN
    !
    ! 3rd quadrant
    !
                   THETA = ATAN(F(1)/F(2))
                   X1(K) = X2(K) - XDELTA*COS(THETA)/TWO
                   Y1(K) = Y2(K) - YDELTA*SIN(THETA)/TWO
                ELSEIF (F(1).LT. - RTOL .AND. F(2).GT.RTOL) THEN
    !
    ! 4th quadrant
    !
                   THETA = ATAN( - F(1)/F(2))
                   X1(K) = X2(K) + XDELTA*COS(THETA)/TWO
                   Y1(K) = Y2(K) - YDELTA*SIN(THETA)/TWO
                ELSEIF (ABS(F(1)).LE.RTOL .AND. ABS(F(2)).LE.RTOL) THEN
    !
    ! The singular case when F(1) = F(2) = 0 so set X1 = X2, Y1 = Y2
    !
                   X1(K) = X2(K)
                   Y1(K) = Y2(K)
                ELSEIF (ABS(F(2)).LE.RTOL) THEN
    !
    ! Vertical
    !
                   X1(K) = X2(K)
                   IF (F(1).GT.ZERO) THEN
                      Y1(K) = Y2(K) + YDELTA/TWO
                   ELSE
                      Y1(K) = Y2(K) - YDELTA/TWO
                   ENDIF
                ELSE
    !
    ! Horizontal
    !
                   Y1(K) = Y2(K)
                   IF (F(2).GT.ZERO) THEN
                      X1(K) = X2(K) + XDELTA/TWO
                   ELSE
                      X1(K) = X2(K) - XDELTA/TWO
                   ENDIF
                ENDIF
             ENDDO
          ENDDO
    !
    ! Now call GKSVF1 to draw the vector field
    !
          CALL GKSVF1 (IARROW, IKOLOR, JARROW, LCOLOR, NGKS, &
                       HEAD, X1, X2, Y1, Y2, &
                       PTITLE, XTITLE, YTITLE, &
                       AXES, GSAVE)
          END
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem25: gkseb4, a simple subroutine to plot error bars
    ! ========================================================
    !
    ! subroutine
    ! ----------
    ! gkseb4 ... up to two sets of data/error bars plus two best fit curves
    !
    ! arguments
    ! ---------
    ! The subroutine is designed to fit up to two sets of data with error bars
    ! and up to two best fit curves. Usually x1, y1, yh1, yl1 would be data for one
    ! components and x2, y2 would be the best-fit curve, etc., but actually all four
    ! components are independent.
    !      l: intent (in) line type, e.g. 0 = none, 1 = solid, 2 = dashed, 3 = dotted, etc
    !      m: intent (in) symbol type, e.g. 0 = none,
    !          5 = empty circle,    6 = half filled circle,    7 = filled circle,
    !          8 = empty triangle,  9 = half filled triangle, 10 = filled triangle,
    !         11 = empty square,   12 = half filled square,   13 = filled square,
    !         14 = empty diamond,  15 = half filled diamond,  16 = filled diamond, etc.
    !      n: intent (in) number of points to be plotted
    !    yh1: intent (in) upper error bar for y1
    !    yl1: intent (in) lower error bar for y1
    !    yh3: intent (in) upper error bar for y3
    !    yl3: intent (in) lower error bar for y3
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend subtitle
    ! ytitle: intent (in) y legend subtitle
    !   axes: intent (in) .true.
    !  gsave: intent (in) .true.
    ! ===========================================================================
    !
    !
          program    main
          implicit   none
          integer    i, n
          integer    nmax
          parameter (nmax = 100)
          integer    l1, l2, l3, l4, m1, m2, m3, m4, n1, n2, n3, n4
          double precision x1(nmax), x2(nmax), x3(nmax), x4(nmax)
          double precision y1(nmax), y2(nmax), y3(nmax), y4(nmax)
          double precision yh1(nmax), yh3(nmax), yl1(nmax), yl3(nmax)
          double precision delta
          double precision one, two, ten, factor, xbot, xtop
          parameter (one = 1.0d+00, two = 2.0d+00, ten = 10.0d+00, &
                     factor = 0.675d+00, xbot = one/ten**2, xtop = ten)
          character  ptitle*12, xtitle*1, ytitle*1
          logical    axes, gsave
          parameter (axes = .true., gsave = .true.)
          external   gkseb4
          intrinsic  dble
    !
    ! Define the line types (li), plotting symbols (mi), no. of points (ni)
    !
          l1 = 0
          l2 = 1
          l3 = 0
          l4 = 2
          m1 = 5
          m2 = 0
          m3 = 8
          m4 = 0
          n = nmax/10
          n1 = n
          n3 = n
    !
    ! Generate equally spaced plotting points and function values
    !
          x1(1) = xbot
          x1(n) = xtop
          delta = (x1(n) - x1(1))/(dble(n) - one)
          do i = 2, n - 1
             x1(i) = x1(i - 1) + delta
          enddo
          do i = 1, n
             x3(i) = x1(i)
             y1(i) = x1(i)/(one + x1(i))
             y3(i) = factor*x3(i)**2/(two + x3(i)**2)
             yh1(i) = y1(i) + y1(i)/ten
             yh3(i) = y3(i) + y3(i)/ten
             yl1(i) = y1(i) - y1(i)/ten
             yl3(i) = y3(i) - y3(i)/ten
          enddo
          n = nmax
          n2 = n
          n4 = n
          x2(1) = xbot
          x2(n) = xtop
          delta = (x2(n) - x2(1))/(dble(n) - one)
          do i = 2, n - 1
             x2(i) = x2(i - 1) + delta
          enddo
          do i = 1, n
             x4(i) = x2(i)
             y2(i) = x2(i)/(one + x2(i))
             y4(i) = factor*x4(i)**2/(two + x4(i)**2)
          enddo
    !
    ! Plot rational functions and error bars
    !
          ptitle = 'Error Bars'
          xtitle = 'x'
          ytitle = 'y'
          call gkseb4 (l1, l2, l3, l4, &
                       m1, m2, m3, m4, &
                       n1, n2, n3, n4, &
                       x1, x2, x3, x4, &
                       yh1, yh3, yl1, yl3, y1, y2, y3, y4, &
                       ptitle, xtitle, ytitle, &
                       axes, gsave)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem26: dsplay, a simple matrix viewer (also writes to file)
    ! ==============================================================
    !
    ! subroutine
    ! ----------
    ! dsplay ... display a matrix but also write to results file if required
    !
    ! arguments
    ! ---------
    ! dsplay is similar to viewit = simdem14 but it can also write
    ! the array out to a pre-connected file on unit nout
    !  ncmax: intent (in) column dimension >= ncol
    !   ncol: intent (in) actual number of columns
    !  nrmax: intent (in) row dimension >= nrow
    !   nrow: intent (in) actual number of rows
    !  ntype: intent (in) flag as follows:
    !                     ntype = 1: i format (integers)
    !                     ntype = 2: f format (floats)
    !                     ntype = 3: e format (large/small)
    ! fileit: intent (in) if .true. then write to file opened on unit nout
    !                     where unit is opened in w_menus.dll and all input
    !                     and output, etc. uses opener, closer, and writer
    !                     (unless the calling program and w_menus.dll use the
    !                      same run-time system, i.e. same compiler).
    !
          program    main
          implicit   none
          integer    i, j
          integer    ncmax, ncol, nout, nrmax, nrow, ntype
          parameter (nrmax = 20, nout = 4, ncmax = 10)
          double precision a(nrmax,ncmax), dj
          double precision ten
          parameter (ten = 10.0d+00)
          character  title*20
          logical    fileit
          parameter (fileit = .false.)
          external   dsplay
          intrinsic  dble
    !
    ! Initialise a
    !
          do j = 1, ncmax
             dj = dble(j)
             do i = 1, nrmax
                a(i,j) = ten*dble(i) + dj
             enddo
          enddo
    !
    ! i format
    !
          ncol = 9
          nrow = 9
          title = 'i format'
          ntype = 1
          call dsplay (ncmax, ncol, nout, nrmax, nrow, ntype, a, &
                       title, fileit)
    !
    ! f format
    !
          ncol = ncol - 1
          nrow = nrow - 1
          do j = 1, ncol
             do i = 1, nrow
                a(i,j) = a(i,j)/ten
             enddo
          enddo
          title = 'f format'
          ntype = 2
          call dsplay (ncmax, ncol, nout, nrmax, nrow, ntype, a, &
                       title, fileit)
    !
    ! e format
    !
          ncol = ncol - 1
          nrow = nrow - 1
          do j = 1, ncol
             do i = 1, nrow
                a(i,j) = a(i,j)/ten
             enddo
          enddo
          title = 'e format'
          ntype = 3
          call dsplay (ncmax, ncol, nout, nrmax, nrow, ntype, a, &
                       title, fileit)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem27: using table2 to output a simple coloured table in a window (text)
    ! ===========================================================================
    !
    ! subroutine
    ! ----------
    ! table2 ... use colours for a individual letters in a table
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) colour as follows:
    !         icolor(i) = 0(black), 1(blue), 4(red), 14(yellow), 15(white), etc. (VGA type)
    !   line: intent (in) character string as follows:
    !         line = 'OPEN' then open a window,
    !         line = 'CLOSE' close the window, otherwise line is displayed in the window.
    !
    ! If the user closes the window during output, the calculation will not be
    ! interrupted but there will be no further output. The subroutine will scroll
    ! through the intermediate or total output.
    ! The only difference between this and table1 = simdem08 is that the colour
    ! of any individual letters can be set using the array icolor. This makes table2
    ! slower and more complicated to use but it can be very useful to set the colour
    ! of individual letters.

    !
          program    main
          implicit   none
          integer    i, icmax, imax, j, k, l
          parameter (icmax = 30, imax = 70)
          integer    icolor(icmax)
          character  line*(icmax)
          external   table2
    !
    ! Initialise icolor(i) = 0 (black)
    !
          do i = 1, icmax
             icolor(i) = 0
          enddo
          do l = 1, 2
    !
    ! White background first time, then change to grey background
    !
             if (l.eq.1) then
                icolor(1) = 15
             else
                icolor(1) = 7
             endif
    !
    ! Set line = 'OPEN' to open the window and set the background colour = icolor(1)
    !
             call table2 (icolor, 'OPEN')
             icolor(1) = 0
    !
    ! Output the text strings
    !
             j = 0
             do i = 1, imax
                if (i.eq.11) then
                   if (l.eq.1) then
                      j = 1
                   else
                      j = 14
                   endif
                   do k = 9, 14
                      icolor(k) = j
                   enddo
                elseif (i.eq.21) then
                   j = 4
                   do k = 9, 14
                      icolor(k) = j
                   enddo
                elseif (i.eq.31) then
                   j = 0
                   do k = 9, 14
                      icolor(k) = j
                   enddo
                endif
                write (line,100) j
                call table2 (icolor, line)
             enddo
             call table2 (icolor,'CLOSE')
          enddo
      100 format ('This is colour number',I4)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem28: creating background windows
    ! =====================================
    !
    ! subroutine
    ! ----------
    ! window ... plant code inside a background window
    !
    ! arguments
    ! ---------
    !  isend: intent (in) number of the independent window (if several can be opened)
    !          Note: currently window only opens 1 background window and
    !                isend is not referenced.
    !  title: intent (in) title of window
    ! action: intent (in) if .true. then open, o/w close the window
    !
          program    main
          implicit   none
          integer    i
          integer    isend
          parameter (isend = 1)
          double precision x
          character  line*100, title*12
          parameter (title = 'simdem28.for')
          logical    action
          external   getr01, putadv, window, puttxt
    !
    ! open background window (number = isend)
    !
          action = .true.
          call window (isend, title, action)
    !
    ! do something
    !
          line = 'This shows how to plant code inside a background window'
          call puttxt (line)
          do i = 1, 2
             call getr01 (x, 'An arbitrary real number')
             write (line,100) i, x
             call putadv (line)
          enddo
    !
    ! close background window number isend
    !
          action = .false.
          call window (isend, title, action)
      100 format ('Value number',i2,' was =',1p,e11.3)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem29: linein, retrieve a line of text
    ! =========================================
    !
    ! subroutine
    ! ----------
    ! linein ... plant a text edit box inside a window
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) 1 = blue, 4 = red, 9 = white, o/w grey
    ! ix, iy: intent (in) position down from top left hand in average characters
    !                     this may be disabled and will always be so when ix or iy =< 0
    !  nchar: intent (in) number of extra border characters (set this = 0)
    ! numbld: intent (in) font type as follows:
    !                     1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !                     odd number = normal, even number = highlighted
    ! numtxt: intent (in) text dimension
    !   line: intent (inout) text string enetered by the user
    !   text: intent (in) text array
    !  fixed: intent (in) .true. = Courier, .false. = Times Roman
    !
    ! Note that a grave accent can be used for tabbing
    !
    !
          program    main
          implicit   none
          integer    i, icolor, ix, iy, nchar, numtxt
          parameter (icolor = 7, ix = 4, iy = 4, nchar = 0, numtxt = 17)
          integer    numbld(numtxt)
          character  line*60, text(numtxt)*80
          logical    fixed
          parameter (fixed = .false.)
          external   linein, putadv
          do i = 1, numtxt
             numbld(i) = 0
          enddo
    !
    ! Typical text window using line and text
    !
          write (text,100)
          numbld(1) = 1
          numbld(10) = 1
          numbld(14) = 1
          line = ' '
          call linein (icolor, ix, iy, nchar, numbld, numtxt, &
                       line, text, fixed)
          if (line.eq.' ') line = 'nothing'
          call putadv ('You wrote '//line)
      100 format ( &
           'Demonstrating the use of subroutine linein' &
          / &
          /'This subroutine creates a text window which you can control' &
          /'in many ways to display information, as with patch1.' &
          /'For instance, you can control the position and select the' &
          /'font required for each line of text, e.g. to make headings.' &
          /'The routine opens a little edit box where the user can type' &
          /'in character strings.' &
          / &
          /'About tabbing' &
          / &
          /'A grave character is used to indicate the tabbing positions.' &
          / &
          /'About font selection' &
          / &
          /'Setting fixed = .true. forces use of Courier New, otherwise' &
          /'Standard Font is used. Array numbld controls font details.')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem30: title page and tutorial
    ! =================================
    !
    ! subroutines
    ! -----------
    ! titles ... Display a title with menu
    ! tutor1 ... Display a tutorial
    !
    ! arguments
    ! ---------
    ! titles: similar to patch1 and linein as follows:
    !         ICOLOR: intent (in) colour
    !         NUMBLD: intent (in) font type
    !         NUMDEC: intent (inout) default on entry and retirns the choice
    !         NUMHDR: intent (in) dimension of header
    !         NUMOPT: intent (in) number of options
    !         NUMPOS: intent (in) hot key positions
    !         HEADER: intent (in) text before menu
    !         OPTION: intent (in) the menu
    !
    ! tutor1: similar to titles except that next and updown control the
    !         allowed movement forwards and backwards through the tutorial pages.
    !         ICOLOR: intent (in) colour
    !         NUMBLD: intent (in) font type
    !         NUMHDR: intent (in) header dimensions
    !         HEADER: intent (in) header
    !          FRAME: intent (in) if .true. uses Courier New
    !           NEXT: intent (in) if .true. move to next item (see below)
    !         UPDOWN: intent (in) if .true. allow up/down scrolling (see below)
    !                 The effect of next and updown depends on the version. Usually
    !                 next = updown = .true. causes the buffer to fill and either
    !                 of them .false. causes display. probably best to keep updown
    !                 fixed and control the tutorial using next as in the example.
    !
          program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          logical    abort, first
          parameter (first = .true.)
          external   advise
          call advise (nmax, abort, first)
          end
    !
    !
          SUBROUTINE ADVISE (NMAX, ABORT, FIRST)
    !
    ! Advise user
    !
          IMPLICIT   NONE
          INTEGER    NMAX
          INTEGER    ISEND
          INTEGER    ICOLOR, NUMHDR, NUMOPT
          PARAMETER (ICOLOR = 3, NUMHDR = 8, NUMOPT = 3)
          INTEGER    NUMBLD(NUMHDR), NUMPOS(NUMOPT)
          INTEGER    JCOLOR, JMAX
          PARAMETER (JCOLOR = 9, JMAX = 20)
          INTEGER    JUMBLD(JMAX), NUMTXT
          CHARACTER  HEADER(NUMHDR)*63, OPTION(NUMOPT)*15
          CHARACTER  TEXT(20)*80, LINE*80
          LOGICAL    ABORT, FIRST
          LOGICAL    FRAME, NEXT, REPEET
          LOGICAL    UPDOWN
          PARAMETER (UPDOWN = .TRUE.)
          EXTERNAL   TITLES, TUTOR1, PUTADV
          DATA       JUMBLD / JMAX*0 /
          DATA       NUMBLD / 0, 0, 0, 0, 0, 0, 0, 0 /
          DATA       NUMPOS / 1, 1, 1 /
          DATA       OPTION / &
          'Provide details', &
          'Run the program', &
          'Quit  ...  Exit' /
          ABORT = .FALSE.
          REPEET = .TRUE.
          DO WHILE (REPEET)
             IF (FIRST) THEN
                WRITE (HEADER,100) NMAX
                ISEND = 1
                CALL TITLES (ICOLOR, NUMBLD, ISEND, NUMHDR, NUMOPT, NUMPOS, &
                             HEADER, OPTION)
             ELSE
                ISEND = 1
             ENDIF
             IF (ISEND.EQ.1) THEN
                WRITE (TEXT,200)
                NUMTXT = 20
                FRAME = .FALSE.
                JUMBLD(1) = 1
                NEXT = .TRUE.
                CALL TUTOR1 (JCOLOR, JUMBLD, NUMTXT, TEXT, FRAME, NEXT, &
                             UPDOWN)
                WRITE (TEXT,300)
                CALL TUTOR1 (JCOLOR, JUMBLD, NUMTXT, TEXT, FRAME, NEXT, &
                             UPDOWN)
                WRITE (TEXT,400)
                CALL TUTOR1 (JCOLOR, JUMBLD, NUMTXT, TEXT, FRAME, NEXT, &
                             UPDOWN)
                WRITE (TEXT,500)
                NEXT = .FALSE.
                CALL TUTOR1 (JCOLOR, JUMBLD, NUMTXT, TEXT, FRAME, NEXT, &
                             UPDOWN)

                IF (FIRST) THEN
                   REPEET = .TRUE.
                ELSE
                   ABORT = .FALSE.
                   REPEET = .FALSE.
                ENDIF
             ELSEIF (ISEND.EQ.2) THEN
                WRITE (LINE,600)
                CALL PUTADV (LINE)
             ELSEIF (ISEND.EQ.3) THEN
                ABORT = .TRUE.
                REPEET = .FALSE.
             ENDIF
          ENDDO
      100 FORMAT ( &
           'Package     `SIMFIT' &
          /'Program     `ADDERR' &
          /'Action      `Add random error to simulate experimental data.' &
          /'            `Input: file with exact data from program MAKDAT' &
          /'            `Output: file with data after adding random errors' &
          /'Version     `5.2, array dimension',I5 &
          /'Graphics    `CWP/Hershey' &
          /'Author      `W. G. Bardsley, University of Manchester, U.K.')
      200 FORMAT ('Summary'/ &
          /,'Data files are required as follows:' &
          /' x, y(x), s                 `... one variable (usual) case' &
          /'x1, x2, y(x1,x2), s         `... two variable case' &
          /'x1, x2, x3, y(x1,x2,x3), s  `... three variable case' &
          /'You can then use this program in several ways to perturb the' &
          /'y-values by adding random errors. Finally an output file can' &
          /'be produced with old x-values, new y-values and s-values set' &
          /'equal or approximately equal to the standard error of y. The' &
          /'output file is then ready for curve fitting.' &
          /'The input file must have exact values for y as a function of' &
          /'x and arbitrary s,e.g. s = 1. Such files can be generated by' &
          /'program MAKDAT or editors MAKFIL(1 var.) or MAKMAT(2/3 var.)' &
          /'and they are not altered by program ADDERR. The output files' &
          /'contain the simulated experimental data.'/ &
          /'The statistical theory of experimental error assumes that' &
          /5X,'y-perturbed = y-exact + random error' &
          /'and you have several choices for random errors.')
      300 FORMAT ('Variance models'/ &
          /'Three commonly encountered models for s^2 (i.e. V(y) the' &
          /'variance of y) are given special prominence.'/ &
          /'a) `Constant variance' &
          /'   `V(y) = sigma^2' &
          /'b) `Constant relative error' &
          /'   `V(y) = (fraction|y|)^2' &
          /'c) `Mixed power law' &
          /'   `V(y) = sigma^2 + (coefficient|y|)^power'/ &
          /'To simulate a), b) or c) normally distributed numbers with' &
          /'zero mean and appropriate variance are added to y-exact to' &
          /'give y-perturbed then s-values can be set in several ways.' &
          /'Note that variance types a) and b) are really special cases' &
          /'of c) so the distinction is only for convenience.' &
          /'This program also allows you to generate random errors from' &
          /'a variety of distributions so you can explore the effect of' &
          /'uniform, exponential, normal or Cauchy random errors.')
      400 FORMAT ('Options for s (the standard deviation of y)'/ &
          /'Weighted non linear least-squares regression analysis  needs' &
          /'s to be the exact standard deviation of the y-value but this' &
          /'can never be obtained in real life.'/ &
          /'Three situations can occur.'/ &
          /'1. `You assume a model for V(y) then substitute measured,i.e.' &
          /'   `perturbed or best-fit y in a formula for V(y). A special' &
          /'   `case would be assuming constant variance, i.e. all s = 1.' &
          /'2. `You use replicates to estimate s at each fixed x and then' &
          /'   `set s = sample estimates of standard deviations.' &
          /'3. `You perform experiments to estimate s then substitute for' &
          /'   `s = F(y), s = G(x) or smoothing, e.g. by program EDITFL.'/ &
          /'This program allows you to set exact values for s or to use' &
          /'s-values that would be typical of 1, 2 or 3.' &
          /'You can assume single measurements or replicates and you can' &
          /'generate outliers and re-calculate s if required.')
      500 FORMAT ('Outliers'/ &
          /'Outliers are y-values with errors that are improbably large' &
          /'or are not from the same distribution as the other errors.' &
          /'To avoid generating such errors in the previous options the' &
          /'normal distribution is truncated at 3 standard deviations.'/ &
          /'There are several ways you can add arbitrary errors to data' &
          /'to simulate outliers.  You can use a Cauchy distribution or' &
          /'add outliers directly to the original or perturbed data.The' &
          /'s-values can be left alone or with replicates re-calculated' &
          /'from the perturbed data set with outliers.'/ &
          /'Positions and signs of outliers can be selected randomly or' &
          /'by the user and the magnitude can be fixed in several ways.' &
          /'The outlier can be a fixed % of the exact |y|-value, it can' &
          /'be a set amount, you can input individual errors etc.'/ &
          /'The effect of outliers can be very dramatic especially when' &
          /'they occur at critical positions in small data sets.')
      600 FORMAT ('Not available ... get SIMFIT')
          END
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem31: calling geti0n to return n integers
    ! =============================================
    !
    ! subroutine
    ! ----------
    ! geti0n ... input n integers then return n edited values
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of integers required, n >= 1
    ! nvalue: intent (inout) the n integers
    !   text: intent (in) the associated text array
    !
          program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          integer    i, icolor, n, nvalue(nmax)
          character  line*100, text(nmax)*100
          external   geti0n, table1
    !
    ! initialise n and the n values before calling geti00n
    !
          n = nmax/4
          do i = 1, n
             nvalue(i) = i
             write (text(i),100) 'Before call to GETI0N', i, nvalue(i)
          enddo
    !
    ! retrieve the n new values then display the new values
    !
          call geti0n (n, nvalue, text)
          icolor = 15
          call table1 (icolor, 'open')
          icolor = 0
          do i = 1, n
             write (line,100) 'After call to GETI0N', i, nvalue(i)
             call table1 (icolor, line)
          enddo
          call table1 (icolor, 'close')
      100 format (a,', integer number',i3,' is',i10)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem32: calling getr0n to return n reals (doubles)
    ! ====================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! getr0n ... input n double precision variables then return n edited values
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of double precison variables, n >= 1
    ! xvalue: intent (inout) the n double precision variables
    !   text: intent (in) the n associated text strings
    !
    ! character (len = 25) function form25 takes an intent (in) double precision
    ! value and returns the value written to a left justified string with up to
    ! 15 significant figures, but with trailing zeros removed.
    !
          program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          integer    i, icolor, n
          double precision xvalue(nmax)
          character  line*100, text(nmax)*100
          character  form25*25, x25*25
          external   getr0n, table1, form25
          intrinsic  dble
          n = nmax/4
          do i = 1, n
             xvalue(i) = dble(i)
             x25 = form25(xvalue(i))
             write (text(i),100) 'Before call to GETR0N', i, x25
          enddo
          call getr0n (n, xvalue, text)
          icolor = 15
          call table1 (icolor, 'open')
          icolor = 0
          do i = 1, n
             x25 = form25(xvalue(i))
             write (line,100) 'After call to GETR0N', i, x25
             call table1 (icolor, line)
          enddo
          call table1 (icolor, 'close')
      100 format (a,', x-value(',i2,') = ',a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem33: calling gets0n to return n text strings
    ! =================================================
    !
    ! subroutine
    ! ----------
    ! gets0n ... input n text strings then return n edited values
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of text strings >= 1
    ! svalue: intent (inout) the n text strings
    !   text: intent (in) the associated text descriptions
    !
          program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          integer    i, icolor, n
          character  svalue(nmax)*20
          character  line*100, text(nmax)*100
          external   gets0n, table1
          n = nmax/5
          do i = 1, n
             svalue(i) = 'unassigned'
             write (text(i),100) 'Before call to GETS0N', i, svalue(i)
          enddo
          call gets0n (n, svalue, text)
          icolor = 15
          call table1 (icolor, 'open')
          icolor = 0
          do i = 1, n
             write (line,100) 'After call to GETS0N', i, svalue(i)
             call table1 (icolor, line)
          enddo
          call table1 (icolor, 'close')
      100 format (a,', s-value',i3,' is',2x,a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem34: calling getl0n to return n logicals
    ! =============================================
    !
    ! subroutine
    ! ----------
    ! getlon ... input n logical variables then return n edited values
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of logicals >= 1
    !   text: intent (in) the n associated text strings
    ! lvalue: intent (inout) the n logical variables
    !
          program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          integer    i, icolor, n
          character  line*100, result*5, text(nmax)*80
          logical    lvalue(nmax)
          external   getl0n, table1
          n = nmax/2
          result = 'false'
          do i = 1, n
             lvalue(i) = .false.
             write (text(i),100) 'Before call to GETL0N', i, result
          enddo
          call getl0n (n, text, lvalue)
          icolor = 15
          call table1 (icolor, 'open')
          icolor = 0
          do i = 1, n
             if (lvalue(i)) then
                result = 'true'
                icolor = 4
             else
                icolor = 0
                result = 'false'
             endif
             write (line,100) 'After call to GETL0N', i, result
             call table1 (icolor, line)
          enddo
          call table1 (icolor, 'close')
      100 format (a,', logical number',i3,' is',2x,a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem35: calling get00n to return n variables
    ! ==============================================
    !
    ! subroutine
    ! ----------
    ! get00n ... input 3*n variables of any type then return numopt edited values
    !
    ! n variables of type integer, double precision, character and logical = integer
    ! are supplied, then a control is set up with numopt options starting
    ! at position (i.e. line) numsta in a character array. For each line in the
    ! options, numpos is set to indicate the variable to be edited. Only the
    ! variables of type indicated by numpos are edited. In other words, a
    ! total of 3*n variables are supplied of which only numopt are returned
    ! edited. Note the grave accents for tabbing in the header text.
    !
    ! arguments
    ! ---------
    !  icolor: intent (in) colour scheme       (may be disabled in some versions)
    !     ixl: intent (in) window x-coordinate (may be disabled in some versions)
    !     iyl: intent (in) window y-coordinate (may be disabled in some versions)
    !  kvalue: intent (inout) integers or 0/1 for logical variables
    !  lshade: intent (in) 1 to add a shadow   (may be disabled in some versions)
    !  numbld: intent (in) font and colour scheme
    !  numopt: intent (in) number of options >= 1
    !  numpos: intent (in) variable type as follows:
    !          numpos = 1: integers
    !          numpos = 2: doubles
    !          numpos = 3: strings
    !          numpos = 4: logicals (i.e. corresponding kvalue as 0/1)
    !  numsta: intent (in) start position for options
    !  xvalue: intent (inout) double precision variables
    !  svalue: intent (inout) character strings
    !    text: intent (in) description of functions and associated items
    ! tab_bot: intent (in) .false. for Standard Font, .true. for Courier New
    ! tab_mid: intent (in) should be set as a .false. tabbing parameter
    ! tab_top: intent (in) .true. to tab at grave accents in header
    !
     program    main
          implicit   none
          integer    nmax
          parameter (nmax = 20)
          integer    icolor, ixl, iyl, lshade, numopt, numsta, &
                     numtxt
          parameter (icolor = 7, ixl = 4, iyl = 4, lshade = 0)
          integer    kvalue(nmax), numbld(nmax), numpos(nmax)
          integer    i, j, k
          double precision xvalue(nmax)
          character (len = 40) svalue(nmax)
          character (len = 80) text(nmax)
          logical    tab_bot, tab_mid, tab_top
          parameter (tab_bot = .false., tab_mid = .false., tab_top = .true.)
          external   get00n, table1
          numtxt = 18
          do i = 1, numtxt
             numbld(i) = 0
          enddo
          numbld(1) = 4                                                      ! example of how to emphasize a title
          numbld(3) = 1                                                      ! example of how to colour a line
          numbld(numtxt) = 4
          numopt = 8
          numsta = 9
          do j = 1, numopt
             kvalue(j) = 0
             xvalue(j) = 0.0d+00
             svalue(j) = 'unassigned character string'
          enddo
    !
    ! edit integers 1 and 2, double precision variables 3 and 4, character
    ! strings 5 and 6, and logical variables 7 and 8, i.e. integers kvalue
    ! 7 and 8 returned in the usual way as as 0 = .false. or 1 = .true.
    !
          numpos(1) = 1
          numpos(2) = 1
          numpos(3) = 2
          numpos(4) = 2
          numpos(5) = 3
          numpos(6) = 3
          numpos(7) = 4
          numpos(8) = 4
          write (text,100)
          call get00n (icolor, ixl, iyl, kvalue, lshade, &
                       numbld, numopt, numpos, numsta, numtxt, &
                       xvalue, &
                       svalue, text, &
                       tab_bot, tab_mid, tab_top)
          text(1) = &
          'Results from editing the previous values'
          text(2) = &
          'INTEGERS       DOUBLES   CHARACTER STRINGS'// &
          '                        LOGICALS'
          do j = 1, numopt
             if (numpos(j).eq.1) then
                write (text(j + 2),200) kvalue(j)
             elseif (numpos(j).eq.2) then
                write (text(j + 2),300) xvalue(j)
             elseif (numpos(j).eq.3) then
                write (text(j + 2),400) svalue(j)
             elseif (numpos(j).eq.4) then
                if (kvalue(j).eq.0) then
                   write (text(j + 2),500) '.false.'
                else
                   write (text(j + 2),500) '.true.'
                endif
             endif
          enddo
          k = 15
          call table1 (k, 'OPEN')
          k = 0
          do i = 1, numopt + 2
             if (i.eq.1) then
                k = 1
             elseif (i.eq.2) then
                k = 4
             else
                k = 0
             endif
             call table1 (k, text(i))
          enddo
          call table1(k, 'CLOSE')

      100 format ('simdem35.for: demonstration of get00n' &
          / &
          /'numpos value`winio@ format (data type)' &
          /'numpos = 1  `%rd (integers)' &
          /'numpos = 2  `%rf (doubles)' &
          /'numpos = 3  `%rs (character strings)' &
          /'numpos = 4  `%rb (logicals (0/1))' &
          / &
          /'Select first integer' &
          /'Select second integer' &
          /'Select first double' &
          /'Select second double' &
          /'Select first string' &
          /'Select second string' &
          /'Select first logical' &
          /'Select second logical' &
          / &
          /'Edit the above values, character strings, and tick boxes.')
      200 format (i8,13x,'*',3x,'*',40x,'*')
      300 format (7x,'*',1p,e14.4,3x,'*',40x,'*')
      400 format (7x,'*',13x,'*',3x,a40,1x,'*')
      500 format (7x,'*',13x,'*',3x,'*',39x,a8)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem36: bbox01, vbox01, hbox01 ... display text/buttons
    ! =========================================================
    !
    ! subroutines
    ! -----------
    ! bbox01 ... normal buttons
    ! hbox01 ... horizontal buttons
    ! vbox01 ... vertical buttons
    ! Note: The hot key as set by numpos must be consistent across buttons
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) 0 = black, 1 = blue, 4 = red, etc. as for VGA
    ! ix, iy: intent (in) window position             (may be disabled)
    ! lshade: intent (in) 0 = no shading, 1 = shading (may be disabled))
    ! numbld: intent (in) 1, 2 = Normal; 3,4 = Italic; 4,5 = Bold; 6,7 = Bold Italic
    !                    odd number = normal, even number = highlighted
    ! numdec: intent (inout) decision (pre-set to default before entry)
    ! numopt: intent (in) number of options >= 1
    ! numpos: intent (in) position of hot key in button text
    ! nstart: intent (in) starting line for buttons in text array
    ! numtxt: intent (in) text dimension
    !   text: intent (in) text array
    !  fixed: intent (in) use Courier New if .true.
    !  flash: intent (in) not used
    !   high: intent (in) not used
    !
    !
          program    main
          implicit   none
          integer    i, icolor, ix, iy, lshade, numdec, numopt, numsta, &
                     numtxt
          parameter (lshade = 1)
          integer    numbld(20), numpos(20)
          character  line*80, text(20)*80
          character  srname(3)*6
          logical    fixed, flash, high
          parameter (fixed = .false., flash = .false., high = .true.)
          external   bbox01, vbox01, hbox01, putadv
          data       srname / 'bbox01', 'vbox01', 'hbox01' /
    !
    ! initialise
    !
          do i = 1, 20
             numbld(i) = 0
             numpos(i) = 1
          enddo
    !
    ! Typical text/button window
    !
          icolor = 9
          ix = 4
          iy = 4
          numbld(1) = 1
          numtxt = 13
          numsta = 8
          numopt = 3
          numdec = 1
          do i = 1, 3
             write (text,100) srname(i)
             if (i.eq.1) then
                call bbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             elseif (i.eq.2) then
                call vbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             elseif (i.eq.3) then
                call hbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             endif
             write (line,200) numdec
             call putadv (line)
          enddo
    !
    ! One liners
    !
          numtxt = 3
          numopt = 3
          numsta = 1
          numpos(3) = 8
          do i = 1, 3
             write (text,300)
             numdec = i
             ix = ix + 4
             iy = iy + 4
             if (i.eq.1) then
                icolor = 0
                call bbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             elseif (i.eq.2) then
                icolor = 1
                call vbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             elseif (i.eq.3) then
                icolor = 4
                call hbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                             numopt, numpos, numsta, numtxt, &
                             text, &
                             fixed, flash, high)
             endif
             write (line,200) numdec
             call putadv (line)
          enddo
      100 format ('Demonstrating subroutine ',a &
          /' ' &
          /'This subroutine creates a text window to' &
          /'display information and buttons.' &
          /'You can control the position and select a' &
          /'font for each line of text for headings.' &
          /'You can tab using the grave character.' &
          /'Advice' &
          /'Proceed' &
          /'Stop' &
          /'Note: `bbox01 is a normal button box' &
          /'      `vbox01 has vertical buttons' &
          /'      `hbox01 has horizontal buttons')
      200 format ('Button number',I2,' was selected')
      300 format ( &
           'Yesterday' &
          /'Today' &
          /'Tomorrow')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem37: rbox01 ... radio/tick box control
    ! ===========================================
    !
    ! subroutine
    ! ----------
    ! rbox01 ... ganged radio or check boxes
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) colour scheme               (may be disabled)
    ! ix, iy: intent (in) window position             (may be disabled)
    ! lshade: intent (in) 0 = no shading, 1 = shading (may be disabled))
    ! numbld: intent (in) Used inside the check box item list for ganging as follows ...
    !         0 implies independent
    !         positive multiples of 100 imply ganged group with one true.
    !         negative multiples of 100 imply ganged groups where all can be .false.
    !         Only one can be .true. in a ganged group
    !         Outside the check box item list, numbld determines the font type
    ! numdec: intent (in) sets the check box type as follows ...
    !         numdec = 0 radio box
    !         numdec = 1 tick box
    ! numopt: intent (in) number of options
    ! numpos: intent (inout) pseudo logical integer variables as follows:
    !         0 =.false.
    !         1 = .true.
    ! numsta: intent (in) starting line for check boxes
    ! numtxt: intent (in) text dimension
    !   text: intent (in) text array
    !  fixed: not used
    !  flash: not used
    !   high: not used
    !
    !
          program   main
          implicit  none
          integer   i, icolor, ix, iy, lshade, numdec, numopt, numsta, &
                    ntext
          integer   numbld(20), numpos(20)
          character text(20)*80
          logical   fixed, full, high
          external  rbox01
    !
    ! initialise
    !
          icolor = 7
          ix = 4
          iy = 4
          lshade = 0
          do i = 1, 20
             numbld(i) = 0
             numpos(i) = 0
          enddo
          fixed = .false.
          full = .false.
          high = .false.
    !
    ! create a full control
    !
          numdec = 0
          ntext = 18
          numopt = 7
          numsta = 9
    !
    ! set 3 initialised-type ganged groups and logical variables
    !
          numbld(1) = 1              ! emphasize the title
          numbld(numsta) = 100       ! initialised ganging group 1
          numbld(numsta + 1) = 100   ! initialised ganging group 1
          numbld(numsta + 2) = 200   ! initialised ganging group 2
          numbld(numsta + 3) = 200   ! initialised ganging group 2
          numbld(numsta + 4) = 300   ! initialised ganging group 3
          numbld(numsta + 5) = 300   ! initialised ganging group 3
          numpos(1) = 1
          numpos(2) = 0
          numpos(3) = 1
          numpos(4) = 0
          numpos(5) = 1
          numpos(6) = 0
          icolor = i
          write (text,100)
          call rbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                       numopt, numpos, numsta, ntext, text, &
                       fixed, full, high)
    !
    ! now a short control with an unitialised-type ganging group
    !
          numsta = 1
          ntext = 5
          numopt = 5
          numbld(1) = - 100 ! an unititialised ganging group
          numbld(2) = - 100 ! an unititialised ganging group
          numbld(3) = - 100 ! an uninitialised ganging group
          numbld(4) = 1
          numbld(5) = 1
          numpos(1) = 0
          numpos(2) = 0
          numpos(3) = 0
          numpos(4) = 0
          numpos(5) = 0
          numdec = 1
          write (text,200)
          ix = ix + 4
          iy = iy + 4
          call rbox01 (icolor, ix, iy, lshade, numbld, numdec, &
                       numopt, numpos, numsta, ntext, text, &
                       fixed, full, high)
      100 format ('Demonstrating subroutine rbox01' &
          /'...' &
          /'Logical variables are as an integer array numpos.' &
          /'Ganging is achieved by the integer array numbld.' &
          /'Check box type is set by scalar integer numdec.' &
          /'The user must interpret the selection by analysing' &
          /'the results returned in the integer array numpos.' &
          /'...' &
          /' First item' &
          /' Second item' &
          /' Third item' &
          /' Fourth item' &
          /' Fifth item' &
          /' Sixth item' &
          /' Seventh item' &
          /'...' &
          /'Extra text can be set at the bottom of' &
          /'the control if required.')
      200 format ( &
           ' One' &
          /' Two' &
          /' Three' &
          /' Four' &
          /' Five')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem38: table4 ... planting a function call in a window
    ! =========================================================
    !
    ! subroutine
    ! ----------
    ! table4 ... interactive calculations in real time
    !
    ! arguments
    ! ---------
    ! icolor: intent (in) colour scheme
    !      n: intent (inout) an integer array
    !      x: intent (inout) a double precison array
    !   line: intent (in) character string as follows:
    !                'OPEN'  opens table4  ... n and x are ignored
    !                'CLOSE' closes table4 ... n and x are ignored
    !                line = name of an allowed subroutine sets up that subroutine call
    !                so the next line is the declaration for the call when n and x
    !                are then used by the subroutine called.

    ! The idea is to specify a function that can be used interactively
    ! and the results of the calculation can be dispayed in real time.
    ! The variables n and x can be simple values for editing or they can be
    ! limits required for the editing process, depending on the active
    ! subroutine being called. The following scheme illustrates the use of
    ! arrays n and x in several situations.
    !
    ! Use N and X for input/output functions as follows:
    ! ==================================================
    ! GETI01: N(1) = IMID                                    ! get one arbitrary integer
    ! GETIL1: N(1) = IBOT, N(2) = IMID, N(3) = ITOP          ! get one limited integer
    ! GETIM1: N(1) = IBOT, N(2) = IMID, N(3) = ITOP          ! get one integer in a range
    ! GETRG3: X(1) = X, X(2) = Y, X(3) = Z Z >= Y >= X        ! get three values x =< y =< z
    ! GETRL1: X(1) = XBOT, X(2) = XMID, X(3) = XTOP          ! get one limited value
    ! GETRM1: X(1) = XBOT, X(2) = XMID, X(3) = XTOP          ! get one value in a range
    ! GETR01: X(1) = X                                       ! get one arbitrary value
    !
          program    main
          implicit   none
          integer    i
          integer    ibot, imid, itop, nmax
          parameter (ibot = 0, itop = 20, nmax = 5)
          integer   icolor, n(3)
          double precision x(3)
          character  line*80
          external   table4
    !
    ! initialise
    !
          icolor = 9
          imid = ibot
          x(1) = 0.0d+00
          x(2) = 0.0d+00
          x(3) = 0.0d+00
          n(1) = ibot
          n(2) = imid
          n(3) = itop
    !
    ! open the table
    !
          call table4 (icolor, n, x, 'OPEN')
          do i = 1, nmax
             call table4 (icolor, n, x, 'GETIM1')
             call table4 (icolor, n, x, &
                          'value required for calculation')
             imid = n(2)
             write (line,100) imid, imid**2
             call table4 (icolor, n, x, line)
          enddo
    !
    ! close the table
    !
          call table4 (icolor, n, x, 'CLOSE')
      100 format ('imid =',I2,', imid squared =',i4)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem39: waiter ...Wait ... calculations in progress
    ! =====================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! waiter ... inform users when a slow process is taking place
    !
    ! argument
    ! --------
    ! action: intent (in) switch the waiting message on or off
    !

          program    main
          implicit   none
          integer    i
          double precision delay, t1, t2
          character  line*80
          logical    on, off
          parameter (on = .true., off = .false.)
          external   clock1, waiter, putadv, sleep1
          intrinsic  dble
    !
    ! record the starting time
    !
          call clock1 (t1)
          do i = 1, 3
    !
    ! open the waiting message
    !
             call waiter (on)
    !
    ! cause a delay
    !
             delay = dble(i)
             call sleep1 (delay)
    !
    ! close down the waiting message
    !
             call waiter (off)
    !
    ! record the current time then show the result
    !
             call clock1 (t2)
             write (line,100) i, t2 - t1
             call putadv (line)
          enddo
      100 format ('Delay was',i3,' sec., CPU sec. so far =',1p,e10.3)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem40: config ... Configure the dlls
    ! =======================================
    !
    ! subroutine
    ! ----------
    ! config
    !
    ! arguments
    ! ---------
    ! mode: intent (in) controls action as follows:
    !       mode = 0: just return arguments silently
    !       mode = 1: set the arguments interactively
    ! nval: intent (inout) integer arguments
    ! cval: intent (inout) character arguments
    !
    ! Subroutine config is used to configure the Simfit dlls. This is very important
    ! if you want to control paths for printers, etc.  Details are taken from and
    ! written to the local Simfit configuration file w_simfit.cfg. Details are in the
    ! documents configure.txt and linux.txt.
    !
    ! Simdem users should press [Check] to correct the paths to auxiliaries then
    ! [Apply] to overwrite the installation defaults.
    !
          program    main
          implicit   none
          integer    mode, nval(12)
          character  cval(12)*1024
          external   config
          mode = 1
          call config (mode, nval, cval)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem41: use vec1in to get a vector from the user
    ! ==================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    !-----------
    ! vec1in ... read in a vector from console, clipboard or file
    !
    ! arguments
    ! ---------
    !  isend: intent (inout) as follows:
    !         isend = 1: user types in data from the console
    !         isend = 2: vector is read in from a file specified by the user
    !         isend = k: k < 1 or k > 2 then decide interactively how to input data
    !    nin: intent (in) input unit
    !   nmax: intent (in) maximum dimension
    !   npts: intent (inout) as follows:
    !         fixnpt = .false. number of points actually read in
    !         fixnpt = .true. number of points expected
    !      x: intent (out) the data vector
    !  fname: intent (inout) file name
    !  title: intent (inout) data title
    !  abort: intent (out) .false. if successful
    ! fixnpt: intent (in) forces the input dimension to be npts
    !  label: intent (in) request title from user if .true.
    !
          program    main
          implicit   none
          integer    nin, nmax
          parameter (nin = 3, nmax = 20)
          integer    i, isend, n, npts
          double precision x(nmax)
          character  filex*1024, text(25)*100, title*100, trim80*80
          logical    fixnpt, label
          parameter (fixnpt = .false., label = .true.)
          logical    abort
          external   vec1in, putadv, putmes, trim80
          external   closer
    !
    ! The user types in a vector from the console
    !
          call putadv ('Now create a short vector, say 1, 2, 3, 4, 5')
          call closer (nin)
          isend = 1
          call vec1in (isend, nin, nmax, npts, x, filex, title, &
                       abort, fixnpt, label)
          call closer (nin)
    !
    ! Echo the title and data
    !
          write (text(1),100)
          do i = 1, npts
             write (text(i + 1),200) x(i)
          enddo
          n = npts + 1
          call putmes (n, text)
          write (text,300) trim80(filex)
          n = 5
          call putmes(n, text)
    !
    ! The user reads the data back in from the temporary file
    !
          isend = 2
          call closer (nin)
          call vec1in (isend, nin, nmax, npts, x, filex, title, &
                       abort, fixnpt, label)
          call closer (nin)
          if (.not.abort) then
             write (text,400) trim80(filex)
             do i = 1, npts
                write (text(i + 2),200) x(i)
             enddo
             n = npts + 2
             call putmes (n, text)
          endif
      100 format ('You have just typed in these values:')
      200 format (1p,e11.3)
      300 format ( &
           'What to do next' &
          / &
          /'These values have been written to the temporary file' &
          /a &
          /'so now read the data back in from this file')
      400 format ('You have just read in these data from the file:'/a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem42: use mattin to get a matrix from the user
    ! ==================================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! mattin ... read in a matrix from console, clipboard or file
    !
    ! arguments
    ! ---------
    !  isend: intent (inout) as follows:
    !         isend = 1: user types in data from the console
    !         isend = 2: matrix is read in from a file specified by the user
    !         isend = k: k < 1 or k > 2 then decide interactively how to input data
    !  ncmax: intent (in) maximum column dimension
    !   ncol: intent (inout) actual number of columns
    !    nin: intent (in) input unit
    !  nrmax: intent (in) maximum row dimension
    !   nrow: intent (inout) actual number of rows
    !      a: intent (out) the matrix
    !      b: intent (inout) a workspace vector
    !  fname: intent (inout) file name
    !  title: intent (inout) data title
    !  abort: intent (out) .false. if successful
    ! fixcol: intent (in) forces the input column dimension to be ncol
    ! fixrow: intent (in) forces the input row dimension to be nrow
    !  label: intent (in) request title from user if .true.
    !
          program    main
          implicit   none
          integer    nin, ncmax, nrmax
          parameter (nin = 3, ncmax = 5, nrmax = 10)
          integer    i, isend, j, n, ncol, nrow
          double precision a(nrmax,ncmax), b(nrmax)
          character  filex*1024, text(25)*100, title*100, trim80*80
          logical    fixcol, fixrow, label
          parameter (fixcol = .false., fixrow = .false., label = .true.)
          logical    abort
          external   mattin, putadv, putmes, trim80
          external   closer
    !
    ! The user types in a matrix from the console
    !
          call putadv ('Now create a small matrix, say 4 by 3')
          call closer (nin)
          isend = 1
          call mattin (isend, ncmax, ncol, nin, nrmax, nrow, &
                       a, b, &
                       filex, title, &
                       abort, fixcol, fixrow, label)
          call closer (nin)
    !
    ! Echo the title and data
    !
          write (text(1),100)
          do i = 1, nrow
             write (text(i + 1),200) (a(i,j), j = 1, ncol)
          enddo
          n = nrow + 1
          call putmes (n, text)
          write (text,300) trim80(filex)
          n = 5
          call putmes(n, text)
    !
    ! The user reads the data back in from the temporary file
    !
          isend = 2
          if (.not.abort) then
             call closer (nin)
             call mattin (isend, ncmax, ncol, nin, nrmax, nrow, a, b, &
                          filex, title, &
                          abort, fixcol, fixrow, label)
             call closer (nin)
             if (.not.abort) then
                write (text,400) trim80(filex)
                do i = 1, nrow
                   write (text(i + 2),200) (a(i,j), j = 1, ncol)
                enddo
                n = nrow + 2
                call putmes (n, text)
             endif
          endif
      100 format ('You have just typed in these values:')
      200 format (1p,5e11.3)
      300 format ( &
           'What to do next' &
          / &
          /'These values have been written to the temporary file' &
          /a &
          /'so now read the data back in from this file')
      400 format ('You have just read in data from the file:'/a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem43: get a data matrix from the clipboard
    ! ==============================================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! mattin ... read in a matrix from console, clipboard or file
    ! attrib ... does a file exist and have the read_only attribute
    ! getnou ... get an unconnected unit
    !
    ! arguments
    ! ---------
    ! For subroutine mattin ...
    !
    !  isend: intent (inout) as follows:
    !         isend = 1: user types in data from the console
    !         isend = 2: matrix is read in from a file specified by the user
    !         isend = k: k < 1 or k > 2 then decide interactively how to input data
    !  ncmax: intent (in) maximum column dimension
    !   ncol: intent (inout) actual number of columns
    !    nin: intent (in) input unit
    !  nrmax: intent (in) maximum row dimension
    !   nrow: intent (inout) actual number of rows
    !      a: intent (out) the matrix
    !      b: intent (inout) a workspace vector
    !  fname: intent (inout) file name
    !  title: intent (inout) data title
    !  abort: intent (out) .false. if successful
    ! fixcol: intent (in) forces the input column dimension to be ncol
    ! fixrow: intent (in) forces the input row dimension to be nrow
    !  label: intent (in) request title from user if .true.
    !
    ! For subroutine attrib ...
    !     fname: intent (in) file name
    !     there: intent (out) does it exist
    ! read_only: intent (out) is it read_only
    !
    ! For subroutine getnou ...
    ! nout: intent (out) unconnected unit betwwen 10 and 100
    !
          program    main
          implicit   none
          integer    i, isend, j, n, nrow, ncol, nout
          integer    ncmax, nrmax
          parameter (ncmax = 5, nrmax = 25)
          integer    ios, nlines
          parameter (nlines = 1)
          integer    error_code
          double precision di, dj, a(nrmax,ncmax), b(nrmax)
          double precision ten
          parameter (ten = 10.0d+00)
          character  temp*1024, text(30)*100 , title*100
          character  line(1)*100
          logical    fixcol, fixrow, label
          parameter (fixcol = .false., fixrow = .false., label = .true.)
          logical    abort, askif, read_only, there
          external   getnou, mattin, putadv, putmes, revpro
          external   deleet, gettmp
          external   attrib, opener, closer, writer
          intrinsic  dble
    !
    ! Initialise the matrix a
    !
          nrow = 8
          ncol = 4
          do j = 1, ncol
             dj = dble(j)/ten
             do i = 1, nrow
                di = dble(i)
                a(i,j) = di + dj
             enddo
          enddo
    !
    ! Use getnou to get an unopened unit then connect a temporary file to it
    !
          call getnou (nout)
          call gettmp (error_code, temp)
          call opener (ios, nout, temp)
    !
    ! Write the data to the temporary file
    !
          do i = 1, nrow
             write (line(1),'(1p,4e11.3)') (a(i,j), j = 1, ncol)
             call writer (ios, nlines, nout, line)
          enddo
    !
    ! Recommend user to copy data to the clipboard
    !
    ! Note: If all the file is copied to the clipboard then the full file will be
    ! ===== read in for analysis, just like a simfit data file with header.
    !
          call putadv ( &
          'Select All ... for the next data table and copy to clipboard')
    !
    ! View the table so user can copy to clipboard
    !
          call revpro (nout)
    !
    ! Delete the temporary file
    !
          call closer (nout)
          askif = .false.
          call deleet (temp, askif, there)
    !
    ! The user can now read the data back in from the clipboard, just like a data file
    !
          call putadv ( &
          'Select the Paste button on the next file selection control')
          isend = 2
          call getnou (nout)
          call closer (nout)
          temp = ' '
          call mattin (isend, ncmax, ncol, nout, nrmax, nrow, a, b, &
                       temp, title, &
                       abort, fixcol, fixrow, label)
          call closer (nout)
          call attrib (temp, there, read_only)
          if (there) then
             open (unit = nout, file = temp)
             read (nout,'(a)') text(1)
             read (nout,*) nrow, ncol
             write (text(2),'(2i6)') nrow, ncol
             do i = 1, nrow
                read (nout,*) (a(i,j), j = 1, ncol)
                write (text(i + 2),'(4f6.1)') (a(i,j), j = 1, ncol)
             enddo
             n = nrow + 2
             close (nout)
             call putmes (n, text)
          endif
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem44: the Simfit file selection controls
    ! ============================================
    !
    ! subroutines
    ! -----------
    ! ofiles ... comprehensive Simfit file selection control
    ! getfil ... simple Windows file selection control
    ! fserch ... Simfit file searching procedure
    ! infofl ... identify the file located
    !
    ! arguments
    ! ---------
    ! For subroutine ofiles ...

    ! isend: integer,             intent (in) as follows:
    !        isend = 1: Save As (select a filename for saving data)
    !        isend = 2: Save    (provide a file name as argument o/w as 1)
    !        isend = 3: Open    (select an existing file for analysis)
    !        isend = 4: Open    (provide a file name as argument o/w as 3)
    !  nout: integer,             intent (in) unit for file connection
    ! fname: character (len = *), intent (inout) file name
    ! abort: logical,             intent (out) set to .false. if successful and
    !                             nout is then returned connected
    !
    ! For subroutine getfil ...
    !
    ! isend: integer,             intent (in) as follows:
    !        isend = 0 Save As ..
    !        isend = 1 Open ...
    !   ext: character (len = *), intent (in)    default file extension
    ! fname: character (len = *), intent (inout) filename
    ! type1: character (len = *), intent (in)    description of default file type
    ! abort: logical,             intent (out)   returned as .true. on error exit
    !
    !
    ! For subroutine fserch ...
    !
    !       dir: character (len = *), intent (in)  default starting directory
    !     fname: character (len = *), intent (in)  default starting file name
    ! full_path: character (len = *), intent (out) fully qualified drive\path\filename if there = .true.
    !     there: logical,             intent (out) indicates if file was located
    !
    ! For subroutine infofl ...
    !
    ! isend: integer,             intent (in) indicator (9 for file located)
    ! fname: character (len = *), intent (in) filename
    !
    ! Advice
    ! ------
    ! The advanced simfit file selection control is very versatile. You can type in
    ! file names or use the Windows Browse function. Alternatively you can
    ! toggle backwards or forwards through the lists of recently created/analysed
    ! files which allows keystroke editing or you can select directly from the
    ! file lists. You can also set filters interactively. There are many powerful
    ! built in functions, e.g. try opening an exe or dll file. You cannot set
    ! demonstration filenames from this example so the Demo button will not work.
    !
    ! The simple file control is just an interface to the usual Windows file
    ! selection control with no special Simfit features. It is initialised by
    ! the arguments ext and type1
    !
    ! Note: this example does not actually open files or connect units, so existing
    !       files in file store will not be altered.
    !
          program    main
          implicit   none
          integer    jsend, numopt, numtxt
          parameter (jsend = 9, numopt = 5, numtxt = 23)
          integer    isend, numdec, nout
          integer    numbld(numtxt)
          character (len = 1024) dir, fname, full_path
          character (len = 80  ) sname, text(numtxt), type1
          character (len = 10  ) ext
          logical    abort, repeet, there
          external   getnou, ofiles, putadv, putfat, fserch, patch2, &
                     closer, getfil, listbx, infofl
          data       numbld / numtxt*0 /
    !
    ! initialise
    !
          dir = 'C:'
          ext = 'txt'
          fname = 'file.tmp'
          sname = 'simdem.exe'
          type1 = 'Text files'
    !
    ! main loop
    !
          repeet = .true.
          numdec = numopt - 1
          do while (repeet)
             write (text,100)
             call listbx (numdec, numopt, &
                          text)
             if (numdec.eq.1) then
    !
    ! numdec = 1: Simfit file selection control
    !
             call putadv ('Specify a new/old filename for ... Save As')
    !
    ! Find an unconnected unit then attempt to Save As
    !
             call getnou (nout)
             isend = 1
             call closer (nout)
             call ofiles (isend, nout, fname, abort)
             call closer (nout)
             if (abort) then
                call putfat ('Failure to open a file')
             else
                call infofl (jsend, fname)
             endif
             isend = 3
             call putadv ('Specify an exisiting file for ... Open')
    !
    ! Find an unconnected unit then attempt to Open
    !
             call getnou (nout)
             isend = 3
             call closer (nout)
             call ofiles (isend, nout, fname, abort)
             call closer (nout)
             if (abort) then
                call putfat ('Failure to open a file')
             else
                call infofl (jsend, fname)
             endif
          elseif (numdec.eq.2) then
    !
    ! numdec = 2: Windows file selection control
    !

             call putadv ('Specify a new/old filename for ... Save As')
    !
    ! Attempt to Save As
    !
             isend = 0
             call getfil (isend, ext, fname, type1, abort)
             isend = 0
             if (abort) then
                call putfat ('Failure to open a file')
             else
                call infofl (jsend, fname)
             endif
             isend = 3
             call putadv ('Specify an exisiting file for ... Open')
    !
    ! Attempt to Open
    !
             isend = 1
             call getfil (isend, ext, fname, type1, abort)
             if (abort) then
                call putfat ('Failure to open a file')
             else
                call infofl (jsend, fname)
             endif
             elseif (numdec.eq.3) then
    !
    ! numdec = 3: file searching
    !
                call fserch (dir, sname, full_path, &
                             there)
             elseif (numdec.eq.4) then
    !
    ! numdec = 4: help
    !
                numbld(1) = 1
                numbld(11) = 1
                numbld(14) = 1
                write (text,200)
                call patch2 (numbld, numtxt, &
                             text)
             else
    !
    ! numdec = 5: finish
    !
                repeet = .false.
             endif
          enddo
      100 format ( &
           'Comprehensive file selection' &
          /'Simple file selection' &
          /'File searching procedure' &
          /'Help' &
          /'Quit ... Exit simdem44')
      200 format ( &
           'Comprehensive file selection' &
          /'This allows you to select files for opening or saving in very' &
          /'many ways. For example:' &
          /'1.`Typing in a file name' &
          /'2.`Selecting from previously opened files' &
          /'3.`Selecting from previously saved files' &
          /'4.`Pasting in data from the clipboard' &
          /'5.`Scrolling through a user supplied list' &
          /'6.`Browsing with the standard Windows control.' &
          / &
          /'Simple file selection' &
          /'This is just a shortcut to the previous item 6.' &
          / &
          /'File searching procedure' &
          /'You start by providing a starting folder and file name and then' &
          /'have numerous options. For instance:' &
          /'a)`Search using the folder and file name supplied' &
          /'b)`Specify a fully qualified drive\path\filename' &
          /'c)`Input a new starting folder' &
          /'d)`Input a new file name' &
          /'e)`Stop the search if it proves too long.' &
          /'If the search succeeds (i.e. there = .true.) then full_path' &
          /'will be the fully qualified drive\path\filename located')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem45: print a text file
    ! ===========================
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! fprint ... print a text file
    !
    ! arguments
    ! ---------
    !  lpti: intent (in) parallel port, usually l
    !        Note: In this version lpti is not referenced but should
    !              be set equal to 1 in order to print to all types
    !              of remote and local printers.
    ! fname: intent (in) file name of a text file
    !
    ! The subroutine fprint opens the Windows printer dialogue and allows
    ! users to copy selected text files to the printer. This version will
    ! not attempt to print Postscript or PDF files, or any special file
    ! types with standard extensions, like, .bat, .com, .exe, .dll, etc.
    !
    !
          program    main
          implicit   none
          integer    isend, nout
          integer    lpti
          parameter (lpti = 1)
          character  fname*1024, word60*60, trim60*60
          logical    abort, repeet
          external   getl01, getnou, ofiles, putadv, putfat, fprint
          external   closer, trim60
          fname = 'file.tmp'
          repeet = .true.
          do while (repeet)
             isend = 3
             call putadv ('Select an existing text file for printing')
    !
    ! Find an unconnected unit then attempt to Open
    !
             call getnou (nout)
             isend = 3
             call ofiles (isend, nout, fname, abort)
             call closer (nout)
             word60 = trim60(fname)
             if (abort) then
                call putfat ('Failure to open: '//word60)
             else
                call putadv ('Success opening: '//word60)
                call fprint (lpti, fname)
             endif
             call getl01 ('Another go', repeet)
          enddo
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem46: create n plots using smplot
    ! ========
    ! For details read simdem.chm or simdem.html
    !
    ! subroutine
    ! ----------
    ! smplot ... overlay n graphs
    !
    ! arguments
    ! ---------
    !      j: intent (in) colour
    !      l: intent (in) line type
    !      m: intent (in) symbol type
    !      n: intent (in) number of plots
    !  files: intent (in) file names
    ! titles: intent (in) plot title and legends
    !
          program    main
          implicit   none
          integer    n, nout, nplot
          parameter (n = 4, nout = 4, nplot = 10)
          integer    j(n), l(n), m(n)
          integer    i, k
          double precision one, x, y
          parameter (one = 1.0d+00)
          character  blank*1, files(n)*1024, titles(4)*40
          parameter (blank = ' ')
          external   deltmp, gettmp, smplot
          intrinsic  dble
    !
    ! initialise arguments for n data sets
    !
          do i = 1, n
    !
    ! j = colour (0 to 71, 0 to 15 are standard VGA colours, rest from palette)
    !
             j(i) = i
    !
    ! l = line type (1 to 4, as follows: 1 = solid,  2 = dashed,
    !                                    3 = dotted, 4 = dash-dotted)
    !
             l(i) = i
    !
    ! m = symbol type (0 to 19, as follows:  5 = circle,  8 = triangle,
    !                                       11 = square, 14 = diamond)
    !
             if (i.eq.1) then
                m(1) = 5
             else
                m(i) = m(i - 1) + 3
             endif
          enddo
    !
    ! define the plot title and legends
    !
          titles(1) = 'Demonstrating SMPLOT'
          titles(2) = 'X-values'
          titles(3) = 'Y-values'
          titles(4) = blank
    !
    ! create the temporary Simfit plotting files
    !
          do i = 1, n
             call gettmp (k, files(i))
             open (unit = nout, file = files(i))
             write (nout,'(a)') blank
             write (nout,'(2i4)') nplot, 2
             y = dble(i)
             do k = 1, nplot
                x = dble(k)
                y = y + one
                write (nout,'(1p,2e11.3)') x, y
             enddo
             close(unit = nout)
          enddo
    !
    ! plot the data
    !
          call smplot (j, l, m, n, files, titles)
    !
    ! delete the temporary files
    !
          call deltmp
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem47: create a pie chart using pcplot
    ! ========
    !
    ! subroutine
    ! ----------
    ! pcplot ... plot a vector as a pie chart
    !
    ! arguments
    ! ---------
    !  isend: intent (in) as follows:
    !         isend = 1: input a vector and use defaults
    !         isend = 2: input a vector and use the arguments supplied
    !  ifill: intent (in) fill style (if isend = 2)
    !   ihue: intent (in) colour (if isend = 2)
    !      n: intent (in) number of segments >= 2
    !      d: intent (in) displacements (if isend = 2)
    !      x: intent (in) values >= 0
    ! labels: intent (in) segment labels (if isend = 2)
    !  title: intent (in) pie chart title
    !
          program    main
          implicit   none
          integer    n
          parameter (n = 7)
          integer    isend, ifill(n), ihue(n)
          integer    i
          double precision d(n), x(n), zero, epsi, one
          parameter (zero = 0.0d+00, epsi = 0.075d+00, one = 1.0d+00)
          character  labels(n)*20, title*40
          external   pcplot
          intrinsic  dble
    !
    ! example 1: use the default simfit configuration options
    ! ==========
    !

    !
    ! initialise essential arguments for default pie chart
    !
          do i = 1, n
             x(i) = dble(i)
          enddo
          title = 'Demonstrating pcplot, isend = 1'
    !
    ! isend = 1: call pcplot in default mode
    !
          isend = 1
          call pcplot (isend, ifill, ihue, n, d, x, labels, title)

    !
    ! example 2: set all arguments individually
    ! ==========
    !

    !
    ! initialise arguments for n segments for advanced pie chart
    !
          do i = 1, n
    !
    ! ifill = fill style (0 to 10)
    !
             ifill(i) = i
    !
    ! ihue = colour (0 to 71, 0 to 15 are standard VGA colours, rest from palette)
    !
             ihue(i) = i
    !
    ! d = segment displacement (0 to 1)
    !
             if (i.eq.1) then
               d(i) = zero
             else
               d(i) = d(i - 1) + epsi
             endif
    !
    ! x = segment values > 0
    !
             x(i) = one
    !
    ! labels = segment labels
    !
             write (labels(i),'(a,i3)') 'Segment', i
          enddo
          title = 'Demonstrating pcplot, isend = 2'
    !
    ! isend = 2: call pcplot with the values supplied
    !
          isend = 2
          call pcplot (isend, ifill, ihue, n, d, x, labels, title)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem48: create a bar chart using bcplot
    ! ========
    !
    ! subroutine
    ! ----------
    ! bcplot ... plot a matrix as a bar chart
    !
    ! arguments
    ! ---------
    !  isend: intent (in) as follows:
    !         isend = 1: use default labels
    !         isend = 2: use labels supplied
    !   ncol: intent (in) number of columns to plot
    !  nrmax: intent (in) leading dimension of x
    !   nrow: intent (in) number of rows to plot
    !      x: intent (in) data
    ! labels: intent (in) group labels (if isend = 2)
    ! titles: intent (in) title and legends
    !
          program    main
          implicit   none
          integer    ncol, nrow, nrmax
          parameter (ncol = 3, nrow = 5, nrmax = 10)
          integer    isend
          integer    i, j
          double precision x(nrmax,ncol)
          character  blank*1, labels(nrow)*20, titles(4)*40
          parameter (blank = ' ')
          external   bcplot
          intrinsic  dble
    !
    ! example 1: use the default simfit configuration options and labels
    ! ==========
    !

    !
    ! initialise essential arguments for default bar chart
    !
          do j = 1, ncol
             do i = 1, nrow
                x(i,j) = dble(i + j)
             enddo
          enddo
          titles(1) = 'Demonstrating bcplot, isend = 1'
          titles(2) = 'Rows'
          titles(3) = 'Columns'
          titles(4) = blank
    !
    ! isend = 1: call bcplot in default mode
    !
          isend = 1
          call bcplot (isend, ncol, nrmax, nrow, x, labels, titles)

    !
    ! example 2: set labels individually
    ! ==========
    !

          do i = 1, nrow
    !
    ! labels = bar chart labels
    !
             write (labels(i),'(a,i3)') 'Row', i
          enddo
          titles(1) = 'Demonstrating bcplot, isend = 2'
    !
    ! isend = 2: call bcplot with the labels supplied
    !
          isend = 2
          call bcplot (isend, ncol, nrmax, nrow, x, labels, titles)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem49: create a box and whisker plot using bwplot
    ! ========
    !
    ! subroutine
    ! ----------
    ! bwplot ... plot a vector as a box and whisker plot
    !
    ! arguments
    ! ---------
    !  isend: intent (in) as follows:
    !         isend = 1: use default labels
    !         isend = 2: use labels supplied
    !   nobs: intent (in) number of observations per set
    !   nset: intent (in) number of sets of observations
    !   nvec: intent (in) total number of observations
    !    vec: intent (in) the observations as ordered by nobs and nset
    ! labels: intent (in) labels (if isend = 2)
    ! titles: intent (in) title and legends
    !
          program    main
          implicit   none
          integer    nmax, nset
          parameter (nmax = 500, nset = 5)
          integer    isend, nobs(nset), nvec
          integer    i, j, k
          double precision vec(nmax)
          character  blank*1, labels(nset)*20, titles(4)*40
          parameter (blank = ' ')
          external   bwplot
          intrinsic  dble
    !
    ! example 1: use default labels
    ! ==========
    !

    !
    ! initialise essential arguments for box and whisker plot
    ! nset = number of sets, i.e. groups
    ! nobs = number of observations per set, nobs(i) >= 4
    ! nvec = total number of observations as ordered by nobs
    !
          nvec = 0
          do i = 1, nset
             j = 0
             do k = 1, i + 4
                j = j + 1
                nvec = nvec + 1
                vec(nvec) = dble(k)
             enddo
             nobs(i) = j
             labels(i) = blank
          enddo
          titles(1) = 'Demonstrating bwplot, isend = 1'
          titles(2) = 'Groups'
          titles(3) = 'Values'
          titles(4) = blank
    !
    ! isend = 1: call bwplot in default mode
    !
          isend = 1
          call bwplot (isend, nobs, nset, nvec, vec, labels, titles)

    !
    ! example 2: set labels individually
    ! ==========
    !

          do i = 1, nset
    !
    ! labels = box and whisker labels
    !
             write (labels(i),'(a,i3)') 'Group', i
          enddo
          titles(1) = 'Demonstrating bwplot, isend = 2'
    !
    ! isend = 2: call bwplot with the labels supplied
    !
          isend = 2
          call bwplot (isend, nobs, nset, nvec, vec, labels, titles)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem50: create a bar chart with error bars using ebplot
    ! =========
    !
    ! subroutine
    ! ----------
    ! ebplot ... plot a vector as a bar chart with error bars
    !
    ! arguments
    ! ---------
    !  isend: intent (in) as follows:
    !         isend = 1: use default labels
    !         isend = 2: use labels supplied
    !   nobs: intent (in) number of observations per set
    !   nset: intent (in) number of sets of observations
    !   nvec: intent (in) total number of observations
    !    vec: intent (in) the observations as ordered by nobs and nset
    ! labels: intent (in) labels (if isend = 2)
    ! titles: intent (in) title and legends
    !
          program    main
          implicit   none
          integer    nmax, nset
          parameter (nmax = 500, nset = 5)
          integer    isend, nobs(nset), nvec
          integer    i, j, k
          double precision vec(nmax)
          character  blank*1, labels(nset)*20, titles(4)*40
          parameter (blank = ' ')
          external   ebplot
          intrinsic  dble

    !
    ! initialise essential arguments for bar chart with error bars
    ! nset = number of sets, i.e. groups
    ! nobs = number of observations per set, nobs(i) >= 2
    ! nvec = total number of observations as ordered by nobs
    !
          nvec = 0
          do i = 1, nset
             j = 0
             do k = 1, i + 4
                j = j + 1
                nvec = nvec + 1
                vec(nvec) = dble(k)
             enddo
             nobs(i) = j
             write (labels(i),'(a,i3)') 'Group', i
          enddo
          titles(1) = 'ebplot, isend = 2'
          titles(2) = 'Groups'
          titles(3) = 'Values'
          titles(4) = blank
    !
    ! isend = 2: call ebplot with the labels supplied
    !            use isend = 1 if there are no labels
    !
          isend = 2
          call ebplot (isend, nobs, nset, nvec, vec, labels, titles)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem51: get the current DLL versions
    ! ========
    !
    ! Important note added at 11/12/2012
    ! The call to scclib returns isalf from salflibc.dll in the 32-bit version
    ! but returns -isalf from clearwin64.dll in the 64-bit version. So a call
    ! to scclib identifies if the 32-bit or 64-bit version is in use.
    ! Important note added at 23/11/2017
    ! simdem32.dll (or simdem64.dll) distributed with the FTN95 version 7.4.0 onwards are noted

    ! subroutines
    ! -----------
    ! scclib ... signature for salflibc.dll   (salflibc64.dll   in 64-bit version)
    ! dllmen ... signature for w_menus.dll    (x64_menus.dll    in 64-bit version)
    ! dllgra ... signature for w_graphics.dll (x64_graphics.dll in 64-bit version)
    ! dllclr ... signature for w_clearwin.dll (x64_clearwin.dll in 64-bit version)
    !
    ! In the dedicated FTN95 version from version 7.4.0 onwards the three simdem
    ! run-time dlls are replaced by a single dll, i.e., simdem32.dll or simdem64.dll
    !
    ! arguments
    ! ---------
    ! isalf: intent (out) version identifier
    !
    ! For the Simfit DLLs ...
    ! xver: intent (out) version
    ! yver: intent (out) release number
    ! dver: intent (out) description
    !
          program    main
          implicit   none
          integer    i, isalf, j, n
          double precision xver_c, xver_m, xver_g, yver_c, yver_m, yver_g
          character (len = 1  ) blank
          parameter (blank = ' ')
          character (len = 7  ) word7(3)
          character (len = 12 ) dll32, dll64, form12, word12
          parameter (dll32 = 'simdem32.dll', dll64 = 'simdem64.dll')
          character (len = 15 ) form15, word15
          character (len = 30 ) dver_c, dver_m, dver_g
          character (len = 100) text(10)
          character (len = 256) fname
          logical    x86_version, xtra
          external   dllclr, dllmen, dllgra, scclib, table1, form12
          external   dllnam, lcase1
          intrinsic  adjustr, nint, index
    !
    ! call in the salflibc.dll/clearwin64.dll identifier isalf
    !
          call scclib (isalf)
          if (isalf.gt.0) then
             x86_version = .true.
          else
             x86_version = .false.
          endif
    !
    ! call in the simfit DLL details as follows:
    ! xver = version number
    ! yver = release number
    ! dver = description
    !
          call dllclr (xver_c, yver_c, dver_c)
          word15 = form15(xver_c)
          word7(1) = word15(1:7)
          call dllnam (fname)
          call lcase1 (fname)
          xtra = .false.
          if (index(fname,dll32).gt.0) then
             xtra = .true.
             fname = dll32
          elseif (index(fname,dll64).gt.0) then
             xtra = .true.
             fname = dll64
          endif

          call dllmen (xver_m, yver_m, dver_m)
          word15 = form15(xver_m)
          word7(2) = word15(1:7)

          call dllgra (xver_g, yver_g, dver_g)
          word15 = form15(xver_g)
          word7(3) = word15(1:7)

          if (x86_version) then
             word12 = form12(isalf)
             write (text,100) word12, &
                              adjustr(word7(1)), nint(yver_m), dver_m, &
                              adjustr(word7(2)), nint(yver_g), dver_g, &
                              adjustr(word7(3)), nint(yver_c), dver_c
          else
             isalf = -isalf
             word12 = form12(isalf)
             write (text,200) word12, &
                              adjustr(word7(1)), nint(yver_m), dver_m, &
                              adjustr(word7(2)), nint(yver_g), dver_g, &
                              adjustr(word7(3)), nint(yver_c), dver_c

          endif
          j = 15
          call table1 (j, 'OPEN')
          n = 6
          if (xtra) then
             n = n + 1
             text(n) = blank
             n = n + 1
             text(n) = ' Note: For FTN95 versions from 7.4.0 on the three'
             n = n + 1
             text(n) = ' dlls above have been combined into the single dll'
             n = n + 1
             text(n) = blank//fname(1:12)
          endif
          do i = 1, n
             if (i.eq.1 .or. i.eq.3 .or. i.eq.10) then
                j = 4
             else
                j = 0
             endif
             call table1 (j, text(i))
          enddo
          call table1 (J, 'CLOSE')
      100 format ( &
           'Current dynamic link libraries' &
          /'  salflibc.dll: ',a &
          /'               Version  Release  Description' &
          /'   w_menus.dll:',a7,i9,2x,a &
          /'w_graphics.dll:',a7,i9,2x,a &
          /'w_clearwin.dll:',a7,i9,2x,a)
      200 format ( &
           'Current dynamic link libraries' &
          /'  salflibc64.dll: ',a &
          /'                 Version  Release  Description' &
          /'   x64_menus.dll:',a7,i9,2x,a &
          /'x64_graphics.dll:',a7,i9,2x,a &
          /'x64_clearwin.dll:',a7,i9,2x,a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem52: retrieve a colour number for plotting
    ! ========
    !
    ! subroutine
    ! ----------
    ! palett ... edit or retrieve the Simfit colours
    !
    ! arguments
    ! ---------
    ! kolor: intent (inout) colour (sets the default on entry)
    !  mode: intent (in) as follows:
    !        mode = 0: just retrieve a colour
    !        otherwise depends on the current version
    !
          program main
          implicit   none
          integer    after, before, mode
          parameter (mode = 0)
          character  line*100
          external   palett, putadv
          before = 0
          after = before
          call palett (after, mode)
          write (line,100) before, after
          call putadv (line)
      100 format ('Colour on entry =',i3,', colour on exit =',i3)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem53: 2D plot with labels
    ! =========
    !
    ! subroutine
    ! ----------
    ! lbplot ... plot symbols with labels
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of coordinate pairs
    !      x: intent (in) x-coordinates
    !      y: intent (in) y-coordinates
    ! ptitle: intent (in) plot title
    !  wordx: intent (in) labels
    ! xtitle: intent (in) x-legend
    ! ytitle: intent (in) y-legend
    !
          program main
          implicit none
          integer  n
          parameter (n = 5)
          double precision x(n), y(n)
          character ptitle*19, wordx(n)*12, xtitle*8, ytitle*8
          external lbplot
          x(1) = 1.0d+00
          x(2) = x(1)
          x(3) = -1.0d+00
          x(4) = x(3)
          x(5) = 0.0d+00
          y(1) = 1.0d+00
          y(2) = -1.0d+00
          y(3) = y(2)
          y(4) = y(1)
          y(5) = 0.0d+00
          ptitle = '2D plot with labels'
          xtitle = 'X-values'
          ytitle = 'Y-values'
          write (wordx,100)
          call lbplot (n, &
                       x, y, &
                       ptitle, wordx, xtitle, ytitle)
      100 format ( &
           'Apples' &
          /'Pears' &
          /'Plums' &
          /'Oranges' &
          /'Strawberries')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem54: plot sample cumulative distribution and best-fit cdf
    ! ========
    !
    ! subroutine
    ! ----------
    ! cdplot ... display best-fit cdf on sample cumulative distribution
    !
    ! arguments
    ! ---------
    !   npdf: intent (in) number of pdf(t) values (>= 10 ?)
    !  nrmax: intent (in) dimension of workspace (>= 2*nsamp)
    !  nsamp: intent (in) size of sample (>= 20 ?)
    !    pdf: intent (in) best-fit (or exact) pdf(t) as calculated elsewhere
    ! sample: intent (in) sample (must be in nondecreasing order)
    !      t: intent (in) argument for pdf (any spacing as required)
    !  x,y,z: intent (inout) workspaces for creating step curve
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x-legend
    ! ytitle: intent (in) y-legend
    !
    ! Advice
    ! ------
    ! There should be (say) >= 20 points to estimate a best-fit pdf
    ! in a meaningful way. Then the subroutine cdplot integrates the
    ! best-fit pdf by the trapezoidal method to show a smooth cdf curve,
    ! so there should be (say) >= 10 best-fit pdf points.
    !

    !
          program main
          implicit none
          integer npdf, nrmax, nsamp
          parameter (npdf = 10, nsamp = 20, nrmax = 20)
          double precision pdf(npdf), sample(nsamp), t(npdf), &
                           x(2*nrmax), y(2*nrmax), z(2*nrmax)
          character ptitle*23, xtitle*6, ytitle*21
          external  cdplot
          data sample / &
          -0.1251D+01, -0.8949D+00, -0.8082D+00, -0.7000D+00, -0.6648D+00, &
          -0.3640D+00, -0.3588D+00, -0.3125D+00, -0.3073D+00, -0.2855D+00, &
          -0.8175D-01,  0.1030D+00,  0.1130D+00,  0.1229D+00,  0.2740D+00, &
           0.4958D+00,  0.5124D+00,  0.8592D+00,  0.1301D+01,  0.1565D+01 /
          data t / &
          -0.1251D+01, -0.9381D+00, -0.6252D+00, -0.3124D+00,  0.5063D-03, &
           0.3134D+00,  0.6262D+00,  0.9391D+00,  0.1252D+01,  0.1565D+01 /
          data pdf / &
          0.1343D+00,  0.2528D+00,  0.3948D+00,  0.5116D+00,  0.5501D+00, &
          0.4909D+00,  0.3635D+00,  0.2233D+00,  0.1139D+00,  0.4819D-01 /
          ptitle = 'Sample and best-fit cdf'
          xtitle = 'Values'
          ytitle = 'CDF and step function'
          call cdplot (npdf, nrmax, nsamp, &
                       pdf, sample, t, x, y, z, &
                       ptitle, xtitle, ytitle)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem55: plot sample histogram and best-fit pdf
    ! ========
    !
    ! subroutine
    ! ----------
    ! pdplot ... display best fit pdf on sample histogram
    !
    ! arguments
    ! ---------
    !  nbins: intent (in) number of histogram bins (say nsamp/nbins >= 5)
    !   npdf: intent (in) number of pdf(t) values (>= 10 ?)
    !  nrmax: intent (in) dimension of workspace (>= 4*nbins)
    !  nsamp: intent (in) size of sample (>= 20 ?)
    !    pdf: intent (in) best-fit (or exact) pdf(t) as calculated elsewhere
    ! sample: intent (in) sample (must be in nondecreasing order)
    !      t: intent (in) argument for pdf (any spacing as required)
    !    x,y: intent (inout) workspaces for creating histogram
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x-legend
    ! ytitle: intent (in) y-legend
    !
    ! Advice
    ! ------
    ! There should be (say) >= 40 points to plot a histogram in
    ! a meaningful way. Then the subroutine pdplot creates the
    ! histogram and plots the best-fit pdf as a smooth curve,
    ! so there should be (say) >= 10 best-fit pdf points.
    !
          program main
          implicit none
          integer nbins, npdf, nrmax, nsamp
          parameter (nbins = 5, npdf = 20, nsamp = 40, nrmax = 4*nsamp)
          double precision pdf(npdf), sample(nsamp), t(npdf), &
                           x(nrmax), y(nrmax)
          character ptitle*26, xtitle*6, ytitle*12
          external  pdplot
          data sample / &
          -0.2117D+01, -0.1583D+01, -0.1275D+01, -0.1202D+01, -0.1018D+01, &
          -0.8655D+00, -0.8011D+00, -0.6995D+00, -0.6744D+00, -0.5887D+00, &
          -0.5654D+00, -0.4868D+00, -0.4810D+00, -0.4470D+00, -0.4403D+00, &
          -0.3938D+00, -0.3613D+00, -0.2735D+00, -0.2422D+00, -0.2067D+00, &
          -0.1680D+00, -0.1423D+00, -0.1130D+00, -0.1040D+00, -0.7391D-01, &
          -0.6547D-02,  0.1313D+00,  0.1880D+00,  0.2213D+00,  0.2657D+00, &
           0.2844D+00,  0.5517D+00,  0.5544D+00,  0.5581D+00,  0.6531D+00, &
           0.7271D+00,  0.7323D+00,  0.1018D+01,  0.1561D+01,  0.1761D+01 /
          data t / &
          -0.2117D+01, -0.1913D+01, -0.1709D+01, -0.1505D+01, -0.1301D+01, &
          -0.1097D+01, -0.8924D+00, -0.6883D+00, -0.4841D+00, -0.2800D+00, &
          -0.7582D-01,  0.1283D+00,  0.3325D+00,  0.5366D+00,  0.7407D+00, &
           0.9449D+00,  0.1149D+01,  0.1353D+01,  0.1557D+01,  0.1761D+01 /
          data pdf / &
          0.2165D-01,  0.4036D-01,  0.7028D-01,  0.1143D+00,  0.1736D+00, &
          0.2463D+00,  0.3263D+00,  0.4038D+00,  0.4668D+00,  0.5040D+00, &
          0.5082D+00,  0.4786D+00,  0.4210D+00,  0.3459D+00,  0.2654D+00, &
          0.1902D+00,  0.1273D+00,  0.7961D-01,  0.4649D-01,  0.2536D-01 /
          ptitle = 'Histogram and best-fit pdf'
          xtitle = 'Values'
          ytitle = 'Bins and pdf'
          call pdplot (nbins, npdf, nrmax, nsamp, &
                       pdf, sample, t, x, y, &
                       ptitle, xtitle, ytitle)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem56: create a histogram with error bars
    ! ========
    !
    ! subroutine
    ! ----------
    ! hist01 ... display a histogram with error bars
    !
    ! arguments
    ! ---------
    !      n: intent (in) number of histogram centres (n >= 1)
    !     nh: intent (in) maximum number of coordinates for plotting (nh >= 10*n + 1)
    ! number: intent (out) cells plotted (returned > 0 for stats if successful)
    !      s: intent (in) error bar heights (e >= 0, e.g. t_{nu}*std.err.)
    !      x: intent (in) equally spaced histogram centres in increasing order
    !     xh: intent (inout) workspace
    !      y: intent (in) histogram cell heights (y >= 0, e.g. number per cell)
    !     yh: intent (inout) workspace
    !  gsave: intent (in) unused logical (but set gsave = .true.)
    !
          program main
          implicit none
          integer  n, nh, number
          parameter (n = 5, nh = 10*n + 1)
          double precision s(n), x(n), xh(nh), y(n), yh(nh)
          logical gsave
          parameter (gsave = .true.)
          external hist01
          data x / 1.0d+00, 2.0d+00, 3.0d+00, 4.0d+00, 5.0d+00 /
          data y / 1.0d+00, 2.0d+00, 3.0d+00, 2.0d+00, 1.0d+00 /
          data s / 0.1d+00, 0.1d+00, 0.2d+00, 0.1d+00, 0.1d+00 /
          call hist01 (n, nh, number, &
                       s, x, xh, y, yh, &
                       gsave)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem57: plot a dendrogram
    ! ========
    !
    ! subroutine
    ! ----------
    ! dgplot ... display a dendrogram with a threshold
    !
    ! arguments
    ! ---------
    ! Parameters are as returned from G03ECF except that
    ! thresh = threshold to plot horizontal line as used
    ! for selecting subgroups in the simfit package
    !    ilc: intent (in) as G03ECF
    !    iuc: intent (in) as G03ECF
    !   iord: intent (in) as G03ECF
    !      n: intent (in) number of observations
    !   nmax: intent (in) dimension >= n
    !     cd: intent (in) as G03ECF
    ! thresh: intent (in) dendrogram threshold for selecting subgroups
    !      x: intent (inout) workspace
    ! ptitle: intent (in) plot title
    !  wordx: intent (in) labels
    ! xtitle: intent (in) x-legend
    ! ytitle: intent (in) y-legend
    !
    !
          program    main
          implicit   none
          integer    n, nmax
          parameter (n = 5, nmax = 5)
          integer    ilc(n - 1), iuc(n - 1), iord(n)
          double precision cd(n - 1), thresh, x(nmax,3)
          character  ptitle*10, wordx(n)*1, xtitle*1, ytitle*1
          parameter (ptitle = 'Dendrogram', xtitle = 'X', ytitle = 'Y')
          external   dgplot
          data ilc   / 2, 1, 1, 1 /
          data iuc   / 4, 3, 5, 2 /
          data iord  / 1, 3, 5, 2, 4 /
          data cd    / 1.0d+00, 2.0d+00, 6.5d+00, 14.13d+00 /
          data wordx / 'A', 'B', 'C', 'D', 'E' /
          thresh = 5.0d+00
          call dgplot (ilc, iuc, iord, n, nmax, &
                       cd, thresh, x, &
                       ptitle, wordx, xtitle, ytitle)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem58: scrolling check boxes
    ! ========
    !
    ! subroutine
    ! ----------
    ! chkbox ... toggle tick boxes
    ! rboxes ... select from ganged tick boxes
    !
    ! arguments to chkbox
    ! -------------------
    !     n: intent (in)    number of items
    !  text: intent (in)    labels for items
    ! title: intent (in)    header information
    ! useit: intent (inout) .true./.false.
    !
    ! arguments to rboxes
    ! -------------------
    !      irb: intent (inout) number of check box selected at each row
    !                          Note that 1 =< irb(i) =< n_across
    ! n_across: intent (in)    number of ganged check boxes across
    !   n_down: intent (in)    number of rows of ganged check boxes
    ! n_header: intent (in)    number of lines of header information
    !   header: intent (in)    lines of header information
    !     text: intent (in)    captions for rows of check boxes (width =< 20)
    !
          program    main
          implicit   none
          integer    i, m, n, n_across, n_down, n_header
          parameter (n = 50, n_across = 10, n_down = 30, n_header = 2)
          integer    irb(n_down), irb_sav(n_down)
          character  cipher*4, header(n_header)*80, line*100, text(n)*20, &
                     title*30
          parameter (title = 'Tick to select items required')
          logical    useit(n)
          external   chkbox, putadv, rboxes, table1
    !
    ! Code to demonstrate subroutine chkbox
    !
          do i = 1, n
             write (text(i),100) i
             useit(i) = .false.
          enddo
          call chkbox (n, text, title, useit)
          m = 0
          do i = 1, n
             if (useit(i)) m = m + 1
          enddo
          write (line,200) m
          call putadv (line)
    !
    ! Code to demonstrate subroutine rboxes
    !
          write (header,300)
          do i = 1, n_down
             irb(i) = 1
             irb_sav(i) = irb(i)
             write (text(i),400) i
          enddo
          call rboxes (irb, n_across, n_down, n_header, &
                       header, text)
          m = 15
          call table1 (m, 'OPEN')
          write (line,500)
          m = 4
          call table1 (m, line)
          m = 0
          do i = 1, n_down
             if (irb(i).eq.irb_sav(i)) then
                cipher = '    '
             else
                cipher = '****'
             endif
             write (line,600) i, irb_sav(i), irb(i), cipher
             call table1 (m, line)
          enddo
          call table1 (m, 'CLOSE')
      100 format (' .... Item number',i3)
      200 format ('Number of items selected =',i3)
      300 format ( &
           'Demonstrating the Simfit multi check box routine' &
          /'Note that the check boxes are ganged across rows')
      400 format ('Check box row',i3)
      500 format ('Row  Before   After')
      600 format (i3,2i8,2x,a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem59: multiple file selection
    ! ========
    !
    ! subroutine
    ! ----------
    ! mfiles ... select a set of files
    !
    ! arguments
    ! ---------
    ! nfiles: intent (out) number of files selected (=< nmax)
    !   nmax: intent (in) maximum number of files to be selected (nmax >= 1)
    !  files: intent (out) names of the files selected (just names)
    !
          program    main
          implicit   none
          integer    i, j, nfiles, nmax
          parameter (nmax = 10)
          character  files(nmax)*1024
          character  word60*60, trim60*60
          external   mfiles, trim60, table1, putadv
          call mfiles (nfiles, nmax, &
                       files)
          if (nfiles.ge.1) then
             j = 15
             call table1 (j, 'OPEN')
             j = 4
             write (word60,100) nfiles
             call table1 (j, word60)
             j = 0
             do i = 1, nfiles
                word60 = trim60(files(i))
                call table1 (j, word60)
             enddo
             call table1 (J, 'CLOSE')
          else
             write (word60,200)
             call putadv (word60)
          endif
      100 format ('Number of files selected =',i3)
      200 format ('No files were selected')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem60: comprehensive list box
    ! ========
    !
    ! subroutine
    ! ----------
    ! lstbox ... list box with header and trailer
    !
    ! arguments
    ! ---------
    ! numbld: intent (in) 0 for black, 1 for blue, or 4 for bold
    ! numdec: intent (inout) as follows:
    !         on entry sets the pre-selected item
    !         on exit returns the item selected or
    !         the default Cancel or Quit item if
    !         the closure cross is used.
    ! numopt: intent (in) number of options available
    ! numsta: intent (in) number of the starting line for menu items
    ! numtxt: intent (in) total number of text lines
    !   text: intent (in) header, menu, then trailer
    !
    ! Advice
    ! ------
    ! 1) The subroutine will only work if all arguments
    !    are initalised correctly.
    ! 2) Grave accents (like `) create tabbing when in the
    !    header or trailer text lines.
    ! 3) Grave accents (like `) in the menu items invoke a
    !    different tabbing procedure which may suppress
    !    colours set by numbld.
    ! 4) If a menu item contains words like Cancel, Exit,
    !    or Quit, a default closure cross option is made
    !    available which will select the option containing
    !    the words Cancel, Exit, or Quit. For instance,
    !    note the differences in the loop when i = 2.
    !
          program    main
          implicit   none
          integer    i, numdec, numopt, numsta, numtxt
          parameter (numopt = 4, numsta = 5, numtxt = 11)
          integer    numbld(numtxt)
          character  line*100, text(numtxt)*100
          external   lstbox, putadv
          data       numbld / numtxt*0 /
          write (text, 100) numsta, numopt, numtxt
          numbld(1) = 4
          numbld(numtxt) = 1
          do i = 1, 2
             if (i.eq.2) text(numopt + numsta - 1) = 'Anything`else'
             numdec = 1
             call lstbox (numbld, numdec, numopt, numsta, numtxt, &
                          text)
             write (line,200) numdec
             call putadv (line)
          enddo
      100 format ( &
           'Example of a list box' &
          /'No. of start line',i3 &
          /'No. of options',i3 &
          /'No. text lines',i3 &
          /'Apples' &
          /'Oranges' &
          /'Plums' &
          /'Cancel ... No choice' &
          /'Extra text appears here' &
          /'Grave accents`used for tabbing' &
          /'numbld       `used for colours')
      200 format ('Option',i3,1x,'was selected')
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem61: normal and half normal plots
    ! =========
    !
    ! subroutine
    ! ----------
    ! hnplot ... plot a vector as half or normal scores
    !
    ! arguments
    ! ---------
    ! isend: intent (in) as follows:
    !        isend = 1: half-normal
    !        isend = 2: full-normal
    !     n: intent (in) number of values
    !     x: intent (in) vector of values
    !

          program    main
          implicit   none
          integer    isend, n
          parameter (n = 40)
          double precision x(n)
          external   hnplot
          data x / &
          -0.2117D+01, -0.1583D+01, -0.1275D+01, -0.1202D+01, -0.1018D+01, &
          -0.8655D+00, -0.8011D+00, -0.6995D+00, -0.6744D+00, -0.5887D+00, &
          -0.5654D+00, -0.4868D+00, -0.4810D+00, -0.4470D+00, -0.4403D+00, &
          -0.3938D+00, -0.3613D+00, -0.2735D+00, -0.2422D+00, -0.2067D+00, &
          -0.1680D+00, -0.1423D+00, -0.1130D+00, -0.1040D+00, -0.7391D-01, &
          -0.6547D-02,  0.1313D+00,  0.1880D+00,  0.2213D+00,  0.2657D+00, &
           0.2844D+00,  0.5517D+00,  0.5544D+00,  0.5581D+00,  0.6531D+00, &
           0.7271D+00,  0.7323D+00,  0.1018D+01,  0.1561D+01,  0.1761D+01 /
    !
    ! isend = 1: half normal
    !
          isend = 1
          call hnplot (isend, n, x)
    !
    ! isend = 2: normal
    !
          isend = 2
          call hnplot (isend, n, x)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem62: bivariate confidence ellipses
    ! ========
    !
    ! subroutines
    ! -----------
    ! g02cafg ... fit a straight line
    ! elips1  ... data and mean 95% confidence region
    !
    ! arguments
    ! ---------
    ! For g02cafg ... (as for G02CAF)
    !      n: intent (in) number of x,y pairs
    !      x: intent (in) x-values
    !      y: intent (in) y-values
    ! params: intent (out) vector of results (as for G02CAF)
    !  ifail: intent (inout) (as for G02CAF)
    !
    ! For elips1 ...
    !      n: intent (in) number of x,y pairs
    ! params: intent (in) (as returned from G02CAF)
    !      x: intent (in) x-values
    !      y: intent (in) y-values
    !

          program    main
          implicit   none
          integer    ifail, n
          parameter (n = 12)
          double precision x(n), y(n)
          double precision params(20)
          external g02cafg, elips1
          data x / &
          0.100D+01, 0.800D+01, 0.300D+01, 0.900D+01, 0.700D+01, 0.200D+01, &
          0.110D+02, 0.600D+01, 0.800D+01, 0.190D+02, 0.170D+02, 0.150D+02 /
          data y / &
          0.400D+01, 0.500D+01, 0.100D+01, 0.000D+00, 0.120D+02, 0.130D+02, &
          0.700D+01, 0.300D+01, 0.210D+02, 0.140D+02, 0.180D+02, 0.210D+02 /
    !
    ! fit a line and retrieve all necessary parameters
    !
          call g02cafg(n, x, y, params, ifail)
    !
    ! now plot confidence ellipses for either
    ! a) estimates means x_bar and y_bar, or
    ! b) region expecting next new data point.
    !
          call elips1 (n, params, x, y)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem63: plot rows and columns from a matrix
    ! ========
    !
    ! subroutine
    ! -----------
    ! mtplot ... interpret rows or columns as x,y coordinates
    !
    ! arguments
    ! ---------
    ! isend: intent (in) controls the plot types as follows:
    !        1: vector supplied
    !        2: columns only
    !        3: rows only
    !        4: rows and columns
    ! ncmax: intent (in) maximum column dimension
    !  ncol: intent (in) actual number of columns for plotting
    ! nrmax: intent (in) maximumm row dimension
    !  nrow: intent (in) actual number of rows for plotting
    !     a: intent (in) nrow by ncol matrix
    !
          program    main
          implicit   none
          integer    i, isend, j, k, ncmax, ncol, nrmax, nrow
          parameter (ncmax = 10, nrmax = 10)
          double precision a(nrmax,ncmax), x(36)
          external   mtplot
          data x / &
          0.100D+01, 0.800D+01, 0.300D+01, 0.900D+01, 0.700D+01, 0.200D+01, &
          0.110D+02, 0.600D+01, 0.800D+01, 0.190D+02, 0.170D+02, 0.150D+02, &
          0.400D+01, 0.500D+01, 0.100D+01, 0.000D+00, 0.120D+02, 0.130D+02, &
          0.700D+01, 0.300D+01, 0.210D+02, 0.140D+02, 0.180D+02, 0.210D+02, &
          0.120D+01, 0.790D+01, 0.470D+01, 0.940D+01, 0.370D+02, 0.110D+02, &
          0.940D+01, 0.860D+01, 0.150D+02, 0.130D-01, 0.720D-01, 0.340D+01 /
    !
    ! set up matrix a
    !
          ncol = 6
          nrow = 6
          k = 0
          do j = 1, ncol
             do i = 1, nrow
                k = k + 1
                a(i,j) = x(k)
             enddo
          enddo
    !
    ! 1D, 2D, or 3D plots
    !
          isend = 4
          call mtplot (isend, ncmax, ncol, nrmax, nrow, &
                       a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem64: plot r = r(theta)
    ! ========
    !
    ! subroutine and function
    ! -----------------------
    ! rtplot ... interpret r(theta) in x,y space
    ! x01aafg ... pi
    !
    !
    ! arguments
    ! ---------
    !     n: intent (in) number of r(theta) pairs
    !     r: intent (inout) input as r ... returned as y
    ! theta: intent (inout) input as theta ... returned as x
    !
    ! Note: r and theta are returned as y and x
    !
          program    main
          implicit   none
          integer    i, n
          parameter (n = 250)
          double precision r(n), theta(n)
          double precision delta, pi, x01aafg
          double precision zero, two, four
          parameter (zero = 0.0d+00, two = 2.0d+00, four = 4.0d+00)
          external   x01aafg, rtplot
          intrinsic  dble, sin
    !
    ! calculate r = sin(4*theta)
    !
          pi = x01aafg(delta)
          delta = two*pi/dble(n - 1)
          theta(1) = zero
          do i = 2, n - 1
             theta(i) = theta(i - 1) + delta
          enddo
          theta(n) = two*pi
          do i = 1, n
             r(i) = sin(four*theta(i))
          enddo
    !
    ! plot the 8 leaved rose
    !
          call rtplot (n, &
                       r, theta)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem65: select a file to view or open from a list
    ! ========
    ! For details read simdem.chm or simdem.html
    !
    ! function
    ! --------
    ! aux256 ... returns the full path to simdem auxiliaries
    !
    ! subroutine
    ! ----------
    ! vuopen ... choose a file from a list to view or open
    !
    ! arguments
    ! ---------
    ! numdec: intent (inout) as follows:
    !         on entry sets the default list box item
    !         on exit returns the list box item selected
    ! numtxt: intent (in) number of text lines
    ! source: intent (in) text array
    !   view: intent (inout) returned as user selects to view or open
    !

          program    main
          implicit   none
          integer    isend, numdec, numtxt
          parameter (isend = 1, numtxt = 7)
          character  aux256*1024, fname*1024, trim80*80
          character  line*100, path*1, pattern*1
          character  source(numtxt)*12
          logical    repeet, there, view
          logical    askif
          parameter (askif = .false.)
          external   putadv, vuopen, viewer, trim80, deleet, &
                     aux256
    !
    ! build up the list of files then initialise
    !
          source(1) = 'simdem.for'
          source(2) = 'runsim.for'
          source(3) = 'simdem.f95'
          source(4) = 'runsim.f95'
          source(numtxt - 2) = 'Temp_File'
          source(numtxt - 1) = 'Missing_File'
          source(numtxt) = 'Cancel'
    !
    ! create the temp file and make sure the missing file is missing
    !
          fname = aux256(source(numtxt - 2))
          open (unit = 10, file = fname)
          write (10,'(a)') 'You are now reading the file called'
          write (10,'(a)') trim80(fname)
          close (unit = 10)
          call deleet (source(numtxt - 1), &
                       askif, there)
          path = ' '
          pattern = ' '
          numdec = numtxt - 2
          repeet = .true.
          view = .true.
    !
    ! loop to view, open, cancel
    !
          do while (repeet)
             call vuopen (numdec, numtxt, &
                          source, &
                          view)
             if (numdec.lt.numtxt) then
                if (numdec.le.5) then
    !
    ! use aux256 to get the full path to the simdem auxiliaries
    !
                   fname = aux256(source(numdec))
                else
    !
    ! otherwise just use the name allocated
    !
                   fname = source(numdec)
                endif
                inquire (file = fname, exist = there)
                if (there) then
                   if (view) then
                      call viewer (isend, &
                                   fname, path, pattern)
                   else
                      write (line,100) trim80(fname)
                      call putadv (line)
                   endif
                else
                   write (line,200) trim80(fname)
                   call putadv (line)
                endif
             else
                repeet = .false.
             endif
          enddo
    !
    ! delete the temporary file
    !
          fname = aux256(source(numtxt - 2))
          call deleet (fname, &
                       askif, there)
      100 format ('File to open:',1x,a)
      200 format ('Cannot locate',1x,a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem66: Matrices ... read/write procedures
    ! ========
    !
    ! subroutines
    ! -----------
    ! mat2in ... read in a matrix from a Simfit data file
    ! isitmf ... check if a file is a Simfit matrix file
    ! matout ... write a matrix to a file
    !
    ! arguments
    ! ---------
    ! For mat2in ...
    !   nin: intent (in) unit for file connection
    ! ncmax: intent (in) maximum column dimension
    !  ncol: intent (inout) actual column dimension
    ! nrmax: intent (in) maximum row dimension
    !  nrow: intent (inout) actual row dimension
    !     b: intent (out) matrix
    ! fname: intent (inout) file name
    ! title: intent (inout) data title
    ! abort: intent (out) error indicator
    !
    ! For isitmf ...
    !  ncol: intent (out) number of columns (or 0 if error)
    !  nrow: intent (out) number of rows (or 0 if error)
    ! fname: intent (in) file name
    !
    ! For matout ...
    !  isend, intent (in)    if 1, user supplies filename, then open new file
    !                        if 2, filename as argument, then open new file
    !                        if 3, filename already opened on unit nout
    !   ncol: intent (in)    column size >= 1
    !   nout: intent (in)    unit that must be connected if ISEND = 3
    !  nrmax: intent (in)    leading dimension
    !   nrow: intent (in)    row size >= 1
    !  ntext: intent (in)    text size >= 1
    !      a: intent (in)    data matrix
    !  fname: intent (inout) file name
    !   text: intent (in)    trailing text
    !  title: intent (inout) title
    !  abort: intent (out)   error indicator
    ! header: intent (in)    if .true. add header and trailing text
    !  qtext: intent (in)    if .true. ask for text, otherwise use text supplied
    ! qtitle: intent (in)    if .true. ask for title, otherwise use title supplied

    ! Advice
    ! ------
    ! This program demonstrates how simfit writes wide matrices
    ! to file with fixed wrap round at column 50 but, if the
    ! header correctly specifies the number of rows and columns,
    ! the format is irrelevent as long as the data are arranged
    ! in row-major sequence. In other words, hard returns and
    ! wrap-round are of no significance when simfit reads in a
    ! matrix from a data file.
    !
          program    main
          implicit   none
          integer    ncmax, nrmax, nwrap
          parameter (nwrap = 50, ncmax = nwrap + 2, nrmax = 9)
          integer    isend, jsend, nin, mout, nout, ntext
          parameter (isend = 2, jsend = 1, mout = 4, nin = 3, nout = 11, &
                     ntext = 1)
          integer    i, ios, j, ncol, nrow
          double precision factor
          parameter (factor = 100.0d+00)
          double precision a(nrmax,ncmax), b(nrmax,ncmax)
          character  aux256*1024, myfile*1024
          character  dfolt*10, path*1, pattern*1
          parameter (dfolt = 'matrix.tmp', path = ' ', pattern = ' ')
          character  line*100, title*80, text(ntext)*80
          logical    askif, header, qtext, qtitle
          parameter (askif = .false., header = .true., qtext = .false., &
                     qtitle = .false.)
          logical    abort, exist, read_only, there
          external   attrib, closer, deleet, matout, mat2in, putadv, putfat, &
                     viewer, aux256
          external   abdiff, fquery
          intrinsic  dble
    !
    ! first of all check if myfile = matrix.tmp is accidentally read only
    ! note: myfile should be a variable and not a parameter as some simfit routines
    !       are designed to left-trim filenames, change cases, etc.
    !
          myfile = aux256(dfolt)
          call attrib (myfile, &
                       exist, read_only)
          if (read_only) then
    !
    ! if so then complain and stop until the user issues ... attrib -r matrix.tmp
    !
             write (line,100)
             call putfat (line)
          else
    !
    ! otherwise delete matrix.tmp if necessary then generate matrix a
    !
             if (exist) call deleet (myfile, &
                                     askif, there)
             ncol = ncmax
             nrow = nrmax
             do j = 1, ncol
                do i = 1, nrow
                   a(i,j) = dble(i) + dble(j)/factor
                enddo
             enddo
    !
    ! Example 1:
    ! ==========
    ! use procedure matout to write the matrix to myfile in genuine simfit style
    ! Note: closer must be used to close unit = mout before and after calling matout
    ! if the DLLs and executables are created using different compilers, as closer
    ! closes the same unit as matout uses to write the output file. The output
    ! format used by matout is 1p,50e13.5. Subroutine matout provides many options
    ! as will be clear from browsing the subroutine in the w_menus.dll source codes.
    !
             title = 'Data written by matout to the file matrix.tmp'
             text(1) = 'Arbitrary extra line for further information'
             call closer (mout)
             call matout (isend, ncol, mout, nrmax, nrow, ntext, &
                          a, &
                          myfile, text, title, &
                          abort, header, qtext, qtitle)
             call closer (mout)
             if (.not.abort) then
    !
    ! use isitmf to make sure file created is a valid simfit matrix-type file
    !
                call fquery (ncol, nrow, &
                             myfile, &
                             abort)
             endif
             if (abort) then
    !
    ! here only if the file could not be created for some reason
    !
                write (line,200)
                call putfat (line)
             else
    !
    ! otherwise advise user about default simfit wrap-round then display the file
    !
                write (line,300)
                call putadv (line)
                call viewer (jsend, &
                             myfile, path, pattern)
    !
    ! now read matrix b off the simfit style file matrix.tmp that has just been created
    ! note: closer can be used to close unit = nin before and after calling mat2in
    !
                call closer (nin)
                call mat2in (nin, ncmax, ncol, nrmax, nrow, &
                             b, &
                             myfile, title, &
                             abort)
                call closer (nin)
                if (abort) then
    !
    ! here only if failure to read b from myfile for some reason
    !
                   write (line,400)
                   call putfat (line)
                else
    !
    ! examine a - b for any differences
    !
                   call abdiff (ncol, nrmax, nrow, &
                                a, b)
    !
    ! Example 2:
    ! ==========
    ! now create a file with simfit header but arbitrary column widths
    ! note: open and close can be used now instead of opener and closer as
    !       the write operation is going to happen locally, not in the DLLs.
    !
                   title = 'Now header is OK but wrap-round is arbitrary'
                   call deleet (myfile, &
                                askif, there)
                   close (unit = nout)
                   open (unit = nout, file = myfile)
                   write (nout,'(a)',iostat=ios) title
                   write (nout,'(2i6)',iostat=ios) nrow, ncol
                   do i = 1, nrow
                      if (i.eq.1) then
                         write (nout,'(1p,5e13.5)',iostat=ios) &
                               (a(i,j), j = 1, ncol)
                      elseif (i.eq.2) then
                         write (nout,'(1p,10e13.5)',iostat=ios) &
                               (a(i,j), j = 1, ncol)
                      elseif (i.eq.3) then
                         write (nout,'(1p,20e13.5)',iostat=ios) &
                                (a(i,j), j = 1, ncol)
                      else
                         write (nout,'(1p,51e13.5)',iostat=ios) &
                               (a(i,j), j = 1, ncol)
                      endif
                   enddo
                   close (unit = nout)
    !
    ! use isitmf to make sure file created is a valid simfit matrix-type file
    !
                   call fquery (ncol, nrow, &
                                myfile, &
                                abort)
                   if (.not.abort) then
                      write (line,500)
                      call putadv (line)
                      call viewer (jsend, &
                                   myfile, path, pattern)
                      call closer (nin)
                      call mat2in (nin, ncmax, ncol, nrmax, nrow, &
                                   b, &
                                   myfile, title, &
                                   abort)
                      call closer (nin)
                      call abdiff (ncol, nrmax, nrow, &
                                   a, b)
                   endif
    !
    ! Example 3:
    ! ==========
    ! finally create a file with a correct simfit header but with data as a vector
    ! note: the important point is that although the simfit default is to wrap-round
    !       in output files at 50 columns, files with arbitrary rows and columns will
    !       be read correctly as long as the header dimensions are correct and the
    !       values are in row-major order.
    !
                   title = 'File with correct header but just one column'
                   call deleet (myfile, &
                                askif, there)
                   close (unit = nout)
                   open (unit = nout, file = myfile)
                   write (nout,'(a)',iostat=ios) title
                   write (nout,'(2i6)',iostat=ios) nrow, ncol
                   do i = 1, nrow
                      do j = 1, ncol
                         write (nout,'(1p,e13.5)') a(i,j)
                      enddo
                   enddo
                   close (unit = nout)
    !
    ! use isitmf to make sure file created is a valid simfit matrix-type file
    !
                   call fquery (ncol, nrow, &
                                myfile, &
                                abort)
                   if (.not.abort) then
                      write (line,600)
                      call putadv (line)
                      call viewer (jsend, &
                                   myfile, path, pattern)
                      call closer (nin)
                      call mat2in (nin, ncmax, ncol, nrmax, nrow, &
                                   b, &
                                   myfile, title, &
                                   abort)
                      call closer (nin)
                      call abdiff (ncol, nrmax, nrow, &
                                   a, b)
                   endif
                endif
             endif
          endif
      100 format ('Please issue the command ... attrib -r matrix.tmp')
      200 format ('Failure to write matrix A to the file matrix.tmp')
      300 format ('Example 1: note default simfit wrap-round at column 50')
      400 format ('Failure to read matrix B from the file matrix.tmp')
      500 format ('Example 2: note the arbitrary wrap-round positions')
      600 format ('Example 3: note if header OK a row-major vector will do')
          end
    !
    c...................................................................
    !
          subroutine abdiff (ncol, nrmax, nrow, &
                             a, b)
    !
    ! count the number of differences between matrices a and b
    ! Note: the arguments are not changed by this subroutine
    !
          implicit   none
    !
    ! arguments
    !
          integer    ncol, nrmax, nrow
          double precision a(nrmax,ncol), b(nrmax,ncol)
    !
    ! locals
    !
          integer    i, j, numdiff
          double precision delta
          double precision epsi
          parameter (epsi = 0.005d+00)
          character  line*100
          external   putadv, putwar
          intrinsic  abs
          numdiff = 0
          do j = 1, ncol
             do i = 1, nrow
                delta = abs(a(i,j) - b(i,j))
                if (delta.gt.epsi) numdiff = numdiff + 1
             enddo
          enddo
          if (numdiff.eq.0) then
             write (line,100)
             call putadv (line)
          else
             write (line,200) numdiff
             call putwar (line)
          endif
      100 format ('The matrix has been read correctly from the file')
      200 format ('The number of differences betweeen A and B =',i5)
          end
    !
    c.....................................................................
    !
          subroutine fquery (ncol, nrow, &
                             myfile, &
                             abort)
    !
    ! use isitmf to check if the file is a valid simfit matrix type file
    ! Note: the arguments are unchanged except that abort is an output variable
    !
          implicit  none
    !
    ! arguments
    !
          integer   ncol, nrow
          character myfile*(*)
          logical   abort
    !
    ! locals
    !
          integer   ncol1, nrow1
          external  isitmf, putadv, putfat
    !
    ! subroutine isitmf returns ncol1 > 0 and nrow1 > 0 only if the file is
    ! a valid simfit matrix-type data file with ncol1 columns and nrow1 rows
    !
          call isitmf (ncol1, nrow1, &
                       myfile)
          if (ncol1.eq.ncol .and. nrow1.eq.nrow) then
             abort = .false.
             call putadv ('File created is a valid simfit matrix-type file')
          else
             abort = .true.
             call putfat ('File created is not a simfit matrix-type file')
          endif
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem67: Matrices ... editing and transforming
    ! ========
    !
    ! subroutine
    ! ----------
    ! mattrn ... input then edit and/or transform a matrix
    !
    ! arguments
    ! ---------
    ! isend: intent (in) as follows:
    !        isend = 1 only allows column operations
    !        isend = 2 only allows row operations
    !        isend = 3 allows row and column operations
    !        isend = 4 as 3 except that title is not altered
    ! ncols: intent (in) number of columns
    ! nrmax: intent (in) leading dimension
    ! nrows: intent (in) number of rows
    !     a: intent (inout) matrix
    ! title: intent (inout) data title
    !
    ! Advice
    ! ------
    ! Matrix a is input to subroutine mattrn but then it is edited and
    ! transformed interactively and returned as output, i.e. changed
    !
          program    main
          implicit   none
          integer    i, isend, j, ncols, ncmax, nrows, nrmax
          parameter (nrmax = 100, ncmax = 100)
          double precision a(nrmax,ncmax)
          double precision ten
          parameter (ten = 10.0d+00)
          character  title*80
          external   mattrn
          isend = 3
          nrows = 10
          ncols = 10
          do i = 1, nrows
             do j = 1, ncols
                a(i,j) = dble(i) + dble(j)/ten
             enddo
          enddo
          title = 'test matrix'
          call mattrn (isend, ncols, nrmax, nrows, &
                       a, &
                       title)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem68: Matrices ... default matrices of arbitrary size
    ! ========
    ! For details read simdem.chm or simdem.html
    !
    ! subroutines
    ! -----------
    ! mat3in ... try to open an arbitrary data file
    ! mat4in ... get a matrix from a known file or return for a new matrix
    !
    ! arguments
    ! ---------
    ! For mat3in ...
    !  isend: intent (inout) as follows:
    !         isend = 1: user inputs data
    !         isend = 2: data from a file
    !   ncol: intent (inout) number of columns
    !    nin: intent (in) unit for file connection
    !   nrow: intent (inout) number of rows
    !  fname: intent (out) file name
    !  title: intent (out) data title
    !  abort: intent (out) error indicator
    ! fixcol: intent (in) fixed number of columns = ncol if .true.
    ! fixrow: intent (in) fixed number of rows = nrow if .true.
    !  label: intent (in) user supplies title if no file
    !
    ! For mat4in ...
    !  ncmax: intent (in) maximum column dimension
    !   ncol: intent (in) actual column dimension
    !  nrmax: intent (in) maximum row dimension
    !   nrow: intent (in) actual row dimension
    !      a: intent (inout) matrix
    !  fname: intent (in) file name
    ! header: intent (in) header for menu
    !  title: intent (inout) data title
    !  abort: intent (out) error indicator
    ! newdat: intent (out) request for new data

    ! Advice
    ! ------
    ! This program demonstrates how to input default matrices from
    ! files, or how to provide an automatic default data set. The
    ! subroutine demo creates the necessary workspace to hold the
    ! matrix and any workspaces required and then analyses the data.
    ! Note that subroutine demo can easily be edited to read in or
    ! provide any number of default matrices by allocating workspaces
    ! as necessary before calling the subsequent procedures, as
    ! defined by the parameter isend passed to subroutine demo.
    ! For an example of how to do this, browse m_matone in the
    ! w_simfit.dll source codes.
    !
    !
          program    main
          implicit   none
          integer    ncmax, nrmax, nwrap
          parameter (nwrap = 50, ncmax = nwrap + 2, nrmax = 9)
          integer    isend, jsend, nin, nout
          parameter (isend = 1, jsend = 2, nout = 4, nin = 3)
          integer    i, j, ncol, nrow
          double precision factor
          parameter (factor = 100.0d+00)
          double precision a(nrmax,ncmax)
          character  fname*1024, myfile*1024, results*1024, title*80
          external   deltmp, putadv, viewer, gettmp
          intrinsic  dble
          external   demo
    !
    ! Part 1: create a temporary file containing the matrix
    ! ======
    !

    !
    ! first of all generate myfile
    !
          call gettmp (i, &
                       myfile)
          if (i.eq.0) then
    !
    ! generate matrix a
    !
             ncol = ncmax
             nrow = nrmax
             do j = 1, ncol
                do i = 1, nrow
                   a(i,j) = dble(i) + dble(j)/factor
                enddo
             enddo
    !
    ! write the matrix to myfile in simfit style
    ! note: subroutine closer is not required as opening and closing are local
    !
             title = 'Arbitrary matrix written to a temporary file'
             close (unit = nout)
             open (unit = nout, file = myfile)
             write (nout,'(a)') title
             write (nout,'(2i6)') nrow, ncol
             do i = 1, nrow
                write (nout,'(1p,50e13.5)') (a(i,j), j = 1, ncol)
             enddo
             close (unit = nout)
    !
    ! open an output file for the results from subroutine demo
    !
             call gettmp (i, &
                          results)
             open (unit = nout, file = results)
             write (nout,'(a)') 'Log file for results from analysis'
             write (nout,'(a)') ' '

    !
    ! Part 2: call demo with a default ... ncol, nrow, and myfile are consistent
    ! =======
    !

             call putadv ( &
          'First we call demo with known data: choose Analyse then Cancel')
             call demo (isend, ncol, nin, nout, nrow, &
                        myfile, title)

    !
    ! Part 3: call demo with no default ... ncol, nrow, and fname are inconsistent
    ! =======
    !

             ncol = 0
             nrow = 0
             fname = 'no file'
             title = 'no data'
             call putadv ( &
          'Now input your own data matrix: choose Analyse then Cancel')
             call demo (jsend, ncol, nin, nout, nrow, &
                        fname, title)
             close (unit = nout)
             call putadv ( &
          'Now we view results that have been written to the log file')
             call viewer (isend, &
                          results, ' ', ' ')
             call deltmp
          endif
          end
    !
    !......................................................................
    !
          subroutine demo (isend, ncol, nin, nout, nrow, &
                           fnamea, titlea)
    !
    ! action: install a demo matrix then call the program indicated by isend
    ! author: w.g.bardsley, university of manchester, u.k.
    !         derived from m_matone 07/06/2006
    ! advice: isend dictates the action required and sets the default
    !         filename and matrix. However, if a correct filename is supplied
    !         and ncol and nrow supplied on that file are correct and agree
    !         with ncol and nrow in the argument list, then the matrix
    !         supplied in fnamea will be used as the default.
    !         To see how to adapt this routine for any number of procedures
    !         and workspaces browse m_matone in the w_simfit.dll source codes
    !
    !   isend: (input/unchanged) as follows:
    !           isend = 1: do_something
    !           isend = 2: do_something_else
    !           isend = 3: not asigned
    !           isend = 4: etc.
    !           isend = 5: etc.
    !    ncol: (input/output) column size
    !     nin: (input/unchanged) unconnected unit for data input
    !    nout: (input/unchanged) preconnected unit for results
    !    nrow: (input/output) row size
    !  fnamea: (input/output) data file name
    !  titlea: (input/output) data title
    !
          implicit   none
    !
    ! arguments
    !
          integer    isend, ncol, nin, nout, nrow
          character  fnamea*(*), titlea*(*)
    !
    ! local allocatable array
    !
          double precision, allocatable :: a(:,:)
    !
    ! locals
    !
          integer    ierr, jsend, ncmax, ncol1, nrmax, nrow1
          integer    ncadd, nradd
          integer    nitems
          parameter (nitems = 5)
          integer    ncsav(nitems), nrsav(nitems)
          double precision temp
          character  no_data*30, no_file*30, title1*80
          parameter (no_data = 'No data', &
                     no_file = 'No file')
          character  header(nitems)*80, line*100, tfiles(nitems)*1024, &
                     word15*15
          logical    abort, fixcol, fixrow, label, newdat, repeet
          parameter (fixcol = .false., fixrow = .false., label = .true.)
          external   isitmf, mat2in, mat3in, mat4in, putadv, closer
          external   do_something, do_something_else
          save       ncsav, nrsav, header, tfiles
    !
    !  data 1: ncsav holds the column dimensions for the default demo files
    !          for isend = 1, 2, ..., nitems
    !
          data       ncsav / 52, 52, 52, 52, 52 /
    !
    ! data 2: nrsav holds the row dimensions for the default demo files
    !         for isend = 1, 2, ..., nitems
    !
          data       nrsav /  9,  9,  9,  9,  9 /
    !
    ! data 3: header holds the information about the procedures being called from demo
    !         for isend = 1, 2, ..., nitems
    !
          data       header / &
          'Do something', &!1
          'Do something else', &!2
          'Not assigned', &!3
          'Not assigned', &!4
          'etc.' /                                                           !5
    !
    ! data 3: tfiles holds the actual file names for the procedures called from demo
    !         for isend = 1, 2, ..., nitems
    !
           data      tfiles / &
          'matrix.tf1', &!1
          'matrix.tf1', &!2
          'matrix.tf1', &!3
          'matrix.tf1', &!4
          'matrix.tf1' /                                                     !5
    !
    ! check isend then initialise ncadd and nradd if it is necessary for
    ! ncmax > ncol or nrmax > nrow, e.g., bordered matrices for workspace
    !
          if (isend.lt.1 .or. isend.gt.5) return
          ncadd = 2
          nradd = 2
    !
    !------------------------------------------------------------
    ! Start of code to access a matrix
    !------------------------------------------------------------
    !
          if (ncol.le.0 .or. nrow.le.0) then
    !
    ! install a default if nrow or ncol =< 0
    !
             fnamea = tfiles(isend)
             ncol = ncsav(isend)
             nrow = nrsav(isend)
          endif
          repeet = .true.
          do while (repeet)
    !
    ! Step 1: if ncol > 0 and nrow > 0 check if fname supplied is a current matrix file
    ! ======= isitmf returns ncol1 > 0 and nrow1 > 0 if fnamea is a matrix file
    !
             ncol1 = 0
             nrow1 = 0
             if (ncol.gt.0 .and. nrow.gt.0) call isitmf (ncol1, nrow1, &
                                                         fnamea)
    !
    ! Step 2: if fnamea is not a matrix file of correct size try to open a file
    ! ======= mat3in selects a matrix file of size nrow1 > 0 by ncol1 > 0 if successful
    !
             if (ncol1.le.0 .or. nrow1.le.0 .or. &
                 ncol1.ne.ncol .or. nrow1.ne.nrow) then
                ncol = 0
                nrow = 0
                fnamea = no_file
                titlea = no_data
                jsend = 3
                call closer (nin)
                word15 = 'matrix.tf1'
                write (line,100) word15
                call putadv (line)
                call mat3in (jsend, ncol1, nin, nrow1, &
                             fnamea, titlea, &
                             abort, fixcol, fixrow, label)
                call closer (nin)
                if (abort) then
                   ncol = 0
                   nrow = 0
                   fnamea = no_file
                   titlea = no_data
                   return
                endif
             endif
             if (ncol1.le.0 .or. nrow1.le.0) return
    !
    ! Step 3: we now have a matrix file of size nrow > 0 by ncol > 0 so allocate workspaces
    ! ======  if there is any error then ierr is nonzero and exit happens
    !
             ncol = ncol1
             nrow = nrow1
             ierr = 0
             if (allocated(a)) deallocate(a, stat = ierr)
             if (ierr.ne.0) return
             ncmax = ncol + ncadd
             nrmax = nrow + nradd
             allocate(a(nrmax,ncmax), stat = ierr)
             if (ierr.ne.0) return
    !
    ! Step 4: read in the data consisting of nrow by ncol points from file fnamea
    ! ======= if an error occurs then workspaces are deallocated and exit occurs
    !         otherwise fnamea and titlea are not changed from now on
    !
             call closer (nin)
             call mat2in (nin, ncmax, ncol, nrmax, nrow, &
                          a, &
                          fnamea, titlea, &
                          abort)
             call closer (nin)
             if (abort) then
                deallocate (a, stat = ierr)
                ncol = 0
                nrow = 0
                fnamea = no_file
                titlea = no_data
                return
             endif
    !
    ! Step 5: see what the user wants to do ... title may change in mat4in
    ! ======= mat4in is the equivalent of vecone offering as follows:
    !         abort = .true. on return: deallocate workspaces then exit
    !         newdat = .true. on return: try for a new data set
    !         newdat = .false. on return: proceed with original or edited data
    !         title1 is altered if the data are edited but title is unchanged
    !
             title1 = titlea
             call mat4in (ncmax, ncol, nrmax, nrow, &
                          a, &
                          fnamea, header(isend), title1, &
                          abort, newdat)
             if (abort) then
    !
    ! Option 1 on return from mat4in: Deallaocate then exit
    ! --------
    !
                deallocate (a, stat = ierr)
                return
             elseif (newdat) then
    !
    ! Option 2 on return from from mat4in: New data
    ! --------
    !
                fnamea = no_file
                titlea = no_data
                ncol = 0
                nrow = 0
             else
    !
    ! Option 3 on return from from mat4in: Proceed to analysis
    ! --------
    !
                ncol1 = ncol
                nrow1 = nrow
                newdat = .true.
                if (isend.eq.1) then
                   call do_something (ncmax, ncol1, nout, nrmax, nrow1, &
                                      a, &
                                      fnamea, titlea)
                elseif (isend.eq.2) then
                   temp = a(1,1)
                   call do_something_else (nout, &
                                           temp, &
                                           fnamea, titlea)
                else
                   call putadv ('No action assigned')
                endif
                if (.not.newdat) then
                   deallocate(a, stat = ierr)
                   return
                endif
             endif
          enddo
    !------------------------------------------------------------
    ! End of code to access a matrix
    !------------------------------------------------------------
    !
      100 format ('Now input a file formatted like',1x,a)
          end
    !
    !............................................................
    !
          subroutine do_something (ncmax, ncol, nout, nrmax, nrow, &
                                   a, &
                                   fname, title)
          implicit  none
    !
    ! arguments
    !
          integer   ncmax, ncol, nout, nrmax, nrow
          double precision a(nrmax,ncmax)
          character fname*(*), title*(*)
    !
    ! locals
    !
          integer   i, j
          character chop80*80, trim80*80
          character line*100
          external  chop80, putadv, trim80
          if (ncol.lt.1 .or. ncol.gt.ncmax .or. &
              nrow.lt.1 .or. nrow.gt.nrmax) return
          write (nout,100) trim80(fname), chop80(title)
          i = 1
          j = 1
          write (line,200) i, j, a(i,j)
          write (nout,'(a)') line
          call putadv (line)
      100 format ( &
          /'Results from subroutine do_something' &
          / &
          /'File:',1x,a &
          /'Title:',1x,a &
          /a)
      200 format ('A(',i2,',',i2,') =',1pe11.3)
          end
    !
    !...............................................
    !
          subroutine do_something_else (nout, &
                                        temp, &
                                        fname, title)
          implicit   none
    !
    ! arguments
    !
          integer    nout
          double precision temp
          character  fname*(*), title*(*)
    !
    ! locals
    !
          integer    i, j
          parameter (i = 1, j = 1)
          character  chop80*80, line*100, trim80*80
          external   chop80, putadv, trim80
          write (line,100) i, j, temp
          call putadv (line)
          write (nout,200) trim80(fname), chop80(title), line
      100 format ('A(',i2,',',i2,') =',1pe11.3)
      200 format ( &
          /'Results from subroutine do_something_else' &
          / &
          /'File:',1x,a &
          /'Title:',1x,a &
          /a)
          end
    !
    !

Back to Menu or Programs: Brief description

    !
    ! simdem69: plot a vector field with labels, e.g. for a matrix biplot
    ! ========
    !
    ! subroutine
    ! ----------
    ! gksvf3 ... display a vector field with arbitrary arrows and labels
    !
    ! arguments
    ! ---------
    ! iarrow: intent (in) arrow type
    ! ikolor: intent (in) arrow colour
    ! jarrow: intent (in) number of arrows
    ! jcolor: intent (in) text colour
    ! lcolor: intent (in) background colour
    !      m: intent (in) label displacement type (use 0)
    !   ngks: intent (in) gks transformation to use (use 0)
    !  hsize: intent (in) arrow head size
    !  tsize: intent (in) label text size
    ! x1, y1: intent (in) arrow head position
    ! x2, y2: intent (in) arrow tail position
    ! x3, y3: intent (in) label position
    ! label1: intent (in) text label
    ! label2: intent (in) text key (for maths, superscripts, subscripts, etc.)
    ! ptitle: intent (in) plot title
    ! xtitle: intent (in) x legend
    ! ytitle: intent (in) y legend
    !   axes: intent (in) plot axes (may be unused in this version)
    !  gsave: intent (in) option to save (may be unused in this version)
    !
          program    main
          implicit   none
          integer    nmax, nplots
          parameter (nmax = 16, nplots = nmax)
          integer    i
          integer    iarrow(nmax), ikolor(nmax), jarrow, jcolor, lcolor, &
                     m, ngks
          integer    black, blue, green, red, white
          parameter (black = 0, blue = 9, green = 10, red = 12, white = 15)
          double precision hsize(nmax), x1(nmax), x2(nmax), x3(nmax), &
                           y1(nmax), y2(nmax), y3(nmax)
          double precision addtox, addtoy, delta, denom, r, theta, tsize
          double precision zero, half, one, two, twopi
          parameter (zero = 0.0d+00, half = 0.5d+00, one = 1.0d+00, &
                     two = 2.0d+00, twopi = 6.2831853d+00)
          character  label1(nmax)*2, label2(nmax)*2
          character  ptitle*20, xtitle*20, ytitle*20
          parameter (ptitle = 'arrows', &
                     xtitle = 'x', &
                     ytitle = 'y')
          logical    axes, gsave
          parameter (axes = .true., gsave = .true.)
          external   gksvf3
          intrinsic  dble
    !
    ! initialise colours and various sizes
    !
          lcolor = white
          jcolor = black
          m = 0
          jarrow = nplots
          ngks = 0
          tsize = 0.75d+00
          addtox = 0.05d+00
          addtoy = 0.05d+00
          delta = twopi/dble(jarrow)
          theta = - delta
          denom = two*dble(nplots)
    !
    ! generate the coordinates and label displacements
    !
          do i = 1, nplots
             write (label1(i),'(i2)') i
             label2(i) = '00'
             theta = theta + delta
             if (i.le.5) then
                iarrow(i) = 1
                ikolor(i) = black
             elseif (i.le.9) then
                iarrow(i) = 16
                ikolor(i) = blue
             elseif (i.le.13) then
                iarrow(i) = 2
                ikolor(i) = green
             else
                iarrow(i) = 3
                ikolor(i) = red
             endif
             hsize(i) = 0.01d+00
             r = dble(i - 1)/denom
             x2(i) = r*cos(theta)
             y2(i) = r*sin(theta)
             x1(i) = cos(theta)
             y1(i) = sin(theta)
             x3(i) = x1(i)
             y3(i) = y1(i)
             if (x3(i).gt.addtox) then
                x3(i) = x3(i) + addtox
             elseif (x3(i).lt.-addtox) then
                x3(i) = x3(i) - two*addtox
             endif
             if (y3(i).gt.addtoy) then
                y3(i) = y3(i) + addtoy
             elseif (y3(i).lt.-addtoy) then
                y3(i) = y3(i) - two*addtoy
             endif
          enddo
    !
    ! display the plot
    !
          call gksvf3 (iarrow, ikolor, jarrow, jcolor, lcolor, m, ngks, &
                       hsize, tsize, x1, x2, x3, y1, y2, y3, &
                       label1, label2, &
                       ptitle, xtitle, ytitle, &
                       axes, gsave)
          end
    !
    !

Back to Menu or Programs: Brief description

## Simdem 70 options

Option 00: START OF SIMDEM70 CODE ... including declarations for variables
Option 01: patch2 ... Display messages
Option 02: gks001 ... Simple plot for 1 item
Option 03: gks004 ... Simple plot for up to 4 items
Option 04: gks012 ... Simple plot for up to 12 items
Option 05: gkst04 ... Simple plot for up to 4 transforms
Option 06: gkst12 ... Simple plot for up to 12 transforms
Option 07: gkseb4 ... Simple plot for up to 4 error bars (standard)
Option 08: gkscb4 ... Simple plot for up to 4 error bars (restricted)
Option 09: gkshb4 ... Simple plot for up to 4 error bars (rotated)
Option 10: gksvf1 ... Plot a vector field
Option 11: gksvf3 ... Plot a vector field with arrow labels
Option 12: bcplot ... Plot a bar chart (standard)
Option 13: sbplot ... Plot a bar chart (stacked)
Option 14: ebplot ... Plot a bar chart (error bars)
Option 15: cdplot ... Cumulative and cdf plots for a normal distribution
Option 16: dgplot ... Dendrogram plot
Option 17: bwplot ... Box and whisker plot
Option 18: elips1 ... Plot confidence limit ellipses
Option 19: hist01 ... Plot a histogram
Option 20: hnplot ... Normal and Half-normal plots
Option 21: lbplot ... Plot labels and markers
Option 22: mtplot ... Plot columns and rows from a matrix
Option 23: pcplot ... Plot a pie chart
Option 24: pdplot ... Plot a histogram with corresponding density function
Option 25: rtplot ... Parametric plot for r = r(theta)
Option 26: smplot ... Advanced plot for n profiles
Option 27: tsplot ... Time series plots
Option 28: space0 ... 3D parameteric space curves
Option 29: surd2s ... 3D surfaces, contours, bars, and cylinder plots
Option 30: space6 ... 3D curves, swarms, perpendiculars, and vectors
Option 31: images ... Display images of plotting styles
Option 32: editps ... PostScript collages and procedures
Option 33: dbplot ... Double plot (one x-scale, two y-scales)
Option 34: gstyle ... Configure graph styles (edit/restore default features)
Option 35: symcfg ... Configure symbols, lines, and colours
Option 36: labcfg ... Configure labels, keys, and fill styles
Option 37: defkey ... Configure maths, accents, subscripts and superscripts
Option 38: tsizes ... Configure text sizes
Option 39: deflab ... Define panels, labels, and character-keys
Option 40: nsteps ... Create steps between data (i.e., gaps to suppress plotting)
Option 41: xfonts ... Display Simfit font substitution maps
Option 42: resdef ... Restore Simfit 2D plotting defaults
Option 43: mfplot ... Load a metafile to resume editing
Option 44: END OF SIMDEM70 CODE ... changing n and definition of format statements
Menu

    ! simdem70: comprehensive illustration of the simfit plotting styles
    ! ========
    ! For details read simdem.chm or simdem.html
    !
    ! The idea behind this program is to collect together a set of calls
    ! to the user-friendly front ends for the Simfit plotting routines so
    ! that users of the Simdem package can quickly see what is available.
    ! The sample sizes can be altered interactively for some of these calls
    ! to illustrate the effects encountered with very small or very large
    ! data sets. More details can be found from the headers in the Simdem
    ! source code for the individual routines or in the w_graphics.dll
    ! source codes available from https://simfit.org.uk
    !
          program    main
          implicit   none
          integer    ncmax, ndend, nmax, nout, npmax, nrmax, nsmax, ntheta, &
                     nwmax
          parameter (ncmax = 20, ndend = 5, nmax = 10000, nout = 4, &
                     npmax = 50, nrmax = 500, nsmax = 100, ntheta = 250, &
                     nwmax = 2000)
          integer    l0, l1, l2, m0, m5, m8
          parameter (l0 = 0, l1 = 1, l2 = 2, m0 = 0, m5 = 5, m8 = 8)
          integer    i, ifail, isend, itype, i1, i2, i3, j, k, ntemp, &
                     numbld(30), numdec, numopt, numtxt
          integer    mode
          parameter (mode = 0)
          integer    ncol, nfiles, nlab, npie, nrow
          integer    jcolor(15), l(15), m(15), n(15)
          integer    ifill(npmax), ihue(npmax)
          integer    nbins, nobs(nwmax), nset, nsur, nvec
          integer    ilc(ndend - 1), iuc(ndend - 1), iord(ndend)
          integer    iarrow(nmax), ikolor(nmax), jarrow, lcolor, ngks
          parameter (lcolor = 15, ngks = 0)
          integer    ncdf, nsamp, ncdmax
          parameter (ncdf = 10, nsamp = 20, ncdmax = 2*nsamp)
          integer    ncbins, npdf, npdmax, nsamp1
          parameter (ncbins = 5, npdf = 20, nsamp1 = 40, npdmax = 4*nsamp1)
          integer    jarrow_vf
          parameter (jarrow_vf = 16)
          integer    iarrow_vf(jarrow_vf), ikolor_vf(jarrow_vf), &
                     jcolor_vf, lcolor_vf, m_vf, ngks_vf
          integer    black, blue, green, red, white
          parameter (black = 0, blue = 9, green = 10, red = 12, white = 15)
          double precision a, atemp, btemp
          parameter (a = 20.0d+00)
          double precision e(nmax), xh(nmax), yh(nmax)
          double precision x1(nmax), x2(nmax),  x3(nmax),  x4(nmax), &
                           x5(nmax), x6(nmax),  x7(nmax),  x8(nmax), &
                           x9(nmax), x10(nmax), x11(nmax), x12(nmax)
          double precision y1(nmax), y2(nmax),  y3(nmax),  y4(nmax), &
                           y5(nmax), y6(nmax),  y7(nmax),  y8(nmax), &
                           y9(nmax), y10(nmax), y11(nmax), y12(nmax)
          double precision yh1(nmax), yh3(nmax), yl1(nmax), yl3(nmax)
          double precision xx1(nmax), xx2(nmax), yy1(nmax), yy2(nmax)
          double precision xp(nmax), xptemp(nmax), yp(nmax), yptemp(nmax)
          double precision x(nrmax,ncmax), xvec(nmax), yvec(nmax)
          double precision r(ntheta), t(ntheta)
          double precision fact(npmax)
          double precision vector(nsmax**2 + 6), xmax, xmin, ymax, ymin, &
                           z(nsmax,nsmax)
          double precision delta, r1, r2, hsize(nmax), params(20), theta, &
                           twopi
          double precision cd(ndend - 1), thresh, xdend(ndend,3)
          double precision cdf(ncdf), sample(nsamp), tcdf(ncdf), &
                           xcdf(nrmax), ycdf(nrmax), zcdf(nrmax)
          double precision pdf(npdf), sampl1(nsamp1), tpdf(npdf), &
                           xpdf(npdmax), ypdf(npdmax)
          double precision g05cafg, g05ddfg, x01aafg
          double precision error, four, head, one, two, zero
          parameter (error = 0.25d+00, four = 4.0d+00, head = 0.01d+00, &
                     one = 1.0d+00, two = 2.0d+00, zero = 0.0d+00)
          double precision addtox, addtoy, hsize_vf(jarrow_vf), tsize_vf, &
                           x1_vf(jarrow_vf), x2_vf(jarrow_vf), &
                           x3_vf(jarrow_vf), &
                           y1_vf(jarrow_vf), y2_vf(jarrow_vf), &
                           y3_vf(jarrow_vf)
          character  labels(nwmax)*4
          character  ptitle*40, xtitle*20, ytitle*20
          character  ptitl1(2)*40, xtitl1(2)*20, ytitl1(2)*20
          character  temp(20)*100, text(50)*100, titles(4)*40
          character  files(12)*1024, wordx(ndend)*1
          character  label1_vf(jarrow_vf)*2, label2_vf(jarrow_vf)*2
          character  ptitle_vf*18, xtitle_vf*1, ytitle_vf*1
          parameter (ptitle_vf = 'Arrows with Labels', xtitle_vf = 'x', &
                     ytitle_vf = 'y')
          character  blank*1
          parameter (blank = ' ')
          logical    unused(nsmax,nsmax)
          logical    axes, gsave, repeet
          parameter (axes = .true., gsave = .true.)
          external   listbx, getjm1, putfat, gettmp, deltmp, patch2, &
                     gks001, gks004, gks012, gkst04, gkst12, gkseb4, gkscb4, &
                     gkshb4, gksvf1, gksvf3, &
                     bcplot, bwplot, ebplot, hist01, hnplot, lbplot, mtplot, &
                     pcplot, tsplot, space0, surd2s, elips1, smplot, rtplot, &
                     dgplot, cdplot, pdplot, demo3d, sbplot, xfonts, resdef
          external   editps, images, double_plot, configure_plots, &
                     configure_labels, configure_symbols, configure_keys, &
                     configure_panels, configure_sizes, configure_nsteps, mfplot
          external   g05cafg, g05ccfg, g05ddfg, g02cafg, x01aafg
          intrinsic  dble, sin, cos, min
          data numbld / 30*0 /
          data ilc   / 2, 1, 1, 1 /
          data iuc   / 4, 3, 5, 2 /
          data iord  / 1, 3, 5, 2, 4 /
          data cd    / 1.0d+00, 2.0d+00, 6.5d+00, 14.13d+00 /
          data wordx / 'A', 'B', 'C', 'D', 'E' /
          data sample / &
          -0.1251D+01, -0.8949D+00, -0.8082D+00, -0.7000D+00, -0.6648D+00, &
          -0.3640D+00, -0.3588D+00, -0.3125D+00, -0.3073D+00, -0.2855D+00, &
          -0.8175D-01,  0.1030D+00,  0.1130D+00,  0.1229D+00,  0.2740D+00, &
           0.4958D+00,  0.5124D+00,  0.8592D+00,  0.1301D+01,  0.1565D+01 /
          data tcdf / &
          -0.1251D+01, -0.9381D+00, -0.6252D+00, -0.3124D+00,  0.5063D-03, &
           0.3134D+00,  0.6262D+00,  0.9391D+00,  0.1252D+01,  0.1565D+01 /
          data cdf / &
          0.1343D+00,  0.2528D+00,  0.3948D+00,  0.5116D+00,  0.5501D+00, &
          0.4909D+00,  0.3635D+00,  0.2233D+00,  0.1139D+00,  0.4819D-01 /
          data sampl1 / &
          -0.2117D+01, -0.1583D+01, -0.1275D+01, -0.1202D+01, -0.1018D+01, &
          -0.8655D+00, -0.8011D+00, -0.6995D+00, -0.6744D+00, -0.5887D+00, &
          -0.5654D+00, -0.4868D+00, -0.4810D+00, -0.4470D+00, -0.4403D+00, &
          -0.3938D+00, -0.3613D+00, -0.2735D+00, -0.2422D+00, -0.2067D+00, &
          -0.1680D+00, -0.1423D+00, -0.1130D+00, -0.1040D+00, -0.7391D-01, &
          -0.6547D-02,  0.1313D+00,  0.1880D+00,  0.2213D+00,  0.2657D+00, &
           0.2844D+00,  0.5517D+00,  0.5544D+00,  0.5581D+00,  0.6531D+00, &
           0.7271D+00,  0.7323D+00,  0.1018D+01,  0.1561D+01,  0.1761D+01 /
          data tpdf / &
          -0.2117D+01, -0.1913D+01, -0.1709D+01, -0.1505D+01, -0.1301D+01, &
          -0.1097D+01, -0.8924D+00, -0.6883D+00, -0.4841D+00, -0.2800D+00, &
          -0.7582D-01,  0.1283D+00,  0.3325D+00,  0.5366D+00,  0.7407D+00, &
           0.9449D+00,  0.1149D+01,  0.1353D+01,  0.1557D+01,  0.1761D+01 /
          data pdf / &
          0.2165D-01,  0.4036D-01,  0.7028D-01,  0.1143D+00,  0.1736D+00, &
          0.2463D+00,  0.3263D+00,  0.4038D+00,  0.4668D+00,  0.5040D+00, &
          0.5082D+00,  0.4786D+00,  0.4210D+00,  0.3459D+00,  0.2654D+00, &
          0.1902D+00,  0.1273D+00,  0.7961D-01,  0.4649D-01,  0.2536D-01 /
    !
    ! initialise random number generator and starting parameters
    !
          call g05ccfg
          twopi = two*x01aafg(delta)
          nbins = 5
          ncol = 4
          nfiles = 3
          nlab = 20
          npie = 8
          nrow = 5
          nset = 5
          nsur = 20
          ntemp = 20
          nvec = 20
    !
    ! initialise values for gks routines that remain unaltered
    !
          do i = 1, 12
             jcolor(i) = i
             l(i) = 0
             m(i) = i
             n(i) = ntemp
          enddo
          do i = 1, nmax
             x1(i) = dble(i)
             x2(i) = x1(i)
             x3(i) = x1(i)
             x4(i) = x1(i)
             x5(i) = x1(i)
             x6(i) = x1(i)
             x7(i) = x1(i)
             x8(i) = x1(i)
             x9(i) = x1(i)
             x10(i) = x1(i)
             x11(i) = x1(i)
             x12(i) = x1(i)
          enddo
    !
    ! initialise yj(i) values that depend on the current value of ntemp
    ! note parameter a > yj(i)and yj(i) > 0 for possible transforms
    !
          delta = twopi/dble(ntemp)
          do i = 1, ntemp
             y1(i) = two + sin(x1(i)*delta)
             y2(i) = y1(i) + one
             y3(i) = y2(i) + one
             y4(i) = y3(i) + one
             y5(i) = y4(i) + one
             y6(i) = y5(i) + one
             y7(i) = y6(i) + one
             y8(i) = y7(i) + one
             y9(i) = y8(i) + one
             y10(i) = y9(i) + one
             y11(i) = y10(i) + one
             y12(i) = y11(i) + one
             yh1(i) = y1(i) + error
             yh3(i) = y3(i) + error
             yl1(i) = y1(i) - error
             yl3(i) = y3(i) - error
             xp(i) = cos(two*x1(i)*delta)
             yp(i) = sin(two*x1(i)*delta)
          enddo
    !
    ! initialise vector field data
    !
          j = 0
          k = 0
          delta = twopi/50.0d+00
          r2 = error
          r1 = r2 + error
          do i = 1, nmax
             e(i) = error
             j = j + 1
             if (j.eq.51) then
                j = 1
                r1 = r1 + two*error
                r2 = r2 + two*error
                if (k.eq.14) then
                   k = 0
                else
                   k = k + 1
                endif
             endif
             ikolor(i) = k
             theta = dble(i)*delta
             xx1(i) = r1*cos(theta)
             yy1(i) = r1*sin(theta)
             xx2(i) = r2*cos(theta)
             yy2(i) = r2*sin(theta)
          enddo
          do i = 1, nmax
            iarrow(i) = 1
            hsize(i) = head
          enddo
    !
    ! initialise random matrix x(i,j) >= 0 for possible bar chart
    !
          atemp = zero
          btemp = one
          do j = 1, ncmax
             do i = 1, nrmax
                x(i,j) = two + g05cafg(theta) + g05ddfg(atemp, btemp)
                if (x(i,j).lt.zero) x(i,j) = zero
             enddo
          enddo
    !
    ! initialise labels
    !
          do i = 1, nwmax
             write (labels(i),'(i4)') i
          enddo

    !
    ! end of initialisation and start of main loop
    ! ============================================
    !
          numdec = 1
          repeet = .true.
          do while (repeet)
             write (temp,100)
             do i = 1, 19
                text(i) = temp(i)
             enddo
             write (temp,101)
             numopt = 45
             do i = 20, 38
                text(i) = temp(i - 19)
             enddo
             write (temp,102) ntemp
             do i = 39, numopt
                text(i) = temp(i - 38)
             enddo
             write (ptitle,200) ntemp
             xtitle = 'x-axis'
             ytitle = 'y-axis'

             call listbx (numdec, numopt, text)

    ! -------------------------------------------------------------------------
    ! The simdem70 source has been interrupted at this point so that the codes
    ! for options 1 to 43 resulting from the value of numdec returned by this
    ! call to listbx can be viewed individually from the simdem70 options menu.
    ! The closing code and format statements can be viewed from Option 44.
    ! -------------------------------------------------------------------------

Back to Menu or Simdem70 options

    !
    ! numdec = 1: help
    !
                write (text,300)
                numtxt = 21
                numbld(1) = 1
                numbld(18) = 1
                call patch2 (numbld, numtxt, &
                             text)

Back to Menu or Simdem70 options

    !
    ! numdec = 2: single plot
    !
                call gks001 (l(1), m(1), n(1), &
                             x1, &
                             y1, &
                             ptitle, xtitle, ytitle)

Back to Menu or Simdem70 options

    !
    ! numdec = 3: up to 4 plots
    !
                call gks004 (l(1), l(2), l(3), l(4), &
                             m(1), m(2), m(3), m(4), &
                             n(1), n(2), n(3), n(4), &
                             x1, x2, x3, x4, &
                             y1, y2, y3, y4, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 4: up to 12 plots
    !
                call gks012 (l(1), l(2), l(3), l(4),  l(5),  l(6), &
                             l(7), l(8), l(9), l(10), l(11), l(12), &
                             m(1), m(2), m(3), m(4),  m(5),  m(6), &
                             m(7), m(8), m(9), m(10), m(11), m(12), &
                             n(1), n(2), n(3), n(4),  n(5),  n(6), &
                             n(7), n(8), n(9), n(10), n(11), n(12), &
                             x1, x2, x3, x4,  x5,  x6, &
                             x7, x8, x9, x10, x11, x12, &
                             y1, y2, y3, y4,  y5,  y6, &
                             y7, y8, y9, y10, y11, y12, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec= 5: up to 4 transforms
    !
                call gkst04 (l(1), l(2), l(3), l(4), &
                             m(1), m(2), m(3), m(4), &
                             n(1), n(2), n(3), n(4), &
                             a, &
                             x1, x2, x3, x4, &
                             y1, y2, y3, y4, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 6: up to 12 transforms
    !
                call gkst12 (l(1), l(2), l(3), l(4),  l(5),  l(6), &
                             l(7), l(8), l(9), l(10), l(11), l(12), &
                             m(1), m(2), m(3), m(4),  m(5),  m(6), &
                             m(7), m(8), m(9), m(10), m(11), m(12), &
                             n(1), n(2), n(3), n(4),  n(5),  n(6), &
                             n(7), n(8), n(9), n(10), n(11), n(12), &
                             a, &
                             x1, x2, x3, x4,  x5,  x6, &
                             x7, x8, x9, x10, x11, x12, &
                             y1, y2, y3, y4,  y5,  y6, &
                             y7, y8, y9, y10, y11, y12, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 7: up to 2 standard error bars and best fit curves
    !
                call gkseb4 (l0, l1, l0, l2, &
                             m5, m0, m8, m0, &
                             n(1), n(2), n(3), n(4), &
                             x1, x2, x3, x4, &
                             yh1, yh3, yl1, yl3, y1, y2, y3, y4, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 8: as gkseb4 but restricted for such as bar chart use
    !
                call gkscb4 (l0, l1, l0, l2, &
                             m5, m0, m8, m0, &
                             n(1), n(2), n(3), n(4), &
                             x1, x2, x3, x4, &
                             yh1, yh3, yl1, yl3, y1, y2, y3, y4, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 9: swapped error bars for horizontal use such as log-odds
    !
                itype = 1                        ! must be 1 for log-e or 2 for log-10
                ptitl1(1) = 'Interchanged axes'  !title for simple graph
                ptitl1(2) = ptitle               !true plot title (for simplot)
                xtitl1(1) = 'x'                  !y legend for simple graph
                xtitl1(2) = ytitle               !true x-title (for simplot)
                if (itype.eq.1) then
                   ytitl1(1) = 'log_e(y)'        !x legend for simple graph
                else
                   ytitl1(1) = 'log_10(y)'       !x legend for simple graph
                endif
                ytitl1(2) = xtitle               !true y-title (for simplot)
                call gkshb4 (itype, &
                             l0, l1, l0, l2, &
                             m5, m0, m8, m0, &
                             n(1), n(2), n(3), n(4), &
                             x1, x2, x3, x4, &
                             yh1, yh3, yl1, yl3, y1, y2, y3, y4, &
                             ptitl1, xtitl1, ytitl1, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 10: vector field
    !
                jarrow = ntemp
                call gksvf1 (iarrow, ikolor, jarrow, lcolor, ngks, &
                             hsize, xx1, xx2, yy1, yy2, &
                             ptitle, xtitle, ytitle, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 11: vector field with labels, e.g. for matrix bi-plot
    !
                lcolor_vf = white
                jcolor_vf = black
                m_vf = 0
                ngks_vf = 0
                tsize_vf = one
                addtox = 0.05d+00
                addtoy = 0.05d+00
                delta = twopi/dble(jarrow_vf)
                theta = - delta
                do i = 1, jarrow_vf
                   write (label1_vf(i),'(i2)') i
                   label2_vf(i) = '00'
                   theta = theta + delta
                   if (i.le.5) then
                      iarrow_vf(i) = 1
                      ikolor_vf(i) = black
                   elseif (i.le.9) then
                      iarrow_vf(i) = 16
                      ikolor_vf(i) = blue
                   elseif (i.le.13) then
                      iarrow_vf(i) = 2
                      ikolor_vf(i) = green
                   else
                      iarrow_vf(i) = 3
                      ikolor_vf(i) = red
                   endif
                   hsize_vf(i) = 0.01d+00
                   x2_vf(i) = zero
                   y2_vf(i) = zero
                   x1_vf(i) = cos(theta)
                   y1_vf(i) = sin(theta)
                   x3_vf(i) = x1_vf(i)
                   y3_vf(i) = y1_vf(i)
                   if (x3_vf(i).gt.addtox) then
                      x3_vf(i) = x3_vf(i) + addtox
                   elseif (x3_vf(i).lt.-addtox) then
                      x3_vf(i) = x3_vf(i) - two*addtox
                   endif
                   if (y3_vf(i).gt.addtoy) then
                      y3_vf(i) = y3_vf(i) + addtoy
                   elseif (y3_vf(i).lt.-addtoy) then
                      y3_vf(i) = y3_vf(i) - two*addtoy
                   endif
                enddo
                call gksvf3 (iarrow_vf, ikolor_vf, jarrow_vf, jcolor_vf, &
                             lcolor_vf, m_vf, ngks_vf, &
                             hsize_vf, tsize_vf, &
                             x1_vf, x2_vf, x3_vf, &
                             y1_vf, y2_vf, y3_vf, &
                             label1_vf, label2_vf, &
                             ptitle_vf, xtitle_vf, ytitle_vf, &
                             axes, gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 12: bar chart plot
    !
                i1 = 2
                i2 = ncmax
                call getjm1 (i1, ncol, i2, 'No. of columns required')
                i2 = nrmax
                call getjm1 (i1, nrow, i2, 'No. of rows required')
                isend = 2
                titles(1) = 'Bar Chart'
                titles(2) = 'Columns'
                titles(3) = 'Rows'
                titles(4) = blank
                call bcplot (isend, ncol, nrmax, nrow, &
                             x, &
                             labels, titles)

Back to Menu or Simdem70 options

    !
    ! numdec = 13: stack plot
    !
                i1 = 2
                i2 = ncmax
                call getjm1 (i1, ncol, i2, 'No. of columns required')
                i2 = nrmax
                call getjm1 (i1, nrow, i2, 'No. of rows required')
                isend = 2
                titles(1) = 'Stack Plot'
                titles(2) = 'Columns'
                titles(3) = 'Rows'
                titles(4) = blank
                call sbplot (isend, ncol, nrmax, nrow, &
                             x, &
                             labels, titles)

Back to Menu or Simdem70 options

    !
    ! numdec = 14: boxes and whiskers
    ! numdec = 17: bar chart with error bars
    !
                i1 = 1
                i2 = nwmax/4
                if (nset.gt.i2) nset = i2
                call getjm1 (i1, nset, i2, 'No. of bars required')
                j = nwmax/nset
                nvec = 0
                atemp = zero
                btemp = one
                do i = 1, nset
                   nobs(i) = j
                   do k = 1, j
                      nvec = nvec + 1
                      xvec(nvec) = two + g05ddfg(atemp, btemp)
                      if (xvec(nvec).lt.zero) xvec(nvec) = zero
                   enddo
                enddo
                isend = 2
                titles(2) = 'Groups'
                titles(3) = 'Values'
                titles(4) = ' '
                if (numdec.eq.14) then
                   titles(1) = 'Boxes and Whiskers'
                   call bwplot (isend, nobs, nset, nvec, &
                                xvec, &
                                labels, titles)
                else
                   titles(1) = 'Error Bar Plot'
                   call ebplot (isend, nobs, nset, nvec, &
                                xvec, &
                                labels, titles)
                endif

Back to Menu or Simdem70 options

    !
    ! numdec = 15: cdf plot
    !
                titles(1) = 'Sample and best-fit cdf'
                titles(2) = 'Values'
                titles(3) = 'CDF and step function'
                call cdplot (ncdf, ncdmax, nsamp, &
                             cdf, sample, tcdf, xcdf, ycdf, zcdf, &
                             titles(1), titles(2), titles(3))

Back to Menu or Simdem70 options

    !
    ! numdec = 16: dendrogram
    !
                 thresh = 5.0d+00
                 titles(1) = 'Dendrogram'
                 titles(2) = 'Item'
                 titles(3) = 'Metric'
                 call dgplot (ilc, iuc, iord, ndend, ndend, &
                              cd, thresh, xdend, &
                              titles(1), wordx, titles(2), titles(3))

Back to Menu or Simdem70 options

    !
    ! numdec = 18: bivariate confidence ellipses
    !
                atemp = zero
                btemp = two
                do i = 1, ntemp
                   xvec(i) = g05ddfg(atemp, btemp)
                   yvec(i) = g05ddfg(atemp, btemp)
                enddo
                ifail = 0
                call g02cafg(ntemp, xvec, yvec, params, ifail)
                if (ifail.eq.0) then
                   call elips1 (ntemp, params, xvec, yvec)
                else
                   call putfat ('failure in call to g02caf')
                endif

Back to Menu or Simdem70 options

    !
    ! numdec = 19: histograms
    !
                i1 = 2
                i2 = min(ntemp,200)
                if (nbins.gt.i2) nbins = i2
                call getjm1 (i1, nbins, i2, 'No. of bins required')
                call hist01 (nbins, nmax, j, &
                             e, x1, xh, y1, yh, &
                             gsave)

Back to Menu or Simdem70 options

    !
    ! numdec = 20: normal or half normal plots
    !
                atemp = zero
                btemp = two
                do i = 1, ntemp
                   yvec(i) = g05ddfg(atemp, btemp)
                enddo
                isend = 1
                call hnplot (isend, ntemp, &
                             yvec)
                isend = 2
                call hnplot (isend, ntemp, &
                             yvec)

Back to Menu or Simdem70 options

    !
    ! numdec = 21: labels plot
    !
                i1 = 2
                i2 = nwmax
                if (nlab.gt.i2) nlab = i2
                call getjm1 (i1, nlab, i2, 'No. of labels required')
                atemp = zero
                btemp = one
                do i = 1, nlab
                   xvec(i) = g05ddfg(atemp, btemp)
                   yvec(i) = g05ddfg(atemp, btemp)
                enddo
                write (ptitle,200) nlab
                call lbplot (nlab, &
                             xvec, yvec, &
                             ptitle, labels, xtitle, ytitle)

Back to Menu or Simdem70 options

    !
    ! numdec = 22: matrix plots
    !
                i1 = 2
                i2 = ncmax
                call getjm1 (i1, ncol, i2, 'No. of columns required')
                i2 = nrmax
                call getjm1 (i1, nrow, i2, 'No. of rows required')
                isend = 4
                call mtplot (isend, ncmax, ncol, nrmax, nrow, &
                             x)

Back to Menu or Simdem70 options

    !
    ! numdec = 23: pie chart
    !
                i1 = 2
                i2 = npmax
                if (npie.gt.i2) npie = i2
                call getjm1 (i1, npie, i2, 'No. of segments required')
                isend = 1
                call pcplot (isend, ifill, ihue, npie, &
                             fact, x1, &
                             labels, 'Pie Chart')

Back to Menu or Simdem70 options

    !
    ! numdec = 24: pdf
    !
                titles(1) = 'Histogram and best-fit pdf'
                titles(2) = 'Values'
                titles(3) = 'Bins and pdf'
                call pdplot (ncbins, npdf, npdmax, nsamp1, &
                             pdf, sampl1, tpdf, xpdf, ypdf, &
                             titles(1), titles(2), titles(3))

Back to Menu or Simdem70 options

    !
    ! numdec = 25: r(theta)
    !
                delta = twopi/dble(ntheta - 1)
                t(1) = zero
                do i = 2, ntheta - 1
                   t(i) = t(i - 1) + delta
                enddo
                t(ntheta) = twopi
                do i = 1, ntheta
                   r(i) = sin(four*t(i))
                enddo
                call rtplot (ntheta, &
                             r, t)

Back to Menu or Simdem70 options

    !
    ! numdec = 26: arbitrary number of plots
    !
                i1 = 1
                i2 = 12
                if (nfiles.gt.i2) nfiles = i2
                call getjm1 (i1, nfiles, i2, 'No. of plots required')
                do i = 1, nfiles
                   call gettmp (j, files(i))
                   open (unit = nout, file = files(i))
                   write (nout,'(a)') blank
                   write (nout,'(2i4)') ntemp, 2
                   do j = 1, ntemp
                      atemp = x1(j)
                      if (i.eq.1) then
                         btemp = y1(j)
                      elseif (i.eq.2) then
                         btemp = y2(j)
                      elseif (i.eq.3) then
                         btemp = y3(j)
                      elseif (i.eq.4) then
                         btemp = y4(j)
                      elseif (i.eq.5) then
                         btemp = y5(j)
                      elseif (i.eq.6) then
                         btemp = y6(j)
                      elseif (i.eq.7) then
                         btemp = y7(j)
                      elseif (i.eq.8) then
                         btemp = y8(j)
                      elseif (i.eq.9) then
                         btemp = y9(j)
                      elseif (i.eq.10) then
                         btemp = y10(j)
                      elseif (i.eq.11) then
                         btemp = y11(j)
                      elseif (i.eq.12) then
                         btemp = y12(j)
                      endif
                      write (nout,'(1p,2e11.3)') atemp, btemp
                   enddo
                   close(unit = nout)
                enddo
                write(titles(1),200) ntemp
                titles(2) = 'x'
                titles(3) = 'y'
                titles(4) = blank
                call smplot (jcolor, l, m, nfiles, files, titles)
                call deltmp

Back to Menu or Simdem70 options

    !
    ! numdec = 27: time series
    !
                do i = 1, ntemp
                   yvec(i) = y1(i) - two
                enddo
                i1 = 1
                i2 = 0
                isend = 2
                call tsplot (isend, i1, i2, ntemp, &
                             one, xvec, xvec, one, yvec, &
                             ptitle, xtitle, ytitle)
                isend = 4
                call tsplot (isend, i1, i2, ntemp, &
                             one, xvec, xvec, one, yvec, &
                             ptitle, xtitle, ytitle)

Back to Menu or Simdem70 options

    !
    ! numdec = 28: spiral
    !
                call space0 (ntemp, nmax, &
                             xp, xptemp, yp, yptemp, x1)

Back to Menu or Simdem70 options

    !
    ! numdec = 29: 3D surface/bar chart/contours
    !
                i1 = 10
                i2 = nsmax
                if (nsur.gt.i2) nsur = i2
                call getjm1 (i1, nsur, i2, 'No. of divisions required')
                xmin = - one
                xmax = one
                ymin = - one
                ymax = one
                delta = (xmax - xmin)/(dble(nsur - 1))
                atemp = xmin - delta
                do j = 1, nsur
                   atemp = atemp + delta
                   btemp = ymin - delta
                   do i = 1, nsur
                      btemp = btemp + delta
                      z(i,j) = btemp**2 - atemp**2
                   enddo
                enddo
                isend = 4
                call surd2s (isend, nsmax, nsur, nsur, &
                             vector, xmax, xmin, ymax, ymin, z, &
                             unused)

Back to Menu or Simdem70 options

    !
    ! numdec = 30: 3D curves/swarms/vectors
    !
                call demo3d
    !
    !----------------------------------------------------------------------
    !
          subroutine demo3d
    !
    ! Demonstrate how to call space6 for 3D space curves, swarms, labels,
    ! perpendiculars, and vectors
    !
    !  call space6 (nfiles,             ... integer, number of files to be plotted
    ! +             fnames,             ... character, files with x,y coordinates
    ! +             plot_arrows,        ... logical
    ! +             plot_labels,        ... logical
    ! +             plot_lines,         ... logical
    ! +             plot_perpendiculars,... logical
    ! +             plot_symbols)       ... logical
    !
          implicit   none
          integer    i, ifail, j, n, nfiles, nout, numdec
          integer    nmax, numopt, ncols
          parameter (nmax = 50, numopt = 7, ncols = 3)
          double precision zero, one, two, three, pi, stretch1, stretch2
          parameter (zero = 0.0d+00, one = 1.0d+00, two = 2.0d+00, &
                     three = 3.0d+00, pi = 3.1415927d+00, &
                     stretch1 = 0.666d+00, stretch2 = 1.50d+00)
          double precision delta
          double precision t(nmax), x(nmax), y(nmax), z(nmax)
          character  fnames(4)*1024
          character  text(numopt)*80
          character  file1*1024, file2*1024, file3*1024, file4*1024, &
                     file5*1024
          character  begin_labels*13, end_labels*11, title*25
          parameter (begin_labels = 'begin{labels}', &
                       end_labels = 'end{labels}', &
                            title = 'Temporary File for demo3D')
          logical    repeet
          logical    askif, there
          parameter (askif = .false.)
          logical    plot_arrows, plot_labels, plot_lines, &
                     plot_perpendiculars, plot_symbols
          external   listbx, space6, gettmp, deleet, getnou
          intrinsic  cos, sin, dble
    !
    ! find an unopened unit
    !
          call getnou (nout)
    !
    ! inititialise logical variables
    !

          plot_arrows = .false.
          plot_labels = .false.
          plot_lines = .false.
          plot_perpendiculars = .false.
          plot_symbols = .false.
    !
    ! Define t
    !
          n = nmax
          t(1) = zero
          t(n) = two*pi
          delta = (t(n) - t(1))/(dble(n) - one)
          do i = 2, n - 1
             t(i) = t(i - 1) + delta
          enddo
    !
    ! Define x, y, z as a helix
    !
          x(1) = one
          y(1) = zero
          z(1) = one
          do i = 2, n - 1
             delta = two*t(i)
             x(i) = cos(delta)
             y(i) = sin(delta)
             z(i) = dble(i)
          enddo
          x(n) = x(1)
          y(n) = y(1)
          z(n) = dble(n)
    !
    ! file1 just contains x, y, z data
    !
          call gettmp (ifail, &
                       file1)
          open (unit = nout, file = file1)
          write (nout,'(a)') title
          write (nout,'(2i6)') n, ncols
          do i = 1, n
            write (nout,'(3e12.4)') x(i), y(i), z(i)
          enddo
          close (unit = nout)
    !
    ! file2 contains an interior helix
    !
          call gettmp (ifail, &
                       file2)
          open (unit = nout, file = file2)
          write (nout,'(a)') title
          write (nout,'(2i6)') n, ncols
          do i = 1, n
            write (nout,'(3e12.4)') x(i)/two, y(i)/two, stretch1*z(i)
          enddo
          close (unit = nout)
    !
    ! file3 contains another interior helix
    !
          call gettmp (ifail, &
                       file3)
          open (unit = nout, file = file3)
          write (nout,'(a)') title
          write (nout,'(2i6)') n, ncols
          do i = 1, n
            write (nout,'(3e12.4)') x(i)/three, y(i)/three, stretch2*z(i)
          enddo
          close (unit = nout)
    !
    ! file4 contains a subset of file1 but with labels added
    !
          call gettmp (ifail, &
                       file4)
          open (unit = nout, file = file4)
          write (nout,'(a)') title
          write (nout,'(2i6)') n/2, ncols
          do i = 1, n/2
            write (nout,'(3e12.4)') x(i), y(i), z(i)
          enddo
          write (nout,'(a)') begin_labels
          do i = 1, n/2
             if (i.lt.10) then
                write (nout,'(a1,i1)') 'A', i
             elseif (i.lt.100) then
                write (nout,'(a1,i2)') 'A', i
             else
                write (nout,'(a1,i3)') 'A', i
             endif
          enddo
          write (nout,'(a)') end_labels
          close (unit = nout)
    !
    ! file5 contains a subset of file2 but with labels added
    !
          call gettmp (ifail, &
                       file5)
          open (unit = nout, file = file5)
          write (nout,'(a)') title
          write (nout,'(2i6)') n/2 - 15, ncols
          j = -1
          do i = 1, n/2 - 15
            j = j + 2
            write (nout,'(3e12.4)') x(j)/two, y(j)/two, stretch1*z(j)
          enddo
          write (nout,'(a)') begin_labels
          j = -1
          do i = 1, n/2 - 15
             j = j + 2
             if (j.lt.10) then
                write (nout,'(a1,i1)') 'B', j
             elseif (j.lt.100) then
                write (nout,'(a1,i2)') 'B', j
             else
                write (nout,'(a1,i3)') 'B', j
             endif
          enddo
          write (nout,'(a)') end_labels
          close (unit = nout)
    !
    ! The main loop
    !
          write (text,100)
          repeet = .true.
          do while (repeet)
              numdec = numopt
              call listbx (numdec, numopt, &
                           text)
              if (numdec.eq.1) then
    !
    ! curves
    !
                 nfiles = 3
                 fnames(1) = file1
                 fnames(2) = file2
                 fnames(3) = file3
                 plot_lines = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_lines = .false.
              elseif (numdec.eq.2) then
    !
    ! swarms
    !
                 nfiles = 3
                 fnames(1) = file1
                 fnames(2) = file2
                 fnames(3) = file3
                 plot_symbols = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_symbols = .false.
              elseif (numdec.eq.3) then
    !
    ! swarms with perpendiculars
    !
                 nfiles = 2
                 fnames(1) = file4
                 fnames(2) = file5
                 plot_symbols = .true.
                 plot_perpendiculars = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_symbols = .false.
                 plot_perpendiculars = .false.
              elseif (numdec.eq.4) then
    !
    ! swarms with labels
    !
                 nfiles = 2
                 fnames(1) = file4
                 fnames(2) = file5
                 plot_symbols = .true.
                 plot_labels = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_symbols = .false.
                 plot_labels = .false.
              elseif (numdec.eq.5) then
    !
    ! arrows
    !
                 nfiles = 2
                 fnames(1) = file4
                 fnames(2) = file5
                 plot_arrows = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_arrows = .false.
              elseif (numdec.eq.6) then
    !
    ! arrows with labels
    !
                 nfiles = 2
                 fnames(1) = file4
                 fnames(2) = file5
                 plot_arrows = .true.
                 plot_labels = .true.
                 call space6 (nfiles, &
                              fnames, &
                              plot_arrows, &
                              plot_labels, &
                              plot_lines, &
                              plot_perpendiculars, &
                              plot_symbols)
                 plot_arrows = .false.
                 plot_labels = .false.
              elseif (numdec.eq.numopt) then
                 repeet = .false.
              endif

          enddo
    !
    ! delete temporary files
    !
          call deleet (file1, &
                       askif, there)
          call deleet (file2, &
                       askif, there)
          call deleet (file3, &
                       askif, there)
          call deleet (file4, &
                       askif, there)
          call deleet (file5, &
                       askif, there)
    !
    ! format statement
    !
      100 format ( &
           'Demonstrate 3D curves' &
          /'Demonstrate 3D swarms' &
          /'Demonstrate 3D swarms with perpendiculars' &
          /'Demonstrate 3D swarms with labels' &
          /'Demonstrate 3D vectors' &
          /'Demonstrate 3D vectors with labels' &
          /'Cancel ... No more demonstrations')
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 31: images
    !
                call images (mode)

Back to Menu or Simdem70 options

    !
    ! numdec = 32: PostScript procedures
    !
                call editps
    !
    !----------------------------------------------------------------------
    !
          subroutine editps
    !
    ! action: front end to the DLL version of the Simfit Editps program
    !
    ! call editps_driver
    !
          implicit   none
          integer    nout
          character  aux256*1024, temp*1024
          character  fname*12, title*6
          parameter (fname = 'f$simfit.tmp', &
                     title = 'editps')
          logical    askif, there
          parameter (askif = .false.)
          external   aux256, deleet, getnou, putadv
          external   editps_driver
    !
    ! Create the editps identifier file f$simfit.tmp so the [Demo] button will work
    !
          temp = aux256(fname)
          call getnou (nout)
          open (unit = nout, file = temp)
          write (nout,'(a)') title
          close (unit = nout)
    !
    ! call the editps driver interface
    !
          call putadv ( &
          'Use the [Demo] file selection option for EDITPS test files')call editps_driver
    !
    ! delete the identifier file
    !
          call deleet (temp, &
                       askif, there)
          end
    !
    !----------------------------------------------------------------------
    !

Back to Menu or Simdem70 options

    !
    ! numdec = 33: double plot
    !
                call double_plot
    !
    !----------------------------------------------------------------------
    !
          subroutine double_plot
    !
    ! Calling dbplot to plot data with one X-scale and two Y-scales
    !
    !  call dbplot (jfiles, lfiles, mfiles, nfiles,
    ! +             files, titles,
    ! +             left_axis)
    !
    ! jfiles: intent (in) = JCOLOR vector (colours)
    ! lfiles: intent (in) = L vector (line types)
    ! mfiles: intent (in) = M vector (symbol types)
    ! nfiles: intent (in) = Number of files
    !  files: intent (in) = FSAV (coordinate files)
    ! titles: intent (in) = Title, x-, y-, z-legends
    !
          implicit   none
          integer    ncols, nfiles, nout
          parameter (ncols = 2, nfiles = 4, nout = 10)
          integer    jfiles(nfiles), lfiles(nfiles), mfiles(nfiles)
          integer    i, j, nrows
          double precision x(11)
          double precision ten
          parameter (ten = 10.0d+00)
          character  files(nfiles)*1024, titles(4)*80
          logical    left_axis(nfiles)
          logical    askif, there
          parameter (askif = .false.)
          external   dbplot, deleet, gettmp
          intrinsic  dble
    !
    ! Make a vector of X-coordinates 0, 1, ..., 10
    !
          do i = 1, 11
            x(i) = dble(i - 1)
          enddo
    !
    ! Create the data files 1, 2, ..., nfiles
    !
          do i = 1, nfiles
             call gettmp (j, &
                          files(i))
             open (unit = nout, file = files(i))
             write (nout,'(a)') files(i)
             if (i.eq.1) then
    !
    ! Straight line from 0 to 5 plotted to left hand axis
    !
                jfiles(i) = 0
                lfiles(i) = 1
                mfiles(i) = 5
                left_axis(i) = .true.
                nrows = 5
                write (nout,'(2i3)') nrows, ncols
                do j = 1, nrows
                   write (nout,'(1p,2e13.5)') x(j), x(j)
                enddo
                close(unit = nout)
             elseif (i.eq.2) then
    !
    ! Straight line from 6 to 10 plotted to left hand axis
    !
                jfiles(i) = 4
                lfiles(i) = 2
                mfiles(i) = 8
                left_axis(i) = .true.
                nrows = 5
                write (nout,'(2i3)') nrows, ncols
                do j = 1, nrows
                   write (nout,'(1p,2e13.5)') x(j + 6), x(j + 6)
                enddo
                close(unit = nout)
             elseif (i.eq.3) then
    !
    ! Parabola plotted to right hand axis
    !
                jfiles(i) = 1
                lfiles(i) = 3
                mfiles(i) = 11
                left_axis(i) = .false.
                nrows = 11
                write (nout,'(2i3)') nrows, ncols
                do j = 1, nrows
                   write (nout,'(1p,2e13.5)') x(j), x(j)*(x(j) - ten)
                enddo
                close(unit = nout)
             elseif (i.eq.4) then
    !
    ! Inverted parabola plotted to right hand axis
    !
                jfiles(i) = 2
                lfiles(i) = 4
                mfiles(i) = 14
                left_axis(i) = .false.
                nrows = 11
                write (nout,'(2i3)') nrows, ncols
                do j = 1, nrows
                   write (nout,'(1p,2e13.5)') x(j), - x(j)*(x(j) - ten)
                enddo
                close(unit = nout)
             endif
          enddo
    !
    ! Create the titles
    !
          titles(1) = 'Example of a Double Plot'
          titles(2) = 'X-axis'
          titles(3) = 'Left hand axis'
          titles(4) = 'Right hand axis'
    !
    ! Call dbplot
    !
          call dbplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles, &
                       left_axis)
    !
    ! Deleet the temporary files
    !
          do i = 1, nfiles
             call deleet (files(i), &
                          askif, there)
          enddo
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 34: configure plot styles and colours
    !
                call configure_plots
    !
    !----------------------------------------------------------------------
    !
          subroutine configure_plots
    !
    ! Subroutine configure_plots shows users how to alter the graphics parameters
    ! such as style and colour interactively from a menu, or by direct input.
    ! The specification for the subroutines called are now listed, but note that
    ! the advanced plot defaults are set by the configuration routine config.

    !-----------------------------------------------------------------------------------
    ! call gkscol (isend, jcol, kcol, numj, numk)
    !
    ! Re-sets colours temporarily for items displayed in the simple graphics procedures.
    ! isend, numj, and numk are integer intent (in), the rest are integer intent (inout)
    !
    ! isend = 1: set colours jcol and kcol directly
    ! isend = 2: set colours jcol and kcol from a menu
    ! jcol(1) = Plot title
    ! jcol(2) = Plot legends
    ! jcol(3) = Plot labels
    ! jcol(4) = Plot axes
    ! jcol(5) = Plot background
    ! jcol(6) to jcol(12)  = ***Unassigned
    ! kcol(i) = colour for data set(i) for i = 1, 15
    ! numj = dimension of jcol (e.g. 15)
    ! numk = dimension of kcol (e.g. 15)
    !-----------------------------------------------------------------------------------
    !  call gkslgl (isend, nlgl,
    ! +             varlgl)

    ! Defines logical defaults for the simple graphics procedures.
    ! isend and nlgl are integer intent (in) the rest are logical intent (inout)
    ! Note: This subroutine alters default settings in w_graphs.cfg
    !
    ! isend = 1: set default values directly
    ! isend = 2: set default values from a menu
    ! isend = 3: retrieve default values
    !      nlgl: number of logical variables (7 or more, depending on version)
    !    varlgl: Meaning of logical variables varlgl(nlgl) is as follows:
    !  (1) Box round data plotted                  ... default = .true.
    !  (2) Frame round outside of figure           ... default = .false.
    !  (3) Offset X, Y axes                        ... default = .false.
    !  (4) Grid at X-tic marks parallel to Y axis  ... default = .false.
    !  (5) Grid at Y-tic marks parallel to X axis  ... default = .false.
    !  (6) Cross hairs at 0,0 if in range          ... default = .false.
    !  (7) Tick marks pointing in                  ... default = .true.
    !
    !-----------------------------------------------------------------------------------
    !  call grflgl (isend, nlgl,
    ! +             varlgl)

    ! Exactly as for gkslgl except logical variables are for advanced graphics
    ! with additional options 8 to 12 as follows.
    !
    !  (8) Advanced only: Display a panel           ... default = .false.
    !  (9) Advanced only: Panel at RHS of plot      ... default = .false.
    ! (10) Advanced only: Show line type in panel   ... default = .true.
    ! (11) Advanced only: Show symbol type in panel ... default = .true.
    ! (12) Advanced only: Border round plot         ... default = .false.
    !----------------------------------------------------------------------------------
    !  call gstyle (n,
    ! +            la, ls, store)
    !
    ! Edit then store, or else retrieve current plotting styles held in w_graphs.cfg.
    ! Note: This subroutine alters default settings in w_graphs.cfg
    !
    !     n is integer intent (in) : dimension of la and ls (e.g. 12 or more depending on version)
    ! la(n) is logical intent (out): advanced logicals
    ! ls(n) is logical intent (out): simple logicals
    ! store is logical intent (in) : controls action i.e. edit then save, or retrieve
    !-----------------------------------------------------------------------------------
    ! call resdef (itype)
    !
    ! This subroutine is not usually necessary, but it makes sure that all the plotting
    ! parameters are initialised, and restores plot style parameters to Simfit defaults
    ! It over-writes current data in the graphics configuration files.
    !
    ! itype is integer intent (in)
    !
    ! itype = 0: choose from a menu
    ! itype = 1: restore simple graphics
    ! itype = 2: restore advanced graphics
    ! itype = 3: restore labels and panels
    ! itype = 4: restore lines and symbols
    ! itype = 5: restore all Simfit graphics defaults
    !-----------------------------------------------------------------------------------
    !
          implicit   none
          integer    isend, jsend, nfiles, njcol, nkcol, nlgl, nout
          parameter (isend = 1, jsend = 2, nfiles = 1, njcol = 5, &
                     nkcol = 12, nlgl = 12)
          integer    i, l, m, n
          integer    jcol(njcol), kcol(nkcol)
          integer    jfiles(nfiles), lfiles(nfiles), mfiles(nfiles)
          double precision x(100), y(100)
          character  files(nfiles)*1024, titles(4)*40
          logical    lglval_a(nlgl), lglval_s(nlgl)
          logical    askif, store, there
          parameter (askif = .false., store = .true.)
          external   gks001, smplot, getnou, deleet, gettmp
          external   gkslgl
          external   grflgl
          external   gkscol
          external   gstyle, resdef
    !
    ! restore defaults for simple and advanced graphics
    !
          call resdef (isend)
          call resdef (jsend)
    !
    ! set current default plotting styles interactively
    !
          call gstyle (nlgl, &
                       lglval_a, lglval_s, store)
    !
    ! initialise data for plotting then call gks001 using defaults
    !
          n = 6
          x(1) = 1.0000d+00
          x(2) = 1.0002d+00
          x(3) = 1.0004d+00
          x(4) = 1.0006d+00
          x(5) = 1.0008d+00
          x(6) = 1.0010d+00
          do i = 1, n
             y(i) = x(i) - 1.0d+00
          enddo
          l = 1
          m = 6
          titles(1) = 'Default Plot'
          titles(2) = 'X'
          titles(3) = 'Y'
          titles(4) = ' '
          call gks001 (l, m, n, &
                       x, y, &
                       titles(1), titles(2), titles(3))
    !
    ! now alter simple graphics defaults and colours then call gks001 again
    !

          lglval_s(1) = .true.  !BOXIT      ... box round data plotted
          lglval_s(2) = .false. !FRAME      ... frame round outside edge of diagram
          lglval_s(3) = .true.  !OFFSET     ... offset intersection of axes at origin
          lglval_s(4) = .true.  !XGRID      ... grid marks at X-axis tick marks
          lglval_s(5) = .true.  !YGRID      ... grid marks at Y-axis tick marks
          lglval_s(6) = .false. !XHAIRS     ... extra axes intersecting at (0,0)
          lglval_s(7) = .false. !TICK MARKS ... .TRUE.=in (KTIC=3), .FALSE.=out (KTIC=1)
          call gkslgl (isend, nlgl, &
                       lglval_s)

          jcol(1) = 4     !title      ... red
          jcol(2) = 1     !legends    ... blue
          jcol(3) = 2     !labels     ... green
          jcol(4) = 3     !axes       ... cyan
          jcol(5) = 7     !background ... grey
                          ! ...
          kcol(1) = 5     !data       ... magenta
          do i = 2, 12
             kcol(i) = 0 !data       ... colours for up to 12 data sets
          enddo
          call gkscol (isend, jcol, kcol, njcol, nkcol)

          titles(1) = 'User-configured Plot'
          call gks001 (l, m, n, &
                       x, y, &
                       titles(1), titles(2), titles(3))
    !
    ! call smplot showing that advanced graphics defaults have not been changed
    !
          call gettmp (i, &
                       files(1))
          call getnou (nout)
          open (unit = nout, file = files(1))
          write (nout,'(a)') 'Temporary data'
          write (nout,'(2i6)') n, 2
          do i = 1, n
             write (nout,'(2e13.5)') x(i), y(i)
          enddo
          close (unit = nout)
          jfiles(1) = 4
          lfiles(1) = l
          mfiles(1) = m
          titles(1) = 'Default Plot'
          call smplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles)
    !
    ! alter advanced graphics defaults then call smplot again
    !
          lglval_a(1) = .true.   !BOXIT      ... box round data plotted
          lglval_a(2) = .false.  !FRAME      ... frame round outside edge of diagram
          lglval_a(3) = .true.   !OFFSET     ... offset intersection of axes at origin
          lglval_a(4) = .true.   !XGRID      ... grid marks at X-axis tick marks
          lglval_a(5) = .true.   !YGRID      ... grid marks at Y-axis tick marks
          lglval_a(6) = .false.  !XHAIRS     ... extra axes intersecting at (0,0)
          lglval_a(7) = .false.  !TICK MARKS ... .TRUE.=in (KTIC=3), .FALSE.=out (KTIC=1)
          lglval_a(8) = .false.  !Display an information panel
          lglval_a(9) = .false.  !Panel at RHS of plot
          lglval_a(10) = .true.  !Display line-types in panel
          lglval_a(10) = .true.  !Display symbol-types in panel
          lglval_a(12) = .false. !Border round plot
          call grflgl (isend, nlgl, &
                       lglval_a) !Alter logical variables as for simple graphics
          titles(1) = 'User-configured Plot'
          call smplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles)
    !
    ! restore all defaults, simple and advanced, then delete the temporary file
    !
          call resdef (isend)
          call resdef (jsend)
          call deleet (files(1), &
                       askif, there)
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 35: configure lines, symbols, and colours
    !
                call configure_symbols
    !
    !----------------------------------------------------------------------
    !
           subroutine configure_symbols
    !
    ! This demonstrates how to use the subroutine symbol to configure the
    ! colours, lines, and symbols in calls to SIMFIT advanced graphics.
    !
    !  call symcfg (isend, jcolor, kcolor, l, m, n,
    ! +             sizes, thick)
    !
    !  isend: isend = 1 ... retrieve current defaults   ... return new values
    !         isend = 2 ... edit defaults interactively ... return new values
    !         isend = 3 ... restore built-in defaults   ... return new values
    !         isend = 4 ... over-write current defaults ... use values supplied
    ! jcolor: symbol colours
    ! kcolor: feature colours
    !      l: line styles
    !      m: symbol styles
    !      n: dimension
    !  sizes: symbol sizes
    !  thick: line thicknesses
    !
    ! Note: The arrays can be dimensioned up to nmax = 20
    !
          implicit   none
          integer    n, nmax, nout
          parameter (n = 6, nmax = 15, nout = 10)
          integer    i, isend, j
          integer    j_sav(nmax), k_sav(nmax), l_sav(nmax), m_sav(nmax)
          integer    jcolor(nmax), kcolor(nmax), l(nmax), m(nmax)
          double precision s_sav(nmax), t_sav(nmax)
          double precision sizes(nmax), thick(nmax)
          double precision const, x, y
          double precision one, two
          parameter (one = 1.0d+00, two = 2.0d+00)
          character (len = 1024) files(n)
          character (len = 20) titles(4)
          logical    askif, there
          parameter (askif = .false.)
          external   deleet, symcfg, smplot, gettmp
          intrinsic  dble
    !
    ! create the n data sets and write n temporary files
    !
          const = -one
          do i = 1, n
             call gettmp (j, &
                          files(i))
             const = const + one
             open (unit = nout, file = files(i))
             write (nout,'(a)') 'temporary file'
             write (nout,'(2i6)') n, 2
             do j = 1, n
                x = dble(j)
                y = const + x
                write (nout,'(1p,2e13.5)') x, y
             enddo
             close (unit = nout)
          enddo
    !
    ! retrieve the current parameters for subsequent restoration
    !
          isend = 1
          call symcfg (isend, j_sav, k_sav, l_sav, m_sav, n, &
                       s_sav, t_sav)
    !
    ! set the colour, type, and size parameters interactively but
    ! note that this control also displays the parameter meanings
    !
          isend = 2
          call symcfg (isend, jcolor, kcolor, l, m, n, &
                       sizes, thick)
    !
    ! plot the n data sets using the current defaults
    !
          titles(1) = 'Default'
          titles(2) = 'X'
          titles(3) = 'Y'
          titles(4) = ' '
          call smplot (jcolor, l, m, n, &
                       files, titles)
    !
    ! edit the plot style parameters
    !
          jcolor(1) = 4   !red for line 1
          kcolor(1) = 1   !blue title
          m(1) = 0        !suppress symbol 1
          thick(1) = two  !double line thickness 2
          jcolor(2) = 0   !black for line 2
          kcolor(2) = 4   !red for axes
          l(2) = 0        !suppress line 2
          sizes(3) = two  !double symbol size 3
          l(6) = 0        !suppress line 6
          m(6) = 1        !change symbol 6 to dots
          kcolor(8) = 7   !change background to grey
    !
    ! install the edited parameters
    !
          isend = 4
          call symcfg (isend, jcolor, kcolor, l, m, n, &
                       sizes, thick)
    !
    ! plot using the new parameter values
    !
          titles(1) = 'Edited'
          call smplot (jcolor, l, m, n, &
                       files, titles)
    !
    ! restore the defaults
    !
          isend = 4
          call symcfg (isend, j_sav, k_sav, l_sav, m_sav, n, &
                       s_sav, t_sav)
    !
    ! delete the temporary files
    !
          do i = 1, n
             call deleet (files(i), &
                          askif, there)
          enddo
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 36: configure labels
    !
                call configure_labels
    !
    !----------------------------------------------------------------------
    !
          subroutine configure_labels
    !
    ! This demonstrates how to call subroutine labcfg to set defaults such as
    ! pie chart and bar chart colours, and fill styles for pie chart segments,
    ! and bar chart rectangles. It also allows you to configure the default
    ! labels for pie and bar charts as well as for arbitrary plots with labels
    ! plotted next to symbols. In addition, panel keys for pie charts, bar
    ! charts, or all other types of information panel can be initialised.
    !
    ! Note: The arrays can be dimensioned up to nmax = 20
    !
    !  call labcfg (isend, jcolor, jfill, n,
    ! +             label, panel)
    !
    !  isend: isend = 1 ... retrieve current defaults   ... return new values
    !         isend = 2 ... edit defaults interactively ... return new values
    !         isend = 3 ... restore built-in defaults   ... return new values
    !         isend = 4 ... over-write current defaults ... use values supplied
    ! jcolor: colours
    !  jfill: fill styles
    !      n: dimension
    !  label: piechart segment or barchart labels
    !  panel: information panel labels
    !
          implicit   none
          integer    nmax
          parameter (nmax = 15)
          integer    i, isend, jsend, nvec
          integer    jcolor(nmax), jfill(nmax)
          integer    jcolor_sav(nmax), jfill_sav(nmax)
          double precision zero, one
          parameter (zero = 0.0d+00, one = 1.0d+00)
          double precision fact(nmax), xvec(nmax)
          character  label(nmax)*40, panel(nmax)*40
          character  label_sav(nmax)*40, panel_sav(nmax)*40
          character  title*80
          external   labcfg, pcplot
    !
    ! retrieve and store the current parameters
    !
          isend = 1
          call labcfg (isend, jcolor, jfill, nmax, &
                       label, panel)
    !
    ! save current values just set using isend = 1
    !
          do i = 1, nmax
             jcolor_sav(i) = jcolor(i)
             jfill_sav(i) = jfill(i)
             label_sav(i) = label(i)
             panel_sav(i) = panel(i)
             fact(i) = zero
             xvec(i) = one
          enddo
    !
    ! demonstrate use of the interactive control (isend = 2)
    !
          isend = 2
          call labcfg (isend, jcolor, jfill, nmax, &
                       label, panel)
    !
    ! plot a pie chart with the current configuration
    !
          nvec = 10
          jsend = 2
          title = 'Current Labels and Panel Keys'
          call pcplot (jsend, jfill, jcolor, nvec, &
                       fact, xvec, &
                       label, title)
    !
    ! alter the configuration and displace the segments
    !
          do i = 1, nvec
            fact(i) = one
            write (label(i),'(a,i3)') 'Segment',i
            write (panel(i),'(a,i3)') 'Data',i
          enddo
    !
    ! over-write the configuration (isend = 4)
    !
          isend = 4
          call labcfg (isend, jcolor, jfill, nvec, &
                       label, panel)
    !
    ! plot a pie chart with the new labels and panel keys
    !
          jsend = 2
          title = 'New Labels and Panel keys'
          call pcplot (jsend, jfill, jcolor, nvec, &
                       fact, xvec, &
                       label, title)
    !
    ! restore the original pie chart parameters (isend = 4)
    !
          call labcfg (isend, jcolor_sav, jfill_sav, nmax, &
                       label_sav, panel_sav)
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 37: configure character keys
    !
                call configure_keys
    !
    !----------------------------------------------------------------------
    !
          subroutine configure_keys
    !
    ! Demonstration of subroutine defkey
    !
    ! Simfit uses text keys to display non-standard characters and
    ! subroutine defkey allows programmers to specify special Maths
    ! characters, subscripts, superscripts, and accents, etc. for
    ! individual character strings. Additionally, defkey can be used
    ! to install a subsidiary plot title.
    !
    ! call defkey (isend, jsend,
    !              key,
    !              store)
    !
    ! isend: integer, intent (in) acts as follows,
    !        isend = 1: store/retrieve title keys
    !        jsend = 1 key for main title
    !        jsend = 2 key for x-legend
    !        jsend = 3 key for y-legend
    !        jsend = 4 key for z-legend in double plots
    !        jsend = 5 key for subsidiary title
    !        jsend = 6 text for subsidiary title
    !        isend = 2: store/retrieve panel keys
    !        isend = 3: store/retrieve label keys
    !        isend = 4: store/retrieve x_tick keys
    ! jsend: integer, intent (in) index within the array of text keys
    !        specified by isend when isend = 2, 3 or 4
    !   key: character, intent (inout) key that is stored or retrieved
    ! store: logical, intent (in) dictates if store or retrieve is required.
    !
    ! Character keys alter the way that characters are plotted as follows:
    !
    ! key  effect on character plotted
    ! ---  ---------------------------
    !   0  normal font (can also use ?)
    !   1  subscript
    !   2  superscript
    !   3  Maths/Greek
    !   4  Maths/Greek subscript
    !   5  Maths/Greek superscript
    !   6  Bold Maths/Greek
    !   7  ZapfDingbats in Postscript, Wingdings in Windows
    !   8  ISOLatin1 (almost identical to Windows)
    !   9  Special in PostScript, Wingding2 in Windows
    !   A  Grave accent
    !   B  Acute accent
    !   C  Hat
    !   D  Tilde
    !   E  Bar
    !   F  Dieresis
    !   G  Maths/Greek with hat
    !   H  Maths/Greek with bar
    !   I  Bold Maths/Greek with hat
    !   J  Bold Maths/Greek with bar
    !   K  Symbol
    !   L  Bold Symbol
    !
    ! Every text string plotted has an associated text key vector to control
    ! the appearance as described in the documents w_manual.pdf and pscodes.pdf.
    ! The corresponding code pages and keyboard maps to explain what these
    ! parameters mean can be displayed from the SIMFIT plot text editing control,
    ! and extensive documentation can be found in w_manual.pdf or pscodes.pdf.
    !
          external panel_keys
          call panel_keys
          end
    !
    !----------------------------------------------------------------------
    !
          subroutine panel_keys
    !
    ! demonstrate labels and panels with special characters
    !
          implicit   none
          integer    n
          parameter (n = 9)
          integer    i, j
          integer    isend, ifill(n), ihue(n)
          double precision d(n), x(n), zero, one
          parameter (zero = 0.0d+00, one = 1.0d+00)
          character  label(n)*40, pline(n)*40, title*80
          character  label_sav(n)*40, pline_sav(n)*40
          character  lkey*40, lkey_sav(n)*40, pkey*40, pkey_sav(n)*40
          logical    store
          external   labcfg, pcplot, defkey
          intrinsic  dble
    !
    ! save the default colours, fill styles, labels, panels, and keys
    !
          isend = 1
          call labcfg (isend, ihue, ifill, n, &
                       label_sav, pline_sav)
          store = .false.
          do i = 1, n
             isend = 2
             call defkey (isend, i, &
                          pkey_sav(i), &
                          store)
             isend = 3
             call defkey (isend, i, &
                          lkey_sav(i), &
                          store)
          enddo
    !
    ! initialise the n labels and panel as a, b, c, d, ...
    !
          j = 96
          do i = 1, n
             j = j + 1
             write (label(i),'(a)') char(j)
             pline(i) = label(i)
          enddo
    !
    ! define the segment values
    !
          do i = 1, n
             d(i) = zero
             x(i) = one
          enddo
    !
    ! define the pie chart title
    !
          title = 'Maths Characters for Labels and Panel Keys'
    !
    ! define the new panels and associated character keys
    !
          store = .true.
          pkey = '3'
          lkey = '3'
          do i = 1, n
             isend = 2
             call defkey (isend, i, &
                          pkey, &
                          store)
             isend = 3
             call defkey (isend, i, &
                          lkey, &
                          store)
          enddo
    !
    ! install the new pline to overwrite the existing panel text defaults
    !
          isend = 4
          call labcfg (isend, ihue, ifill, n, &
                       label, pline)
    !
    ! call pcplot with isend = 2 to use the arguments supplied
    !
          isend = 2
          call pcplot (isend, ifill, ihue, n, &
                       d, x, label, &
                       title)
    !
    ! clean up
    !
          isend = 4
          call labcfg (isend, ihue, ifill, n, &
                       label_sav, pline_sav)
          store = .true.
          do i = 1, n
             isend = 2
             call defkey (isend, i, &
                          pkey_sav(i), &
                          store)
             isend = 3
             call defkey (isend, i, &
                          lkey_sav(i), &
                          store)
          enddo
          end
    !
    !----------------------------------------------------------------------
    !
          subroutine title_keys
    !
    ! plot subsidiary titles with reduced size and special characters
    !
          implicit   none
          integer    n, nfiles, nout
          parameter (n = 100, nfiles = 1, nout = 10)
          integer    i, j
          integer    jfiles(nfiles), lfiles(nfiles), mfiles(nfiles)
          double precision delta, factor, x, y
          character  files(nfiles)*1024, titles(4)*80, title2*80
          character  key*80, key_sav*80
          logical    askif, there
          logical    store
          external   defkey, deleet, smplot, gettmp, tsizes
    !
    ! retrieve and save the existing default title key
    !
          store = .false.
          i = 1
          j = 1
          call defkey (i, j, &
                       key_sav, &
                       store)
    !
    ! set up data for a graph
    !
          jfiles(1) = 0
          lfiles(1) = 1
          mfiles(1) = 1
          call gettmp (i, &
                       files(1))
          titles(1) = 'Order 2:2 Positive Rational Function'
          titles(2) = 'x'
          titles(3) = 'y'
          titles(4) = ' '
          open (unit = nout, file = files(1))
          write (nout,'(a)') 'temporary file'
          write (nout,'(2i6)') n, 2
          delta = 0.1d+00
          x = delta
          do i = 1, n
             y = x/(1.0d+00 + x + x**2)
             x = x + delta
             write (nout,'(2e13.5)') x, y
          enddo
          close (unit = nout)
    !
    ! store the new subsidiary plot title and key then plot the graph
    !
          title2 = '(a1x + a2x2)/(1 + b1x + b2x2)'
             key = '03100003102000000031000031020'
          store = .true.
          i = 1
          j = 5
          call defkey (i, j, &
                       key, &
                       store)
          j = 6
          call defkey (i, j, &
                       title2, &
                       store)
    !
    ! make the font smaller for the subsidiary title
    !
          i = 12
          factor = 0.75d+00
          call tsizes (i, &
                       factor, &
                       store)
          call smplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles)
    !
    ! clean up
    !
          store = .true.
          i = 1
          j = 5
          call defkey (i, j, &
                       key_sav, &
                       store)
          j = 6
          title2 = ' '
          call defkey (i, j, &
                       title2, &
                       store)
          askif = .false.
          call deleet (files(1), &
                       askif, there)
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 38: configure font sizes
    !
                call configure_sizes
    !
    !----------------------------------------------------------------------
    !
          subroutine configure_sizes
    !
    ! This demonstrates how to call tsizes to adjust font sizes for titles, etc.
    ! which is often required, e.g. with subsidiary plot titles. Colour for
    ! the subsidiary title is set using subroutine labcfg.
    !
    ! call tsizes (itype,
    !              factor,
    !              store)
    !
    !  itype: integer, intent (in)
    !         indicates the type of font required as follows:
    !         itype =  1: title (main)
    !         itype =  2: x-legend
    !         itype =  3: y-legend
    !         itype =  4: z-legend
    !         itype =  5: x-text-labels
    !         itype =  6: y-text-labels
    !         itype =  7: z-text-labels
    !         itype =  8: bar chart labels
    !         itype =  9: pie chart labels
    !         itype = 10: panel labels
    !         itype = 11: data point labels
    !         itype = 12: title (subsidiary)
    !         itype = 13: x-numbers
    !         itype = 14: y-numbers
    !         itype = 15: z-numbers
    ! factor: double precision, intent (inout)
    !         if store = .true. store factor
    !         if store = .false. return the stored value
    !  store: logical, intent (in) type of action required as above
    !
          external title_keys
          call title_keys
          end
    !
    !----------------------------------------------------------------------
    !
          subroutine title_keys
    !
    ! plot subsidiary titles with reduced size and special characters
    !
          implicit   none
          integer    n, nfiles, nout
          parameter (n = 100, nfiles = 1, nout = 10)
          integer    i, j
          integer    jfiles(nfiles), lfiles(nfiles), mfiles(nfiles)
          double precision delta, factor, x, y
          character  files(nfiles)*1024, titles(4)*80, title2*80
          character  key*80, key_sav*80
          logical    askif, there
          logical    store
          external   defkey, deleet, smplot, gettmp, tsizes
    !
    ! retrieve and save the existing default title key
    !
          store = .false.
          i = 1
          j = 1
          call defkey (i, j, &
                       key_sav, &
                       store)
    !
    ! set up data for a graph
    !
          jfiles(1) = 0
          lfiles(1) = 1
          mfiles(1) = 1
          call gettmp (i, &
                       files(1))
          titles(1) = 'Order 2:2 Positive Rational Function'
          titles(2) = 'x'
          titles(3) = 'y'
          titles(4) = ' '
          open (unit = nout, file = files(1))
          write (nout,'(a)') 'temporary file'
          write (nout,'(2i6)') n, 2
          delta = 0.1d+00
          x = delta
          do i = 1, n
             y = x/(1.0d+00 + x + x**2)
             x = x + delta
             write (nout,'(2e13.5)') x, y
          enddo
          close (unit = nout)
    !
    ! store the new subsidiary plot title and key then plot the graph
    !
          title2 = '(a1x + a2x2)/(1 + b1x + b2x2)'
             key = '03100003102000000031000031020'
          store = .true.
          i = 1
          j = 5
          call defkey (i, j, &
                       key, &
                       store)
          j = 6
          call defkey (i, j, &
                       title2, &
                       store)
    !
    ! make the font smaller for the subsidiary title
    !
          i = 12
          factor = 0.75d+00
          call tsizes (i, &
                       factor, &
                       store)
          call smplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles)
    !
    ! clean up
    !
          store = .true.
          i = 1
          j = 5
          call defkey (i, j, &
                       key_sav, &
                       store)
          j = 6
          title2 = ' '
          call defkey (i, j, &
                       title2, &
                       store)
          askif = .false.
          call deleet (files(1), &
                       askif, there)
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 39: configure panels
    !
                call configure_panels
    !
    !----------------------------------------------------------------------
    !
          subroutine configure_panels
    !
    ! subroutine deflab .. store/retrieve complete or partial vectors for the default
    !                      plot-labels, panel-labels, or associated character-keys
    !
    ! call deflab (isend, ntext,
    !              text,
    !              store)
    !
    ! isend: integer, intent (in)
    !        isend = 1 ... plot-labels
    !        isend = 2 ... panel-labels
    !        isend = 3 ... plot-label character-keys
    !        isend = 4 ... panel-label character-keys
    !     n: integer, intent (in)
    !        number of values required 1 =< n =< nmax, nmax = 20
    !  text: character, intent (inout)
    !        text string corresponding to the value of isend
    ! store: logical, intent (in)
    !        store = .true.  ... store text
    !        store = .false. ... retrieve text
    !
    ! This routine uses the same conventions as defkey except that deflab can
    ! store or retrieve the complete default vectors of plot-labels, panel-labels,
    ! plot-label character-keys or panel-label character-keys, not just the
    ! character-keys used by defkey.
    !
    ! Note: k = lambda and l = mu when the corresponding character key is 3
    !
          implicit none
          integer    nfiles, n, nout, ntext
          parameter (nfiles = 8, n = 10, nout = 10, ntext = nfiles)
          integer    i, isend, j, jcolor(nfiles), jsend, l(nfiles), &
                     m(nfiles)
          double precision const, slope, x, y
          double precision zero, one, epsi
          parameter (zero = 0.0d+00, one = 1.0d+00, epsi = 0.1d+00)
          character (len = 1024) files(nfiles)
          character (len = 80) titles(4), tkey, tkey_sav
          character (len = 40) pline(15), pline_sav(15), psymb(15), &
                               psymb_sav(15)
          logical    store
          external   smplot, gettmp, deltmp, deflab, defkey
    !
    ! retrieve the default panel-labels, panel-keys, and plot_title key
    !
          store = .false.
          isend = 2
          call deflab (isend, ntext, pline_sav, store)
          isend = 4
          call deflab (isend, ntext, psymb_sav, store)
          isend = 1
          jsend = 1
          call defkey (isend, jsend, tkey_sav, store)
    !
    ! initialise new panel_labels and panel keys
    !
          do i = 1, ntext
             pline(i) = pline_sav(i)
             psymb(i) = psymb_sav(i)
          enddo
    !
    ! calculate the data
    !
          const = - one
          slope = one - epsi
          do i = 1, nfiles
             jcolor(i) = i
             l(i) = 1
             m(i) = i
             call gettmp (j, &
                          files(i))
             open (unit = nout, file = files(i))
             write (nout,'(a)') 'temporary file'
             write (nout,'(2i4)') n, 2
             const = const + one
             slope = slope + epsi
             write (pline(i),100) const, slope
             write (psymb(i),200)
             x = zero
             do j = 1, n
                x = x + one
                y = const + slope*x
                write (nout,'(1p,2e11.3)') x, y
             enddo
             close(unit = nout)
          enddo
    !
    ! define the titles, install the new panel and keys then plot
    !
          titles(1) = 'y = k + lx: Please Display the Panel'
               tkey = '000030003000000000000000000000000000'
          isend = 1
          jsend = 1
          store = .true.
          call defkey (isend, jsend, tkey, store)
          titles(2) = 'x'
          titles(3) = 'y'
          titles(4) = ' '
          store = .true.
          isend = 2
          call deflab (isend, ntext, pline, store)
          isend = 4
          call deflab (isend, ntext, psymb, store)
          call smplot (jcolor, l, m, nfiles, files, titles)
    !
    ! clean up
    !
          store = .true.
          isend = 2
          call deflab (isend, ntext, pline_sav, store)
          isend = 4
          call deflab (isend, ntext, psymb_sav, store)
          isend = 1
          jsend = 1
          call defkey (isend, jsend, tkey_sav, store)
          call deltmp
      100 format ('k=',f3.1,',l=',f3.1)
      200 format ('30000030000')
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 40: configure nsteps
    !
                call configure_nsteps
    !
    !----------------------------------------------------------------------
    !
    !
          subroutine configure_nsteps
    !
    ! Subroutine nsteps allows plots to be made where it is useful to
    ! leave gaps and insert steps between consecutive points plotted
    ! to avoif over-crowding, especially with symbols.
    ! This is a useful way to identify data plotted in information
    ! panels, so this feature is also illustrated.
    !
    ! call nsteps (isend, l_step, m_step, nfiles)
    !
    !  isend: isend = 1 ... retrieve current values
    !         isend = 2 ... interactive control then return new values
    !         isend = 3 ... install new defaults using values supplied
    !         isend = 4 ... restore original defaults (all = 0)
    ! l_step: nstep values for lines   ... leave gaps of l_step points
    ! m_step: nstep values for symbols ... leave gaps of m_step points
    ! nfiles: number of current files for plotting
    !
          implicit   none
          integer    n, nfiles, nlgl, nout, ntext
          parameter (n = 200, nfiles = 3, nlgl = 10, nout = 10, &
                     ntext = nfiles)
          integer    i, j
          integer    jfiles(nfiles), lfiles(nfiles), mfiles(nfiles)
          integer    isend, l_sav(nfiles), l_step(nfiles), m_sav(nfiles), &
                     m_step(nfiles)
          double precision const, delta, five, two, zero, x, y
          parameter (delta = 0.05d+00, five = 5.0d+00, two = 2.0d+00, &
                     zero = 0.0d+00)
          character  files(nfiles)*1024, titles(4)*80
          character  pline_sav(15)*20, pline(15)*20
          logical    lgl_sav(nlgl), lgl(nlgl)
          logical    askif, store, there
          parameter (askif = .false.)
          external   smplot, gettmp, deleet, grflgl, nsteps, deflab
    !
    ! Save current defaults then over-write for appropriate steps between symbols
    !
          isend = 1
          call nsteps (isend, l_sav, m_sav, nfiles)
          do i = 1, nfiles
             l_step(i) = l_sav(i)
          enddo
          m_step(1) = 0
          m_step(2) = 5
          m_step(3) = 20
          isend = 3
          call nsteps (isend, l_step, m_step, nfiles)
    !
    ! save current defaults then configure graph to display a panel and a border
    !
          isend = 3
          call grflgl (isend, nlgl, &
                       lgl_sav)
          do i = 1, 8
             lgl(i) = lgl_sav(i)
          enddo
          lgl(8) = .true.   !Plot a Panel
          lgl(9) = .false.  !Place panel underneath graph not at side
          lgl(10) = .true.  !Add a border around the graph
          isend = 1
          call grflgl (isend, nlgl, &
                       lgl)
    !
    ! save current defaults then over-write panel labels
    !
          isend = 2
          store = .false.
          call deflab (isend, ntext, &
                       pline_sav, &
                       store)
          pline(1) = 'nstep = 0'
          pline(2) = 'nstep = 5'
          pline(3) = 'nstep = 20'
          store = .true.
          call deflab (isend, ntext, &
                       pline, &
                       store)
    !
    ! define the plot titles and symbols
    !
          titles(1) = 'Damped Oscillations'
          titles(2) = 't'
          titles(3) = 'f(t) = exp(-t/2)sin(5t)'
          titles(4) = ' '
          mfiles(1) = 1
          mfiles(2) = 5
          mfiles(3) = 8
    !
    ! generate the data
    !
          const = - two
          do i = 1, nfiles
             jfiles(i) = 0
             lfiles(i) = 1
             call gettmp (j, &
                          files(i))
             open (unit = nout, file = files(i))
             write (nout,'(a)') 'temporary file'
             write (nout,'(2i6)') n, 2
             const = const + two
             x = zero
             do j = 1, n
                y = const + exp(-x/two)*sin(five*x)
                x = x + delta
                write (nout,'(2e13.5)') x, y
             enddo
             close (unit = nout)
          enddo
    !
    ! create the graph
    !
          call smplot (jfiles, lfiles, mfiles, nfiles, &
                       files, titles)
    !
    ! clean up
    !
          isend = 3
          call nsteps (isend, l_sav, m_sav, nfiles)
          isend = 2
          store = .true.
          call deflab (isend, ntext, &
                       pline_sav, &
                       store)
          isend = 1
          call grflgl (isend, nlgl, &
                       lgl_sav)
          do i = 1, nfiles
             call deleet (files(i), &
                          askif, there)
          enddo
          end

Back to Menu or Simdem70 options

    !
    ! numdec = 41: display font maps
    !
                call xfonts

Back to Menu or Simdem70 options

    !
    ! numdec = 42: restore defaults
    !
                i1 = 0
                call resdef (i1)

Back to Menu or Simdem70 options

    !
    ! numdec = 43: replay a metafile
    !
                call replay
    !
    !----------------------------------------------------------------------
    !
          subroutine replay
    !
    ! replay a metafile stored from Simfit advanced graphics
    ! in order to resume editing
    !
          integer    nout
          character  aux256*1024, temp*1024
          character  fname*12, title*6
          parameter (fname = 'f$simfit.tmp', &
                     title = 'simdem')
          logical    askif, there
          parameter (askif = .false.)
          external   aux256, deleet, getnou
          external   mfplot, putadv
    !
    ! Create the simdem identifier file f$simfit.tmp so the [Demo] button will work
    !
          temp = aux256(fname)
          call getnou (nout)
          open (unit = nout, file = temp)
          write (nout,'(a)') title
          close (unit = nout)
          call putadv ( &
          'Use the [Demo] file selection option for SIMDEM test files')
          call mfplot
    !
    ! delete the identifier file
    !
          call deleet (temp, &
                       askif, there)
          end

Back to Menu or Simdem70 options

    ! ------------------------------------------------------
    ! Closing source code for simdem70 and format statements
    ! ------------------------------------------------------
    !
    ! numdec = 44: change ntemp and re-set y1 through to y12
    !
                i1 = 5
                i2 = ntemp
                i3 = nmax
                call getjm1 (i1, i2, i3, 'New value required')
                if (i2.ne.ntemp) then
                   ntemp = i2
                   do i = 1, 12
                      n(i) = ntemp
                   enddo
                   delta = twopi/dble(ntemp)
                   do i = 1, ntemp
                      y1(i) = two + sin(x1(i)*delta)
                      y2(i) = y1(i) + one
                      y3(i) = y2(i) + one
                      y4(i) = y3(i) + one
                      y5(i) = y4(i) + one
                      y6(i) = y5(i) + one
                      y7(i) = y6(i) + one
                      y8(i) = y7(i) + one
                      y9(i) = y8(i) + one
                      y10(i) = y9(i) + one
                      y11(i) = y10(i) + one
                      y12(i) = y11(i) + one
                      yh1(i) = y1(i) + error
                      yh3(i) = y3(i) + error
                      yl1(i) = y1(i) - error
                      yl3(i) = y3(i) - error
                      xp(i) = cos(two*x1(i)*delta)
                      yp(i) = sin(two*x1(i)*delta)
                   enddo
                endif
    !
    ! numdec = numopt: exit loop
    !
                repeet = .false.
             endif
          enddo
    !
    ! delete all temporary files
    !
          call deltmp
    !
    ! format statements
    !
      100 format ( &
           'Help  `Details                              ` ' &
          /'gks001`no. of plots = 1                     `*' &
          /'gks004`no. of plots =< 4                    `*' &
          /'gks012`no. of plots =< 12                   `*' &
          /'gkst04`no. of transforms =< 4               `*' &
          /'gkst12`no. of transforms =< 12              `*' &
          /'gkseb4`error bars...standard                `*' &
          /'gkscb4`error bars...restricted              `*' &
          /'gkshb4`error bars...rotated                 `*' &
          /'gksvf1`vector field                         `*' &
          /'gksvf3`vector field with labels             ` ' &
          /'bcplot`bar chart                            ` ' &
          /'sbplot`stack plot                           ` ' &
          /'bwplot`box and whisker plot                 ` ' &
          /'cdplot`cumulative and cdf                   ` ' &
          /'dgplot`dendrogram                           ` ' &
          /'ebplot`bar chart with error bars            ` ' &
          /'elips1`confidence ellipses                  `*' &
          /'hist01`histograms                           ` ')
      101 format ( &
           'hnplot`normal/half-normal plot              `*' &
          /'lbplot`plot with labels                     ` ' &
          /'mtplot`columns/rows from matrix             ` ' &
          /'pcplot`pie chart                            ` ' &
          /'pdplot`histogram and pdf                    ` ' &
          /'rtplot`parametric r = r(theta)              ` ' &
          /'smplot`n advanced plots                     `*' &
          /'tsplot`time series                          `*' &
          /'space0`parametric space curve               `*' &
          /'surd2s`surface/contour/barchart             ` ' &
          /'space6`3D curves/swarms/vectors             ` ' &
          /'images`display examples                     ` ' &
          /'editps`Postscript collages and procedures   ` ' &
          /'dbplot`one x-scale but two y-scales         ` ' &
          /'gstyle`edit/restore default plot features   ` ' &
          /'symcfg`configure symbols/lines/colours      ` ' &
          /'labcfg`configure labels/keys/fill-styles    ` ' &
          /'defkey`define maths/accents/sub/superscripts` ' &
          /'tsizes`adjust font sizes                    ` ')
      102 format ( &
           'deflab`define labels/panels/character-keys  ` ' &
          /'nsteps`create gaps between data plotted     ` ' &
          /'xfonts`display Simfit font substitution maps` ' &
          /'resdef`restore Simfit 2D plotting defaults  ` ' &
          /'mfplot`replay a metafile to resume editing  ` ' &
          /'edit n`current n =',i6,'                    `*' &
          /'Cancel`Exit program SIMDEM70                ` ')
      200 format ('Plot with n =',i6)
      300 format ('Calling the Simfit graphics routines' &
          / &
          /'This program provides a simple way to explore the standard' &
          /'plot types that you can call from the simdem library DLLs.' &
          /'The DLLs also contain many more advanced subroutines that' &
          /'can also be called, as the DLLs are compiled with exportall.' &
          / &
          /'Many of the routines have a size parameter (n) which you can' &
          /'alter to observe the effects of different sample sizes. Such' &
          /'routines are indicated by a *, meaning that editing the value' &
          /'for n changes the sample size for all routines so indicated.' &
          / &
          /'This synopsis only gives an outline of the scope of simdem70,' &
          /'as it expected that after running an option you will want to' &
          /'view the source code for that chosen option. To do this, run' &
          /'an option then select to view the corresponding source code.' &
          / &
          /'Further documentation' &
          / &
          /'Read the documents simdem.html, simdem.chm, or source files' &
          /'that can be can be downloaded from https://simfit.org.uk.')
          end

Back to Menu or Simdem70 options