xgauprof.src

        Copyright (c) Kapteyn Laboratorium Groningen 2001
        All Rights Reserved.

Name:         xgauprof.src
Creator:      vogelaar
Host:         albirumi
Date:         Nov 15, 2001
Contents:     xgauprof.make xgauprof.dc1 xgauprof.tex xgauprof.h gui.h
              plotdevices.h import.h parcol.h pgutils.h param.h
              plotopt.h outputresults.h slider.h hidden.h misopt.h
              xgauprof.c gui.c plotdevices.c dofit.c allocs.c
              import.c parcol.c pgutils.c utils.c param.c
              plotopt.c outputresults.c slider.c hidden.c misopt.c

#>            xgauprof.make
#----------------------------------------------------------------------
# Makefile for XGAUPROF, Feb 22, 1999
#
#
# Pack sources into render.src with:     > make -f xgauprof.make pack
# Clean executable and objects           > make -f xgauprof.make clean
# Unpack source files with:              > $gip_exe/xfile xgauprof.src
# Install source file with:              > p -reserve xgauprof.src
#                                        > p -install xgauprof.src
#
# Local compilation for testing:         > p xgauprof.make
#
# The CC_OPTS etc. are set by 'compile'
#----------------------------------------------------------------------

SHELL = /bin/sh

OPTS  = $(CC_OPTS)
COMP  = $(CC_COMP)
LIBS  = $(CC_LIBS)

.SUFFIXES: .c .o

DOCUMENTS = xgauprof.dc1 xgauprof.tex

INCLUDES  = xgauprof.h gui.h plotdevices.h import.h parcol.h pgutils.h param.h  plotopt.h outputresults.h slider.h hidden.h misopt.h

SOURCES   = xgauprof.c gui.c plotdevices.c dofit.c allocs.c import.c parcol.c pgutils.c utils.c param.c  plotopt.c outputresults.c slider.c hidden.c misopt.c

OBJECTS   = xgauprof.o gui.o plotdevices.o dofit.o allocs.o import.o parcol.o pgutils.o utils.o param.o plotopt.o outputresults.o slider.o hidden.o misopt.o


default:: xgauprof

pack::
	$${gip_sys}/pack.csh xgauprof.src xgauprof.make \
        $(DOCUMENTS) $(INCLUDES) $(SOURCES) $(PGINCLUDE)

clean::
	rm -f xgauprof $(OBJECTS)

xgauprof.o: xgauprof.h

dofit.o:    xgauprof.h

allocs.o:   xgauprof.h

gui.o: gui.h


.c.o:  
	@echo "$(CC_COMP) -c $(CC_OPTS) $(X11_OPTS) $< ";\
	$(CC_COMP) -c $(CC_OPTS) $(X11_OPTS) $<

xgauprof: $(OBJECTS)
	@echo "$(CC_COMP) -o xgauprof $(OBJECTS) $(X11_LIBS) $(CC_LIBS) $(XT_LIBS)";\
	$(CC_COMP) -o xgauprof $(OBJECTS) $(X11_LIBS) $(CC_LIBS) $(XT_LIBS)

#<

#>            xgauprof.dc1
Program:       XGAUPROF
               

#begin section gettingstarted
                                 GETTING STARTED
                                 ===============


               XGAUPROF fits parameters of a number of Gauss related 
               functions to data from a GIPSY set or to data from file.
               The functions include also fitting of skewness and 
               kurtosis parameters and Lorentzian line widths.
                             
               Enter the name of a GIPSY set in the 'Setname' input field.
               Do not specify any axes or ranges yet.
               If the set exists, you get a 'Profile axis' menu to the
               right of the 'Setname' field. Select the axis that represents
               the X-axis of your profile(s). A default grid range will
               appear. Enter a box. If you press <enter> in an empty box 
               field, a default will appear. The first profile in the box
               will be plotted and if you see a green curve (initial guess
               curve) you can push the <FIT> button to fit the profile.

#end section gettingstarted               
              
               
#begin section buttons              
                       DESCRIPTION OF THE BUTTONS AND INPUT FIELDS
                       ===========================================
               
               MAIN GUI
               
               Usually you will start the program without specifying any
               keywords. To get results you will have to enter the name 
               of a GIPSY image first (if you want to import data from other 
               sources, see description at <IMPORT>).
               Then the 'Profile axis' menu will become active. This menu 
               contains the names of all the axes in your set. After this,
               the default limits in grid coordinates of your profiles is
               displayed in the input field 'Grid range'. This value can
               be changed at any time to exclude unsuitable data. The input 
               field 'Phys. range' corresponds to the grid range. Here you 
               can change the limits in physical coordinates.
               
              
               Pressing <enter> in the 'Box' input field will generate a default 
               box. Note that the default generates the maximum possible box,
               so if you start with a big cube, then it can take a while 
               before all data is read. Finally you get a default in the
               'Position' input field. Usually this is the first position 
               in the box and you immediately will see the corresponding 
               profile in the plot at the left of the gui.
               You can go trough all the selected profiles with the 
               '<' and '>' buttons. If you have initial guesses (usually 
               plotted in green) then you can try to make a fit by pressing 
               the <FIT> button. Results will appear in the panels just 
               below the input fields. 
               The output of results will be discussed later.
             
               It is possible to exclude data by clicking with the left
               hand mouse button in the neighbourhood of the point that you 
               want to exclude. In the <FIT OPTIONS> window there is also 
               an option to exclude points by giving the range of points
               that you want to include!

               You can set a clip or range to the Y data in the Clip
               input field in the same <FIT OPTIONS> window. Values
               below the clip (1 value entered) are marked in the plot 
               and get weight zero in the fit. If you entered two values,
               then all values outside this range are marked and get 
               weight zero in the fit. 
             
               The button <STORE> is designed to allow 
               the storage of the fit results on disk. It is activated only 
               after the selection of a proper file name in the <FILE> menu.
               The <CLEAR> button redraws data and initial estimates.

               <FILE>
               
               This button starts a menu with the options:
               
               
               1) 'save plot' 
                  This option results in sending your current plot 
                  to a printer or a PostScript file. In a sub menu you
                  will be asked to give a file name and to select a 'Plotter'.
                  If the file already exists, you will be warned. Writing
                  is started after pressing the <PLOT> button. 
                  The file name that you entered, is displayed in the 
                  gui and the GIPSY log.
               2) 'save profile data'
                  Save current profile data to a file on disk. This can be
                  handy if you want to import your GIPSY data in a package
                  that reads ASCII files.
                  Be sure that you made a fit before saving the data, otherwise
                  the fitted amplitudes and the residuals are dummies.
                  Here is part of an example output file:

                  !  X GRID   X PHYSICAL    AMPLITUDE  FITTED AMPL     RESIDUAL
                        -49      816.783    -0.229097  2.63399e-47    -0.229097
                        -48      820.927    -0.245038  7.42847e-46    -0.245038  
                  .......
                  .......

               3) 'Fit output file (short)'
                  Open a file to which the fit results can be sent. If
                  you entered a valid name, the <STORE> button in the main gui
                  is enabled. Pressing this button results in writing the 
                  current fit data to the ASCII file until the program is
                  finished. The layout of the file
                  is such that all output of one fit is written onto one 
                  line. A header will inform you about the meaning of the 
                  numbers. If a fit could not be made, a message is given.
               4) 'Fit output file (long)'
                  Same as above, but the results are written in a so called 
                  log format.
               5) 'Events input file'
                  If you want to process a couple of profiles, it is sometimes
                  easier to store events in a file. There are two methods. 
                  
                  The common method is using the Ggi event player which is started
                  by clicking the right mouse button in the background of the
                  main gui. 

                  However, this application has also it's own event player and
                  this one works as follows: Create an ASCII file on 
                  disk and write the following lines in that file:

                  setname=real
                  profile=freq
                  box=-10 -10 10 10
                  GUI_FILE=2
                  PROMPTER_OK=y
                  PROMPTER_OK=y 
                  fit=y
                  fstore=y
                  next=y
                  fit=y 
                  fstore=y 

                  Give it the name events.txt and enter this name in the 
                  input field under <FILE>, 'Events input file'.
                  The text will be read and events are generated immediately.
                  The events are just keywords with a value. The problem
                  is to find which keyword corresponds to a button.
                  If you are running XGAUPROF, type on the Hermes command
                  line: XGAUPROF MONITOR=Y
                  Press a button and you will see a log of the keyword(s)
                  that is/are involved. However you have to distinguish 
                  yourself which events are generated by you and which are
                  generated by the system as a reaction on your action.
                  Note that this mechanism is different from the so called
                  GIPSY defaults file.
                  


                 
               <IMPORT>
               
               Pressing <IMPORT> will pop up a window for importing
               data from OTHER sources than a GIPSY image. Both reading
               from text file and reading from a GIPSY table are supported. 
               The syntax for the rows is displayed in the help text
               of the 'Rows' input field.
               
               Example: Read all x and y values from file 'perfil.dat':
               
                        Filename:  perfil.dat
                        Column X:  1
                               Y:  2
                        Errors  :
                        Rows    :  :
                        
               (Pressing <enter> in the rows field has the same effect
               as entering the colon.)
               Note that in order to get initial guesses for the least
               squares fit, your Y values must not be too small
               (> 1e-8). 
               For the least squares fit routine it doesn't matter how
               the X-values in your data are distributed, however for
               the initial estimates routine we need equally spaced
               X-values. Therefore XGAUPROF will eliminate duplicates
               in X and uses a spline interpolation to create a dummy
               profile with equidistant X-values and without blanks.
               If a spline interpolation could not be made (e.g. all 
               Y values blank except one) then no initial estimates 
               could be found.
               Note that the fit routine works with the raw data.
               
 
               <PLOT OPTIONS>
                              

               The use of these inputs is straightforward. 
               If you fix the amplitude range, then each profile in the
               box will get the same range in Y-values (=amplitudes).
               The <APPLY> button clears the plot and redraws data and
               estimates. 
               


               <MIS OPTIONS>

              
               'amp. %'
      
               Set the percentage of the maximum at which the user wants 
               the width. This option works only for standard gaussians
               because only for this function there is a simple relation
               between fitted dispersion and the width at arbitrary height.

               
               <flip>

               Turn valleys into peaks with this button. The original data
               is multiplied by -1. In order to restore the original data you
               have to push the <FLIP> button again.


              
               <FIT OPTIONS>
               

               'tolerance'
               
               This window contains two parts. The first part contains 
               parameters which control the least squares fit routine.
               The tolerance is a stop criterion. its default is zero,
               which implies that the program determines the minimum value.
               If the fit routine cannot improve the reduced chi-squared
               by 'tolerance', it stops and returns the current fit
               parameters.
               
              
               'lambda'
               
               Lambda is the mixing parameter. it determines the initial
               weight of steepest descent method relative to the Taylor 
               method. Lambda should be a small value (i.e. 0.01). 
               It can only be zero when the partial derivatives are 
               independent of the parameters which is not the case in 
               this program. In practice, this values will almost never 
               be changed. 
               
               
               'max. Its'
               
               The least squares routine fails to produce results if it 
               needs more than this number of iterations to achieve 
               convergence.


               'Include range'
               
               Enter the range in physical coordinates for which you want
               to include the data. Other points are masked and get zero
               weight in the least squares fit. If you enter an empty input
               then the entire data range is taken into account and the
               masked points are reset.
               

               'Clip'
   
               You can set a clip or range to the Y data.  Values
               below the clip (1 value entered) are marked in the plot
               and get weight zero in the fit. If you entered two values,
               then all values outside this range are marked and get 
               weight zero in the fit. The clip is applied to all the 
               profiles not only the current.


               'Min. ampl.'
               
               Initial estimates with an amplitude smaller than this value 
               are discarded. See also 'Q'. 

               
               'Min. disp.'
               
               Initial estimates with a dispersion smaller than this value
               are discarded. The input has the same units as the X-values
               in the plot. Usually these are physical units and not 
               grids. See also 'Q'. 
               

               'Q'
               
               This is called the 'smoothing factor'. The initial estimate
               routine uses 2Q+1 points around a maximum to fit a second 
               order polynomial. The coefficient of the second-order term
               of the polynomial is an approximation of the second derivative
               of the observed profile. With a moments method
               the center and dispersion are stimated. The maximum amplitude 
               is derived from the observed profile.
               The default is a series of Q's (1 2 3 4 & 5). If you enter
               more than one Q then the Q with the best (i.e. lowest chi-
               squared) initial estimates is used for the least squares fit.
               The estimate filters 'Min. ampl.' and Min. disp.' apply 
               only to this 'best' Q.

               Note that there is one special case build in the program. 
               If a profile contains blanks or zero-level values except
               for one, then the estimate routine fails to return an 
               estimate. One can treat this peak as a peak with
               known amplitude and center, and a full width at half maximum
               of one pixel (which is automatically converted to a dispersion).
               However,...
               the least squares fit routine will not fit such profiles 
               because any dispersion results in the same reduced chi-squared
               and therefore there is no convergence.
               

               'Median filter'

               If a profile contains spurious elements, you can use a 
               three pixel median filter to smooth the data a bit.
               In many cases this is less work than excluding these points 
               by hand.
               


               <WEIGHTS>
  
                
               There are three options in the weights menu. First, the 
               default, is uniform weight, i.e. each non blank point in 
               the profile gets weight 1. The reduced chi-square that is 
               calculated is corrected for the current rms of that profile
               afterwards. 
               Second option is an automatic weighting. The program calculates
               a second profile that is a three pixel median filter of the
               original profile. The distance in Y between these two profiles
               is a measure for a weight of each point. With this method,
               spurious elements get less weight in the fit, which improves
               the fit results for some profiles.
               The third option allows you to use errors from an 
               ASCII file on disk as specified in the <IMPORT> menu.
               If the uncertainty of a data point is given by E then the 
               corresponding weight is equal to 1/(E*E) normalized to the 
               average of all weighting factors (Bevington, Data Reduction and
               Error Analysis, Ch 10).

               

               <PARAM>
               
               
               This window contains input parmaters and fit results.
              
               Gaussian parameters:
               
               The param window allows you to control the initial estimates
               as proposed by the program. If the program cannot find any
               estimates, perhaps you can and this is the place to do that.
               This is also the window where you tell the fit routine
               to set gaussian parameters to fixed or free. The more you fix,
               the better the fit.
               
               Background:
               
               The background is taken into account in the fit. It has
               three parameters. A constant, a linear and a quadratic term.
               In the default situation only the constant term is a 
               free parameter.
               
               Slider:
               
               Each parameter has a <SLI> button. If you push this button,
               you activate the slider for this parameter. While moving the 
               slider, you can watch the parameter value changing in the
               value field and in the plot.
               
               rms:
               
               Initial estimates can only be determined if a reasonable
               value for the rms of the noise is given. If you have a value 
               in mind, push the <FIX> button to the right of the rms 
               input field and enter your value. Otherwise, a default is
               calculated. The profile data is sorted and the distance 
               between the quartiles is taken a a measure of rms of the 
               noise. Usually this value is higher than expected, but
               it works well to find initial estimates.
               
               Below right in this window there are two buttons <CLEAR> and
               <FIX> that have the same function as the buttons with the same
               labels in the main gui.


               <FUNCTION>
               
               A menu is presented with four options:
               1) A standard gaussian. Parameters are amplitude, center,
                  and dispersion,
               2) Gauss-Hermite polynomial (h3). Parameters are a,b,c,
                  (which are NOT the same as amplitude, center and
                  dispersion) and h3. The parameters are translated to
                  the more familiar amplitude, center, dispersion and
                  skewness. 
               3) Gauss-Hermite polynomial (h3, h4). Same as above, but 
                  an extra parameter h4 is included. The value for this
                  h4 parameter is translated to kurtosis.
               4) Voigt. Fit Lorentzian and Doppler widths together 
                  with center and amplitude. 
                  
                  The mathematics behind all this is worked out
                  in a separate document.                  
               
                  
               <NCOMP>
               
               Select the number of gaussians that you want to fit.
               
               
               <HELP>
               
               Show this document. Push the <HELP> button again to get rid of
               the help window.  


               OUTPUT
               ------

               The different functions generate different output, but there
               are some quantities that are the same for all. First there 
               is output in the status area; the number of iteration to
               reach convergence, the total flux, reduced chi-square, the
               standard deviation of the residuals and
               the current value of the fit tolerance are displayed.
                
               In the so called output panel, the fit parameters are listed.
               These are the parameters that characterize a distribution
               like the line strength (or area) of the profile, the
               mean X value (which is only the center if the distribution
               is symmetric like the standard Gauss and the Voigt profile),
               Further the maximum amplitude is given and also the
               values for the background are listed. For the gauss-Hermite
               series, the skewness and kurtosis are listed. The real function
               parameters of the Gauss-Hermite functions are not listed in 
               the gui log, but can be found in the GIPSY log. These 'real' 
               function parameters are transformed into properties of a
               distributions. An extra parameter gives the position
               of the maximum which is, as mentioned before, for the 
               GH-series not the same as the value of the mean X.
               
               A description of the functions and their parameters can be 
               found in a separate document. Here is a summary for the
               GH-series.
               
               The GH-series with h3 and h4:
               
               f =  a.Exp[-1/2.g^2] * 
                      { 1 + h3[c1.g+c3.g^3] + h4[c5+c2.g^2+c4.g^4] }
               and:
               
               g = (x-b)/c
               
               c1..c5 have fixed values.

             
               The output in short format to file disk has a table header
               and columns with results. The first line can look like:

               ! GAUSS fit parameter table created: Tue Jul  6 16:25:04 1999

               !RCHI2 |SIG.RES |AREA | err | MEAN | err | DISP. | err | ......
                  8.97364    1.04838    1030.28    141.687    2237.89   ......
                  8.97364    1.04838    1030.28    141.687    2237.89   .....
               .....
               etc. etc. 
              
               The meaning of the titles:
               RCHI2:     reduced chi-squared. This value is scaled by the
                          rms of the noise that you entered. If you did not
                          enter a rms, the value 1.0 is substituted.
               SIG.RES:   Standard deviation of the residuals.
               AREA:      Total flux under fitted function.
               err:       Error on this parameter.
               MEAN:      Mean of gaussian of first component.
               DISP:      Dispersion
               FW at 50.0 pct: Full width at certain percentage of maximum.
               AMPL.      Amplitude 
               Z0/1/2     Background terms constant, linear and quadratic.
               RA PARAM   Position of profile in grids. These are the axis
                          names of the box.


               
               INITIAL ESTIMATES
               -----------------

               In a separate document we describe the method and give
               a reference to the article of U.J. Schwarz on which the
               estimate method is based.
               

               LEAST SQUARES FIT
               -----------------
               
               The least squares fit minimizes the reduced chi-square
               which relates a model profile to the real data. If the
               decrement in the value of the reduced chi-squared is less
               than a given tolerance, then the iteration stops and
               the fitted parameters are returned.
               Maximum accuracy can be obtained by setting the tolerance to
               0 which is also the default value.
               
               
               BLANKS
               ------
               
               Blanks in the profile get weight zero in the fit. For
               the estimate routine, blanks are replaced by the current
               zero level. In the plot window the blanks are indicated by 
               character 'b'. 
#end section buttons

#begin section keywords
                                KEYWORDS
                                ========


               CHANGE THE SIZE OF YOUR GUI AT STARTUP
               --------------------------------------

               keyword:   GUISIZE= 
               arguments: size in X in pixels
                          size in Y in pixels
                          height of residual window in pixels

               For building events files you need to know the keywords used by 
               the application. Here is a (incomplete) list with possible keywords 
               with some default values. You can use the Ggi monitor function to
               find the keywords corresponding to certain events. The monitor
               tool is started when you click the right mouse button in the 
               background of the main gui.

               AMPPERC= 50
               CHARSIZE= 1.10
               COLCON= 8
               COLEST= 3
               COLFIT= 2
               COLFRAME= 1
               COLMED= 4
               CONNECT= NO
               CRITAMP= 0
               CRITDISP= 0
               DRAWZERO= YES
               ESTFILTER= NO
               FITFILE= profilefit.dat
               FUNCTION= 0
               GGIOPT= FIXCOL
               GUI_FILE=
               HCFILENAME= profilefit.ps
               HELP=
               LAB= 0.01
               LWIDTH= 2
               LWIDTHCUR= 2
               MAXITS= 200
               NCOMP= 1
               PARAM=
               PLOTDENS= 200
               PLOTEST= YES
               PLOTMED= NO
               PLOTRMS= NO
               PLOTTER= 0
               PROFFILE= profiledata.dat
               Q= 1 2 3 4 5
               RMS= 1.0
               SUBDIV= 1 1
               TOLERANCE= 0
               VIEWPORT= 0.15 0.1 0.95 0.9
               WEIGHTS= 0
               Z0_EST= 0
               Z1_EST= 0
               Z1_FIX= YES
               Z2_EST= 0
               Z2_FIX= YES

#end section keywords 


#begin section about
Purpose:       Fit parameters of a standard Gauss function,
               a Gauss-Hermite series or a Voigt lineshape to data from 
               GIPSY sets or ASCII files 

Category:      ANALYSIS, PROFILES, PLOTTING

File:          xgauprof.src

Author:        M.G.R. Vogelaar (GUI: J.P. Terlouw)

Keywords:      See section keywords

Version:       2.1
                               
Example:       

Notes:         

Related document: xgauprof.ps

Updates:       Feb 22, 1999: VOG, Document created.
               Jun 15, 2001: VOG, Help updated, connect lines added.
#end section about
#<

#>            xgauprof.tex
\documentclass[10pt,a4paper]{report}
%\documentclass[11pt,fleqn]{article}
\usepackage{graphicx}
\def\eherm{A{e^{-\frac{1}{2} {\left(\frac{\nu - b}{c}\right)}^2}}}
\def\epow{A{e^{-\frac{1}{2} {\left(\frac{x - x_0}{\sigma}\right)}^2}}} 
\def\erf{\rm erf}
\def\erfc{\rm erfc}
\def\ampfac{\left(1+c_0\,h_4+c_2\,h_4+3c_4\,h_4\right)}

%\parskip=0.8cm

%\vspace{12pt}

\oddsidemargin=0cm
\evensidemargin=0cm
\textwidth=16cm

\begin{document}

\begin{center}
{\Large XGAUPROF}\\[1.5cm]
{\large A GIPSY program to fit parameters of a Gauss function, 
the Gauss-Hermite series or 
a Voigt line-shape to data from GIPSY sets or ASCII files }\\[1.5cm]
May 7,  1999
\end{center}

\begin{figure}[htb]
  \centering
  \includegraphics[height=10cm,width=15cm, angle=0]{gui.ps}
  \caption{\it XGAUPROF Graphical User Interface}
  \label{fig:gui}
\end{figure}  


\begin{flushleft}


\chapter{Introduction} 

\section{History}
An article from 1966 called {\it Computer Analysis of Observed Distributions
into Gaussian components} by Kaper et al. described a first Kapteyn
Institute attempt to use a computer to decompose an observed frequency 
or intensity profile  
into a superposition of Gaussian components. A least squares method was 
applied to get a `best fit' to study profiles of the spectral line at 21 cm. 
The program was implemented on a Stantec ZEBRA, installed in 1956. It had a
memory of 8192 words of 33 bits. This limited the analysis to 150 data points
and 6 parameters. The average access time to an address on the ZEBRA was 
0.005 sec. and one least-squares iteration cycle took about 20 minutes.
Initial guesses for the parameters were found by sketching a decomposition 
into Gaussians on a graph of the observed profile. 
\section{Standard Gauss}
GIPSY program {\bf \it XGAUPROF} finds best fit parameters for three functions
given data from file or from a GIPSY set. The base function is a Gauss. 
The parameters are fitted with a least-squares fit algorithm which needs 
initial guesses. A special routine automates the procedure of getting
reasonable estimates for a Gauss and the other functions in the program.
The user can modify these values by hand
using a graphical slider. 
A one component standard Gauss function with background is defined as:

\begin{equation}
\phi(x) = \epow + Z
\end{equation}

Usually x is frequency or velocity. $A$ is the amplitude at the center 
$x = x_0$ 
and ${\sigma }$ is the dispersion of the profile, i.e. the half width at 
$\frac{A}{\sqrt{e}}$ and Z is a representation for the background.


In {\bf \it XGAUPROF} the background consists of a constant, a linear and 
a quadratic term and
is represented by:
\begin{equation}
Z = Z_0 + Z_1\, (x-x_0) + Z_2\, (x-x_0)^2
\end{equation}
The constant term $Z_0$ is often referred to as 'zero level'. 


\section{Gauss-Hermite series}

If your profile deviates from a Gaussian shape (e.g. asymmetric profiles) 
then you can use the so called {\it Gauss-Hermite} series.
The lowest order term of the series is a
Gaussian. The higher order terms are orthogonal to this Gaussian.
The higher order that we use in our fits are the 
parameters $h_3$ and $h_4$ measuring asymmetric and symmetric 
deviations of a Gaussian. 
The Gauss-Hermite function used in {\bf \it XGAUPROF} is (Van der Marel \& Franx):



\begin{center} 
\begin{figure}[htb]
\begin{minipage}{7cm} 
  \centering
  \includegraphics[height=8cm,width=6cm, angle=0]{h3.ps}
  \caption{\it Gauss-Hermite $h3 = 0.2$, $h_4 = 0$. } 
  \label{fig:skewness}
\end{minipage}
\begin{minipage}{7cm}
  \centering
  \includegraphics[height=8cm,width=6cm, angle=0]{h4.ps}
  \caption{\it Gauss-Hermite $h3 = 0$, $h_4 =0.1$. }
  \label{fig:kurtosis}
\end{minipage} 
\end{figure} 
\end{center}


\begin{equation}
\phi(x) = a\,e^{-\frac{1}{2}y^2} \left\{ 1+\frac{h_3}{\sqrt{6}}
(2\sqrt{2}y^3-3\sqrt{2}y) + 
\frac{h_4}{\sqrt{24}}(4y^4-12y^2+3)   \right\} + Z
\end{equation} 


with $y \equiv \frac{x-b}{c}$. 
Note that the parameters $a$, $b$ and $c$ are equivalent to $A$, $x_0$ and
$\sigma$ of a Gaussian, only if $h_3 = h_4 = 0$.


\section{Voigt profile}

The line-shapes of spectroscopic 
transitions depend on the broadening mechanisms
of the initial and final states, and include natural broadening, 
collisional broadening, power broadening, and
Doppler broadening. Natural, collisional, and power broadening are 
homogeneous mechanisms and produce Lorentzian line-shapes. 
Doppler broadening is a form of inhomogeneous broadening and has a 
Gaussian line-shape. Combinations of
Lorentzian and Gaussian line-shapes can be approximated by a Voigt profile. 
In fact, the Voigt profile is a convolution of these two line-shapes. 
It has the form:

\begin{equation}
\phi(\nu) = \frac{A}{\alpha_D }\sqrt{\frac{\ln(2)}{\pi }} \, K(x,y) + Z
\end{equation}


$K(x,y)$ is the {\it Voigt function} and is defined as:
$$
K(x,y) = \frac{y}{\pi} \int_{-\infty}^{\infty} \frac{e^{-t^{2}}}{y^{2}+(x-t)^{2}} dt 
$$

where 
\begin{equation} 
y \equiv \frac{\alpha_L}{\alpha_D}\sqrt{\ln(2)} \hspace{0.5cm} and \hspace{0.5cm}
x \equiv \frac{(\nu-\nu_0)}{\alpha_D} \sqrt{\ln(2)}
\end{equation}

$y$ is the ratio of Lorentz to Doppler widths and $x$ the frequency 
scale (in units of the Doppler Line-shape half-width  $\alpha_D$.


\chapter{The standard Gauss function}
\section{Properties of a profile using moments of a distribution}

One way to characterize a distribution is the use of its moments.
The $k$th-$moment$ of a distribution $\phi(x)$ is:
$$ \mu_k = \int\limits_{-\infty}^{\infty}{(x-x_0)}^k\,\phi(x) dx $$

With these moments one can calculate more familiar properties of a 
distribution like the line strength (i.e. area under the curve) 
$\gamma$, the mean $X_0$,
the dispersion $\sigma$, the coefficient of skewness
$\xi_1 \equiv \mu_3/\mu_2^{3/2}$ and the coefficient of kurtosis 
$\xi_2 \equiv \mu_4/\mu_2^2$. These quantities are calculated from:
$$\gamma \equiv \int\limits_{-\infty}^{\infty} \phi(x)\, dx
\hspace{0.5cm} 
X_0 \equiv \frac{1}{\gamma}\int\limits_{-\infty}^{\infty}x\, \phi(x)\,dx
\hspace{0.5cm} 
\sigma^2_0 \equiv \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} 
{(x-X_0)}^2\,\phi(x)\,dx 
$$
\begin{equation}
\xi_i \equiv \frac{1}{\gamma}\int\limits_{-\infty}^{\infty}
\left((x-X_0)/\sigma\right)^{2+i}\,\phi(x)\,dx \hspace{1cm} (i=1,2) 
\end{equation}

{\it Skewness} is a lack of symmetry in a distribution.
If a distribution is symmetric about its mean it has zero skewness.
The skewness defined above is called the Fisher Skewness.

{\it Kurtosis} is a measure of how "fat" the tails of a distribution are,
measured relative to a normal distribution having the same
standard deviation. A distribution is said to be {\it leptokurtic}
if its tails are fatter than those of a corresponding normal distribution
(high peak).
It is said to be {\it platykurtic} if its tails are thinner than those of the
normal distribution (flat-topped curve). The Fisher Kurtosis is defined by
\begin{equation}
\framebox{$\xi_f = \xi_2 - 3$}  
\end{equation} 
From here we will use $\xi_f$ if we talk about kurtosis.

Using the expressions above, one finds for our standard Gaussian:

\medskip
{\bf The integrated line strength $\gamma $:}
$$ \gamma = \int\limits_{-\infty}^{\infty} \epow dx =
 A\,\sigma\, \sqrt{\frac{\pi}{2}}\, 
\erf {\left(\frac{x-x_0}{\sigma\sqrt{2}}\right)} \Bigr|_{-\infty}^{\infty}$$

$erf$ is the 'error'-function and $\erf (-\infty) = -1$ and $\erf (\infty)= 1.$\\
Then:
\begin{equation}
\framebox{$\gamma = A\sigma\sqrt{2\pi}$}
\end{equation} 

\vspace{1cm} 
{\bf The mean abscissa $X_0$:} 
\begin{eqnarray*}
X_0 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} x\epow dx\\
&=& \frac{1}{\gamma}  \left[ - \epow + 
    A\sqrt{\frac{\pi}{2}}\,x_0\, \sigma \, 
    \erf \left(\frac{x-x_0}{\sigma\sqrt{2}}\right) \right]
                    \biggr|_{-\infty}^{\infty}\\
&=& \frac{2}{\gamma}A\, \sigma \,\sqrt{\frac{\pi}{2}}\,x_0 = x_0
\end{eqnarray*} 

\begin{equation}
\framebox{$X_0 = x_0$}
\end{equation}

\vspace{1cm} 
{\bf The dispersion $\sigma_0$:}
\begin{eqnarray*}
\sigma^2_0 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} (x-x_0)^{2}
\epow dx\\
&=& \frac{1}{\gamma}  \left[
-\,(x-x_0)\,\sigma^2\,\epow +
  A\,{\sqrt{{\frac{\pi }{2}}}}\,
   {{\sigma }^3}\,\erf ({\frac
        {x - x_0} {\sigma {\sqrt{2}}  }})
\right] \biggr|_{-\infty}^{\infty}\\
&=& \frac{2}{\gamma}A\sigma\, \sqrt{\frac{\pi}{2}} \,\,{\sigma}^2 
    = \sigma^2
\end{eqnarray*} 

\begin{equation}
\framebox{$\sigma_0 = \sigma$}
\end{equation}

\vspace{1cm} 
{\bf The Fisher coefficient of Skewness $\xi_1$:}
\begin{eqnarray*}
\xi_1 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} \left({\frac{x-x_0}{\sigma}}\right)^{3}\epow dx\\
&=& \frac{1}{\gamma} { \epow\,\,
\frac{  -2\,{{\left( x - x_0 \right)}^2}\, - 
       4\,{{\sigma }^2} }{2\,\,
     {{\sigma }}}} \biggr|_{-\infty}^{\infty}\\
&=& 0
\end{eqnarray*}

\begin{equation}
\framebox{$\xi_1 = 0$}
\end{equation} 
This is what we expected for a symmetric distribution like a standard Gauss.

\vspace{1cm} 
{\bf The Fisher coefficient of Kurtosis $\xi_2$:} 
\begin{eqnarray*}
\xi_2 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} \left({\frac{x-x_0}{\sigma}}\right)^{4}Ae^{\frac{-(x-x_0)^2}{2\sigma^2}}dx\\
&=& \frac{1}{\gamma} \left[ {A\,{e^{{-\frac{{{\left( x - x_0 \right) }^2}}
      {2\,{{\sigma }^2}}}}}\,\,
\frac{  {{-\left( x - x_0 \right)}^3}\, - 
       3\,\left( x - x_0 \right){{\sigma }^2} }{\,
     {{\sigma }^2}}} +
3\,A\,{\sqrt{{\frac{\pi }{2}}}}\,\,
   {\sigma}\,\erf \left({\frac
        {x - x_0} {{\sqrt{2}}\,
        \sigma }}\right) \right]
\Biggr|_{-\infty}^{\infty}\\
&=& 3
\end{eqnarray*}

\begin{equation}
\framebox{$\xi_2 = 3$}
\end{equation} 
\begin{equation}
\framebox{$\xi_f = 0$}
\end{equation} 


\section{Partial derivatives of the standard Gauss function}
The standard Gauss is represented by the formula:
$$\phi(x)=\epow + Z$$
The partial derivatives used in the least squares routine to fit the parameters
are:
\begin{eqnarray}
\frac{\partial\phi(x)}{\partial A} &=& e^{-\frac{1}{2} {\left(\frac{x - x_0}{\sigma}\right)}^2} \\
\frac{\partial\phi(x)}{\partial x_0} &=& \epow \frac{(x-x_0)}{\sigma^2}\\
\frac{\partial\phi(x)}{\partial \sigma} &=& \epow \frac{{(x-x_0)}^2}{\sigma^3} 
\end{eqnarray}

the derivatives for the background $Z = Z_0 + Z_1\, (x-x_0) + Z_2\, (x-x_0)^2$
are:

\begin{eqnarray}
\frac{\partial\phi(x)}{\partial Z_0} &=& 1\\
\frac{\partial\phi(x)}{\partial Z_1} &=& x - x_0\\ 
\frac{\partial\phi(x)}{\partial Z_2} &=& {(x - x_0)}^2\\
\end{eqnarray}



\section{Relation between FWHM and dispersion of a Gauss}

Consider a standard Gauss function without any offset and symmetric around
$x_0 = 0$:
$$f(x) = A{e^{-\frac{1}{2} {(\frac{x}{\sigma})}^2}} $$
To find a width at certain height given the dispersion, 
find a $x_\lambda$ with $0< \lambda < 1$ for which:
 
$$A\,e^{\frac{-x^2}{2\sigma^2}} = \lambda\,A   \longrightarrow
x^2_\lambda = 2 \sigma^2 \ln{\frac{1}{\lambda}}$$

\begin{center}
\framebox {$x_ \lambda = {\sigma \sqrt{2 Ln {\frac {1}{\lambda}}}}$}
\end{center}

A frequently used measure of profile width is the the Full Width at Half Maximum 
$fwhm$. This width can be expressed in $\sigma$ by substitution of
$\lambda = {\frac {1}{2}}$ and multiplication of the solution by 2
because the dispersion is a half width!

\begin{center}

$$fwhm = 2 \sigma\, \sqrt{2 \ln{ \frac{1}{\frac{1}{2}} } }
= 2 \sigma\, \sqrt{2\ln{2}} \approx 2.355\, \sigma  $$


\framebox {$fwhm = 2\sigma\, \sqrt { 2 \ln{2}}$}
\end{center} 
Note that the error in the fitted width at any height, increases or decreases with the same factor.


\chapter{The Gauss-Hermite series}

The Gauss-Hermite $(GH)$ series in {\bf \it XGAUPROF} with 
$y \equiv \frac{x-b}{c}$ is represented by:
$$
\phi(x) = a\,e^{-\frac{1}{2}y^2} \left\{ 1+\frac{h_3}{\sqrt{6}}
(2\sqrt{2}y^3-3\sqrt{2}y) + 
\frac{h_4}{\sqrt{24}}(4y^4-12y^2+3)   \right\} + Z
$$

Simplify this equation further:

$$\phi(x) = a\,E\,\left\{1+h_3(c_1y+c_3y^3)+h_4(c_0+c_2y^2+c_4y^4)\right\}$$
or:
$$\phi(x) =  a\,E\,Q$$
with  $E \equiv e^{-\frac{1}{2}y^2}$,
$Q = \left\{1+h_3(c_1y+c_3y^3)+h_4(c_0+c_2y^2+c_4y^4)\right\}$ and further:

$$c_0 = \frac{1}{4}\sqrt{6}\hspace{0.4cm}
c_1 = -\sqrt{3}\hspace{0.4cm}
c_2 = -\sqrt{6}\hspace{0.4cm}
c_3 = \frac{2}{3}\sqrt{3}\hspace{0.4cm}
c_4 = \frac{1}{3}\sqrt{6}\hspace{0.4cm}
$$

Then the partial derivatives used in the least-squares fit routine are:
\begin{eqnarray}
\frac{\partial\phi(x)}{\partial a} &=& E\,Q\\
\frac{\partial\phi(x)}{\partial b} &=& a\,E\,\frac{1}{c}
\left[
h_3(-c_1-3c_3y^2)+h_4(-2c_2y-4c_4y^3)+y\,Q
\right]\\
\frac{\partial\phi(x)}{\partial c} &=& a\,E\,\frac{1}{c}
\left[
h_3(-c_1y-3c_3y^3)+h_4(-2c_2y^2-4c_4y^4)+y^2\,Q 
\right] = 
y\,\frac{\partial\phi(x)}{\partial b}\\
\frac{\partial\phi(x)}{\partial h_3} &=& a\,E\,(c_1y+c_3y^3)\\
\frac{\partial\phi(x)}{\partial h_4} &=& a\,E\,(c_0+c_2y^2+c_4y^4)
\end{eqnarray}


Note that $\frac{\partial\phi(x)}{\partial x} = -\frac{\partial\phi(x)}{\partial b}$.
We will need this expression if we want to calculate the position of
the maximum of the $GH$ series. This position is only equal to parameter $b$
if $h_3=h_4=0$!
To find the real maximum, solve:

$$
\frac{\partial\phi(x)}{\partial x} = -a\,E\,\frac{1}{c}
\left[
h_3(-c_1-3c_3y^2)+h_4(-2c_2y-4c_4y^3)+y\,Q
\right] = 0
$$
which means solving:
$$
h_3(-c_1-3c_3y^2)+h_4(-2c_2y-4c_4y^3)+y\,
\left\{1+h_3(c_1y+c_3y^3)+h_4(c_0+c_2y^2+c_4y^4)\right\} = 0
$$
After rearranging the equation above we get:
\begin{equation}
\lambda_5y^5+\lambda_4y^4+\lambda_3y^3+\lambda_2y^2+\lambda_1y+\lambda_0=0
\end{equation}
with coefficients equal to:
\begin{eqnarray*}
\lambda_0 &=&-h_3\,c_1\\
\lambda_1 &=& h_4\,(c_0-2c_2)+1\\
\lambda_2 &=& h_3\,(c_1-3c_3)\\
\lambda_3 &=& h_4\,(c_2-4c_4)\\
\lambda_4 &=& h_3\,c_3\\
\lambda_5 &=& h_4\,c_4
\end{eqnarray*}
We applied a bisection to solve the equation. For initial limits we use
$x_1 = b-\frac{1}{2}c$ and $x_2 = b+\frac{1}{2}c$ which for the 
bisection equation is the same as 
$y_1 = -\frac{1}{2}$ and $y_2 = \frac{1}{2}$.


\section{Moments of the $GH$ series}
As stated before, in the function:
$$\phi(x) = a\,e^{-\frac{1}{2}y^2},\left\{1+h_3(c_1y+c_3y^3)+h_4(c_0+c_2y^2+c_4y^4)\right\}$$
with:
$$y \equiv \frac{x-b}{c}$$
the parameters $a$, $b$ and $c$  are only equal to $A$, $x_0$ and $\sigma$ of
a standard Gaussian, if $h_3=h_4=0$. If we want to compare these parameters 
for $h_3$ and/or $h_4$ unequal to $0$ then we have to calculate the  profile properties using the moments of the
GH distribution:

\medskip
{\bf The integrated line strength $\gamma $:}
$$
\gamma = \int\limits_{-\infty}^{\infty} \phi(x) dx =
 a\,c\, \sqrt{2\pi} \ampfac
= a\,c\, \sqrt{2\pi} (1+\frac{1}{4}\sqrt{6}\,h_4)
$$
\begin{equation}
\framebox{$\gamma = a\,c\, \sqrt{2\pi} (1+\frac{1}{4}\sqrt{6}\,h_4)$}
\end{equation}

\vspace{1cm}
{\bf The mean abscissa $X_0$:}
\begin{eqnarray*}
X_0 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} x \phi(x) dx\\
&=& \frac{1}{\gamma}  a\,c\, \sqrt{2\pi}\ 
(b+c\, c_1\,h_3+3c\,c_3\,h_3+b\,c_0\,h_4+b\,c_2\,h_4+3b\,c_4\,h_4)\\
&=& \frac{1}{\gamma}  a\,c\, \sqrt{2\pi}
\left[
b\, (1+\frac{1}{4}\sqrt{6}\,h_4)+c\, (\sqrt{3}\,h_3)
\right]\\
&=& b + c\,\frac{\sqrt{3}\,h_3}{1+\frac{1}{4}\sqrt{6}\,h_4}\\
&\approx & b + c\,\left[\sqrt{3}\,h_3\,(1-\frac{1}{4}\sqrt{6}\,h_4)\right]
\end{eqnarray*} 

The last step is an approximation. Remember that 
${(1+\alpha\,x)}^\beta \approx 1-\alpha\,\beta\,x$ for small $x$.
If we include only the lowest order terms in $h_3$ and $h_4$, then:

\begin{equation} 
\framebox{$X_0 \approx b + \sqrt{3}\,h_3\,c$}
\end{equation}

\vspace{1cm}
{\bf The dispersion $\sigma_0$:}
\begin{eqnarray*}
\sigma^2_0 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} (x-X_0)^{2}
\phi(x) dx\\
&\approx & \frac{1}{\gamma}\,a\,c\, \sqrt{2\pi}\, c^2\,\, 
\frac{
\left( 
1+3c_0\,h_4+5c_2\,h_4+21c_4\,h4
\right)
}
{ \ampfac^2 } \\ 
&=& c^2\, \frac{\left(1+3c_0\,h_4+5c_2\,h_4+21c_4\,h4 \right) }
{\ampfac^3 }\\
&=& c^2\,
\frac{1+2\frac{3}{4}\sqrt{6}\,h_4}{{\left(1+\frac{1}{4}\sqrt{6}\,h_4\right)}^3}\\
&\approx & c^2\,(1+2\sqrt{6}\,h_4)
\end{eqnarray*} 

\begin{equation}
\framebox{$\sigma_0 \approx c\sqrt{1+2\sqrt{6}\,h_4} \approx c\,(1+\sqrt{6}\,h_4)$}
\end{equation}

\vspace{1cm}
{\bf The Fisher coefficient of Skewness $\xi_1$:}\\
A set of observations that is not symmetrically distributed is said to be skewed.
If the distribution has a longer tail less than the maximum,
the function has {\it negative skewness}. Otherwise, it has
{\it positive skewness}.
\begin{eqnarray*}
\xi_1 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} \left({\frac{x-x_0}{\sigma}}\right)^{3} \phi(x) dx\\
&\approx & \frac{1}{\gamma}\,\,\frac{ 2a\,c\, \sqrt{2\pi}\,c^3\,3\,c_3h_3}
{\ampfac^3 {\left(\frac{c^2\left(1+h_4\,(3c_0+5c_2+21c_4)\right)}{\ampfac^3} \right)}^\frac{3}{2} }\\ 
&=& \frac{6\,c_3\,h_3\, \ampfac^\frac{1}{2} }
{{\left(1+h_4\,(3c_0+5c_2+21c_4)\right)}^\frac{3}{2}}\\
&=& \frac{4\sqrt{3}\,h_3\, {(1+\frac{1}{4}\sqrt{6}\,h_4)}^\frac{1}{2}}
{{\left(1+2\frac{3}{4}\sqrt{6}\,h_4\right)}^\frac{3}{2}}
\end{eqnarray*} 

\begin{equation}
\framebox{$\xi_1 \approx 4\sqrt{3}\,h_3$}
\end{equation} 

This is what we could have expected because $h_3$ is the parameter that
measures asymmetric deviations.

\vspace{1cm}
{\bf The Fisher coefficient of Kurtosis $\xi_2$:}
\begin{eqnarray*}
\xi_2 &=& \frac{1}{\gamma}\int\limits_{-\infty}^{\infty} \left({\frac{x-X_0}{\sigma}}\right)^{4} \phi(x) dx\\
&\approx & \frac{1}{\gamma}\,\, \frac{-3ac\,\sqrt{2\pi}\,{\left(1+c_0h_4+c_2h_4+3c_4h_4 \right)}^2
 \left(-1-5c_0h_4-9c_2h_4-47c_4h_4\right)}
{{\left(1+3c_0h_4+5c_2h_4+21c_4h_4 \right)}^2}\\
&=& \frac{3\,(1+h_4\,(c_0+c_2+3c_4)(1+h_4\,(5c_0+9c_2+47c_4)}
{{\left(1+h_4\,(3c_0+5c_2+21c_4)\right)}^2}\\
&=& \frac{3(1+\frac{1}{4}\sqrt{6}\,h_4)(1+\frac{95}{12}\sqrt{6}\,h_4)}
{{\left(1+2\frac{3}{4}\sqrt{6}\,h_4\right)}^2}
\end{eqnarray*}

\begin{equation}
\framebox{$\xi_2 \approx 3 + 8\sqrt{6}\,h_4$}
\end{equation} 
\begin{equation}
\framebox{$\xi_f \approx 8\sqrt{6}\,h_4$}
\end{equation} 

The initial guesses for the $h_3$ and $h_4$ parameters in the least-squares
fit, are set to zero because we expect that the profile will still resemble
the standard Gaussian. If a fit is successful,
the profile parameters $\gamma$, $X_0$ and $\sigma$, skewness and
kurtosis are calculated from
$a$,$b$, $c$, $h_3$ and $h_4$ using the formulas above.
For the errors in these parameters we derived:
\begin{eqnarray}
\Delta \gamma &=& \frac{1}{\gamma}\, 
\sqrt{{\left(\frac{\Delta a}{a}\right)}^2+
      {\left(\frac{\Delta c}{c}\right)}^2+ 
      {\left(\frac{1}{\frac{2}{3}\sqrt{6}+h_4}\right) }^2 
      {\left(\frac{\Delta h_4}{h_4}\right)}^2 }\\
\Delta X_0 &=& 
\sqrt{ {(\Delta b)}^2 + 3h_3^2{(\Delta c)}^2 +
       3c^2 {(\Delta h_3)}^2 }\\
\Delta \sigma_0 &=& 
\sqrt{{(1+\sqrt{6}\,h_4)}^2\, {(\Delta c)}^2 + 6c^2{(\Delta h_4)}^2  }\\
\Delta \xi_1 &=&  4\sqrt{3}\,\Delta h_3\\
\Delta \xi_2 &=&  8\sqrt{6}\,\Delta h_4
\end{eqnarray}



\chapter{The Voigt profile} 

The Voigt profile is a line-shape which results form a convolution of Lorentzian and Doppler line broadening mechanisms:
\begin{equation}
 \phi_{Lorentz}(\nu)=\frac{1}{\pi} \frac{\alpha_L}{(\nu-\nu_0)^2 + \alpha_L^2}
\end{equation} 
\begin{equation} 
 \phi_{Doppler}(\nu)=\frac{1}{\alpha_D} \sqrt{\frac{\ln{2}}{\pi}} e^{-\ln{2} \frac{(\nu-\nu_0)^2}{\alpha_D^2}}
\end{equation}

Both functions are normalized. {\bf $\alpha_D$ and $\alpha_L$ are half widths
at half maximum}.
Convolution is given by the relation 
$$ f(\nu) \star g(\nu)=\int\limits_{-\infty}^\infty {f(\nu - t ) g(t) dt} $$\\
Define the ratio of Lorentz to Doppler widths as 

\begin{equation} 
 y \equiv \frac{\alpha_L}{\alpha_D} \sqrt{\ln{2}}
\end{equation} 

and the frequency scale (in units of the Doppler Line-shape half-width  $\alpha_D$ )
 
\begin{equation}
 x \equiv \frac{\nu-\nu_0}{\alpha_D} \sqrt{\ln{2}} 
\end{equation}
then:
\[ \phi_L(\nu) = \frac{1}{\pi} \frac{\sqrt{\ln{2}}}{\alpha_D} \frac{y}{x^2+y^2} \]
and
\[ \phi_D(\nu) = \frac{1}{\alpha_D} \sqrt{\frac{\ln{2}}{\pi}} e^{-x^2} \]
The convolution:
\[ \phi_L(\nu)\star\phi_D(\nu)=\int\limits_{-\infty}^\infty {\frac{1}{\pi} \frac{\sqrt{\ln{2}}}{\alpha_D} \frac{y}{(x-t')^2 + y^2} \frac{1}{\alpha_D} \frac{\sqrt{\ln{2}}}{\sqrt{\pi}} e^{-t'^2} dt}\]

If you replace $\nu$ by $\nu-t$  in the expression for $x$, then 
\[ x-t'=\frac{\nu-t}{\alpha_D}\sqrt{\ln{2}}-\frac{\nu_0}{\alpha_D}\sqrt{\ln{2}}=
\frac{\nu-\nu_0}{\alpha_D}\sqrt{\ln{2}}-t\frac{\sqrt{\ln{2}}}{\alpha_D}=
x-\frac{\sqrt{\ln{2}}}{\alpha_D}t \]
and we conclude that $ t'=\frac{\sqrt{\ln{2}}}{\alpha_D}t $ and
$ dt'=\frac{\sqrt{\ln{2}}}{\alpha_D}dt 
\Leftrightarrow dt=\frac{\alpha_D}{\sqrt{\ln{2}}}dt' $

\[ \phi_L(\nu)\star\phi_D(\nu)=\frac{1}{\alpha_D}\frac{\sqrt{\ln{2}}}{\alpha_D}
\frac{\sqrt{\ln{2}}}{\sqrt{\pi}}\frac{\alpha_D}{\sqrt{\ln{2}}}\, \,
\frac{y}{\pi}\int\limits_{-\infty}^\infty {\frac{e^{-t'^2}}{(x-t')^2+y^2}dt'} \]

Replace $t'$ by $t$ to obtain:

\begin{equation} 
\phi_\nu(\nu)=\phi_L(\nu)\star\phi_D(\nu)=
\frac{1}{\alpha_D}\sqrt{\frac{\ln{2}}{\pi}}\, \frac{y}{\pi}\int\limits_{-\infty}^\infty {\frac{e^{-t^2}}{(x-t)^2+y^2}dt}
\label{Voigtprofile}
\end{equation} 

As we will see in the next section: 
$ \int\limits_{-\infty}^\infty {\phi_\nu(\nu)d\nu} = 1 $
so the Voigt profile (eq.\ref{Voigtprofile}) is also normalized.



\section{The Voigt function $K(x,y)$} 

Part of the expression for the Voigt line-shape is the Voigt function.
The formula for this function is:

\[
K(x,y) = \frac{y}{\pi} {\int\limits_{- \infty} ^{\infty}} \frac{e^{-t^{2}}}{y^2 + {(x - t)}^2} dt
\]

Consider:

\begin{displaymath}
\int\limits_{0}^{\infty}
e^{-yv}\cos{\left( (x-t)v\right)}dv = 
\frac{y}{(x-t)^2+y^2}  \rightarrow 
\end{displaymath}

\begin{eqnarray*} 
K(x,y) &=& 
\frac{1}{\pi}
\int\limits_{-{\infty}}^{+{\infty}}
\frac{ye^{-t^2}}{(x-t)^2+y^2}\,dt\\
&=&
\frac{1}{\pi}
\int\limits_{-{\infty}}^{+{\infty}}
e^{-t^2}
\int\limits_{0}^{\infty}
e^{-yv}\cos{\left((x-t)v \right)}\,dv\,dt\\
&=&
\frac{1}{\pi}
\int\limits_{0}^{\infty}
e^{-yv}
\int\limits_{-{\infty}}^{+{\infty}}
e^{-t^2}\cos{\left( (x-t)v\right)}\, dt\,dv\\
&=&
\frac{1}{\pi}
\int\limits_{0}^{\infty}
e^{-yv} \cos{yv}
\int\limits_{-{\infty}}^{+{\infty}}
e^{-t^2}\cos{tv}\, dt\,dv
\end{eqnarray*}  

 Consider:

\begin{displaymath}
\int\limits_{-{\infty}}^{+{\infty}}
e^{-t^2}\cos{(tv)}dt =
\sqrt{{\pi}}e^{-{\frac{v^2}{4}}} \rightarrow
\end{displaymath}

\begin{eqnarray*} 
K(x,y) &=& 
\frac{1}{\sqrt{\pi}}
\int\limits_{0}^{\infty}
e^{-{\frac{v^2}{4}}}e^{-yv}\cos(tv)\,dv\\
&=&
\frac{1}{2{\sqrt{\pi}}}
\int\limits_{0}^{\infty}
e^{-{\frac{v^2}{4}}-yv}
(e^{itv}+e^{-itv})dv \\
&=&
\frac{1}{2{\sqrt{\pi}}}
\int\limits_{0}^{\infty}
(e^{-{\frac{v^2}{4}}-(y-it)v}+e^{-{\frac{v^2}{4}}-(y+it)v})dv
\end{eqnarray*}  

Let $z = t + iy$, then $iz = -(y-it)$, i${\overline{z}} = (y +it)$

\begin{displaymath}
K(x,y) = 
\frac{1}{2{\sqrt{\pi}}}
\int\limits_{0}^{\infty}
(e^{-({\frac{v}{2}}-iz)^2-z^2}+
e^{-({\frac{v}{2}}+i{\overline{z}})^2-{\overline{z}}^2})dv
\end{displaymath}

Let $u1=v/2 - iz$ and $u_2 = v/2 + iz$

\[
K(x,y) = \frac{1}{\sqrt{\pi}} \ e^{-z^2} {\int\limits _{- iz} ^{\infty}} {e^{-{u_1}^{2}}} d{u_1} \ + \ \frac{e^{- \bar{z} ^2}}{\sqrt{\pi}} {\int\limits _{i \bar{z}} ^{\infty}} {e^{-{u_2}^{2}}} d{u_2}
\]

According to Abramowitz \& Stegun (AS): 
$\erfc (z) \equiv \frac{2}{\sqrt{\pi}} {\int\limits _{z} ^{\infty}} {e^{-t^{2}}} dt $
so that: 

\begin{equation}  
K(x,y) = \frac{1}{2} \ \left({e^{-z^{2}}}  \erfc (-iz) \ + {e^{- \bar{z}^{2}}} \erfc (i \bar{z})\right)\
\end{equation}

In AS we find the function $\omega(z)$ defined as: 
\begin{equation}
\omega(z) = e^{-z^2} \erfc (-iz)
\end{equation}

With the relations above one recognizes 
the relation $ \omega( \bar{z}) \ = \ \overline{\omega(-z)} $.
If we write the Voigt function in terms of function $w$ then:


$$
 K(x,y)  = \frac{1}{2} \{ \omega(z) + \omega(- \bar{z} ) \} = 
\frac{1}{2} \{ \omega(z) + \overline{\omega(z)} \} = \Re \{ \omega(z) \}
$$
\begin{equation}
\framebox{$K(x,y) = \Re \{\omega(z)\}$ } 
\end{equation}

\newpage



\section {Area under the Voigt Line-shape}
Remember the Voigt line-shape  was given by:\\
\begin{equation}
\phi (\nu) = \frac {A} {\alpha_D} \sqrt{\frac {\ln 2} {\pi}} \frac {y} {\pi} \int\limits_{t=-\infty}^{t=\infty} \frac {e^{-t^2}} {y^2+(x-t)^2} dt \end{equation}\\

We want to evaluate 
$\int \limits_{-\infty}^{\infty} \phi (\nu) d\nu.$
By changing the integration order, one can write:
$$
\int\limits_{\nu=-\infty}^{\nu=\infty} \phi (\nu) d\nu = \frac {A} {\alpha_D} \sqrt{\frac {\ln 2} {\pi}} \int\limits_{t=-\infty}^{t=\infty} \frac {y} {\pi} \left \{\int\limits_{\nu=-\infty}^{\nu=\infty} \frac {e^{-t^2}} {y^2+(x-t)^2} d\nu \right \} dt
$$
Because $x \equiv \frac {\nu - \nu_0} {\alpha_D} \sqrt{\ln 2}$, we derive $d\nu = \frac {\alpha_D} {\sqrt{\ln2}} dx$
$$
\int\limits_{-\infty}^{\infty} \phi (\nu) d\nu = \frac {A} {\alpha_D} 
\sqrt{\frac {\ln 2} {\pi}}  \frac {\alpha_D} {\sqrt{\ln2}} 
\int\limits_{-\infty}^{\infty} \frac {y} {\pi} 
\left \{ \int\limits_{-\infty}^{\infty} \frac {e^{-t^2}} {y
^2+(x-t)^2} dx \right \} dt
$$
The inner integral $\int\limits_{-\infty}^{\infty} \frac {1} {y^2+(x-t)^2} dx = \frac {1} {y} \arctan \Bigl(\frac {x-t} {y} \Bigr) \Bigr |_{-\infty}^{\infty} = \frac {\pi} {y}$
so that: 
$$
\int\limits_{-\infty}^{\infty} \phi (\nu) d\nu = \frac {A} {\sqrt{\pi}} \int\limits_{-\infty}^{\infty} e^{-t^2} dt 
= {\frac {A} {\sqrt{\pi}} \cdot \sqrt{\pi}}  =  A
$$

This proves what we already expected. Besides the area scaling factor $A$ 
(which is a fit parameter in the least-squares fit) 
the area of the convolution of the two functions 
(Lorentzian and Doppler line-shapes) is normalized.
The amplitude is found at $\nu=\nu_0$. Then according to its definition
$x=0$ and the relation between the amplitude and area is 
$amp=\phi (\nu_0)$:


\begin{equation}
\framebox {$
amp = \frac {A} {\alpha_D} \sqrt{\frac {\ln 2} {\pi}} K(0,y) 
$}
\end{equation}
The error in the amplitude is then:


\begin{eqnarray*}
\Delta amp &=& \sqrt{\frac {\ln 2}{\pi}} \, K(0,y)\,  
\sqrt{\Bigl(\frac {\partial} {\partial\alpha_D} 
\frac {A} {\alpha_D} \Delta \alpha_D \Bigr)^2 + 
\Bigl(\frac {\partial} {\partial A} \frac {A} {\alpha_D} \Delta A \Bigr)^2}\\
&=& \sqrt{\frac {\ln 2} {\pi}} \, K(0,y)\,
\sqrt{  { \left( \frac{A}{\alpha_D ^2}\Delta\alpha_D^2\right)}^2+
        {\left(\frac{1}{\alpha_D ^2}\Delta A \right)}^2 }
\end{eqnarray*} 

\begin{equation}
\framebox {$ \Delta amp =
amp\, \sqrt{ {\left(\frac{\Delta\alpha_D}{\alpha_D}\right)}^2 + 
                {\left(\frac{\Delta A}{A} \right) }^2  }
$}
\end{equation}


\section{Partial derivatives of the Voigt Function}
Consider the relations $z=x+iy$ and $-\bar{z}=-x+iy$. Then:
\[\frac{\partial\omega}{\partial x}=\frac{\partial z}{\partial x}\frac{\partial\omega}{\partial z}=\frac{\partial(x+iy)}{\partial x}\frac{\partial\omega}{\partial z}=\frac{\partial\omega}{\partial z}\]
\[\frac{\partial\omega}{\partial x}=\frac{\partial(-\bar{z})}{\partial x}\frac{\partial\omega}{\partial(-\bar{z})}=\frac{\partial(-x+iy)}{\partial x}\frac{\partial\omega}{\partial(-\bar{z})}=\frac{-\partial\omega}{\partial(-\bar{z})}\]
\[\frac{\partial\omega}{\partial y}=\frac{\partial z}{\partial y}\frac{\partial\omega}{\partial z}=\frac{\partial(x+iy)}{\partial y}\frac{\partial\omega}{\partial z}=i\frac{\partial\omega}{\partial z}\]
\[\frac{\partial\omega}{\partial y}=\frac{\partial(-\bar{z})}{\partial y}\frac{\partial\omega}{\partial(-\bar{z})}=\frac{\partial(-x+iy)}{\partial y}\frac{\partial\omega}{\partial(-\bar{z})}=i\frac{-\partial\omega}{\partial(-\bar{z})}\]
Now it is necessary to find $\frac{\partial\omega(z)}{\partial z}$. In Abramowitz \& Stegun we find the relation $\frac{\partial\omega(z)}{\partial z}=-2z\omega(z)+\frac{2i}{\sqrt{\pi}}$. Then:
\begin{eqnarray*}
\frac{\partial K(x,y)}{\partial x}&=&\frac{\partial}{\partial x}\left\{ \frac{1}{2} \left( \omega(z)+\omega(-\bar{z})\right)\right\}\\
&=&\frac{1}{2}\left\{\frac{\partial\omega(z)}{\partial x}+\frac{\partial\omega(-\bar{z})}{\partial x}\right\}\\
&=&\frac{1}{2}\left\{\frac{\partial}{\partial z}\omega(z)-\frac{\partial}{\partial(-\bar{z})}\omega(-\bar{z})\right\}\\
&=&\frac{1}{2}\left\{-2z\omega(z)+\frac{2i}{\sqrt{\pi}}-\left(-2(-\bar{z})\omega(-\bar{z})+\frac{2i}{\sqrt{\pi}}\right)\right\}\\
&=&-\left(z\omega(z)+\bar{z}\omega(-\bar{z})\right)\\
\mbox{with }\omega(-\bar{z})=\overline{\omega(z)}\mbox{:}&&\\
&=&-\left(z\omega(z)+\overline{z\omega(z)}\right)\\
&=&-2\Re\left\{z\omega(z)\right\} 
\end{eqnarray*}



In the same way we write:

\begin{eqnarray*}
\frac{\partial K(x,y)}{\partial y} 
&=& \frac{\partial}{\partial y} \left\{ \frac{1}{2}
\left( \omega(z)+\omega(-\bar{z})\right) \right\}\\
&=&\frac{1}{2}\left\{\frac{\partial\omega(z)}{\partial y}+\frac{\partial\omega(-\bar{z})}{\partial y}\right\}\\
&=& {i\over 2}\left\{ {\partial \omega(z)\over \partial z} + i{\partial \omega(-\overline{z})\over \partial (-\overline{z})}\right\} \\
&=& {i\over 2}\left\{-2z\omega(z) + {2i\over \sqrt{\pi}} +  -z(-\overline{z})\omega(-\overline{z}) + {2i\over \sqrt{\pi}}\right\}\\
&=& -{2\over \sqrt{\pi}} -i\left\{z\omega(z) - \overline{z}\omega(-\overline{z})\right\}\\
&=& -{2\over \sqrt{\pi}} -i\{z\omega(z) - \overline{z\omega(z)}\} 
\hspace{1cm} (because\,\, \omega(-\overline{z}) = \overline{\omega(z)})\\
&=& -{2\over \sqrt{\pi}} + 2 \Im\{z\omega(z)\}
\end{eqnarray*}

To summarize:
\begin{equation}
\framebox {$ {\partial K(x,y)\over \partial y} = -2 \Re\{z\omega(z)\} $}
\end{equation}
\begin{equation}
\framebox {${\partial k(x,y)\over \partial y} = -{2\over \sqrt{\pi}} + 2 \Im\{z\omega(z)\}  $}
\end{equation}


\section{Partial derivatives of the Voigt Line-shape}
Lets start to recall some definitions:
$$
\phi \left( v \right)={A \over {\alpha_D}}\sqrt {{{\ln{2}} \over
\pi }}K\left( {x,y} \right) \hspace{1cm}
K\left( {x,y} \right)=\Re \left\{ {\omega \left( z
\right)} \right\}
$$
with:
$$
x={{v-v_0} \over {\alpha_D}}\sqrt {\ln{2}} \hspace{1cm}
y={{\alpha_L} \over {\alpha_D}}\sqrt {\ln{2}}
$$
$$
  {\partial  \over {\partial x}}K\left( {x,y} \right)=-2\Re \left\{ {z\omega
\left( z \right)} \right\},\,\, {\partial  \over {\partial y}}K\left( {x,y}
\right)=-{2 \over {\sqrt \pi }}+2\Im \left\{ {z\omega \left( z \right)}
\right\}
$$

Then:
\begin{eqnarray}
{{\partial \phi } \over {\partial A}} &=& {1 \over {\alpha_D}}\sqrt {{{\ln{2}}
\over \pi }}K\left( {x,y} \right)={1 \over {\alpha_D}}\sqrt {{{\ln{2}} \over
\pi }}\,\Re \left\{ {\omega \left( z \right)} \right\}\\
{{\partial \phi } \over {\partial v_0}} &=& {A \over {\alpha_D}}\sqrt {{{\ln{2}}
\over \pi }}{\partial  \over {\partial x}}K\left( {x,y} \right){{\partial x}
\over {\partial v}}={A \over {\alpha_D}}\sqrt {{{\ln{2}} \over
\pi }}\biggl\{ -2\Re \left\{ {z\omega \left( z \right)} \right\}\biggr\}{{-1} \over
{\alpha_D}}\sqrt {\ln{2}}\\
{{\partial \phi } \over {\partial \alpha_L}} &=& {A \over {\alpha_D}}\sqrt
{{{\ln{2}} \over \pi }}{\partial  \over {\partial y}}K\left( {x,y}
\right){{\partial y} \over {\partial v}}={A \over {\alpha_D}}\sqrt {{{\ln{2}}
\over \pi }}\left\{ {-{2 \over {\sqrt \pi }}+2\Im \left\{ {z\omega \left( z
\right)} \right\}} \right\}{1 \over {\alpha_D}}\sqrt {\ln{2}}\\
{{\partial \phi } \over {\partial \alpha_D}} & = & K\left( {x,y}
\right){\partial  \over {\partial \alpha_D}}\left\{ {{A \over {\alpha
_D}}\sqrt {{{\ln{2}} \over \pi }}} \right\}+{A \over {\alpha_D}}\sqrt {{{\ln{2}}
\over \pi }}{\partial  \over {\partial \alpha_D}}K\left( {x,y} \right) \nonumber\\
& = & A\sqrt {{{\ln{2}} \over \pi }}\left( {-{{K\left( {x,y} \right)} \over
{\alpha_D^2}}+{1 \over {\alpha_D}}\left\{ { {\partial \over {\partial
x}}K\left( {x,y} \right){\partial  \over {\partial \alpha_D
}}\left[ {{{v-v_0} \over {\alpha_D}}\sqrt {\ln{2}}} \right]+
{\partial \over
{\partial y}}K\left( {x,y} \right){\partial  \over {\partial \alpha
_D}}\left[ {{{\alpha _L} \over {\alpha_D}}\sqrt {\ln{2}}} \right]} \right\}}
\right) \nonumber\\
& = & A\sqrt {{{\ln{2}} \over \pi }}\left( {-{{K\left( {x,y} \right)} \over
{\alpha_D^2}}+{1 \over {\alpha_D}}\left\{ {-{{v-v_0} \over {\alpha
_D^2}}\sqrt {\ln{2}}{\partial  \over {\partial x}}K\left( {x,y}
\right)-{{\alpha_L} \over {\alpha_D^2}}\sqrt {\ln{2}}{\partial  \over
{\partial y}}K\left( {x,y} \right)} \right\}} \right) \nonumber\\ 
& = & {A \over {\alpha_D}}\sqrt {{{\ln{2}} \over \pi }}{1 \over {\alpha
_D}}\left( {-K\left( {x,y} \right)+\left\{ {-x{\partial  \over {\partial
x}}K\left( {x,y} \right)-y{\partial  \over {\partial y}}K\left( {x,y}
\right)} \right\}} \right)\nonumber\\ 
& = &  -{A \over {\alpha_D}}\sqrt {{{\ln{2}} \over \pi }}{1 \over {\alpha
_D}}\left( {K\left( {x,y} \right)+x{\partial  \over {\partial x
}}K\left( {x,y} \right)+y{\partial  \over {\partial y}}K\left( {x,y}\right)} \right) 
\end{eqnarray}


\chapter{Initial estimates}

We automated calculating initial estimates using a method described by 
Schwarz (1968) called the {\it gauest} method. A second-order polynomial is 
fitted at each pixel  position $x_k$ using $2Q+1$ points distributed 
symmetrically around $x_k$. 
The value at $x_k$ is {\it not} the profile value at that point, but
the median of that value and the two neighbours. Outliers that are not 
filtered with this median filter can be masked in the plot with the 
left mouse button. 
In $XGAUPROF$ the factor $Q$ is called the smoothing factor.
The coefficient of the second-order term of the polynomial is an
approximation of the second derivative of the observed profile. Assuming
that the observed profile can be approximated by the sum of a few (standard)
Gaussian functions, the parameters $x_0$ and $\sigma_0$ are calculated
from the main minima of the second derivative. The amplitude is derived
from the observed profile. Tests using different threshold values make
it possible to discriminate against spurious components; the threshold values 
depend on Q and the r.m.s. noise of the observed profile. The Gaussian
components are then subtracted from the observed profile, and the residual 
profile, mainly the sum of a few remaining broader components, is handled 
in the same way as the original.
Profiles with a maximum amplitude smaller than a user given value and
profiles with a dispersion smaller than a user given value are discarded.
The initial values for these filters are set to zero.
Blanks in the profile and points that are masked by the user are set to 
the value of the zero level. If you did not fix a certain zero level, then
the median of the profile is used as an estimate. If you did not fix
the r.m.s. noise of the observed profile, the distance between the quartiles
of the profile is used as an estimate.
\chapter{References}


\item Abramowitz, M. and Stegun, C. A. (Eds.). {\it Handbook of Mathematical 
Functions with Formulas, Graphs, and Mathematical Tables}, 9th printing. New York: Dover, p. 928, 1972. 
\item Armstrong, B.H., {\it Spectrum Line Profiles: The Voigt Function}. J. Quant. Spectrosc. Radiat. Transfer {\bf 7}, 61-88, 1967\\
\item Kaper, H.G., Smits, D.W., Schwarz, U.J., Takabuko, K., Woerden, H. van,
{Computer Analysis of Observed Distributions into Gaussian components},
Bull. Astr. Inst. Netherlands, {\bf 18} 465-487, 1966 
\item Marel, P. van der, Franx, M.,\,\,{\it A new method for the identification of non-gaussian
line profiles in elliptical galaxies}. A.J., {\bf 407} 525-539, 1993 April 20\\
\item Schwarz, U.J., {\it Analysis of an observed function into components
using its second derivative}, Bull. Astr. Inst. Netherlands, {\bf 19} 405-413, 1968
\end{flushleft}
\end{document}



#<

#>            xgauprof.h
/*
                           COPYRIGHT (c) 1999
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.
*/

#include    "gipsyc.h"       /* Defines the ANSI-F77 types for Fortran to C intface */
                             /* including def. of char2str,str2char,tofchar,zadd */
                             /* and macros tobool and toflog */

#include    "keyevents.h"    /* Definitions for event-driven operation */
#include    "events.h"


#define MYMAX(a,b)     ( (a) > (b) ? (a) : (b) )
#define MYMIN(a,b)     ( (a) > (b) ? (b) : (a) )
#define BETWEEN(a,b,c) ( (a) < (b) ? (b) : ((a) > (c) ? (c) : (a) ) )
#define NINT(a)        ( (a) < 0 ? (int)((a)-.5) : (int)((a)+.5) )
#define ABS(a)         ( (a) < 0 ? (-(a)) : (a) )
#define PI             3.141592653589793
#define RAD(a)         ( (a) * 0.017453292519943295769237 )
#define DEG(a)         ( (a) * 57.295779513082320876798155 )

#define RELEASE        "2.1"      /* Version number */
#define MAXAXES        10         /* Max. axes in a set */
#define MAXSUBSETS     4096       /* Max. allowed subsets */
#define MAXBUF         4096       /* Buffer size for I/O */
#define DUMBUF         16*1024    /* Dummy array */
#define STRLEN         256        /* Max length of strings */
#define FILENAMELEN    256        /* Max length of file names */
#define FITSLEN        20         /* Max length of header items etc.*/
#define NOERRORLOOP    100        /* Special code for gdsinp */
#define NONE           0          /* Default levels in userxxx routines */
#define REQUEST        1
#define HIDDEN         2
#define EXACT          4
#define YES            1          /* C versions of .TRUE. and .FALSE. */
#define NO             0
#define FIRSTLINE      0
#define SECONDLINE     1
#define DEBUG          16
#define MAINPLOT       "XGAUPROF"
#define RESPLOT        "ERRPLOT"
#define MAXFUNCTIONS   4          /* Gauss, Skewed Gauss, Voigt */
#define FIEID          100        /* Code to identify one of the functions */ 
#define MAXQ           16
#define MAXGAUSS       8          /* Max. gaussians in estimates routine */
#define MAXPAR         5          /* Max. parameters in one function */
#define MAXPARALL      MAXPAR*MAXGAUSS+3  /* Max. parameters in all gaussians */
                                          /* + 3 for back ground C+Bx+Ax^2 */
#define GAUSS          0
#define GAUSSHERMITE1  1
#define GAUSSHERMITE2  2
#define VOIGT          3

#define UNIFORM_W      0
#define MEDIAN_W       1
#define FILE_W         2

#define MAXITERS       200
#define TOLERANCE      0.0
#define LAMBDA         0.01

/* Defaults */

#define CHARSIZE       1.1
#define LWIDTH         2

#define PLOTDENS       200   /* Approx. number of points in plot of fit */ 

/* Colors */

#define BACKGROUND    0
#define FOREGROUND    1
#define RED           2
#define GREEN         3  
#define BLUE          4
#define CYAN          5
#define MAGENTA       6
#define YELLOW        7
#define ORANGE        8
#define GREENYELLOW   9
#define GREENCYAN    10
#define BLUECYAN     11
#define BLUEMAGENTA  12
#define REDMAGENTA   13
#define DARKGRAY     14
#define LIGHTGRAY    15


#define FULL_LINE  1                /* PGPLOT related */
#define DASHED     2
#define DOTTED     4



typedef struct
{
   char     npar;
}
function;


typedef struct
{
   bool     drawzero;                      /* Draw fitted background */
   int      id1;                           /* id. if main plot */
   int      id2;                           /* id. of residual plot */
   ident    cursorid;                      /* Cursor interaction function id */
   bool     plotest;
   bool     plotrms;
   bool     plotmed;
   bool     connect;
   fint     colcon;
   fint     colframe;
   fint     colest;
   fint     colfit;
   fint     colmed;
   float    vport[4];
   fint     density;
   float    charsize;
   fint     lwidth;
   fint     lwidthcur;
   char     ttitle[STRLEN];
   char     xtitle[STRLEN];
   char     ytitle[STRLEN];
}
attribs;


typedef struct
{
   int      setexist;
   int      boxexist;
   fchar    Setin;                         /* Name of 2-or 3 dim. input set */
   char     setbuf[STRLEN];
   char     setname[STRLEN];
   int      setnameexist;
   fint     subin[MAXSUBSETS];             /* Subset coordinate words */
   fint     axnum[MAXAXES];
   fint     subdim;                        /* Dimensionality of the subsets */
   fint     axesoutsidesub;

   fint     profilelen;
   fint     numprofiles;
   double   **profiles;
   int      profileexist;
   char     profaxname[FITSLEN];
   fint     profcw;                        /* Coordinate word of profile */
   fint     profaxnum;                     /* Axis number of profile in set */
   int      currentprofilenumber;   
   char     datname[FILENAMELEN];          /* File name for profile data in ascii file */
   char     fitdatname[FILENAMELEN];       /* Default name for fit results */
   char     PSname[FILENAMELEN];           /* File name for profile data in ascii file */   
   int      importprofile;                 /* Profile from set not from file etc. */    
   int      cleanimport;                   /* Can we remove blanks in this import? */
   fint     profxlen;                      /* P. lengths  when reading from file */
   fint     profylen;

   fint     blo[MAXAXES];                  /* Low  edge of box in grids */
   fint     bhi[MAXAXES];                  /* High edge of box in grids */
   fint     flo[MAXAXES];                  /* Low  edge of frame in grids */
   fint     fhi[MAXAXES];                  /* High edge of frame in grids */   
   fint     modvec[MAXAXES];               /* Index to vector help variables */

   float    datamin;
   float    datamax;
   fint     imagesize;
   float    charsize;                      /* PGPLOT Character size */
   char     devnam[20];
   bool     plotslice;                     /* If wanted, plot slice */
   fint     nsubdivxy[2];
   double   *xgrids;
   double   *xphys;
   double   *spline;
   double   *median;
   double   *xphysscale;
   char     positionstr[STRLEN];
   fint     plohi[2];                      /* Range of profile in grids */
   fint     profgridlo;
   fint     profgridhi;   
   char     dataunits[FITSLEN+1];
   char     axunits[FITSLEN+1];
   int      tophys;                        /* Is conversion grid -> phys. possible? */
   double   xgridminmax[2];
   double   yrange[2];
   char     axisnames[MAXAXES*FITSLEN];   
   int      inactive;                      /* Global flag to return immediately */
   int      rangeexist;

   int      nvar;                          /* Variable parameters per function */
   double   tolerance;
   double   lab;
   int      maxits;
   fint     smoothingpar[MAXQ];
   fint     numq;
   fint     iters;
   double   rms;
   double   critamp;
   double   critdisp;
   float    zerolevel;
   double   back_Z2;
   double   back_Z1;
   double   back_Z0;
   double   lorentz;
   double   h3;
   double   h4;
   int      weights;
   int      ncomp;  
   fint     gaussiansfound;
   double   estimates[MAXPARALL];          /* MAXGAUSS*MAXPAR + zero level */
   double   errorpar[MAXPARALL];           
   fint     fixedfree[MAXPARALL];   
   double   *wdat;                         /* Weights for lsqfit function */
   double   *wdatfile;                     /* Weights from file */   
   double   *work;                         /* Work array for sorted profile */
   double   *filtered;
   bool     estfilter;
   int      *mask;
   int      *clipped;   
   double   ampperc;                       /* Calculate width at this percentage */
   int      function;                      /* Which function must be fitted? */
   double   sigmaresidual;

   ident    ids[MAXPARALL];                /* Estimate function (de)schedules */
   int      nids;
   int      hardcopy;
   fint     fitfileformat;
   int      newheader;
   attribs  plot;
} globaltype;



extern void startfit( globaltype * );
extern void getandplotestimates( globaltype * );
extern int  allocs( globaltype *, int );
extern void plotfit( globaltype *, int, int );
extern void plotresidual( globaltype *, fint );
extern void resulttolog( globaltype *, FILE * );
extern void dminmax( double *, fint *, double *, double * );
extern fint dspline( double *, double *, fint *,
                     double *, double *, fint * );
extern int  deblank( double *, double *, int, double * );
extern void schedulefields( globaltype * );                     
extern void deschedulefields( globaltype * );

#<

#>            gui.h
#if !defined(_gui_h_)
#define _gui_h_
void gui(int xsize, int ysize, int esize);  /* activate GUI */
void gui_status(char *message, int lineno); /* display status message */
void gui_log(char *message, int lineno);    /* display log message */
void gui_error(char *message);              /* display error message */
void gui_axnames(char **names);             /* change axis menu entries */
extern void gui_allow_store(bool allow);
#define LOGLINES      22            /* number of log lines */ 
#endif
#<

#>            plotdevices.h
#if !defined(_plotdevices_h_)
#define _plotdevices_h_
extern char **plotdevices(void);
#endif

#<

#>            import.h
#if !defined(_import_h_)
#define _import_h_
void Import(char *key);
#endif
#<

#>            parcol.h
#if !defined(_parcol_h_)
#define _parcol_h_
ident BuildColumn(int nrows, char *title, char *parname);
#endif
#<

#>            pgutils.h
#if !defined(_pgutils_h_)
#define _pgutils_h_
int openplot( char *, int, int );
void setviewport( float, float, float, float );
void plotpoint( double, double, int, int );
void plotarray( double *, double *, int, int, int, bool, fint );
void ploterrors( double *, double *, double *, int, int );
void clearplot( void );
void setwindow( float, float, float, float );
void dsetwindow( double, double, double, double );
void setlinewidth( int );
void setcharheight( float );
void dblemove( double, double );
void dbledraw( double, double );
void flmove( float, float );
void fldraw( float, float );
void setcolor( int );
void selectplot( int );
void setlinestyle( int );
void plottext( float, float, char * );
void plotlabel( char *, char *, char * );
#define FULL_LINE              1          /* PGPLOT line style */
#endif      
#<

#>            param.h
#if !defined(_param_h_)
#define _param_h_
void Param(char *key);
#endif
#<

#>            plotopt.h
#if !defined(_plotopt_h_)
#define _plotopt_h_
void Plotopt(char *key);
#endif
#<

#>            outputresults.h
#if !defined(_outputres_h_)
#define _outputres_h_
void outputresults( globaltype * );
void w( double, double, double *, double * );
double funcd_c( double *, double *, fint *, fint * );
void disp2fwhm( double * );
void fwhm2disp( double * );
void clearguilog( void );
#endif
#<

#>            slider.h
#if !defined(_slider_h_)
#define _slider_h_
void Slider(char *key, ident shell, ident left, ident top);
#endif
#<

#>            hidden.h
#if !defined(_hidden_h_)
#define _hidden_h_
ident Hidden(char*);
#endif

#<

#>            misopt.h
#if !defined(_misopt_h_)
#define _misopt_h_
ident Misopt(char*);
#endif

#<

#>            xgauprof.c
/* xgauprof.c -XT
                            COPYRIGHT (c) 1999
                      Kapteyn Astronomical Institute
                University of Groningen, The Netherlands
                           All Rights Reserved.

*/

/*  xgauprof.c: include files     */

#include    "stdio.h"        /* Defines ANSI C input and output utilities */
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/
#include    "math.h"         /* Declares the mathematical functions and macros.*/
#include    "cmain.h"        /* Defines the main body of a C program with */
                             /* MAIN_PROGRAM_ENTRY and IDENTIFICATION */
#include    "gipsyc.h"       /* Defines the ANSI-F77 types for Fortran to C intface */
                             /* including def. of char2str,str2char,tofchar,zadd */
                             /* and macros tobool and toflog */
#include    "float.h"        /* Definition of FLT_MAX etc.*/
#include    "ctype.h"        /* Declares ANSI C functions for testing characters */
                             /* like: isalpha, isdigit etc. also tolower, toupper.*/


/* Common includes */

#include    "init.h"         /* Declare task running to HERMES and initialize.*/
#include    "finis.h"        /* Informs HERMES that servant quits and cleans up the mess.*/
#include    "anyout.h"       /* General character output routine for GIPSY programs.*/
#include    "setfblank.h"    /* Subroutine to set a data value to the universal BLANK.*/
#include    "error.h"        /* User error handling routine. */
#include    "myname.h"       /* Obtain the name under which a GIPSY task is being run.*/
#include    "nelc.h"         /* Characters in F-string discarding trailing blanks.*/
#include    "minmax1.h"
#include    "axunit.h"
#include    "cotrans.h"

/* User input routines */

#include    "userfio.h"      /* Easy-C companions for user interface routines.*/
#include    "userint.h"      /* User input interface routines.*/
#include    "userlog.h"
#include    "userreal.h"
#include    "userdble.h"
#include    "usertext.h"
#include    "userchar.h"
#include    "usercharu.h"
#include    "userfio.h"      /* Easy-C companions of userxxx_c */
#include    "reject.h"       /* Reject user input.*/
#include    "cancel.h"       /* Remove user input from table maintained by HERMES.*/
#include    "keyevents.h"    /* Definitions for event-driven operation */
#include    "events.h"
#include    "eventmonitor.h" 
#include    "wkey.h"
#include    "subst.h"
#include    "status.h"
#include    "setdblank.h"
#include    "time.h"

/* Input of sets */

#include    "gdsinp.h"       /* Input of set, subsets, return # subsets.*/
#include    "gdspos.h"       /* Define a position in a subset.*/
#include    "gdsbox.h"       /* Define a box inside/around a subset.*/
#include    "gds_exist.h"
#include    "gds_close.h"    /* Close set. */
#include    "gdsc_range.h"   /* Return lower left and upper right corner of a subset.*/
#include    "gdsc_word.h"
#include    "gdsc_ndims.h"   /* Return the dimensionality of a coordinate word.*/
#include    "gdsc_grid.h"    /* Extract grid value.*/
#include    "gdsc_fill.h"    /* return coordinate word filled with a grid */
                             /* value for each axis.*/
#include    "gdsi_read.h"    /* Reads data from (part of) a set.*/
#include    "gdsc_name.h"
#include    "gdsd_rchar.h"

#include    "gui.h" 
#include    "ggi.h"


/* #include "plotdevices.h" */

#include    "xgauprof.h"
#include    "pgplot.h"
#include    "pgutils.h"



/* Initialize Fortran compatible string with macro 'fmake' */

#define fmake(fchr,size) { \
                           static char buff[size+1]; \
                           int i; \
                           for (i = 0; i < size; buff[i++] = ' '); \
                           buff[i] = 0; \
                           fchr.a = buff; \
                           fchr.l = size; \
                         }

/* Malloc version of 'fmake. Strings allocated with'  */
/* finit, must be freed with free( fc.a ) */
#define finit( fc , len ) { fc.a = malloc( ( len + 1 ) * sizeof( char ) ) ;  \
                            fc.a[ len ] = '\0' ; \
                            fc.l = len ; }


#define VIEWPORT       0.15, 0.1, 0.95, 0.9

/* Miscellaneous */

static fint     setlevel = 0;       /* To get header items at set level. */
static float    blank;              /* Global value for BLANK. */
static int      odev;               /* Device to which output is directed */

static char     *taskname = "xgauprof";


double funcd_c( double *xdat, double *fpar, fint *npar, fint *fopt );

static double **fmatrix( int xlo,
                         int ylo,
                         int xhi,
                         int yhi )
/*------------------------------------------------------------------*/
/* PURPOSE: Allocate space for a matrix with subscript range        */
/*          M[ylo..yhi][xlo..xhi]                                   */
/*------------------------------------------------------------------*/
{
   int      rows = yhi - ylo + 1;
   int      cols = xhi - xlo + 1;
   int      i;
   double   **m;


   /* Allocate memory for pointers to rows */
   m = (double **) malloc( rows * sizeof(double*) );
   if (!m)
      return( NULL );
   m -= ylo;                                /* Adjust subscript */

   /* Pointer to first row allocates memory for box */
   m[ylo] = (double *) malloc( rows * cols * sizeof(double) );
   if (!m[ylo])
       return( NULL );
   m[ylo] -= xlo;                           /* Adjust subscript */

   /* Set pointers to rows */
   for (i = ylo+1; i <= yhi; i++)
      m[i] = m[i-1] + cols;

   /* Return pointer to array of pointers to rows */
   return( m );
}



static void freefmatrix( double **m,
                         int   xlo,
                         int   ylo )
/*------------------------------------------------------------------*/
/* PURPOSE: Free space allocated by a matrix made with function     */
/*          'fmatrix'.                                              */
/*------------------------------------------------------------------*/
{
   free( m[ylo] + xlo );
   free( m + ylo );
}





static void hermesstatus( char *txt )
/*------------------------------------------------------------*/
/* PURPOSE: Update status in hermes status                    */
/*------------------------------------------------------------*/
{
   status_c( tofchar(txt) );
}



static void error_status( char *errstr,
                          char *statstr1,
                          char *statstr2 )
/*------------------------------------------------------------*/
/* PURPOSE: Update status and error messages in gui.          */
/*------------------------------------------------------------*/
{
   gui_error( errstr );
   gui_status( statstr1, FIRSTLINE );
   hermesstatus( statstr1 );
   gui_status( statstr2, SECONDLINE );
}



static void clearstatus( void )
/*------------------------------------------------------------*/
/* PURPOSE: Clear status and error messages in gui.           */
/*------------------------------------------------------------*/
{
   gui_error( "" );
   gui_status( "", FIRSTLINE );
   gui_status( "", SECONDLINE );
   hermesstatus("");
}



bool UserLog(char *key)
/*------------------------------------------------------------*/
/* Purpose: Special version of userlog with default.          */
/*------------------------------------------------------------*/
{
   bool result=toflog(FALSE);
   fint fint1=1, fint2=2;

   (void)userlog_c(&result, &fint1, &fint2, tofchar(key), tofchar(" "));
   return tobool(result);
}




static void clearstr( fchar Fstr )
/*------------------------------------------------------------*/
/* Purpose: Blank a Fortran string up to 'len' characters     */
/*------------------------------------------------------------*/
{
   int    i;
   fint   len = Fstr.l;


   for (i = 0; i < (int) len; i++)
   {
      Fstr.a[i] = '\0';
   }
}



static void getdble( ident id,
                     char  *key,
                     int   code,
                     void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for doubles.                      */
/*------------------------------------------------------------*/
{
    double     *userval = (double *) arg;
    fint       nitems = 1;
    fint       dfault = HIDDEN;

    (void) userdble_c( userval,
                       &nitems,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
}




static void getcritamp( ident id,
                        char  *key,
                        int   code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for CRITAMP=.                     */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg;
   fint       nitems = 1;
   fint       dfault = HIDDEN;
   double     userval;


   (void) userdble_c( &userval,
                      &nitems,
                      &dfault,
                      tofchar(key),
                      tofchar(" ") );
                      
   g->critamp = fabs( userval );
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );   
}




static void getcritdisp( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for CRITDISP=.                    */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg;
   fint       nitems = 1;
   fint       dfault = HIDDEN;
   double     userval;


   (void) userdble_c( &userval,
                      &nitems,
                      &dfault,
                      tofchar(key),
                      tofchar(" ") );
                      
   g->critdisp = fabs( userval );
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );   
}




static void getfunction( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for FUNCTION=                     */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg;
   fint       userval;
   fint       nitems = 1;
   fint       dfault = HIDDEN;


   (void) userint_c( &userval,
                     &nitems,
                     &dfault,
                     tofchar(key),
                     tofchar(" ") );   
   if (userval < 0 || userval >= MAXFUNCTIONS) 
   {
      rejectf( key, "Invalid function selection!" );
      g->function = GAUSS;
      g->ncomp = 1;
      return;
   }
   g->function = (int) userval;
   if (g->function == GAUSS)
      g->nvar = 3;              /* Amp, disp, center */
   else if (g->function == GAUSSHERMITE1)
      g->nvar = 4;
   else if (g->function == GAUSSHERMITE2)
      g->nvar = 5;  
   else
      g->nvar = 4;             
      
   g->newheader = YES;
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
}




static void getampperc( ident id,
                        char  *key,
                        int   code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for AMPPERC=                      */
/*------------------------------------------------------------*/
{
    double     *ampperc = (double *) arg;
    double     val;
    fint       nitems = 1;
    fint       dfault = HIDDEN;

    (void) userdble_c( &val,
                       &nitems,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
    if (val < 0.0)
    {
       rejectf( key, "Percentage must be >= 0 %" );
       error_status( "Percentage must be >= 0 %", "", "" );
       val = 50.0;                                    /* percentage */
    }
    if (val > 100.0)
    {
       rejectf( key, "Percentage must be <= 100 %" );
       error_status( "Percentage must be <= 100 %", "", "" );
       val = 50.0;                                    /* percentage */
    }
    *ampperc = val;    
}




static void getviewport( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for floats.                       */
/*------------------------------------------------------------*/
{
    float     *userval = (float *) arg;
    fint       nitems = 4;
    fint       dfault = HIDDEN;

    (void) userreal_c( userval,
                       &nitems,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
}




static void getreal( ident id,
                     char  *key,
                     int   code,
                     void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for floats.                       */
/*------------------------------------------------------------*/
{
    float     *userval = (float *) arg;
    fint       nitems = 1;
    fint       dfault = HIDDEN;

    (void) userreal_c( userval,
                       &nitems,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
}




static void getint( ident id,
                    char  *key,
                    int   code,
                    void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for (f)ints.                      */
/*------------------------------------------------------------*/
{
    fint       *userval = (fint  *) arg;
    fint       nitems  = 1;
    fint       dfault  = HIDDEN;

    (void) userint_c( userval,
                      &nitems,
                      &dfault,
                      tofchar(key),
                      tofchar(" ") );
}




static void getbool( ident id,
                     char  *key,
                     int   code,
                     void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for (f)ints.                      */
/*------------------------------------------------------------*/
{
    bool       *userval = (bool  *) arg;
    fint       nitems  = 1;
    fint       dfault  = HIDDEN;

    *userval = toflog( *userval );
    (void) userlog_c( userval,
                      &nitems,
                      &dfault,
                      tofchar(key),
                      tofchar(" ") );
    *userval = tobool( *userval );
}




static void getncomp( ident id,
                      char  *key,
                      int   code,
                      void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: NCOMP= keyword handler for (f)ints.               */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype*) arg;
   fint       userval = 1;
   fint       nitems  = 1;
   fint       dfault  = HIDDEN;


   (void) userint_c( &userval,
                     &nitems,
                     &dfault,
                     tofchar(key),
                     tofchar(" ") );
                       
   g->ncomp = userval;
   g->newheader = YES;
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
}




static void setestfilter( ident id,
                          char  *key,
                          int   code,
                          void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: ESTFILTER= Keyword handler.                       */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype*) arg; 
   bool       userval;
   fint       dfault = HIDDEN;
   fint       nitems = 1;


   (void) userlog_c( &userval,
                     &nitems,
                     &dfault,
                     tofchar(key),
                     tofchar(" ") );


   g->estfilter = tobool( userval );
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );   
}




static void gettxt( ident id,
                    char  *key,
                    int   code,
                    void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for text.                         */
/*------------------------------------------------------------*/
{
    char      *userval = (char  *) arg;
    fint       dfault  = HIDDEN;
    fchar      Text;
    char       buf[STRLEN];

    Text.a = buf;
    Text.l = STRLEN-1;
    (void) usertext_c( Text,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
    Text.a[nelc_c(Text)] = '\0';
    strcpy( userval, Text.a );
}



#if (0)
static void getchr(  ident id,
                     char  *key,
                     int   code,
                     void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for a string.                     */
/*------------------------------------------------------------*/
{
    char       *userval = (char *) arg;
    fint       nitems  = 1;
    fint       dfault  = HIDDEN;
    fchar      Text;
    char       buf[STRLEN];

    Text.a = buf;
    Text.l = STRLEN-1;

    (void) userchar_c( Text,
                       &nitems,
                       &dfault,
                       tofchar(key),
                       tofchar(" ") );
    Text.a[nelc_c(Text)] = '\0';
    strcpy( userval, Text.a );
}
#endif




static void getqs( ident id,
                   char  *key,
                   int   code,
                   void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for Q=                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype*) arg;
   fint       nitems  = MAXQ;
   fint       dfault  = HIDDEN;
   int        i;

   g->numq = userint_c( g->smoothingpar,
                        &nitems,
                        &dfault,
                        tofchar(key),
                        tofchar(" ") );


   /* Smoothing parameters must be > 1 */
   for (i = 0; i < g->numq; i++)
   {
      if (g->smoothingpar[i] < 1)
         g->smoothingpar[i] = 1;         
   }

   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
}




static void scalearray( double  *in,
                        double  *out,
                        int     len )
/*------------------------------------------------------------*/
/* PURPOSE: Convert array to double and convert values        */
/*          between 0 and 1.                                  */
/*------------------------------------------------------------*/
{
   int      i;
   double   P0, Pmax, Pi;
            
   P0   = in[0];
   Pmax = in[len-1];

   /* Scale values so that they fit between 0 and 1 */
   for (i = 0; i < len; i++) 
   {
      Pi = (double) in[i];
      out[i] = (Pi - P0)/(Pmax - P0);
   }
}




static int resample( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Resample the profile data so that the x-values    */
/* are equidistant and blanks are filtered.                   */
/*------------------------------------------------------------*/
{
   int         len = g->profilelen;
   double      pmin, pmax;
   double      delta;
   fint        flenI, flenO;
   fint        r;
   int         i, uniqueX;
   double      *dummyXI = NULL;
   double      *dummyXO = NULL;  
   double      *dummyY  = NULL;     
   double      dblank;
   
 
   clearstatus();
   if (!g->importprofile)
   {
      error_status( "No import profile!", "", "" );
      return( NO );
   }

   dummyXI = (double *) calloc( len, sizeof(double) );
   dummyXO = (double *) calloc( len, sizeof(double) );   
   dummyY  = (double *) calloc( len, sizeof(double) );      
   if (dummyXI == NULL || dummyXO == NULL || dummyY == NULL)
   {
      error_status( "Cannot allocate enough memory!",
                    "No memory left for spline work array.",
                    "Perhaps you should restart with a smaller box." );
      g->importprofile = NO;
      return( NO );      
   }   

   setdblank_c( &dblank );
  
 
   /*--------------------------------------------------*/
   /* Process the input profile. In this profile there */
   /* can be equal x positions, non equidistant x      */
   /* positions or blanks. These problems can all be   */
   /* filtered out with a spline interpolation.        */
   /*--------------------------------------------------*/   

   /* Skip X-values that are equal */
   dummyXI[0] = g->xphys[0];   
   dummyY[0]  = g->profiles[0][0];
   for (uniqueX = 1, i = 1; i < len; i++)
   {
      double  D;
      D = g->xphys[i] - g->xphys[i-1];
      if (D != 0.0)
      {
         if (g->profiles[0][i] != dblank)
         {
            dummyXI[uniqueX] = g->xphys[i];
            dummyY[uniqueX]  = g->profiles[0][i];
            uniqueX++;
         }
      }
   }
   pmin = g->xphys[0]; pmax = g->xphys[len-1];
   delta = (pmax - pmin) / (double) (len - 1);

   /* Create the sample X-values */
   dummyXO[0] = pmin;
   for (i = 1; i < len; i++)
   {
      dummyXO[i] = dummyXO[i-1] + delta; 
   }
   flenI = (fint) uniqueX;   
   flenO = (fint) len;
   r = dspline( dummyXI, dummyY, &flenI, 
                dummyXO, g->spline, &flenO );
   if (r < 0)
   {
      gui_error( "Problems with resampling profile!" );
      if (r == -1)
      {
         g->importprofile = NO;         
         gui_status( "Memory problems for spline function!", FIRSTLINE );
      }
      if (r == -2)
      {
         gui_status( "Input array has two equal x-coordinates or", FIRSTLINE );
         gui_status( "other interpolation problem.", SECONDLINE );
      }
      g->cleanimport = NO;
      free( dummyY  );
      free( dummyXO );      
      free( dummyXI );
      return( NO );
   }

   free( dummyY  );
   free( dummyXO );      
   free( dummyXI );
   return( YES );
}



static void geterrors( ident id,
                       char  *key,
                       int   code,
                       void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PROFYERR= Keyword handler                         */
/* If there are less entries than the length of the profile   */
/* then set the remaining to 1.                               */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg; 
   fint       nitems;
   fint       dfault = HIDDEN;
   fint       r;

  
   nitems = g->profilelen;
   if (nitems == 0)   
      return;
      
   r = userdble_c( g->wdatfile,
                   &nitems,
                   &dfault,
                   tofchar(key),
                   tofchar(" ") );
  
   if (r < g->profilelen)
   {
      int i;
      for (i = r; i < g->profilelen; i++)
         g->wdatfile[i] = 1.0;          
   }       

   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
} 




static void getweights( ident id,
                        char  *key,
                        int   code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: Keyword handler for WEIGHTS=                      */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg;
   fint       userval;
   fint       nitems  = 1;
   fint       dfault  = HIDDEN;

   (void) userint_c( &userval,
                     &nitems,
                     &dfault,
                     tofchar(key),
                     tofchar(" ") );
                     
   g->weights = (int) userval;
   if (userval == 2)               /* (re)read the errors from file */
      geterrors( NULL, "PROFYERR=", KEYCHANGE, g );
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" ); 
}



static void getfileprof( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PROFX= & PROFY= Keyword handler.                  */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg; 
   double     dumarray[DUMBUF];
   fint       nitems = DUMBUF;
   fint       dfault = HIDDEN;
   fint       r;
   int        i;
   int        xprof = NO;


   if ( strcmp("PROFX=", key) == 0 )
      xprof = YES;

   /* Read all data first */
   r = userdble_c( dumarray,
                   &nitems,
                   &dfault,
                   tofchar(key),
                   tofchar(" ") );
    
   if (r == 0)
      return;
                            
   if (xprof)
   {
      g->profxlen = r;
      if ( !allocs(g, g->profxlen) )
      {
         error_status( "Cannot allocate enough memory!",
                       "No memory left for profile work arrays.",
                       "Perhaps you should restart with a smaller box." );
         return;
      }
      for (i = 0; i < g->profxlen; i++)
      {
         g->xgrids[i] = (double) i;
         g->xphys[i] = dumarray[i];
         scalearray( g->xphys, g->xphysscale, g->profxlen ); 
      }      
      dminmax( g->xgrids, &(g->profxlen), &(g->xgridminmax[0]), &(g->xgridminmax[1]) );           
      g->profylen = 0;
   }      
   else
   {
      g->numprofiles = 1;      
      g->profylen = r; 
      g->profiles = fmatrix( 0, 0, g->profylen-1, g->numprofiles-1 );
      if (!g->profiles)
      {
         error_status( "Cannot allocate memory for profile", "", "" );
         return;
      }
      /* Copy data from file to profile array */
      for (i = 0; i < g->profylen; i++)
      {
         g->profiles[0][i] = dumarray[i];
      }
   }

   /* If the arrays have same lengths then start the action */
   if (g->profxlen == g->profylen)
   {
      error_status( "", "Profile data successfully imported", "" );
      g->profilelen = g->profxlen;
      g->importprofile = YES;
      g->currentprofilenumber = 0;            
      g->cleanimport = resample( g );
      wkeyf( "PLOTDATA=Y" ); 
   }
   else if (g->profxlen != 0 && g->profylen != 0)  
   {
      error_status( "Unequal number of X's and Y's in profile!", "", "" );
   }
}



static int getindex( double  x,
                     double  y,
                     double *X,
                     double *Y,
                     int     n )
/*------------------------------------------------------------*/
/* PURPOSE: Find index of element in array with positions to  */
/*          which the distance to a position (x,y) is the     */
/*          shortest.                                         */
/*------------------------------------------------------------*/
{
   int      i = 0;
   double   Dmin, Dmin2;
   float    xlo,xhi, ylo, yhi;
   double   aspectratio;   


   if (n == 1) 
      return( -1 );
   pgqwin_c( &xlo, &xhi, &ylo, &yhi );
   
   /* Correct for aspect ratio in world coordinates */  
   aspectratio = ABS( (xhi-xlo)/(yhi-ylo) ); 
   Dmin = 0.5*(xhi-xlo)/(n-1);
   Dmin2 = Dmin * Dmin;
   for (i = 0; i < n; i++)
   {
      double D;
      D = (x-X[i])*(x-X[i]) + (y-Y[i])*(y-Y[i])*aspectratio*aspectratio;
      if (D < Dmin2)
      {
         return( i );
      }
   }
   return( -1 );
}                   




static void includerange( ident id,
                          char  *key,
                          int   code,
                          void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: INCLUDE= Keyword handler.                         */
/* Exclude (= mask) data outside this range.                  */
/* Read the INCLUDE= keyword. If there are values available,  */
/* test all physical positions in the profile. Positions      */
/* outside the range are masked. After setting this include   */
/* range, you can exclude points again by hand. The include   */
/* range is valid for the current profile and must be         */
/* triggered again for another profile.                       */
/*------------------------------------------------------------*/
{
   globaltype *g=(globaltype*)arg; 
   fint        nitems = 2;
   fint        dfault = HIDDEN;
   fint        r;
   int         i;
   double      incrange[2];
   
   
   if (!g->boxexist && !g->importprofile)
   {
      error_status( "No data!", "Need set and box or import file", "" );
      return;
   }
    
   r = userdble_c( incrange,
                   &nitems,
                   &dfault,
                   tofchar(key),
                   tofchar(" ") );
   
   if (r == 0)              /* Nothing entered, unmask all */
   {
      for (i = 0; i < g->profilelen; i++) 
         g->mask[i] = 0;
      if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
      return;      
   }

     
   if (r == 1)
   {
      incrange[1] = g->xphys[g->profilelen-1];
   }
   
   
   for (i = 0; i < g->profilelen; i++) 
   {
      if (g->xphys[i] < incrange[0] || g->xphys[i] > incrange[1])
      {
         /* Exclude this point */
         if (!g->mask[i])              /* It is not excluded yet */
         {
            g->mask[i] = 1;
         }
      }
      else
      {
         if (g->mask[i])               /* It is excluded, so include now! */
         {
            /* unmask */
            g->mask[i] = 0;
         }    
      }
   }
   if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
}




static void cursor( ident         id,
                    GgiPlotInfo   info,
                    void          *arg )
/*------------------------------------------------------------*/
/* PURPOSE: React to cursor actions in main plot window       */
/*------------------------------------------------------------*/
{
   globaltype  *g = (globaltype*) arg;
   double      x = (float) info->x;
   double      y = (float) info->y;                        /* World coordinates */
   int         button=info->button, state=info->state;
   int         prof = g->currentprofilenumber;  
   int         indx = -1;


   if ((button&ggiButn1) && !(state&ggiButn1))
   {
      indx = getindex( x, y, g->xphys, g->profiles[prof], g->profilelen );
      if (indx >= 0) 
      {
         if (!g->mask[indx])
         {
            plotpoint( g->xphys[indx], g->profiles[prof][indx], RED,2 ); 
            g->mask[indx] = 1;
         }
         else
         {
            /* unmask */
            plotpoint( g->xphys[indx], g->profiles[prof][indx], FOREGROUND,2 );
            g->mask[indx] = 0; 
         }
      }
   }
}



static void startmouseinteraction( char *dev,
                                   globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Start mouse interaction for this plot device.     */
/*------------------------------------------------------------*/
{
   if (g->plot.cursorid)
   {
      DescheduleGgiPlotCursor( &(g->plot.cursorid) );
   }

   g->plot.cursorid = ScheduleGgiPlotCursor( cursor,
                                            GgiPlotField(dev,0,0),
                                            g );    
}




static void initplots( char *dev1, 
                       char *dev2,
                       fint *nxysub, 
                       globaltype *g  )
/*------------------------------------------------------------*/
/* PURPOSE: Initialize PGPLOT                                 */
/*------------------------------------------------------------*/
{
   int    r;


   r = openplot( dev1, nxysub[0], nxysub[1] );
   if ( r <= 0 )
   {
      error_status( "Cannot open main plot device", "Reason unknown", "" );
      return;
   }
   g->plot.id1 = r;      
   setviewport( g->plot.vport[0], g->plot.vport[1], g->plot.vport[2], g->plot.vport[3] );
   if (nxysub[0] == 1 && nxysub[1] == 1) 
      startmouseinteraction( dev1, g );
   
   r = openplot( dev2, nxysub[0], nxysub[1] );
   if ( r <= 0 )
   {
      error_status( "Cannot open residual plot device", "Reason unknown", "" );
      return;
   }
   g->plot.id2 = r;   
   setviewport( g->plot.vport[0], g->plot.vport[1], g->plot.vport[2], g->plot.vport[3] );      
}




static void setsubdiv( ident id,
                       char  *key,
                       int   code,
                       void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: SUBDIV= keyword handler for a string.             */
/*                                                            */
/* Flag 'first' is used to decide whether to close pgplot or  */
/* not, before opening a new pgplot window.                   */
/*------------------------------------------------------------*/
{
   globaltype   *g=(globaltype*)arg; 
   fint         Nxy[2];
   fint         nitems  = 2;
   fint         r;
   fint         dfault  = HIDDEN;
   int          i;
   static int   first = YES;
    
     
   r =    userint_c( Nxy,
                     &nitems,
                     &dfault,
                     tofchar(key),
                     tofchar(" ") );
   if (r == 1)
      Nxy[1] = Nxy[0];
      
   for (i = 0; i < 2; i++)
   { 
      if (Nxy[i] < 1) 
         Nxy[i] = 1;         
      g->nsubdivxy[i] = Nxy[i];
   }
   if (!first)
      pgend_c();
   else
      first = NO;
      
   if (g->boxexist)
   {
      initplots( MAINPLOT, RESPLOT, g->nsubdivxy, g );   
      selectplot( g->plot.id1 );
   }
}




static int grid2phys2( fchar  Setin, 
                       fint   grid,
                       fint   cowo, 
                       int    axnum,
                       double *physval )
/*------------------------------------------------------------*/
/* PURPOSE: Return physical value of a grid along profile.    */
/*          Return 0 if no conversion was possible.           */ 
/*------------------------------------------------------------*/
{
   fint    r;
   double  coordout[MAXAXES];        /* Phys. coords after cotrans */ 
   int     cindx;
   fint    grid2phys = 1; 
   double  gridin = (double) grid;
  
 
   /* Axis numbers are 1, 2, ... */
   cindx = axnum - 1;

   r = cotrans_c( Setin, &cowo, &gridin, coordout, &grid2phys );
   if (r != 0)   
      return( 0 );
   else
      *physval = coordout[cindx];
   return( 1 );
}


      
                  
 
static void index2vector( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE */
/*------------------------------------------------------------*/
{
   int   k;
   int   j;
   int   curpos;
   int   curvec[MAXAXES];
                     
   curpos = g->currentprofilenumber;
   for (k = g->subdim - 1; k >= 0; k--) 
   {
      j = curpos / g->modvec[k];		
      curvec[k] = g->blo[k] + j;
      curpos -= j * g->modvec[k];
   }    	      
   strcpy( g->positionstr, "" );   
   for (k = 0; k < g->subdim ; k++)
   {
      char   mes[128];      
      sprintf( mes, "%d ", curvec[k] );
      strcat( g->positionstr, mes );      
   }
}





static void getbox( ident id,
                    char  *key,
                    int   code,
                    void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: BOX= Process user input for a box.                */
/*------------------------------------------------------------*/
{
   fint        boxopt = 0;
   fint        dfault = HIDDEN;
   fint        showdev = (fint) odev;
   fint        r;
   int         profindx;
   char        dummytxt[STRLEN+1];
   fchar       Dummytxt;
   globaltype *g=(globaltype*)arg;
   float      *onesubset = NULL;


   if (!g->setexist)
   {
      rejectf( "BOX=", "You cannot define a box without a set!" );
      g->imagesize = 0;
      g->boxexist = NO;
      return;                     /* Nothing changed so return old image data */
   }

   if (g->inactive)
   {
      g->boxexist = NO;
      g->inactive = NO;
      cancel("CURPOS=");
      return;
   }   
 
   /* Check on empty strings */
   Dummytxt.l = STRLEN;
   Dummytxt.a = dummytxt;
   r = usertext_c( Dummytxt, &dfault, tofchar(key), tofchar(" ") );
   if (!r)
   {
      char   mes1[128];
      char   mes2[128];      
      int    i;

      /* Prepare the default for 'gdsbox'. With option 16 */
      /* it does not accept an empty string as input.     */
      
      strcpy( mes1, "BOX=" );
      for (i = 0; i < g->subdim; i++)
      {
         sprintf( mes2, " %d", g->flo[i] );
         strcat( mes1, mes2 );
      }
      for (i = 0; i < g->subdim; i++)
      {
         sprintf( mes2, " %d", g->fhi[i] );
         strcat( mes1, mes2 );
      }      
      wkeyf( mes1 );
      return;
   }

   dfault = REQUEST;
   boxopt = 16;
   gdsbox_c( g->blo, g->bhi,
             g->Setin, g->subin,
             &dfault,
             tofchar(key),
             tofchar(" "),
             &showdev,
             &boxopt );

   if (boxopt == -1)
   {
      /* 'gdsbox' detected an error */
      fchar   Errtxt;
      char    errtxt[STRLEN];
      fint    l;
      fint    dfault = -1;

      Errtxt.a = errtxt; Errtxt.l = STRLEN-1; clearstr(Errtxt);
      cancel( "UCAMESSAGE=" );
      l = usertext_c( Errtxt, &dfault, tofchar("UCAMESSAGE="), tofchar("") );
      Errtxt.a[l] = '\0';

      error_status( Errtxt.a, "Enter another box.", "" );

      g->imagesize = 0;
      g->boxexist = NO;
      return;
   }
   
   /*--------------------------------------------------*/  
   /* With the BOX= keyword, we set the number of      */
   /* profiles to be examined.                         */
   /*--------------------------------------------------*/
   { 
      int  i;

      g->numprofiles = 1;
      for (i = 0; i < g->subdim; i++)
      {
         g->numprofiles *= g->bhi[i] - g->blo[i] + 1;
      }
   }
   if (g->profiles != NULL)
      freefmatrix( g->profiles, 0, 0 );

   anyoutf( DEBUG, "Try to allocate %d bytes?", g->numprofiles * g->profilelen );
   
   /*--------------------------------------------------*/
   /* Index notation fmatrix is M[y][x] if fmatrix     */
   /* called as fmatrix( xlo, ylo, xhi, yhi ). So      */
   /* change this order to get notation M[x][y].       */
   /*--------------------------------------------------*/   
   
   g->profiles = fmatrix( 0, 0, g->profilelen-1, g->numprofiles-1 );   
   if (!g->profiles)
   {
      error_status( "Cannot allocate memory for image", "", "" );
      return;
   }
   onesubset = (float *) calloc( g->numprofiles, sizeof(float) );
   if (onesubset == NULL)
   {
      error_status( "Cannot allocate memory for work array",
                    "Try a smaller box or restart program.", "" );
      reject_c( tofchar(key), tofchar("Cannot allocate memory for box!") );
      g->imagesize = 0;
      g->boxexist = NO;
      return;
   }

   for (profindx = 0; profindx < g->profilelen; profindx++)
   {
      fint  tid = 0;               /* Transfer id's */
      fint  cwlo, cwhi;            /* Coordinate words */
      fint  pixelsread;            /* Number of pixels read by read routine. */
      int   i;
      double   dblank;
      float    fblank;
      
      setfblank_c( &fblank );
      setdblank_c( &dblank );
     
      cwlo   = gdsc_fill_c( g->Setin, &(g->subin[profindx]), g->blo );
      cwhi   = gdsc_fill_c( g->Setin, &(g->subin[profindx]), g->bhi );
      gdsi_read_c( g->Setin,
                   &cwlo, &cwhi,
                   onesubset,
                   &(g->numprofiles),
                   &pixelsread,
                   &tid );
      
      for (i = 0; i < g->numprofiles; i++)      
      {
         /* Transfer the subset data to the profiles buffers */
         float y = onesubset[i];
         if (y != fblank)
            g->profiles[i][profindx] = (double) y;
         else
            g->profiles[i][profindx] = dblank;
         /* anyoutf( 1, "profiles[%d][%d]=%f", i,profindx,g->profiles[i][profindx] );*/
      }
   }

 
   g->boxexist = YES;
   
   /*--------------------------------------------------*/
   /* Create an array with lengths of a pixel, line,   */
   /* area etc. so that a conversion between an index  */
   /* and a subset position can be calculated.         */
   /*--------------------------------------------------*/ 
   {
      int i;
      g->modvec[0] = 1;
      for (i = 1; i < g->subdim; i++) 
         g->modvec[i] = g->modvec[i-1] * (g->bhi[i-1] - g->blo[i-1] + 1);   
   }
   
   r = usertext_c( Dummytxt, &dfault, tofchar(key), tofchar(" ") );
   if (!TriggerKey("CURPOS=")) 
   {
      g->currentprofilenumber = 0;            /* Reset current profile number */
      index2vector( g );                      /* Update string with position */
      wkeyf( "CURPOS=%s", g->positionstr );      
   }
   /*--------------------------------------------------*/
   /* Are we here, then we have a set, we have a box,  */
   /* and a 2-dim buffer filled with data from the box.*/
   /*--------------------------------------------------*/
   free( onesubset );
   return;
}




static void availableaxes( fchar Set )
/*------------------------------------------------------------*/
/* PURPOSE: Fill gui menu with axis names of current set      */
/*------------------------------------------------------------*/
{
   static char  axnames[MAXAXES][FITSLEN];
   static char  *ax[MAXAXES];
   int          i;
   fint         r;
   fint         dim;
   
   
  /* ax = axnames;*/
   dim = gdsc_ndims_c( Set, &setlevel ); 
   for (i = 0; i < dim; i++)
   {
      fchar  Name;
      fint   axnum = (fint) i+1;                 /* Axis numbers start with 1 */
      Name.a = axnames[i];
      Name.l = FITSLEN;
      r = 0;      
      gdsc_name_c( Name, Set, &axnum, &r );       
      ax[i] = Name.a;
      ax[i][nelc_c(Name)] = '\0';
      /* Get rid of extension if axis is not a param axis */
      if (strncmp(ax[i], "PARAM", 5))
         strtok( ax[i], " -" );      
   }
   ax[i] = (char *) NULL;     /* Terminate array */
   gui_axnames( ax );
}




static void getsetname( ident  id,
                        char  *key,
                        int    code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: SETNAME= keyword handler.                         */
/*------------------------------------------------------------*/
{
   fint          r;
   fint          dfault;
   fint          nitems;
   char          dummytxt[STRLEN+1];
   fchar         Dummytxt;
   globaltype   *g=(globaltype*)arg;


   clearstatus();
   
   g->setnameexist = NO;
   dfault     = HIDDEN;
   Dummytxt.l = STRLEN;
   Dummytxt.a = dummytxt;   
   nitems = 1;
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar("SETNAME="), tofchar(" ") );
   Dummytxt.a[nelc_c(Dummytxt)] = '\0';
   if (r == 0)
      return;
   else
   {
      r = 0;
      if (gds_exist_c(Dummytxt, &r))
      {
         strcpy( g->setname, Dummytxt.a );      
         g->setnameexist = YES;
         /* Clear box if a NEW set (i.e. there is a box) is entered */         
         if (g->boxexist)
         {
            g->inactive = YES;
            wkeyf( "BOX=" );
         }
         availableaxes( Dummytxt );
         /*--------------------------------------------------*/
         /* If a new set is entered while a profile axis     */
         /* exist then trigger the profile function. Perhaps */
         /* the user wanted to examine the same profile axis.*/
         /* Clear the plot contents.                         */
         /*--------------------------------------------------*/
         if (g->profileexist)
         {
            clearplot();
            TriggerKey("PROFILE=");            
         }
            
      }
      else
      {
         rejectf( "SETNAME=", "Cannot find set!" );
         error_status( "Cannot find set!",
                       "Check spelling and directory", "" );
         g->setnameexist = NO;
         return;
      }
   }   
}




static void getprofile( ident  id,
                        char  *key,
                        int    code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PROFILE= keyword handler                          */
/*                                                            */
/* If a profile axis name is also entered then the            */
/* set will be read by 'gdsinp'. If then a range is not yet   */
/* specified, a default is generated and the GRIDRANGE=       */
/* keyword is triggered again.                                */
/*------------------------------------------------------------*/
{
   fint          axcount[MAXAXES];
   fint          maxsubs = MAXSUBSETS;
   fint          maxaxes = MAXAXES;          /* Max num. of axes the program can deal with.*/
   fint          class   = 2;                /* Class 2 is for profile applications */
   fint          showdev = (fint) odev;
   fint          r, r1, r2;
   fint          dfault;
   char          dummytxt[STRLEN+1];
   fchar         Dummytxt;
   fint          setdim;
   globaltype   *g=(globaltype*)arg;
   int           i;
   fint          grid = 0;


   clearstatus();

   g->profileexist = NO;
   if (!g->setnameexist)
   {
      error_status( "There is no set name",
                    "Enter name of set first", "" );
      return;
   }
     
   dfault     = HIDDEN;
   Dummytxt.l = STRLEN;
   Dummytxt.a = dummytxt;   
   r = usertext_c( Dummytxt, &dfault, tofchar("PROFILE="), tofchar(" ") );
   Dummytxt.a[r] = '\0';
   if (r == 0)
      return;
   else
   {
      strcpy( g->profaxname, Dummytxt.a );
   }
   wkeyf( "DUMMYSET=%s %s", g->setname, g->profaxname ); 
   
     
   dfault = HIDDEN+NOERRORLOOP;          /* Return immediately when error occurs */
   g->axesoutsidesub = 1;                /* Allow ONE axis, i.e. a profile */
   clearstr( g->Setin );

   g->profilelen = gdsinp_c( g->Setin,
                        g->subin,
                        &maxsubs,
                        &dfault,
                        tofchar( "DUMMYSET=" ),
                        tofchar(" "),
                        &showdev,        /* Device number (as in ANYOUT). */
                        g->axnum,
                        axcount,         /* Number of grids on axes in 'axnum' */
                        &maxaxes,
                        &class,          
                        &(g->axesoutsidesub) );


   if (g->profilelen <= 0)
   {
      fchar   Errtxt;
      char    errtxt[STRLEN];
      fint    dfault = -1;              /* Special default to get UCA message */
      fint    l;

      Errtxt.a = errtxt; Errtxt.l = STRLEN-1; clearstr(Errtxt);
      g->setexist = NO;
      g->imagesize = 0;
      l = usertext_c( Errtxt, &dfault, tofchar("UCAMESSAGE="), tofchar("") );
      Errtxt.a[l] = '\0';
      error_status( Errtxt.a, 
                    "Check name of profile axis, range", 
                    "and minimum axis length of profile (length > 1)." );
      g->profileexist = NO;
      return;
   }

   setdim  = gdsc_ndims_c( g->Setin, &setlevel );
   g->subdim = setdim - g->axesoutsidesub;
   g->profaxnum = g->axnum[g->subdim]; 
   g->profileexist = YES;
   g->profcw = 0;
   for (i = 0; i < g->subdim; i++)
   {
      r = 0;
      g->profcw = gdsc_word_c( g->Setin, &(g->axnum[i]), &grid, &(g->profcw), &r );
   }   

   /*--------------------------------------------------*/
   /* Now we have all the set properties needed for    */
   /* conversions from grids to physical coordinates.  */
   /* The actual reading of the set with user given or */
   /* default range on the profiles axis is done later.*/
   /* If user did not enter a grid or physical range   */
   /* on the command line then take the default range  */
   /* in grids and update the physical range.          */
   /*--------------------------------------------------*/


   /* Read minimum and maximum grid values on profile axis */
   {      
      fint  cwlo, cwhi;
      gdsc_range_c( g->Setin, &setlevel, &cwlo, &cwhi, &r1 );
      r1 = 0;
      g->profgridlo = gdsc_grid_c( g->Setin, &(g->profaxnum), &cwlo, &r1 );
      r2 = 0;
      g->profgridhi = gdsc_grid_c( g->Setin, &(g->profaxnum), &cwhi, &r2 );
   }  


   /* Is a range specified? */

   r1 = usertext_c( Dummytxt, &dfault, tofchar("GRIDRANGE="), tofchar(" ") );
   r2 = usertext_c( Dummytxt, &dfault, tofchar("PHYSRANGE="), tofchar(" ") );

   /* Grid has higher priority than physical coordinates when */
   /* entered on the command line. */

   if (!g->boxexist)
   {   
      if (r1) 
         TriggerKey("GRIDRANGE=");
      else if (r2) 
         TriggerKey("PHYSRANGE=");
   }

   /* Clear box field if a NEW profile is entered */
   if (g->boxexist)
   {
      g->inactive = YES;       
      wkeyf( "BOX=" );    
   }
  
  
   if (g->boxexist || (!r1 && !r2) )
   {      
      /* We must set the default */
      g->plohi[0] = g->profgridlo;
      g->plohi[1] = g->profgridhi;
      wkeyf( "GRIDRANGE=%d %d", g->plohi[0], g->plohi[1] );      
   }
}




static void getset( ident  id,
                    char  *key,
                    int    code,
                    void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: INSET= keyword handler                            */
/*------------------------------------------------------------*/
{
   fint          axcount[MAXAXES];
   fint          maxsubs = MAXSUBSETS;
   fint          maxaxes = MAXAXES;          /* Max num. of axes the program can deal with.*/
   fint          class   = 2;                /* Class 2 is for profile applications */
   fint          showdev = (fint) odev;
   fint          r;
   fint          dfault;
   fint          setdim;
   globaltype   *g=(globaltype*)arg;


   clearstatus();

   if (!g->setnameexist)
   {
      error_status( "There is no set name",
                    "Enter name of set first", "" );
      return;
   }
   if (!g->profileexist)
   {
      error_status( "There is no profile axis name entered",
                    "Enter name of profile axis", "" );
      return;
   }
   
 
   r = 0;
   gds_close_c( g->Setin, &r );

   wkeyf( "INSET=%s %s %d:%d", g->setname, g->profaxname, g->plohi[0], g->plohi[1] );
   anyoutf( DEBUG, "Final opening of set! [%s]", g->setname );   

   dfault = HIDDEN+NOERRORLOOP;          /* Return immediately when error occurs */
   g->axesoutsidesub = 1;                /* Allow ONE axis, i.e. a profile */
   clearstr( g->Setin );

   g->profilelen = gdsinp_c( 
                        g->Setin,
                        g->subin,
                        &maxsubs,
                        &dfault,
                        tofchar( "INSET=" ),
                        tofchar(" "),
                        &showdev,        /* Device number (as in ANYOUT). */
                        g->axnum,
                        axcount,         /* Number of grids on axes in 'axnum' */
                        &maxaxes,
                        &class,          
                        &(g->axesoutsidesub) );
                        
   if (g->profilelen <= 0)
   {
      fchar   Errtxt;
      char    errtxt[STRLEN];
      fint    dfault = -1;              /* Special default to get UCA message */
      fint    l;

      Errtxt.a = errtxt; Errtxt.l = STRLEN-1; clearstr(Errtxt);
      g->setexist = NO;
      g->imagesize = 0;
      l = usertext_c( Errtxt, &dfault, tofchar("UCAMESSAGE="), tofchar("") );
      Errtxt.a[l] = '\0';
      error_status( Errtxt.a, 
                    "Check name of profile axis, range", 
                    "and minimum axis length of profile (length > 1)." );
      g->profileexist = NO;
      return;
   }

   g->setexist = YES;
   setdim  = gdsc_ndims_c( g->Setin, &setlevel );   

   /*-------------------------------*/
   /* Determine edges of input      */
   /*-------------------------------*/
   {
      fint cwlo, cwhi;                          /* Local coordinate words */
      int  m;
      fint r2, r1 = 0;
      gdsc_range_c( g->Setin, &setlevel, &cwlo, &cwhi, &r1 );
      r1 = r2 = 0;
      for (m = 0; m < setdim; m++)
      {
         g->flo[m] = gdsc_grid_c( g->Setin, &(g->axnum[m]), &cwlo, &r1 );
         g->fhi[m] = gdsc_grid_c( g->Setin, &(g->axnum[m]), &cwhi, &r2 );
      }
   }


   /*-------------------------------*/
   /* Allocate memory for profile   */
   /* arrays.                       */
   /*-------------------------------*/ 
   if ( !allocs(g, g->profilelen) )
   {
      error_status( "Cannot allocate enough memory!",
                    "No memory left for profile work arrays.",
                    "Perhaps you should restart with a smaller box." );
      g->setexist = NO;
      g->profileexist = g->boxexist = NO;
      return;
   }
   g->importprofile = NO;               /* Profile from set not from file etc. */ 
   
   /*-------------------------------*/ 
   /* Get the grids on the profiles */
   /*-------------------------------*/ 
   {
      int i;
      for (i = 0; i < g->profilelen; i++)
         g->xgrids[i] = (double) (i + g->plohi[0]);
   }
   dminmax( g->xgrids, &(g->profilelen), &(g->xgridminmax[0]), &(g->xgridminmax[1]) );  


   /*-------------------------------*/
   /* Transform also to physical    */
   /* coordinates.                  */
   /*-------------------------------*/
   {
      int i;
      
      g->tophys = YES;
      for (i = 0; i < g->profilelen; i++)
      {         
         int r;
         
         r = grid2phys2( g->Setin, g->xgrids[i], g->profcw, g->profaxnum, &(g->xphys[i]) );
         /* If conversion not possible, stop loop immediately */
         if (r == 0)           
         {
            g->tophys = NO;
            break;
         }
      }       
   }
   if (!g->tophys)   /* Copy grids to physical coordinates array */
   {
      int   i;
      for (i = 0; i < g->profilelen; i++) 
         g->xphys[i] = g->xgrids[i];
   }
   g->tophys = YES;

   
   /*-------------------------------*/
   /* Transform physical coordinates*/
   /* to interval [-1,1].           */
   /*-------------------------------*/
   if (g->tophys)
   {
      scalearray( g->xphys, g->xphysscale, g->profilelen );
   }

   /*-------------------------------*/
   /* Get a string with axis names  */
   /* for annotation in gui and plot*/
   /*-------------------------------*/
   {
      int    i;
      
      strcpy( g->axisnames, "" );
      for (i = 0; i < g->subdim; i++)
      {
         fint   r = 0;
         char   name[FITSLEN+1];
         char   shortname[FITSLEN];
         fchar  Axisname;
         Axisname.a = name;
         Axisname.l = FITSLEN;
         gdsc_name_c( Axisname, g->Setin, &(g->axnum[i]), &r ); 
         Axisname.a[nelc_c(Axisname)] = '\0';
         sprintf( shortname, " %s", strtok( name, " -" ) ); /* Space and hyphen! */
         strcat( g->axisnames, shortname );
      }
      wkeyf( "BOXAXES=%s", g->axisnames );
   }
   
   /*-------------------------------*/
   /* Get the units of the ampli-   */
   /* tudes for annotations.        */
   /*-------------------------------*/
   {
      fint    r = 0;
      fchar   Dataunits;
      
      Dataunits.a = g->dataunits;
      Dataunits.l = FITSLEN;
      gdsd_rchar_c( g->Setin, tofchar("BUNIT"), &setlevel, Dataunits, &r ); 
      Dataunits.a[nelc_c(Dataunits)]  = '\0'; 
      if (r < 0)
         strcpy( g->dataunits, "??" );
      wkeyf("DATAUNITS=%s", g->dataunits );
   }
   
   /*-------------------------------*/
   /* Get the units of the profile  */
   /* axis for annotations.         */
   /*-------------------------------*/   
   if (g->tophys)
   {
      fint    r;
      fchar   Axunits;
      
      Axunits.a = g->axunits;
      Axunits.l = FITSLEN;
      r = axunit_c( g->Setin, &(g->profaxnum), Axunits );
      Axunits.a[nelc_c(Axunits)]  = '\0'; 
      if (r != 0)
         strcpy( g->axunits, "??" );
   }
   else
   {
      strcpy( g->axunits, "grids" );
   }
   wkeyf("AXUNITS=%s", g->axunits ); 

   /*--------------------------------------------------*/
   /* 1) If a box does not yet exist and if the user   */
   /* did not enter a box on the command line, then    */
   /* wait for the user to enter a box.                */
   /* 2) If a box does not yet exist and the user      */
   /* entered a box on the command line then force a   */
   /* call to 'getbox'.                                */
   /* 3) If a new set or profile is entered (but not a */
   /* new range.                                       */
   /*--------------------------------------------------*/   

   TriggerKey("BOX=");         


#ifdef ERUIT     
   if (first)
   { 
      first = NO;
      TriggerKey("BOX=");         
   }

getbox( NULL, "BOX=", KEYCHANGE, g );     /* pseudo event */     
#endif   
}



static void physrange( ident id,
                       char  *key,
                       int   code,
                       void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PHYSRANGE= keyword handler.                       */
/*------------------------------------------------------------*/
{
   globaltype   *g=(globaltype*)arg; 
   char          dummytxt[STRLEN+1];
   fchar         Dummytxt; 
   fint          r;
   fint          dfault;
   char          *s1, *s2;



   if (g->inactive)
   {
      g->inactive = NO;
      return;
   }

   if (!g->setnameexist)
   {
      error_status( "There is no set name",
                    "Enter name of set first", "" );
      return;
   }
   if (!g->profileexist)
   {
      error_status( "There is no profile axis name entered",
                    "Enter name of profile axis", "" );
      return;
   }
   
   dfault     = HIDDEN;
   Dummytxt.l = STRLEN;
   Dummytxt.a = dummytxt;   
   r = usertext_c( Dummytxt, &dfault, tofchar("PHYSRANGE="), tofchar(" ") );
   Dummytxt.a[r] = '\0';
   s1 = strtok( dummytxt, " ");
   s2 = strtok( NULL, " ");    

   wkeyf( "DUMMYKEY=%s %s %s %s", s1, g->axunits, s2, g->axunits );   
   
   {
      fint          boxopt = 16;  
      fint          loval, hival;
      fint          showdev = (fint) odev;
              
      dfault     = HIDDEN;
      gdsbox_c( &loval, &hival,
                g->Setin, &(g->profcw),
                &dfault,
                tofchar("DUMMYKEY="),
                tofchar(" "),
                &showdev,
                &boxopt );
      if (boxopt == -1)
      {
          cancel( "UCAMESSAGE=" );
          g->rangeexist = NO;
          return;
      }
      else       
      {   
         g->plohi[0] = loval;
         g->plohi[1] = hival;      
      }
   }   
   
   g->rangeexist = YES;
   g->inactive = YES;   
   wkeyf( "GRIDRANGE=%d %d", g->plohi[0], g->plohi[1] );
   getset( NULL, "INSET=", KEYCHANGE, g );                    /* pseudo event */
}



static void gridrange( ident id,
                       char  *key,
                       int   code,
                       void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: GRIDRANGE= keyword handler.                       */
/*------------------------------------------------------------*/
{
   globaltype   *g=(globaltype*)arg; 
   char          dummytxt[STRLEN+1];
   fchar         Dummytxt; 
   fint          r;
   fint          dfault;
   
  
   if (g->inactive)
   {
      g->inactive = NO;
      return;
   }
   
   if (!g->setnameexist)
   {
      error_status( "There is no set name",
                    "Enter name of set first", "" );
      return;
   }
   if (!g->profileexist)
   {
      error_status( "There is no profile axis name entered",
                    "Enter name of profile axis", "" );
      return;
   }
  
 
   dfault     = HIDDEN;
   Dummytxt.l = STRLEN;
   Dummytxt.a = dummytxt;   
   r = usertext_c( Dummytxt, &dfault, tofchar("GRIDRANGE="), tofchar(" ") );
   Dummytxt.a[r] = '\0';   
   if (r == 0)
   {
      wkeyf( "GRIDRANGE=%d %d", g->profgridlo, g->profgridhi );
      return;
   }
   else
   {
      fint      boxopt = 16;
      fint      loval, hival;
      fint      showdev = (fint) odev;
    
      dfault = HIDDEN;   
      gdsbox_c( &loval, &hival,
             g->Setin, &(g->profcw),
             &dfault,
             tofchar( "GRIDRANGE=" ),
             tofchar(" "),
             &showdev,
             &boxopt );

      if (boxopt == -1)
      {
          cancel( "UCAMESSAGE=" );
          g->rangeexist = NO;
          return;
      }
      else       
      {   
         g->plohi[0] = loval;
         g->plohi[1] = hival;      
      }
   }
   /* Update the physical coordinates input field. */
   {
      double physlo, physhi;
      int    r;
      r = grid2phys2( g->Setin, g->plohi[0], g->profcw, g->profaxnum, &physlo);
      r = grid2phys2( g->Setin, g->plohi[1], g->profcw, g->profaxnum, &physhi);
      g->inactive = YES;
      wkeyf( "PHYSRANGE=%g %g", physlo, physhi );       
   }
   getset( NULL, "INSET=", KEYCHANGE, g );     /* pseudo event */
}



static void setprofile( ident id,
                        char  *key,
                        int   code,
                        void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: CURPOS= keyword handler.                          */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   fint       nitems;
   fint       dfault = HIDDEN;
   fint       userval[MAXAXES];
   int        i;


   clearstatus();   
   if (!g->boxexist)
   {
      error_status( "Enter a box first!", "", "" );
      return;
   }  
   nitems = g->subdim;
   (void) userint_c(  userval,
                      &nitems,
                      &dfault,
                      tofchar("CURPOS="),
                      tofchar(" ") );

   for (i = 0; i < g->subdim; i++)
   {
      if (userval[i] < g->blo[i] || userval[i] > g->bhi[i] )      
      {
         reject_c( tofchar(key), tofchar("Position outside box!") );
         error_status( "Position outside box!", "", "" );
         return;
      }
   }
   g->currentprofilenumber = 0;
   for (i = 0; i < g->subdim; i++) 
   {
      g->currentprofilenumber += (userval[i] - g->blo[i]) * g->modvec[i];
   }   
   index2vector( g );


   /* Mask all data below clip value or outside a range */
   {
      double  clip[2];
      fint    nitems = 2;
      fint    dfault = HIDDEN;
      fint    r;
      int     k = g->currentprofilenumber;
       
      r = userdble_c( clip,
                      &nitems,
                      &dfault,
                      tofchar("CLIP="),
                      tofchar(" ") );
     
      for (i = 0; i < g->profilelen; i++)
      {         
         double y =  g->profiles[k][i];
         g->mask[i] = 0;                         /* Reset bad points mask */
         g->clipped[i] = 0;
         if (r == 1)
         {
            if (y < clip[0])
               g->clipped[i] = 1;
         }
         else if (r == 2)
         {
            if (y < clip[0] || y > clip[1])
               g->clipped[i] = 1;
         }
      }
   }      

   wkeyf( "PLOTDATA=Y" );   
}




static void flipprofile( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: FLIP= keyword handler.                            */
/*                                                            */
/* The estimate routine can only fit peaks and not valleys.   */
/* The user can flip the current profile (multiply with -1)   */
/* to change valleys into peaks.                              */
/* Note that the original data is changed.                    */
/*------------------------------------------------------------*/
{
   globaltype  *g = (globaltype *) arg;
   bool        value;
   int         n = g->currentprofilenumber;
   int         len = g->profilelen;
   int         i;
   double      dblank;
   

   setdblank_c( &dblank );  
   value = UserLog( key );
   if (value)
   {
      for (i = 0; i < len; i++)
      {
         if (g->profiles[n][i] != dblank)    /* Leave blanks unaltered */
            g->profiles[n][i] *= -1.0;
      }
      wkeyf( key );    
      if (g->boxexist || g->importprofile) wkeyf( "PLOTDATA=Y" );
   }
}





static void nextprofile( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: NEXT= keyword handler.                            */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   bool       value;

   value = UserLog( key );
   if (value)
   {
      clearstatus();
      if (!g->boxexist)
      {
         error_status( "Enter a box first!", "", "" );
         wkeyf( key );
         return;
      } 
      if (g->currentprofilenumber < g->numprofiles-1)
      {
         g->currentprofilenumber++;                      

         /* Update current position and make the plot */         
         index2vector( g );         
         wkeyf( "CURPOS=%s", g->positionstr );      
      }
      else
      {
         error_status( "No next subset available!", "", "" );
      }
      wkeyf( key );
   }
}



static void prevprofile( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PREV= keyword handler.                            */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   bool       value;


   value = UserLog( key );
   if (value)   
   { 
      clearstatus();
      if (!g->boxexist)
      {
         error_status( "Enter a box first!", "", "" );
         wkeyf( key );
         return;
      }       
      if (g->currentprofilenumber > 0)
      {
         g->currentprofilenumber--;
         /* Update current position and make the plot */ 
         index2vector( g );
         wkeyf( "CURPOS=%s", g->positionstr );      
      }
      else
      {
         error_status( "No previous subset available!", "", "" );
      }
      wkeyf( key );
   }
}




static void readeventsfile( ident id,
                            char  *key,
                            int   code,
                            void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: EVENTFILE= keyword handler.                       */
/* Read keywords from file and generate events with them.     */
/* With this option you can simulate pressing buttons with    */
/* commands in a file on disk.                                */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   FILE       *fp;
   fchar      Dummytxt; 
   fint       dfault, nitems, r;
   char       message[STRLEN+1];
   char       eventsfilename[FILENAMELEN];
   

   clearstatus(); 
    
   dfault = HIDDEN;
   nitems = 1;
   Dummytxt.l = FILENAMELEN-1;
   Dummytxt.a = eventsfilename;
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar(key), tofchar(" ") );
   Dummytxt.a[nelc_c(Dummytxt)] = '\0';
  
   fp = fopen( Dummytxt.a, "r" );
   if (fp == NULL)
   {
      gui_error( "Cannot open events file" );
      GgiPrompter( "AGAIN", "File does not exist" );
      return;            
   }     
   GgiPrompter( "ACCEPT", "" ); 
   clearstatus();
   while (!feof(fp))
   {
      if ( fgets(message, STRLEN, fp) );
      {
         if (!feof(fp))                 /* Extra check on end of file */
         {
            wkeyf( message );
            (void) GgiHandleEvents();
         } 
      }
   }
   fclose( fp );   
}




static void fitresultsfile( ident id,
                            char  *key,
                            int   code,
                            void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: FITFILE= keyword handler.                         */
/* Get a file (name) to select a file to save fit results     */
/* after pressing the <STORE> button.                         */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   FILE       *fp;
   fchar      Dummytxt; 
   fint       dfault, nitems, r;
   static int okayed = NO;


   clearstatus();
   if (!g->boxexist && !g->importprofile)
   {
      error_status( "Enter a box first!", "", "" );
      rejectf( key, "Nothing to save!" );
      return;
   }
   
   gui_allow_store( NO );
   dfault = HIDDEN;
   nitems = 1;
   Dummytxt.l = FILENAMELEN-1;
   Dummytxt.a = g->fitdatname;   
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar(key), tofchar(" ") );
   Dummytxt.a[nelc_c(Dummytxt)] = '\0';     
   
   /* Check existence */
   if (!okayed)
   {
      fp = fopen( g->fitdatname, "r" ); 
      if (fp != NULL) 
      {
         error_status( "File exists!", "", "" );
         GgiPrompter( "AGAIN", "Ok to overwrite?" );
         okayed = YES;
         fclose( fp );
         return;            
      }
   }
   okayed = NO;
   
   
   fp = fopen( g->fitdatname, "w" );
   if (fp == NULL)
   {
      error_status( "Cannot open file on disk", "Check permissions", "" );   
      rejectf( key, "Cannot open file on disk!" );
      return;
   }
   GgiPrompter( "ACCEPT", "" );

   {
      fint   nitems = 1;
      fint   dfault = HIDDEN;   
      /* Save data in short or long format? */
      (void) userint_c( &(g->fitfileformat),
                        &nitems,
                        &dfault,
                        tofchar("FFORMAT="),
                        tofchar(" ") );
   }
   
   g->newheader = YES;
   if (g->fitfileformat == 0)   /* Short */
   {
      char         *ptr;
      time_t       now;      
      /* Put a header when short format is selected   */
      /* Thereafter, all components of one fit are    */
      /* written on the same line in the output file. */
      if (g->function == GAUSS)
         fprintf( fp, "! GAUSS" );
      if (g->function == GAUSSHERMITE1)
         fprintf( fp, "! GAUSS-HERMITE with h3 only" );
      if (g->function == GAUSSHERMITE2)
         fprintf( fp, "! GAUSS-HERMITE with h3 and h4" );
      if (g->function == VOIGT)
         fprintf( fp, "! VOIGT" );      
         
      now = time( NULL );
      ptr = ctime( &now );      
      fprintf( fp, " fit parameter table created at: %s", ptr );
   }
   fclose( fp );
   gui_allow_store( YES );   
   error_status( "", "Save current fit results to file:", g->fitdatname );
}




static void saveresults( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: FSTORE= keyword handler.                          */
/* Save fit results of current profile. This will be either   */
/* a single line format or an extended multi line format.     */
/*------------------------------------------------------------*/ 
{
   globaltype *g = (globaltype *) arg; 
   FILE       *fp; 
   bool       value ;
  
   value = UserLog( key );
   if (value) 
   {
      if (g->fitfileformat == -1)
      {
         error_status( "No file opened to store results!",
                       "Use FILE menu to open a file on disk", "" );
         return;
      }
      fp = fopen( g->fitdatname, "a" );

      /* Short or long format */
      resulttolog( g, fp );   
                 
      fclose( fp );
      wkeyf( key );
   }
}




static void saveprofile( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PROFFILE= keyword handler.                        */
/* Save X,Y data of current profile                           */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   FILE       *fp;
   int        i, n;
   fchar      Dummytxt; 
   fint       dfault, nitems, r;
   fint       npar, opt;
   double     dblank;
   static int okayed = NO;


   clearstatus();
   if (!g->boxexist && !g->importprofile)
   {
      error_status( "Enter a box first!", "", "" );
      rejectf( key, "Nothing to save!" );
      return;
   }
   
   dfault = HIDDEN;
   nitems = 1;
   Dummytxt.l = FILENAMELEN-1;
   Dummytxt.a = g->datname;   
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar(key), tofchar(" ") );
   Dummytxt.a[nelc_c(Dummytxt)] = '\0';     
   
   /* Check existence */
   if (!okayed)
   {
      fp = fopen( g->datname, "r" ); 
      if (fp != NULL) 
      {
         error_status( "File exists!", "", "" );
         GgiPrompter( "AGAIN", "Ok to overwrite?" );
         okayed = YES;
         fclose( fp );
         return;            
      }
   }
   okayed = NO;
   
   
   fp = fopen( g->datname, "w" );
   if (fp == NULL)
   {
      error_status( "Cannot open file on disk", "Check permissions", "" );   
      rejectf( key, "Cannot open file on disk!" );
      return;
   }
   GgiPrompter( "ACCEPT", "" );
   
   n = g->currentprofilenumber;
   fprintf( fp, "!%8s %12s %12s %12s %12s\n", "X GRID", "X PHYSICAL", "AMPLITUDE", "FITTED AMPL", "RESIDUAL" ); 
   setdblank_c( &dblank );
   npar = g->ncomp * g->nvar + 3;    /* Include background components */
   opt  = FIEID*g->function + g->ncomp;        

   /* Calculate residuals. Only valid values after a fit! */
   for (i = 0; i < g->profilelen; i++)   
   {
      double   residual = 0.0;
      double   Yi = g->profiles[n][i];
      double   Xi = g->xphys[i];

                   
      if (Yi != dblank && !(g->mask[i]))
      {
         double   Yi_fit =  funcd_c( &Xi, g->estimates, &npar, &opt );         
         residual = Yi - Yi_fit;

         fprintf( fp, " %8g %12g %12g %12g %12g\n",
                  g->xgrids[i],
                  Xi,
                  Yi,
                  Yi_fit,
                  residual ); 
      }
      else
      {
         fprintf( fp, " %8g %12g %12s %12s %12s\n",
                  g->xgrids[i],
                  Xi,
                  "b",
                  "b",
                  "b" ); 
      }
   }
   fclose( fp );
   error_status( "", "Save current profile to file:", g->datname );
}




static void setamprange( ident id,
                         char  *key,
                         int   code,
                         void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: AMPRANGE= keyword handler.                        */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   fint        nitems = 2;
   fint        dfault = HIDDEN;
   fint        r;

   
   r = userdble_c( g->yrange, &nitems, &dfault, tofchar("AMPRANGE="), tofchar(" ") );   
/*   if (g->boxexist)
      wkeyf( "PLOTDATA=Y" );
*/      
}                      




static void plotbox( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Plot a box for current profile data.              */
/*------------------------------------------------------------*/ 
{
   int     i = g->currentprofilenumber;
   double  Xmin, Xmax;
   double  Ymin, Ymax;
   float   Xtick, Ytick;
   fint    nsubx, nsuby;
   fint    symbol = 2;
   double  dblank;


   if (!g->boxexist && !g->importprofile)
   {
      error_status( "No box!", "Enter a box first", "" );
      return;
   }
   
   setdblank_c( &dblank );
   setlinewidth( g->plot.lwidth );
   setcharheight( g->plot.charsize );
   
   /* Get min and max of the x (= profile) axis */
   if (g->tophys || g->importprofile)
   {
      Xmin = g->xphys[0];
      Xmax = g->xphys[g->profilelen-1];
   }
   else
   {
      Xmin = g->xgridminmax[0];
      Xmax = g->xgridminmax[1];         
   }

   /* Get min and max of the amplitudes in current profile */ 
   dminmax( g->profiles[i], &(g->profilelen), &Ymin, &Ymax );      
   if (Ymin == dblank)
      Ymin = -1.0;
   if (Ymax == dblank)
      Ymax = +1.0;      
   if (Ymin == Ymax)
   {
      Ymin -= 0.5;
      Ymax += 0.5;
   }
   {
      fint    nitems = 2;
      fint    dfault = HIDDEN;
      fint    r;
      double  Xdelta, Ydelta;
      bool    yrangefixed = UserLog("FIXRANGE=");
         
      if (yrangefixed)
      {
         /* If fixed then read current values */
         r = userdble_c( g->yrange, &nitems, &dfault, tofchar("AMPRANGE="), tofchar(" ") );
         if (r > 0)
            Ymin = g->yrange[0];
         if (r > 1)
            Ymax = g->yrange[1];         
      }
      else
      {
         /* Calculate a default */
         Ydelta = (Ymax - Ymin) / 10.0;
         Ymin -= Ydelta; Ymax += Ydelta;
         g->yrange[0] = Ymin;
         g->yrange[1] = Ymax;
         wkeyf( "AMPRANGE=%.3g %.3g", g->yrange[0] , g->yrange[1] );          
      }
      Xdelta = (Xmax - Xmin) / 10.0;            
      Xmin  -= Xdelta; Xmax += Xdelta;            
   }
   
   setcolor( g->plot.colframe );
   /* Plot the upper axis in grids first */
   {
      double xlo = g->xgrids[0];
      double xhi = g->xgrids[g->profilelen-1]; 
      double ylo, yhi;
      double delta;      
      float  ch, oldch;
         
      delta = (xhi - xlo ) / 10.0;  /* Same expansions as physical coordinates */
      xlo -= delta; xhi += delta;
      pgqch_c( &oldch );
      ch = 0.65 * oldch;
      setcharheight( ch );
      ylo = 0.0; yhi = 1.0;
      setwindow( xlo, ylo, xhi, yhi ); 
      if (xhi-xlo < 100.0)
         Xtick = 10.0; 
      else
         Xtick = 50.0;
      Ytick = 0.0;
      nsubx = 10;                     
      nsuby = 0;         
      pgbox_c( tofchar("CISTM1"), &Xtick, &nsubx,
               tofchar(" "), &Ytick, &nsuby );
      setcharheight( oldch );
   }

   dsetwindow( Xmin, Ymin, Xmax, Ymax );
   Xtick = Ytick = 0.0;
   nsubx = nsuby = 0;
   pgbox_c( tofchar("BCNST"), &Xtick, &nsubx,
            tofchar("BCNSTV"), &Ytick, &nsuby );

   /* The axis labels */        
   {      
      char    xtitle[STRLEN];
      char    ytitle[STRLEN];
      char    ttitle[STRLEN];
      char    dummytxt[STRLEN+1];
      fchar   Dummytxt;
      fint    r, dfault;       
      
      dfault     = HIDDEN;
      Dummytxt.l = STRLEN;
      Dummytxt.a = dummytxt;
      r = usertext_c( Dummytxt, &dfault, tofchar("TTITLE="), tofchar(" ") );
      if (r == 0)
      {
         if (g->importprofile)
            sprintf( ttitle, "profile from file or table" );
         else
            sprintf( ttitle, "profile from set [%s] at %s = %s", g->setname, g->axisnames, g->positionstr );         
      }
      else
      {
         Dummytxt.a[r] = '\0';
         strcpy( ttitle, Dummytxt.a );
      }
      r = usertext_c( Dummytxt, &dfault, tofchar("XTITLE="), tofchar(" ") );
      if (r == 0)
         strcpy( xtitle, g->axunits );
      else
      {
         Dummytxt.a[r] = '\0';
         strcpy( xtitle, Dummytxt.a );
      }
      r = usertext_c( Dummytxt, &dfault, tofchar("YTITLE="), tofchar(" ") );
      if (r == 0)
         strcpy( ytitle, g->dataunits );      
      else
      {
         Dummytxt.a[r] = '\0';
         strcpy( ytitle, Dummytxt.a );
      }
      plotlabel( xtitle, ytitle, ttitle );
   }
   {
      double *X;
      if (g->tophys || g->importprofile)
         X = g->xphys;
      else
         X = g->xgrids;                      
      plotarray( X, g->profiles[i], g->profilelen, FOREGROUND, symbol, 
                 g->plot.connect, g->plot.colcon );
      if (g->weights == FILE_W)
      {
         ploterrors( X, g->profiles[i], g->wdatfile, g->profilelen, FOREGROUND );
      }
   } 
   /* Mark the marked points again */
   {
      int j;
      for (j = 0; j < g->profilelen; j++)
      { 
         if (g->mask[j])
            plotpoint( g->xphys[j], g->profiles[g->currentprofilenumber][j], RED, symbol ); 
         if (g->clipped[j]) 
            plotpoint( g->xphys[j], g->profiles[g->currentprofilenumber][j], ORANGE, symbol );
      }
   }
   
   /* Base line */
   dblemove( Xmin, 0.0 );
   dbledraw( Xmax, 0.0 );   
}



static void makeplot( ident id,
                      char  *key,
                      int   code,
                      void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: PLOTDATA= keyword handler.                        */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   bool       value;
                      

   value = UserLog( key );
   if (value)
   {      
      if (!g->boxexist && !g->importprofile)
      {
         /*  error_status( "No box!", "Enter a box first", "" );*/
         return;
      }      
      clearplot();                          /* Clear page */
      clearstatus();
      plotbox( g );                         /* Plot a frame */
      getandplotestimates( g );
      wkeyf( key );                         /* Reset key */
   }
}




static void buildhardcopy( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Build a plot on a hardcopy device.                */
/*------------------------------------------------------------*/
{
   float   xright = 0.65;
   float   oldch; 
   fint    oldfont;
   fint    roman = 2;
  
   g->hardcopy = YES;
   pgqcf_c( &oldfont );
   pgscf_c( &roman );   
   setviewport( g->plot.vport[0], 0.4, xright, g->plot.vport[3] );
   plotbox( g );
   plotfit( g, g->plot.colfit, NO );
   setviewport( g->plot.vport[0], g->plot.vport[1], xright, 0.3 ); 
   plotresidual( g, g->plot.colfit );
   /* Create a pgplot text box */
   setviewport( xright+0.02, g->plot.vport[1], g->plot.vport[2], g->plot.vport[3] );
   setwindow( 0.0, 40.0, 60.0, 0.0 );
   pgqch_c( &oldch );
   setcharheight( 0.4*oldch );
   resulttolog( g, NULL );   
   
   setcharheight( oldch );
   pgscf_c( &oldfont );
   pgiden_c();    
   g->hardcopy = NO;
}




static void hardcopy( ident id,
                      char  *key,
                      int   code,
                      void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: HCFILENAME= keyword handler.                      */
/*                                                            */
/* Open a device (printer or file) and build the plot. Close  */
/* the device and return to the main plot on screen.          */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   fchar      Dummytxt; 
   char       dummytxt[FILENAMELEN];
   fint       dfault, nitems, r;
   int        len;
   char       devname[FILENAMELEN+64];
   FILE       *fp;
   static int okayed = NO;
      
   
   dfault = HIDDEN;
   nitems = 1;
   Dummytxt.l = FILENAMELEN-1;   
   Dummytxt.a = dummytxt;
   clearstr( Dummytxt );
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar(key), tofchar(" ") );
   len = nelc_c(Dummytxt);
   Dummytxt.a[len] = '\0';
   

   if (len == 0)
   {
      error_status( "Need a PostScript file name!", "", "" );
      rejectf( key, "Need a PS file name!" );       
      return;
   }
   strcpy( g->PSname, dummytxt );
   /* Check existence */
   if (!okayed)
   {
      fp = fopen( g->PSname, "r" ); 
      if (fp != NULL) 
      {
         error_status( "File exists!", "", "" );
         GgiPlotPrompter( "AGAIN", NULL, "Ok to overwrite? Press 'PLOT' for ok." );
         okayed = YES;
         fclose( fp );
         return;            
      }
   }
   okayed = NO;
      
   GgiPlotPrompter( "ACCEPT", NULL, NULL );

   Dummytxt.l = FILENAMELEN-1;   
   Dummytxt.a = dummytxt;
   clearstr( Dummytxt );
   r = userchar_c( Dummytxt, &nitems, &dfault, tofchar("HCDEVICE="), tofchar(" ") );
   len = nelc_c(Dummytxt);
   Dummytxt.a[len] = '\0';
   sprintf( devname, "%s/%s", Dummytxt.a, g->PSname );

   {
      float   xloold, xhiold, yloold, yhiold;

      pgqwin_c( &xloold, &xhiold, &yloold, &yhiold );      /* Store old window */
      r = openplot( devname, g->nsubdivxy[0], g->nsubdivxy[1] );
      buildhardcopy( g );
      pgclos_c();
      selectplot( g->plot.id1 );
      setwindow( xloold, yloold, xhiold, yhiold );
   }
   {
      char   mes[STRLEN];
      sprintf( mes, "%s", g->PSname );
      error_status( "", "Output written to:", mes );   
   }
}





static void dofit( ident id,
                   char  *key,
                   int   code,
                   void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: FIT= keyword handler.                             */
/*------------------------------------------------------------*/
{
   globaltype  *g=(globaltype*)arg;     
   bool         value;
   
   value = UserLog( key );
   if (value)   
   {
      if ((!g->setnameexist || !g->profileexist || !g->boxexist) && !g->importprofile)
      {
         error_status( "There is no data to fit",
                       "Need set, profile and box, or file", "" );
         wkeyf( key );
         return;
      }    
      clearstatus();                  
      startfit( g );
      wkeyf( key );
   }
}




static void quit( ident id,
                  char  *key,
                  int   code,
                  void  *arg)
/*------------------------------------------------------------*/
/* PURPOSE: QUIT= keyword handler.                            */
/*------------------------------------------------------------*/
{
   globaltype  *g = (globaltype*) arg;


/*   bool quit = UserLog(key);*/
   if (1)
   {
      /* Release memory */
      if (g->xphysscale != NULL)  free( g->xphysscale );
      if (g->wdat != NULL)  free( g->wdat );
      if (g->filtered != NULL)  free( g->filtered );
      if (g->work != NULL)  free( g->work );
      if (g->xphys != NULL)  free( g->xphys );            
      if (g->xgrids != NULL) free( g->xgrids );
      if (g->profiles != NULL) freefmatrix( g->profiles, 0, 0 );
      cancel( key );                       /* remove QUIT= keyword */
      cancel( "PLOTDATA=" );
      pgend_c();
      finis_c();                                            /* terminate task */
   }
   wkeyf( key );
}



static void initializeplotpars( attribs *p )
/*------------------------------------------------------------*/
/* PURPOSE: Initialize values for plot attributes.            */
/*------------------------------------------------------------*/
{
   p->id1 = p->id2 = 0;
   p->cursorid = NULL;    
   p->plotest  = YES;
   p->drawzero = YES;
   p->plotrms  = NO;
   p->plotmed  = NO;
   p->connect  = NO;
   p->colframe = FOREGROUND;
   p->colest   = GREEN;
   p->colcon   = ORANGE;   
   p->colmed   = BLUE;
   p->colfit   = RED;
   p->vport[0] = 0.15;
   p->vport[1] = 0.1;
   p->vport[2] = 0.95;
   p->vport[3] = 0.9;         
   p->density  = 200;
   p->charsize = CHARSIZE;
   p->lwidth   = LWIDTH;
   p->lwidthcur= 2;
   strcpy( p->ttitle, "" );  
   strcpy( p->xtitle, "" );
   strcpy( p->ytitle, "" );
}



static void initializestruct( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Initialize values for current status.             */
/*------------------------------------------------------------*/
{
   odev = 16;                    /* Output log. destination */

   g->Setin.a = g->setbuf;
   g->Setin.l = STRLEN - 1;
   g->setexist = NO;
   g->setnameexist = NO;
   g->profileexist = NO;
   g->boxexist = NO;
   g->inactive = NO;
   g->rangeexist = NO;
   g->blo[0] = g->blo[1] = 0;    /* Low  edge of box in grids */
   g->bhi[0] = g->bhi[1] = 0;    /* High edge of box in grids */
   g->profilelen = 0;                 /* Number of input subsets */
   g->imagesize = 0;
   g->nsubdivxy[0] = g->nsubdivxy[1] = 1;                /* PGPLOT sub windows */
   g->profiles = NULL;
   g->wdat = NULL;
   g->work = NULL;
   g->filtered = NULL;
   g->mask = NULL;
   g->clipped = NULL;
   g->currentprofilenumber = 0;
   g->xgrids = NULL;
   g->xphys  = NULL;
   g->xphysscale  = NULL;   
   g->spline = NULL;
   g->median = NULL;   
   g->tophys = NO;
   strcpy( g->setname, "" );   
   strcpy( g->profaxname, "" );      
   strcpy( g->positionstr, "" );
   strcpy( g->dataunits, "" );   
   strcpy( g->axunits, "" );      
   strcpy( g->axisnames, "" );   
   strcpy( g->datname, "profiledata.dat" );
   strcpy( g->fitdatname, "profilefit.dat" );   
   strcpy( g->PSname, "profilefit.ps" );         
/*   g->updatephys = g->updategrid = YES;*/
   g->tolerance = TOLERANCE;
   g->lab = LAMBDA;
   g->maxits = MAXITERS;
   g->smoothingpar[0] = 2;
   g->numq = 1;
   g->rms = 0.01; 
   g->critamp = 0.0;
   g->critdisp = 0.0; 
   g->back_Z2 = g->back_Z1 = g->back_Z0 = 0.0;
   g->lorentz = 0.0;
   g->h3 = g->h4 = 0.0;
   g->weights = UNIFORM_W;
   g->ncomp = 1;
   g->ampperc = 50.0;
   g->gaussiansfound = 0;
   g->importprofile = NO;               /* Profile from set not from file etc. */
   g->function = GAUSS;                 /* Default fit a 1 comp standard Gauss */
   g->nvar = 3;                         /* 3 variable parameters */   
   g->profxlen = g->profylen = 0;       /* P. lengths from file */
   g->estfilter = tobool( NO );
   g->hardcopy = NO;
   g->nids = 0;
   {
      int i;
      for (i = 0; i < MAXPARALL; i++)
      {
         g->ids[i] = NULL;
      }
   }
   g->newheader = YES;
   g->fitfileformat = -1;
   g->sigmaresidual = 0.0;
   initializeplotpars( &(g->plot) );
}



static void startgui( int xsize,
                      int ysize, 
                      int esize )
/*------------------------------------------------------------*/
/* PURPOSE: Get plot window sizes fom user and start gui.    */
/*------------------------------------------------------------*/
{
   fint       xyesize[3];
   fint       nitems  = 3;
   fint       dfault  = HIDDEN;
   fint       r;
   int        i;                       
                      
   xyesize[0] = 600;
   xyesize[1] = 480;
   xyesize[2] = 150;      


   r = userint_c( xyesize,
                  &nitems,
                  &dfault,
                  tofchar("GUISIZE="),
                  tofchar("Gui sizes x,y,e:   [600, 480, 150]" ) );

   for (i = 0; i < nitems; i++)
   {
      xyesize[i] = MYMAX( 1, xyesize[i] );
   }

   gui( xyesize[0], xyesize[1], xyesize[2] );  /* Start graphical user interface */
}




MAIN_PROGRAM_ENTRY
/*-------------------------------------------------------------------------*/
/* The macro MAIN_PROGRAM_ENTRY replaces the C-call main() to start the    */
/* main body of your GIPSY application. Variables defined as 'fchar' start */
/* with a capital.                                                         */
/*-------------------------------------------------------------------------*/
{
   globaltype   glob;


   init_c();                                /* Contact Hermes */

   /* Initialize global variables */
   anyoutf( 1, "%s version %s", taskname, RELEASE );
   setfblank_c( &blank );
   initializestruct( &glob );               /* Set default properties */

   wkeyf( "HCFILENAME=%s", glob.PSname );   /* Set default PS file name */
   wkeyf( "PROFFILE=%s", glob.datname );    /* Set file name for output profile data */
   wkeyf( "FITFILE=%s", glob.fitdatname );  /* Set file name for output profile fit */   

   startgui( 600, 480, 150 );                    /* Start graphical user interface */

   /* Initialize PGPLOT */
   initplots( MAINPLOT, RESPLOT, glob.nsubdivxy, &glob );
   selectplot( glob.plot.id1 );

   
   /* Start scheduling the functions */
   (void) ScheduleKeyevent( quit,        "QUIT=",     KEYCHANGE, &glob );
   (void) ScheduleKeyevent( quit,        "FILE=",     KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getsetname,  "SETNAME=",  KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getprofile,  "PROFILE=",  KEYCHANGE, &glob );   
/*   (void) ScheduleKeyevent( getset,      "INSET=",    KEYCHANGE, &glob );*/
   (void) ScheduleKeyevent( physrange,   "PHYSRANGE=",KEYCHANGE, &glob ); 
   (void) ScheduleKeyevent( gridrange,   "GRIDRANGE=",KEYCHANGE, &glob );       
   (void) ScheduleKeyevent( getbox,      "BOX=",      KEYCHANGE, &glob );
   (void) ScheduleKeyevent( hardcopy,    "HCFILENAME=", KEYCHANGE, &glob );
/*   (void) ScheduleKeyevent( getchr,      "PSFILE=",   KEYCHANGE, &(glob.psfile) );*/
   (void) ScheduleKeyevent( setsubdiv,   "SUBDIV=",   KEYCHANGE, &glob );
   (void) ScheduleKeyevent( nextprofile, "NEXT=",     KEYCHANGE, &glob );
   (void) ScheduleKeyevent( prevprofile, "PREV=",     KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( flipprofile, "FLIP=",     KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( setprofile,  "CURPOS=",   KEYCHANGE, &glob ); 
   (void) ScheduleKeyevent( setprofile,  "CLIP=",     KEYCHANGE, &glob );    
   (void) ScheduleKeyevent( setamprange, "AMPRANGE=", KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getdble,     "TOLERANCE=",KEYCHANGE, &(glob.tolerance) );
   (void) ScheduleKeyevent( getdble,     "LAB=",      KEYCHANGE, &(glob.lab) );
   (void) ScheduleKeyevent( getint,      "MAXITS=",   KEYCHANGE, &(glob.maxits) );
   (void) ScheduleKeyevent( getqs,       "Q=",        KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getdble,     "RMS=",      KEYCHANGE, &(glob.rms) );
   (void) ScheduleKeyevent( getcritamp,  "CRITAMP=",  KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getcritdisp, "CRITDISP=", KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( getncomp,    "NCOMP=",    KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getampperc,  "AMPPERC=",  KEYCHANGE, &(glob.ampperc) );
   (void) ScheduleKeyevent( saveprofile, "PROFFILE=", KEYCHANGE, &glob );
   (void) ScheduleKeyevent( fitresultsfile, "FITFILE=", KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( saveresults, "FSTORE=",   KEYCHANGE, &glob );
   (void) ScheduleKeyevent( gettxt,      "DATNAME=",  KEYCHANGE, &(glob.datname) );
   (void) ScheduleKeyevent( gettxt,      "PSNAME=",   KEYCHANGE, &(glob.PSname) );   
   (void) ScheduleKeyevent( dofit,       "FIT=",      KEYCHANGE, &glob ); 
   (void) ScheduleKeyevent( getfileprof, "PROFY=",    KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getfileprof, "PROFX=",    KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( geterrors,   "PROFYERR=", KEYCHANGE, &glob );
   (void) ScheduleKeyevent( getfunction, "FUNCTION=", KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( getweights,  "WEIGHTS=",  KEYCHANGE, &glob );
   (void) ScheduleKeyevent( includerange,"INCLUDE=",  KEYCHANGE, &glob );
   (void) ScheduleKeyevent( setestfilter,"ESTFILTER=",KEYCHANGE, &glob );   
   
   (void) ScheduleKeyevent( makeplot,    "PLOTDATA=", KEYCHANGE, &glob );   
   (void) ScheduleKeyevent( makeplot,    "CLEARFIT=", KEYCHANGE, &glob );      

   (void) ScheduleKeyevent( getbool,     "PLOTEST=",  KEYCHANGE, &(glob.plot.plotest) );
   (void) ScheduleKeyevent( getbool,     "PLOTRMS=",  KEYCHANGE, &(glob.plot.plotrms) );
   (void) ScheduleKeyevent( getbool,     "PLOTMED=",  KEYCHANGE, &(glob.plot.plotmed) );
   (void) ScheduleKeyevent( getbool,     "CONNECT=",  KEYCHANGE, &(glob.plot.connect) );
   (void) ScheduleKeyevent( getint,      "COLFRAME=", KEYCHANGE, &(glob.plot.colframe) );
   (void) ScheduleKeyevent( getint,      "COLEST=",   KEYCHANGE, &(glob.plot.colest) );
   (void) ScheduleKeyevent( getint,      "COLCON=",   KEYCHANGE, &(glob.plot.colcon) );
   (void) ScheduleKeyevent( getint,      "COLMED=",   KEYCHANGE, &(glob.plot.colmed) );
   (void) ScheduleKeyevent( getint,      "COLFIT=",   KEYCHANGE, &(glob.plot.colfit) );
   (void) ScheduleKeyevent( getviewport, "VIEWPORT=", KEYCHANGE, &(glob.plot.vport) );
   (void) ScheduleKeyevent( getreal,     "CHARSIZE=", KEYCHANGE, &(glob.plot.charsize) );
   (void) ScheduleKeyevent( getint,      "LWIDTH=",   KEYCHANGE, &(glob.plot.lwidth) );
   (void) ScheduleKeyevent( getint,      "LWIDTHCUR=",KEYCHANGE, &(glob.plot.lwidthcur) );
   (void) ScheduleKeyevent( gettxt,      "TTITLE=",   KEYCHANGE, &(glob.plot.ttitle) );
   (void) ScheduleKeyevent( gettxt,      "XTITLE=",   KEYCHANGE, &(glob.plot.ttitle) );
   (void) ScheduleKeyevent( gettxt,      "YTITLE",    KEYCHANGE, &(glob.plot.ttitle) );           
   (void) ScheduleKeyevent( readeventsfile, "EVENTFILE=", KEYCHANGE, &glob ); 
 
   /* Initialize some fields */
/*   if (!TriggerKey("PSFILE="))     wkeyf( "PSFILE=%s", glob.psfile );*/
   if (!TriggerKey("PLOTTER="))    wkeyf( "PLOTTER=0" );
   if (!TriggerKey("SUBDIV="))     wkeyf( "SUBDIV=%d %d", glob.nsubdivxy[0], glob.nsubdivxy[1] );
   if (!TriggerKey("TOLERANCE="))  wkeyf( "TOLERANCE=%g", glob.tolerance );
   if (!TriggerKey("LAB="))        wkeyf( "LAB=%g", glob.lab );
   if (!TriggerKey("NCOMP="))      wkeyf( "NCOMP=%d", glob.ncomp );
   if (!TriggerKey("AMPPERC="))    wkeyf( "AMPPERC=%g", glob.ampperc );
   if (!TriggerKey("WEIGHTS="))    wkeyf( "WEIGHTS=%d", glob.weights);
   if (!TriggerKey("ESTFILTER="))  wkeyf( "ESTFILTER=NO" );   
   if (!TriggerKey("FUNCTION="))   wkeyf( "FUNCTION=%d", glob.function );
   if (!TriggerKey("CHARSIZE="))   wkeyf( "CHARSIZE=%.2f", glob.plot.charsize );
   if (!TriggerKey("DRAWZERO="))   wkeyf( "DRAWZERO=YES" );
   if (!TriggerKey("PLOTEST="))    wkeyf( "PLOTEST=YES" );
   if (!TriggerKey("PLOTRMS="))    wkeyf( "PLOTRMS=NO" );
   if (!TriggerKey("PLOTMED="))    wkeyf( "PLOTMED=NO" );
   if (!TriggerKey("CONNECT="))    wkeyf( "CONNECT=NO" );
   if (!TriggerKey("COLFRAME="))   wkeyf( "COLFRAME=%d",   glob.plot.colframe );
   if (!TriggerKey("COLEST="))     wkeyf( "COLEST=%d",     glob.plot.colest );
   if (!TriggerKey("COLCON="))     wkeyf( "COLCON=%d",     glob.plot.colcon );   
   if (!TriggerKey("COLMED="))     wkeyf( "COLMED=%d",     glob.plot.colmed );
   if (!TriggerKey("COLFIT="))     wkeyf( "COLFIT=%d",     glob.plot.colfit );
   if (!TriggerKey("VIEWPORT="))   wkeyf( "VIEWPORT=%g %g %g %g",
                                          glob.plot.vport[0], glob.plot.vport[1],
                                          glob.plot.vport[2], glob.plot.vport[3] );
   if (!TriggerKey("PLOTDENS="))   wkeyf( "PLOTDENS=%d",   glob.plot.density );
   if (!TriggerKey("LWIDTH="))     wkeyf( "LWIDTH=%d",     glob.plot.lwidth );
   if (!TriggerKey("LWIDTHCUR="))  wkeyf( "LWIDTHCUR=%d",  glob.plot.lwidthcur );
   if (!TriggerKey("Q="))          wkeyf( "Q=1 2 3 4 5" );
   if (!TriggerKey("MAXITS="))     wkeyf( "MAXITS=%d", glob.maxits );   
   if (!TriggerKey("CRITDISP="))   wkeyf( "CRITDISP=%g", glob.critdisp );  
   if (!TriggerKey("CRITAMP="))    wkeyf( "CRITAMP=%g", glob.critamp );     

   /* A function is known, fill the parameter fields with background pars. */
   
   if (!TriggerKey("Z2_EST="))               /* Quadratic term */
      wkeyf( "Z2_EST=%g", glob.back_Z2 );
   if (!TriggerKey("Z1_EST="))               /* Linear term */
      wkeyf( "Z1_EST=%g", glob.back_Z1 );   
   if (!TriggerKey("Z0_EST="))               /* Zero level */
      wkeyf( "Z0_EST=%g", glob.back_Z0 );

   if (!TriggerKey("Z2_FIX="))               /* Linear term initially fixed */
      wkeyf( "Z2_FIX=YES" );   
   if (!TriggerKey("Z1_FIX="))               /* Quadratic term initially fixed */
      wkeyf( "Z1_FIX=YES" );

   if (!TriggerKey("RMS="))               /* Quadratic term initially fixed */
      wkeyf( "RMS=1.0" );

      
      

   /* Some events are forced with the trigger_key routine */
   /* Order is important! */


   TriggerKey("SETNAME=");
   TriggerKey("PROFILE=");
   TriggerKey("AMPRANGE=");
   TriggerKey("PROFX=");      
   TriggerKey("PROFY=");   
   TriggerKey("EVENTFILE=");      



   eventmonitor("MONITOR=", TRUE);
   MainLoop();

   return( EXIT_SUCCESS );
}

#<

#>            gui.c
/* gui.c -XT
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#define STATUSLINES    2            /* number of status lines */
#define INPWIDTH     400            /* input box width */

#include "stdio.h"
#include "string.h"
#include "stddef.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "import.h"
#include "param.h"
#include "plotopt.h"
#include "hidden.h"
#include "misopt.h"
#include "gui.h"

static char *file_entries[]={"Save plot",
                             "Save profile data",
                             "Fit output file (short)",
                             "Fit output file (long)",
                             "Events input file",
                             "_LINE", 
                             "Exit", NULL};
                             
typedef enum                {SAVEPLOT,
                             SAVE_PROFILE,
                             SAVE_FIT_S,
                             SAVE_FIT_L,
                             PLAY_EVENTS,
                             LINE,
                             EXIT} file_choices;

static char *func_entries[]={"Gauss",
                             "Gauss Hermite (h3)",
                             "Gauss Hermite (h3, h4)",
                             "Voigt", NULL};

static char *wts_entries[]={"Uniform",
                            "Median filt.",
                            "File", NULL};

static char *helplabels[]={"Getting Started",
                           "Buttons",
                           "Keywords",
                           "About",
                           "_LINE",
                           "User Interface",
                            NULL};

static char *helpdocs[]=   { "xgauprof.dc1#gettingstarted",
                             "xgauprof.dc1#buttons",
                             "xgauprof.dc1#keywords",
                             "xgauprof.dc1#about",
                              NULL,
                             "ggi.doc"};


static char *ncomp_entries[]={"_LINE","1","2","3","4","5","6","7","8",NULL};
static char *defaxes[]={" ", NULL};
static char **axnames=defaxes;

static ident l_status[STATUSLINES], l_error;
static ident l_log[LOGLINES];
static ident axis, fstore, help;

/* -------------------------------------------------------------------------- */
/*                                 setnames                                   */
/* -------------------------------------------------------------------------- */
/*  set name selector.
 */
static char *setnames(char *name)
{
   int  namlen=strlen(name);
   static char result[FILENAME_MAX];

   if (namlen<7) return NULL;
   if (strcmp(name+namlen-6, ".descr")) return NULL;
   strcpy(result, name);
   result[namlen-6] = '\0';
   return result;
}

/* -------------------------------------------------------------------------- */
/*                                 set_browse                                 */
/* -------------------------------------------------------------------------- */
static void set_browse(ident id, char *key, int code, void *arg)
{
   char *fkey=(char*)arg;
   bool button=toflog(FALSE);
    
   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      ident browser=GgiFileBrowser(ggiIdent, fkey);
      wkeyf(key);
      if (browser) {
         (void)GgiFileBrowser(ggiDelete, browser);
      } else {
         (void)GgiFileBrowser(ggiCreate, fkey, "Name of set", setnames);
      }
   }
}

/* -------------------------------------------------------------------------- */
/*                                 statusbox                                  */
/* -------------------------------------------------------------------------- */
/*  statusbox() creates form containing error and status lines
 */
static ident statusbox(int width)
{
   int   i;
   ident curform, prvform, topref=NULL;
   
   curform = GgiForm("status", 1);
   prvform = GgiUseShell(curform);
   l_error  = GgiSetLabel(GgiLabel("error"), " ", 0);
   GgiSetPosition(l_error, 0, NULL,  0, topref);
   topref = l_error;
   for (i=0; i<STATUSLINES; i++) {
      l_status[i] = GgiSetLabel(GgiLabel("status"), " ", 0);
      GgiSetPosition(l_status[i], 0, NULL,  -1, topref);
      topref = l_status[i];
   }
   GgiSetPosition(GgiCanvas(" ",1,1), width, NULL, 0, NULL); /* reserve space */
   (void)GgiUseShell(prvform);
   return curform;
}

/* -------------------------------------------------------------------------- */
/*                                 logbox                                     */
/* -------------------------------------------------------------------------- */
/*  statusbox() creates form containing error and status lines
 */
static ident logbox(int width)
{
   int   i;
   ident curform, prvform, topref=NULL;
   
   curform = GgiForm("log", 1);
   prvform = GgiUseShell(curform);
   for (i=0; i<LOGLINES; i++) {
      l_log[i] = GgiSetLabel(GgiLabel("log"), " ", 0);
      GgiSetPosition(l_log[i], 0, NULL,  -1, topref);
      topref = l_log[i];
   }
   GgiSetPosition(GgiCanvas(" ",1,1), width, NULL, 0, NULL); /* reserve space */
   (void)GgiUseShell(prvform);
   return curform;
}

/* -------------------------------------------------------------------------- */
/*                                 handle_menu                                */
/* -------------------------------------------------------------------------- */
static void handle_menu(ident id, char *key, int code, void *arg)
{
   fint choice, nread;
    
   nread = userfint(&choice, 1, 2, key, " ");
   if (nread>0) {
      switch (choice) {
         case SAVEPLOT: {
            GgiPlotPrompter("HCFILENAME=", "HCDEVICE=",
                            "PostScript plot filename:");
            break;
         }
         case SAVE_PROFILE: {
            GgiPrompter("PROFFILE=", "Profile output filename:");
            break;
         }
         case SAVE_FIT_S:
         case SAVE_FIT_L: {
            GgiPrompter("FITFILE=", "Fit  output filename:");
            wkeyf("FFORMAT=%d", choice==SAVE_FIT_S?0:1);
            break;
         }
         case PLAY_EVENTS: {
            ident browser=GgiFileBrowser(ggiIdent, "EVENTFILE=");
            if (browser) {
               (void)GgiFileBrowser(ggiDelete, browser);
            } else {
               (void)GgiFileBrowser(ggiCreate, "EVENTFILE=",
                                    "File with pre-specified events:", NULL);
            }
            break;
         }
         case EXIT: {
            wkeyf("QUIT=YES");
            break;
         }
         default: {
            break;
         }
      }
      wkeyf(key);
   }
}

/* -------------------------------------------------------------------------- */
/*                                 handle_axis                                */
/* -------------------------------------------------------------------------- */
static void handle_axis(ident id, char *key, int code, void *arg)
{
   fint choice, nread;
    
   nread = userfint(&choice, 1, 2, key, " ");
   if (nread>0) {
      wkeyf("PROFILE=%s", axnames[choice]);
      GgiSetLabel(axis, axnames[choice], 0);
   }
}

/* ========================================================================== */
/*                                 gui_set_units                              */
/* -------------------------------------------------------------------------- */
/*  Keyword handler for setting units-like strings.
 */
extern void gui_set_units(ident id, char *key, int code, void *arg)
{
   fchar ftext;
   char  ctext[41];
   char  ltext[43];
   int   nread;
   
   ftext.a = ctext; ftext.l = 40;
   nread = userftext(ftext, 2, key, " ");
   ctext[nread] = '\0';
   sprintf(ltext,"(%s)", ctext);
   GgiSetLabel((ident)arg, ltext, 0);
}

/* ========================================================================== */
/*                                 gui                                        */
/* -------------------------------------------------------------------------- */
/*  Interface routine to initialize the graphical user interface.
 */
extern void gui(int xsize, int ysize, int esize)
{
static char *my_resources[] = {
   "*error.foreground: red",
   "*log.font: *courier*bold-r*12*",
   NULL
};

   int   barwidth=INPWIDTH+xsize+4;
   
   ident file, import, plopt, misopt, hidden, wts, param, func, ncomp;
   ident inset, selset, laxis, gridrange, physrange, axunits,
         box, boxaxes, position, prevpos, nextpos, fit, clear;
   ident menubar, plotter, errplot, status, log, inputs, logo;

   GgiAutoLayout(FALSE);
   GgiPostponeRealize(TRUE);
   GgiSetResources(my_resources);

/* ----------------------- top level elements ------------------------------ */
   menubar = GgiForm("top", 1);
   plotter = GgiPlotField("XGAUPROF", xsize, ysize);
   errplot = GgiPlotField("ERRPLOT", xsize, esize);
   status  = statusbox(INPWIDTH-1);
   log     = logbox(INPWIDTH-1);
   inputs  = GgiForm("inputs", 1);
   logo = GgiLogo(NULL, 0, 0);    
   
   GgiSetPosition(menubar, 0, NULL,    0, NULL);
   GgiSetPosition(plotter, 0, NULL,    0, menubar);
   GgiSetPosition(errplot, 0, NULL,    0, plotter);
   GgiSetPosition(inputs,  0, plotter, 0, menubar);
   GgiSetPosition(status,  0, plotter, 0, inputs);
   GgiSetPosition(log,     0, plotter, 0, status);
   GgiSetPosition(logo, -GgiWidth(logo), menubar, 0, log);

/* ---------------------------- menu bar ----------------------------------- */
   (void)GgiUseShell(menubar);
   file   = GgiSetLabel(GgiMenu("GUI_FILE=", NULL, file_entries), "FILE", 0);
   (void)ScheduleKeyevent(handle_menu, "GUI_FILE=", KEYCHANGE, NULL);
   import = GgiSetLabel(GgiButton("GUI_IMPORT=", NULL), "IMPORT", 0);
   plopt  = GgiSetLabel(GgiButton("PLOTOPT=", "Plot options"),
                        "PLOT OPTIONS", 0);
   help   = GgiHelpMenu("_HELP=", "HELP", NULL, helplabels, helpdocs);
   wts    = GgiMenu("WEIGHTS=", NULL, wts_entries);
   misopt = GgiSetLabel(GgiButton("MISOPT=", "Miscellaneous options"),
                        "MIS.OPTIONS", 0);
   hidden = GgiSetLabel(GgiButton("OPTIONS=", "Miscellaneous fit options"),
                        "FIT OPTIONS", 0);
   param  = GgiButton("PARAM=", "Parameter window");
   func   = GgiMenu("FUNCTION=", "Function menu", func_entries);
   ncomp  = GgiMenu("NCOMP=", "Number of components", ncomp_entries);
   
   GgiSetPosition(file, 0, NULL, 0, NULL);
   GgiSetPosition(import, 0, file, 0, NULL);
   GgiSetPosition(plopt, 0, import, 0, NULL);
   GgiSetPosition(help, barwidth-GgiWidth(help), NULL, 0, NULL);
   GgiSetPosition(ncomp, -GgiWidth(help)-GgiWidth(ncomp)-4, help, 0, NULL);
   GgiSetPosition(func, -GgiWidth(ncomp)-GgiWidth(func)-4, ncomp, 0, NULL);
   GgiSetPosition(param, -GgiWidth(func)-GgiWidth(param)-4, func, 0, NULL);
   GgiSetPosition(wts, -GgiWidth(param)-GgiWidth(wts)-4, param, 0, NULL);
   GgiSetPosition(hidden, -GgiWidth(wts)-GgiWidth(hidden)-4, wts, 0, NULL);
   GgiSetPosition(misopt, -GgiWidth(hidden)-GgiWidth(misopt)-4, hidden, 0,NULL);
   (void)GgiUseShell(NULL);

/* ------------------------- inputs box ------------------------------------ */
   (void)GgiUseShell(inputs);
   inset = GgiSetLabel(GgiTextField("SETNAME=", "Name of set", 10),
                       "Setname", 80);
   selset = GgiSetLabel(GgiButton("SELSET=", NULL), "BROWSE", 0);
   (void)ScheduleKeyevent(set_browse, "SELSET=", KEYCHANGE, "SETNAME=");
#if 0
   axis  = GgiSetLabel(GgiTextField("PROFILE=", "Profile axis name", 10),
                       "Profile axis", 80); /* +++ change into menu later */
#else
   laxis = GgiLabel("Profile axis");
   axis  = GgiSetLabel(GgiMenu("PROFINDX=", "Profile axis name", axnames),
                       "(none)", 0);
   (void)ScheduleKeyevent(handle_axis, "PROFINDX=", KEYCHANGE, NULL);
#endif
   gridrange = GgiSetLabel(GgiTextField("GRIDRANGE=", "Profile delimeters in x in grids\n Enter as: -30  32", 10),
                           "Grid range", 80);
   physrange = GgiSetLabel(GgiTextField("PHYSRANGE=", "Profile delimeters in x in physical coordinates.\n Enter as: 200.1  660.4" , 10),
                           "Phys. range", 80);
   axunits = GgiLabel("( )");
   (void)ScheduleKeyevent(gui_set_units, "AXUNITS=", KEYCHANGE, axunits);
   box      = GgiSetLabel(GgiTextField("BOX=", "Each position in this box contains a profile.\n Enter as: position low  position high", 20), "Box", 80);
   boxaxes  = GgiLabel("( )");
   (void)ScheduleKeyevent(gui_set_units, "BOXAXES=", KEYCHANGE, boxaxes);
   position = GgiSetLabel(GgiTextField("CURPOS=", "Current position", 10),
                          "Position", 80);
   prevpos  = GgiSetLabel(GgiButton("PREV=", "Previous position"), "<", 0);
   nextpos  = GgiSetLabel(GgiButton("NEXT=", "Next position"), ">", 0);
   fit      = GgiButton("FIT=", "Make fit");
   fstore   = GgiSetLabel(GgiButton("FSTORE=", "Store fit data"), "STORE", 0);
   (void)GgiDeactivate(fstore);
   clear    = GgiSetLabel(GgiButton("CLEARFIT=", "Clear graph"), "CLEAR", 0);
    
   GgiSetPosition(inset, 0, NULL, 0, NULL);
   GgiSetPosition(selset, 0, inset, 0, NULL);
   GgiSetPosition(laxis, 0, selset, 0, NULL);
   GgiSetPosition(axis, 0, laxis, 0, NULL);
   
   GgiSetPosition(gridrange, 0, NULL, 0, inset);
   GgiSetPosition(physrange, 0, gridrange, 0, inset);
   GgiSetPosition(axunits, 0, physrange, 0, inset);
   
   GgiSetPosition(box, 0, NULL, 0, gridrange);
   GgiSetPosition(boxaxes, 0, box,  0, gridrange);

   GgiSetPosition(position, 0, NULL, 0, box);
   GgiSetPosition(prevpos, 0, position, 0, box);
   GgiSetPosition(nextpos, 0, prevpos, 0, box);
   GgiSetPosition(fit, 10, nextpos, 0, box);
   GgiSetPosition(fstore, 0, fit, 0, box);
   GgiSetPosition(clear, INPWIDTH-GgiWidth(clear), NULL, 0, box);
   GgiUseShell(NULL);

   Import("GUI_IMPORT=");
   Param("PARAM=");
   Plotopt("PLOTOPT=");
   Hidden("OPTIONS=");
   Misopt("MISOPT=");

   GgiRealize();
}

/* ========================================================================== */
/*                                 gui_status                                 */
/* -------------------------------------------------------------------------- */
/*  Interface routine to display a status message.   
 */
void gui_status(char *message, int lineno)
{
   GgiSetLabel(l_status[lineno%STATUSLINES], message, 0); 
}

/* ========================================================================== */
/*                                 gui_log                                    */
/* -------------------------------------------------------------------------- */
/*  Interface routine to display a status message.   
 */
void gui_log(char *message, int lineno)
{
   char buffer[512];
   
   sprintf(buffer, "%s", message);
   GgiSetLabel(l_log[lineno%LOGLINES], buffer, 0); 
}

/* ========================================================================== */
/*                                 gui_error                                  */
/* -------------------------------------------------------------------------- */
/*  Interface routine to display an error message.
 */
void gui_error(char *message)
{
   char buffer[512];
   
   if (*message) {
      sprintf(buffer,"Error: %s",message);
      GgiSetLabel(l_error, buffer, 0);
   } else {
      GgiSetLabel(l_error, " ", 0);
   }
}

/* ========================================================================== */
/*                                 gui_axnames                                */
/* -------------------------------------------------------------------------- */
/*  Interface routine to change the axis names menu.
 */
extern void gui_axnames(char **names)
{
   fchar curname;
   char  curnamec[41];
   fint  nread;
   
   curname.a = curnamec;
   curname.l = 40;
   axnames = names;
   (void)GgiMenuLabels(axis, axnames);
   nread = userftext(curname, 2, "PROFILE=", " ");
   if (nread>0) {
      curnamec[nread] = '\0';
      GgiSetLabel(axis, curnamec, 0);
/*      anyoutf(0, "axis: %s", curnamec);*/
   } else {
      GgiSetLabel(axis, "(none)", 0);
   }
}

/* ========================================================================== */
/*                                 gui_allow_store                            */
/* -------------------------------------------------------------------------- */
/*  Interface routine to (de)activate STORE button.
 */
extern void gui_allow_store(bool allow)
{
   if (allow) GgiActivate(fstore); else GgiDeactivate(fstore);
}

#if defined(TESTBED)  /* ++++++++++++++++++++++++++++++++++++++++++++++++++ */
#include "init.h"
#include "finis.h"
#include "cmain.h"  
#include "eventmonitor.h"

static void setmessage(ident id, void *arg)
{
   static int mesno=0;
   char message[80];

   sprintf(message,"Status message %d (%o Oct, %X Hex)", mesno, mesno, mesno);
   gui_status(message,mesno);
   gui_allow_store((bool)(mesno%2));
   mesno++;
}

static void seterror(ident id, void *arg)
{
   static int mesno=1;
   char message[80];
   
   sprintf(message,"Error message %d (%o Oct, %X Hex)", mesno, mesno, mesno);
   mesno++;
   if (mesno%2) gui_error(message); else gui_error("");
}

static void setlog(ident id, void *arg)
{
   static int mesno=0;
   char message[80];
   
   sprintf(message,"This is log message number %d ", mesno*mesno);
   gui_log(message, mesno);
   mesno++;
}

static void quit(ident id, char *key, int code, void *arg)
{
   bool leave=toflog(FALSE);
   (void)userflog(&leave, 1, 2, key, " ");
   if (tobool(leave)) {
      wkeyf(key);
      finis_c();
   }
}
  
MAIN_PROGRAM_ENTRY
{
   static char *axes[]={"RA", "DEC", "FREQ", NULL};

   init_c();
   gui(600,480,150);
   (void)ScheduleTimer(setmessage,  4 SECONDS, NULL);
   (void)ScheduleTimer(seterror,   15 SECONDS, NULL);
   (void)ScheduleTimer(setlog,    10 SECONDS,  NULL);
   (void)ScheduleKeyevent(quit, "QUIT=", KEYCHANGE, NULL);
   eventmonitor("MONITOR=", TRUE);
   gui_axnames(axes);
   {
      char *labels[]={"DC1 document", "_LINE", "Interaction", "Theory", NULL};
      gui_helpmenu(labels);
   }
   MainLoop();
}
#endif
#<

#>            plotdevices.c
#include "stddef.h"
#include "stdlib.h"
#include "gipsyc.h"
#include "grexec.h"
#include "plotdevices.h"

#define MAXDEVLEN 20
#define MAXDEVS   40

extern char **plotdevices(void)
{
   fint   ndevs, idev, ifunc, nbuf, lchr;
   float  rbuf;
   fchar  chr;
   int    mdevs=0;                           /* number of matching devices */
   char   capabilities[MAXDEVLEN];
   char   **devnames=(char**)calloc(MAXDEVS+1,sizeof(char**));
    
   idev = 0; ifunc = 0; nbuf  = 1; lchr  = 1;
   grexec_c(&idev, &ifunc, &rbuf, &nbuf, chr, &lchr);
   ndevs = (fint)rbuf;
   chr.l = MAXDEVLEN;
   for (idev=1; idev<=ndevs && mdevs<MAXDEVS; idev++) {
      chr.a = capabilities;
      ifunc = 4; nbuf  = 1; lchr  = 1;
      grexec_c(&idev, &ifunc, &rbuf, &nbuf, chr, &lchr);
      if ( capabilities[0]=='H' && 
           capabilities[6]!='N') {
         mdevs++;
         chr.a = (char*)calloc(MAXDEVLEN+1,1);
         ifunc = 1; nbuf  = 1; lchr  = 1;
         grexec_c(&idev, &ifunc, &rbuf, &nbuf, chr, &lchr);
         chr.a[lchr] = '\0';
         devnames[mdevs-1] = chr.a;
      }
   }
   devnames[mdevs] = NULL;
   return devnames;
}
#<

#>            dofit.c
#include    "stdio.h"
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/
#include    "gipsyc.h"                             
#include    "math.h"         /* Declares the mathematical functions and macros.*/
#include    "float.h"
#include    "xgauprof.h"
#include    "keyevents.h"
#include    "lsqfitd.h"
#include    "gauestd.h"
#include    "userfio.h"
#include    "userlog.h"
#include    "usertext.h"
#include    "userreal.h" 
#include    "userdble.h"
#include    "pgplot.h"
#include    "setfblank.h"
#include    "time.h"
#include    "minmax1.h"
#include    "setdblank.h"

#include    "gui.h"
#include    "pgutils.h"
#include    "ggi.h"
#include    "outputresults.h"



static float    Xplot[PLOTDENS+10];  /* Plot arrays */
static float    Yplot[PLOTDENS+10];


static double   maxarg;      /* Limit range in exp function */


static char *prefix[5][5] = { {"AMP", "CENTER", "DISP", "", ""},   
                              {"AMP", "CENTER", "DISP", "H3", ""},  
                              {"AMP", "CENTER", "DISP", "H3", "H4"},
                              {"AMP", "CENTER", "DISP", "LORENTZ", ""},
                              {"Z0", "Z1", "Z2", "", ""}  };



static void estimateplot( ident, char *, int, void * );
extern void copyarray( double *, double *, int );



static bool Userlog(char *key)
/*------------------------------------------------------------*/
/* Purpose: Special version of userlog with default.          */
/*------------------------------------------------------------*/
{
   bool result = toflog( FALSE );
   fint fint1 = 1, fint2 = 2;

   (void) userlog_c( &result, 
                     &fint1, 
                     &fint2, 
                     tofchar(key), 
                     tofchar(" "));
   return tobool( result );
}




static int comp( double *x1,
                 double *x2 )
/*------------------------------------------------------------*/
/* PURPOSE: Let qsort sort in DESCENDING order                */
/*------------------------------------------------------------*/
{
   if (*x1 < *x2)
      return( +1 );
   else if (*x1 == *x2)
      return( 0 );
   return( -1 );
}



extern void disp2fwhm( double  *disp )
/*------------------------------------------------------------*/
/* PURPOSE: From dispersion to Full Width Half Maximum.       */
/*------------------------------------------------------------*/
{
   *disp *= 2.0*sqrt(2.0*log(2.0));
}




extern void fwhm2disp( double  *disp )
/*------------------------------------------------------------*/
/* PURPOSE: From Full Width Half Maximum to dispersion.       */
/*------------------------------------------------------------*/
{
   *disp /= 2.0*sqrt(2.0*log(2.0));
}





static double gausshermiteh3( double  X,
                              double *fpar,
                              int     ncomp )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate Hermite polynomial for X.               */
/*                                                            */
/* The function is a superposition of functions of the form   */
/* f =  A.Exp[-(x-xc)^2/(2s^2] *                              */
/*      (1+h3[c1((x-xc)/s)^3-c2(x-xc)/s]                      */
/*                                                            */
/* ==> F(x) = SUM[ f ] + z0 + B*x + A*x*x                     */
/*                                                            */
/* Amplitude        Center      dispersion    skewness        */ 
/* A = fpar[0],  X0 = fpar[1],  s = fpar[2], h3 = fpar[3]     */
/*                                                            */
/*------------------------------------------------------------*/
{
   int     i;
   int     maxpar = 4;               /* 4 parameters per component */
   double  result;
   double  X_X0 = 0.0;
   double  c1 = 2.0*sqrt(3.0)/3.0, c2 = sqrt(3.0);   

   result = 0.0;      
   for (i = 0; i < ncomp; i++) 
   {
      double A, X0, s, h3;
      double arg;
      double E, F;

      A   = fpar[0+i*maxpar];
      X0  = fpar[1+i*maxpar];
      s   = fpar[2+i*maxpar];
      h3  = fpar[3+i*maxpar];

      X_X0 = X - X0;
      F = X_X0/s;
       
      if (s == 0.0)
         E = 0.0;
      else
      {
         arg = 0.5 * F * F;      
         if (arg < maxarg)                     /* 'maxarg' is a global variable */
            E = exp( -arg );
         else
            E = 0.0;     
      }
      E *= (1.0+h3*F*(c1*F*F-c2));
      result += A * E;
   }
   /* Add background components */
   result += fpar[ncomp*maxpar+0] + fpar[ncomp*maxpar+1]*X_X0 + 
             fpar[ncomp*maxpar+2]*X_X0*X_X0;   
   return( result );
}




static void gausshermiteh3derv( double  X,
                                double *fpar,
                                double *epar,
                                int     ncomp ) 
/*------------------------------------------------------------*/
/* PURPOSE: Calculate the derivatives for a skewed gauss at X */
/*------------------------------------------------------------*/
{
   int     i;
   int     maxpar = 4;               /* 4 parameters per component */
   double  c1 = 2.0*sqrt(3.0)/3.0, c2 = sqrt(3.0);
   double  X_X0 = 0.0;

   
   for (i = 0; i < ncomp; i++) 
   {
      double A, X0, s, h3;
      double arg;
      double E, F, Q;

      A   = fpar[0+i*maxpar];
      X0  = fpar[1+i*maxpar];
      s   = fpar[2+i*maxpar];
      h3  = fpar[3+i*maxpar];

      X_X0 = X - X0;
       
      if (s == 0.0)
         E = 0.0;
      else      
      {
         arg = 0.5 * (X_X0/s) * (X_X0/s);      
         if (arg < maxarg)                     /* 'maxarg' is a global variable */
            E = exp( -arg );
         else
            E = 0.0;
      }
      if (E == 0.0)
         F = Q = 0.0;
      else
      {
         F = X_X0 / s;
         Q = F * (c1*F*F - c2);
      }
   
      /* Diff amplitude A */
      epar[0+i*maxpar] = E * (1.0 + h3*Q);
     
      /* Diff center X0 */
      epar[1+i*maxpar] = (A*E/s) *( h3*(c2-3.0*c1*F*F) + F*(1.0+h3*Q) );
         
      /* Diff sigma_0 s0 */
      epar[2+i*maxpar] = F * epar[1+i*maxpar];

      /*  Diff h3 */
      epar[3+i*maxpar] = A*E*Q;
   }      
   /* Derivatives for the background */
   epar[ncomp*maxpar+0] = 1.0;
   epar[ncomp*maxpar+1] = X_X0;
   epar[ncomp*maxpar+2] = X_X0*X_X0;   
}




double gausshermiteh3h4( double  X,
                         double *fpar,
                         int     ncomp )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate Hermite polynomial for X.               */
/*                                                            */
/* The function is a superposition of functions of the form   */
/*                                                            */
/* g = (x-xc)/s                                               */
/* f =  A.Exp[-1/2.g^2]*                                      */
/*      { 1 + h3[c1.g+c3.g^3] + h4[c5+c2.g^2+c4.g^4] }        */
/*                                                            */
/* ==> F(x) = SUM[ f ] + z0 + B*x + A*x*x                     */
/*                                                            */
/* Amplitude        Center      dispersion                    */ 
/* A = fpar[0],  X0 = fpar[1],  s = fpar[2], h3 = fpar[3]     */
/* h4 = fpar[4]                                               */
/*                                                            */
/*------------------------------------------------------------*/
{
   int     i;
   int     maxpar = 5;               /* 5 parameters per component */
   double  result;
   double  X_X0 = 0.0;
   double  c0 = sqrt(6.0)/4.0;
   double  c1 = -sqrt(3.0);      
   double  c2 = -sqrt(6.0);
   double  c3 = 2.0*sqrt(3.0)/3.0;
   double  c4 = sqrt(6.0)/3.0;


   result = 0.0;      
   for (i = 0; i < ncomp; i++) 
   {
      double A, X0, s, h3, h4;
      double arg;
      double E, F;

      A   = fpar[0+i*maxpar];
      X0  = fpar[1+i*maxpar];
      s   = fpar[2+i*maxpar];
      h3  = fpar[3+i*maxpar];
      h4  = fpar[4+i*maxpar];

      X_X0 = X - X0;
      F = X_X0/s;
       
      if (s == 0.0)
         E = 0.0;
      else
      {
         arg = 0.5 * F * F;      
         if (arg < maxarg)                     /* 'maxarg' is a global variable */
            E = exp( -arg );
         else
            E = 0.0;     
      }
      E *= ( 1.0 + h3*F*(c3*F*F+c1) + h4*(c0+F*F*(c2+c4*F*F)) );
      result += A * E;
   }
   /* Add background components */
   result += fpar[ncomp*maxpar+0] + fpar[ncomp*maxpar+1]*X_X0 + 
             fpar[ncomp*maxpar+2]*X_X0*X_X0;   
   return( result );
}




static void gausshermiteh3h4derv( double  X,
                                double *fpar,
                                double *epar,
                                int     ncomp ) 
/*------------------------------------------------------------*/
/* PURPOSE: Calculate the derivatives for a skewed gauss at X */
/*------------------------------------------------------------*/
{
   int     i;
   int     maxpar = 5;               /* 5 parameters per component */
   double  X_X0 = 0.0;
   double  c0 = sqrt(6.0)/4.0;
   double  c1 = -sqrt(3.0);      
   double  c2 = -sqrt(6.0);
   double  c3 = 2.0*sqrt(3.0)/3.0;
   double  c4 = sqrt(6.0)/3.0;

   
   for (i = 0; i < ncomp; i++) 
   {
      double A, X0, s, h3, h4;
      double arg;
      double E, F, Q3, Q4;

      A   = fpar[0+i*maxpar];
      X0  = fpar[1+i*maxpar];
      s   = fpar[2+i*maxpar];
      h3  = fpar[3+i*maxpar];
      h4  = fpar[4+i*maxpar];


      X_X0 = X - X0;
       
      if (s == 0.0)
         E = 0.0;
      else      
      {
         arg = 0.5 * (X_X0/s) * (X_X0/s);      
         if (arg < maxarg)                     /* 'maxarg' is a global variable */
            E = exp( -arg );
         else
            E = 0.0;
      }
      if (E == 0.0)
         F = Q3 = Q4 = 0.0;
      else
      {
         F = X_X0 / s;
         Q3 = F * (c3*F*F+c1);
         Q4 = c0 + F*F*(c2+c4*F*F);
      }
   
      /* Diff amplitude A */
      epar[0+i*maxpar] = E * (1.0 + h3*Q3 + h4*Q4);
     
      /* Diff center X0 */
      epar[1+i*maxpar] = (A*E/s) *( 
                         -h3*(c1+3.0*c3*F*F) - 2.0*h4*F*(c2+2.0*c4*F*F) 
                         + F*(1.0+h3*Q3+h4*Q4) );
         
      /* Diff sigma */
      epar[2+i*maxpar] = F * epar[1+i*maxpar];

      /*  Diff h3 */
      epar[3+i*maxpar] = A*E*Q3;
      
      /*  Diff h4 */
      epar[4+i*maxpar] = A*E*Q4;     
   }      
   /* Derivatives for the background */
   epar[ncomp*maxpar+0] = 1.0;
   epar[ncomp*maxpar+1] = X_X0;
   epar[ncomp*maxpar+2] = X_X0*X_X0;   
}




static double gauss( double  X,
                     double *fpar,
                     int     ngauss )
/*------------------------------------------------------------*/
/* PURPOSE: Fit routine needs evaluation of 1-dim gauss func- */
/*          tion on arbitrary position.                       */
/*                                                            */
/* The function is a superposition of gaussians of the form   */
/* f = A.Exp[-(x-xc)^2/(2s^2] with a zero level z0 added.     */
/* ==> F(x) = SUM[ f ] + z0 + B*x + A*x*x                     */
/*                                                            */
/* Amplitude        Center      dispersion                    */ 
/* A = fpar[0],  x0 = fpar[1],  s = fpar[2];                  */
/*                                                            */
/* etc.                                                       */
/* and the zero level is stored in fpar[ngauss*MAXPAR], the   */
/* last element of the input array.                           */
/*------------------------------------------------------------*/
{
   int      i;
   double   A, X0, s;   
   double   result = 0.0;
   double   X_X0= 0.0;
   int      maxpar = 3;                      /* 3 components for 1 Gauss */


   for (i = 0; i < ngauss; i++)
   {
      double  E, arg;                        /* Exponent and its argument */
      int     offset = i * maxpar;
      
      A  = fpar[offset];  X0 = fpar[1+offset];  s = fpar[2+offset];
      X_X0 = X - X0;
 
      if (s == 0.0)
         E = 0.0;
      else
      {                              
         arg = 0.5*(X_X0/s)*(X_X0/s);
         if (arg < maxarg)                   /* 'maxarg' is a global variable */
            E = exp( -arg );
         else
            E = 0.0;
      }
      result += A * E;
   }
   /* Add background components */
   result += fpar[ngauss*maxpar+0] + fpar[ngauss*maxpar+1]*X_X0 + 
             fpar[ngauss*maxpar+2]*X_X0*X_X0;
   return( result );       
}



static void gaussderv( double  X,
                       double *fpar,
                       double *epar,
                       int     ngauss ) 
/*------------------------------------------------------------*/
/* PURPOSE: Fit routine needs evaluation of 1-dim gauss func- */
/*          tion on arbitrary position.                       */
/*                                                            */
/* The function is a superposition of gaussians of the form   */
/* f = A.Exp[-(x-xc)^2/2s^2] with a zero level z0 added.      */
/* ==> F(x) = SUM[ f ] + z0                                   */
/*                                                            */
/* Amplitude        Center      dispersion                    */ 
/* A = fpar[0],  x0 = fpar[1],  s = fpar[2];                  */
/*                                                            */
/* etc.                                                       */
/* and the zero level is stored in fpar[ngauss*MAXPAR], the   */
/* last element of the input array.                           */
/*                                                            */
/* Let E = Exp[-(x-x0)^2(2s^2)], then                         */
/* D[f,A]  =  E                                               */
/* D[f,x0] =  A.(x-x0).E / s^2                                */
/* D[f,a]  =  A.(x-x0)^2.E / s^2                              */
/* D[F,z0] =  1                                               */
/*------------------------------------------------------------*/
{
   int      i;
   double   A, X0, X_X0=0.0, s;   
   int      maxpar = 3;                      /* 3 components for 1 Gauss */


   for (i = 0; i < ngauss; i++)
   {
      int     offset = i * maxpar;
      double  E, arg;                         /* Exponent and its argument */
      double  AEX_X0;                         /* A*(X-Xc)*E  */
      
      A  = fpar[offset];  X0 = fpar[1+offset];  s = fpar[2+offset];

      X_X0 = X - X0; 

      if (s == 0.0)
         E = 0.0;
      else
      {
         arg = 0.5*((X_X0)/s)*((X_X0)/s);     
         if (arg < maxarg)
            E = exp( -arg );
         else
            E = 0.0;
      }

      AEX_X0 = A * E * X_X0;
      
      epar[0+offset] = E;                       /* Derivative wrt. Amplitude A */
      epar[1+offset] = AEX_X0/s/s;              /* Derv. wrt Center Xc */
      epar[2+offset] = AEX_X0*X_X0/s/s/s;       /* Derv. wrt. dispersion */
   }
   /* Derivatives for the background */
   epar[ngauss*maxpar+0] = 1.0;
   epar[ngauss*maxpar+1] = X_X0;
   epar[ngauss*maxpar+2] = X_X0*X_X0;
}




extern void w( double Rz, 
               double Iz,
               double *Rr,
               double *Ir )
/*------------------------------------------------------------*/
/* PURPOSE: Error function for complex arguments.             */
/*          W(Z) = EXP(-Z*Z)ERFC(-iZ)                         */
/*          see Abromowitz and Stegun (chapter 7)             */
/*          |error|  <  2 * 10e-6                             */          
/*------------------------------------------------------------*/
{
#define EPS     ( 0.0000001 )
   double	wdx = 0.0;		/* real part result */
   double	wdy = 0.0;		/* imag part result */
   double	x, y;			/* real and imaginary arg */

   x = fabs( Rz );		/* real part */
   y = fabs( Iz );		/* imaginairy part */
   if ( x > 6.0 || y > 6.0 ) {		/* approximation for large arguments */
      static double	at[] = { 0.5124242, 0.05176536 };
      static double	bt[] = { 0.2752551, 2.72474500 };
      int		i;

      for ( i = 0; i < 2; i++ ) {
         double	det, dtx, dty, sav;

         sav = ( x * x - y * y - bt[i] );
         det = ( sav * sav + 4.0 * x * x * y * y );
         dtx = ( 2.0 * x * x * y - y * sav ) * at[i];
         dty = ( 2.0 * x * y * y + x * sav ) * at[i];
         wdx += dtx / det;
         wdy += dty / det;
      }
   } else if ( x > 3.9 || y > 3.0 ) {	/* approximation for intermediate arguments */
      static double	at[] = { 0.4613135, 0.09999216, 0.002883894 };
      static double	bt[] = { 0.1901635, 1.78449270, 5.525343700 };
      int		i;

      for ( i = 0; i < 3; i++ ) {
         double	det, dtx, dty, sav;

         sav = ( x * x - y * y - bt[i] );
         det = ( sav * sav + 4.0 * x * x * y * y );
         dtx = ( 2.0 * x * x * y - y * sav ) * at[i];
         dty = ( 2.0 * x * y * y + x * sav ) * at[i];
         wdx += dtx / det;
         wdy += dty / det;
      }
   } else {				/* no approximation */
      double	r;

      wdx = 1.0;
      r = sqrt( x * x + y * y );
      if ( r > 0.0 ) {
         static double	tt[] = { 1.0000000000, 0.5641895835 };
         double		tn[2];
         double		del, csp, snp, tcn, tsn;
         int		n = 0;

         csp = -y / r;
         snp = x / r;
         tcn = 1.0; tsn = 0.0;
         tn[0] = tt[0]; tn[1] = tt[1];
         do {
            double	tc, ts;
            int		i;

            n += 1;				/* increment interation number */
            tc = tcn;				/* save */
            ts = tsn;				/* save */
            tcn = ( tc * csp - ts * snp );	/* next cosine term */
            tsn = ( ts * csp + tc * snp );	/* next sine term */
            i = n%2;				/* argument */
            tn[i] *= ( 2.0 / (double) n );
            tn[0] *= r;				/* multiply with radius */
            tn[1] *= r;				/* multiply with radius */
            del = tn[i];			/* increment */
            wdx += ( tcn * del );		/* add increment */
            wdy += ( tsn * del );		/* add increment */
         } while ( del > EPS );			/* precision is reached */
      }
   }
   if ( Rz >= 0.0 && Iz >= 0.0 ) {
      *Rr = wdx; *Ir = wdy;
   } else if ( Rz >= 0.0 && Iz < 0.0 ) {
      double	csp, snp, sav;

      csp = cos( 2.0 * x * y );
      snp = sin( 2.0 * x * y );
      sav = exp( y * y - x * x );
      *Rr = sav * csp - wdx;
      *Ir = sav * snp + wdy;
   } else if ( Rz < 0.0 && Iz >= 0.0 ) {
      *Rr = wdx;
      *Ir = -wdy;
   } else if ( Rz < 0.0 && Iz < 0.0 ) {
      double	csp, snp, sav;

      csp = cos( 2.0 * x * y );
      snp = sin( 2.0 * x * y );
      sav = exp( y * y - x * x );
      *Rr = sav * csp - wdx;
      *Ir = -sav * snp - wdy;
   }
#undef EPS   
}





static double Voigt( double  X,
                     double *dpar,
                     int     ncomp )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate Voigt function at X.                    */
/*                                                            */
/* We want to use the voigt function from the GIPSY library.  */
/* The parameters of that function are floats and the order   */
/* and meaning of the parameters is different from what we    */
/* are used to. The first parameter is the zero level and     */
/* then for each component the Intensity (?), center, FWHM    */
/* Lorentz factor.                                            */
/*------------------------------------------------------------*/
{
   int      maxpar = 4;                              /* Per component */
   int      i;
   double   x, y;  
   double   result, V;
   double   sqln2 = sqrt( log(2.0) );
   double   Rres, Ires;
   double   X_X0 = 0.0;


   result = 0.0;
   for (i = 0; i < ncomp; i++)
   {
      int      offset = i * maxpar;
      double   Int, X0;
      double   aD, aL;      
      Int = dpar[0+offset];    X0 = dpar[1+offset];  
      aD  = dpar[2+offset];    aL = dpar[3+offset];
      X_X0 = X - X0;
       
      if (aD == 0.0)
         V = 0.0;
      else
      { 
         double ampfct;
         
         x = X_X0 * sqln2 / aD;
         y = aL * sqln2 / aD; 
         w( x, y, &Rres, &Ires );
         ampfct = Int * sqln2/(aD*sqrt(PI));
         V = ampfct * Rres;
      }
      result += V;     
   }
   /* Add background components */
   result += dpar[ncomp*maxpar+0] + dpar[ncomp*maxpar+1]*X_X0 + 
             dpar[ncomp*maxpar+2]*X_X0*X_X0;
   return( result );
}




static void   Voigtderv( double  X,
                         double *dpar,
                         double *epar,
                         int     ncomp )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate Voigt derivatives at X.                 */
/*                                                            */
/*------------------------------------------------------------*/
{
   int      maxpar = 4;                              /* Per component */
   int      i;
   double   x, y;  
   double   sqln2 = sqrt( log(2.0) );
   double   X_X0 = 0.0;
   double   sqpi = sqrt(PI);


   for (i = 0; i < ncomp; i++)
   {
      int      offset = i * maxpar;
      double   Int, X0;
      double   aD, aL;
            
      Int = dpar[0+offset];    X0 = dpar[1+offset];  
      aD  = dpar[2+offset];    aL = dpar[3+offset];
      X_X0 = X - X0;
       
      if (aD == 0.0)
         epar[0+offset] = epar[1+offset] = epar[2+offset] = epar[3+offset] = 0.0; 
      else
      {         
         double Rezwz,Imzwz;
         double ampfct;
         double Rew, Imw;         
         double dxVoigt, dyVoigt;
         
         x = X_X0 * sqln2 / aD;                   /* Definitions for x and y */
         y = aL * sqln2 / aD; 
         w( x, y, &Rew, &Imw );
         Rezwz  = ( x*Rew - y*Imw );              /* Real part of x.w(z) */
         Imzwz  = ( x*Imw + y*Rew );              /* Imaginary part of x.w(z) */
         dxVoigt = -2.0 * Rezwz;                  /* dVoigt/dx */
         dyVoigt = -2.0/sqpi + 2.0 * Imzwz;       /* dVoigt/dy */
         ampfct = Int * sqln2/(aD*sqpi);          /* Help variable */
         
                 
         /* The partial derivatives: */
         
         epar[0+offset] = sqln2/(aD*sqpi) * Rew;             /* Amplitude */
         epar[1+offset] = ampfct * (-sqln2/aD) * dxVoigt;    /* Center    */
         epar[2+offset] = (-ampfct/aD) * 
                          (Rew + x*dxVoigt+ y*dyVoigt);      /* Doppler factor    */
         epar[3+offset] = ampfct * (sqln2/aD) * dyVoigt;     /* Lorentz factor    */      
      }
   }
   /* Derivatives for the background */
   epar[ncomp*maxpar+0] = 1.0;
   epar[ncomp*maxpar+1] = X_X0;
   epar[ncomp*maxpar+2] = X_X0*X_X0;   
}            





extern double funcd_c( double *xdat,
                       double *fpar,
                       fint   *npar,
                       fint   *fopt )
/*------------------------------------------------------------*/
/* PURPOSE: It depends on the value of the function option    */
/*          which function and how many components will be    */
/*          fitted. This function is called by 'lsqfitd' and  */
/*          returns the function value at certain X.          */
/*------------------------------------------------------------*/
{
   int      ncomp, fieid;
   double   result = 0.0;
   double   X = xdat[0];


   fieid = (*fopt) / FIEID;
   ncomp = *fopt - fieid*FIEID;
   
   if (fieid == GAUSS)
      result = gauss( X, fpar, ncomp );
   else if (fieid == GAUSSHERMITE1)
      result = gausshermiteh3( X, fpar, ncomp );
   else if (fieid == GAUSSHERMITE2)
      result = gausshermiteh3h4( X, fpar, ncomp );      
   else if (fieid == VOIGT)
      result = Voigt( X, fpar, ncomp );


   return( result );       
}



extern void dervd_c( double *xdat,
                     double *fpar,
                     double *epar,
                     fint   *npar,
                     fint   *fopt )
/*------------------------------------------------------------*/
/* PURPOSE: It depends on the value of the function option    */
/*          which function and how many components will be    */
/*          fitted. This function is called by 'lsqfitd' and  */
/*          returns the function derivatives at certain X.    */
/*------------------------------------------------------------*/
{
   int      ncomp, fieid;
   double   X = xdat[0];


   fieid = (*fopt) / FIEID;
   ncomp = *fopt - fieid*FIEID;
   
   if (fieid == GAUSS)
      gaussderv( X, fpar, epar, ncomp );
   else if (fieid == GAUSSHERMITE1)
      gausshermiteh3derv( X, fpar, epar, ncomp );
   else if (fieid == GAUSSHERMITE2)
      gausshermiteh3h4derv( X, fpar, epar, ncomp );      
   else if (fieid == VOIGT)
      Voigtderv( X, fpar, epar, ncomp );
      
}




static double getmedian( double x1,
                         double x2,
                         double x3 )
/*------------------------------------------------------------*/
/* PURPOSE: Return median of x1,x2,x3                         */
/*------------------------------------------------------------*/
{
   if ( (x1 > x2 && x1 < x3) || (x1 < x2 && x1 > x3) )
       return( x1 );
   else if ( (x2 > x1 && x2 < x3) || (x2 < x1 && x2 > x3) )
       return( x2 );
   return( x3 );
}




static void  medianfilter( double *profile, 
                           double *medianfiltered, 
                           int    *mask,
                           int     ndat,
                           double  zerolev )
/*------------------------------------------------------------*/
/* PURPOSE: Apply a three pixels wide median filter to data.  */
/*                                                            */
/* If the median is a blank, return the zero level instead.   */
/* If a profile point is masked, return the zero level.       */
/*------------------------------------------------------------*/
{
   int       i, last;
   double    blank;
   
   setdblank_c( &blank );
   
  
   /* Start with first and last points */
   last = ndat-1;
   if (mask[0])
      medianfiltered[0] = zerolev;
   else
      medianfiltered[0] = profile[0];
   if (mask[last])
      medianfiltered[last] = zerolev;
   else
      medianfiltered[last] = profile[last];

     
   /* Process all the points that have neighbours */         
   for (i = 1; i < ndat - 1; i++)
   {
      if (mask[i])
      {
         medianfiltered[i] = zerolev;
      }
      else
         medianfiltered[i] = getmedian( profile[i-1], profile[i], profile[i+1] );
   }


   /* Check whole profile for blank values */
   for (i = 0; i < ndat; i++)   
   {
      if (medianfiltered[i] == blank)
         medianfiltered[i] = zerolev;
   }  
}




static void doqsort( double *Y, 
                     double *sortedY,
                     int     ndat,
                     int    *ndatsorted,
                     int    *numblanks )
/*------------------------------------------------------------*/
/* PURPOSE: */
/*------------------------------------------------------------*/
{
   int       i, j;
   int       nb;
   double    blank;

   setdblank_c( &blank );
   nb = 0;                                          /* Reset number of blanks */
   for (i = 0, j = 0; i < ndat; i++)
   {
      if (Y[i] != blank)
         sortedY[j++] = Y[i];
      else
         nb++;
   }
   qsort( sortedY, j, sizeof(double), (int(*)())comp );
   *ndatsorted = j;
   *numblanks = nb;
}




static void updateparamwindow( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Update parameter window with fits.                */
/*------------------------------------------------------------*/
{
   int        i;
   char       mes[STRLEN];
   int        fie = g->function;
   
  
   for (i = 0; i < g->ncomp; i++)    
   {
      int   indx = i*g->nvar;
      int   j;
      for (j = 0; j < g->nvar; j++)
      {
         sprintf( mes, "%s_FIT%d=%-7g +- %-7g", prefix[fie][j], i, 
                  g->estimates[indx+j], g->errorpar[indx+j] );
         wkeyf( mes );
      }
   }

   /* Background components */
   for (i = 0; i < 3; i++) 
   {
      int  indx = g->ncomp * g->nvar + i;
      
      sprintf( mes, "%s_FIT=%-7g +- %-7g", prefix[MAXFUNCTIONS][i],
                        g->estimates[indx], g->errorpar[indx] ); 
      wkeyf( mes );
   }   
}





void plotresidual( globaltype *g,
                   fint        color )
/*------------------------------------------------------------*/
/* PURPOSE: Plot a residual between original data and fit.    */
/*------------------------------------------------------------*/
{
   int     i; 
   fint    npoints;
   fint    npar;
   fint    oldcol, oldwidth;
   fint    oldlinestyle;
   float   oldch;
   fint    opt;
   float   *X, *Y;
   float   Ymin, Ymax;
   float   xloold, xhiold, yloold, yhiold;
   float   Xtick, Ytick;
   fint    nsubx, nsuby; 
   double  sum = 0.0;


   pgqwin_c( &xloold, &xhiold, &yloold, &yhiold );      /* Store old window */
   if (!g->hardcopy)
   {
      selectplot( g->plot.id2 );
      clearplot();
   }
   /*--------------------------------------------------*/
   /* You must sample here on each profile point. Then */
   /* the arrays Xplot and Yplot cannot be used        */
   /* because they have a fixed length that can be     */
   /* smaller than the profile size.                   */
   /*--------------------------------------------------*/
   X = (float *) calloc( g->profilelen, sizeof(float) );
   Y = (float *) calloc( g->profilelen, sizeof(float) );   
   if (X == NULL || Y == NULL)
   {
      gui_error( "Cannot allocate memory for residual work arrays" );
      return;
   }


   npar = g->ncomp * g->nvar + 3;    /* Include background components */
   opt  = FIEID*g->function + g->ncomp;


   for (i = 0; i < g->profilelen; i++)
   {  
      double   delta;   
      double   Yi = g->profiles[g->currentprofilenumber][i];
      double   Xi = g->xphys[i];
      double   blank;
      
      setdblank_c( &blank );     
      if (Yi != blank && !(g->mask[i]))
      {
         delta = Yi - funcd_c( &Xi, g->estimates, &npar, &opt );
         sum += delta * delta;
      }
      else
         delta = 0.0;
      X[i] = (float) Xi;
      Y[i] = (float) delta; 
   }
   npoints = i;

   sum = 0.0;
   if (npoints > 1)
   {
      double averageresidual = sum / (double) npoints;
      for (i = 0; i < g->profilelen; i++) 
      {
         double   Yi = g->profiles[g->currentprofilenumber][i];
         double   blank;
         
         setdblank_c( &blank );
         if (Yi != blank && !(g->mask[i]))
            sum += (Y[i] - averageresidual) * (Y[i] - averageresidual);
      }
      g->sigmaresidual = sqrt( sum / (double) (npoints-1) );
   }
   else
   {
      g->sigmaresidual = 0.0;
   } 
  
   minmax1_c( Y, &(g->profilelen), &Ymin, &Ymax );
   setwindow( xloold, Ymin, xhiold, Ymax );
   Xtick = Ytick = 0.0;
   nsubx = nsuby = 0;
   pgqch_c( &oldch );
   if (g->hardcopy)
   {
      /* Nothing (yet) */
   }
   else
   {
      setcharheight( g->plot.charsize );      
      setcharheight( 2.5*oldch );
   }   
   setlinewidth( g->plot.lwidth ); 
   pgbox_c( tofchar("BCNST"), &Xtick, &nsubx,
            tofchar("BCNSTV"), &Ytick, &nsuby );
   plotlabel( "", "Residual", "" );   

   pgqlw_c( &oldwidth );
   setlinewidth( g->plot.lwidthcur );
   
   pgqls_c( &oldlinestyle );
   setlinestyle( FULL_LINE );
     
   pgqci_c( &oldcol );
   setcolor( color );
   pgline_c( &npoints, X, Y ); 
   
   /* Base line */  
   setcolor( FOREGROUND );
   flmove( xloold, 0.0 );
   fldraw( xhiold, 0.0 );
  

   /* Restore attributes */   
   setcharheight( oldch );
   setcolor( oldcol );
   setlinewidth( oldwidth );
   setlinestyle( oldlinestyle );
    
   if (!g->hardcopy)
   {  
      selectplot( g->plot.id1 );                            /* Back to main plot */
   }
   setwindow( xloold, yloold, xhiold, yhiold );

   free( Y );
   free( X );
}



void plotpars( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Plot some parameters in plot.                     */
/*------------------------------------------------------------*/
{ 
   fint    oldcol, oldwidth;
   fint    oldlinestyle;
   float   xlo, xhi, ylo, yhi;
   int     i;   
  
 
   pgqlw_c( &oldwidth );
   pgqci_c( &oldcol );
   pgqls_c( &oldlinestyle );   

   pgqwin_c( &xlo, &xhi, &ylo, &yhi ); 

   for (i = 0; i < g->ncomp; i++)     
   {     
      double  amp, zero, center, disp, y, dx;
      double  ampfac = g->ampperc / 100.0;
      int     offset;
   
      offset = i*g->nvar;
   
      zero   = g->estimates[g->ncomp * g->nvar];
      amp    = g->estimates[offset+0];
      center = g->estimates[offset+1];
      disp   = g->estimates[offset+2];
      dx     = disp * sqrt( -2.0*log(ampfac) );            

      setcolor( g->plot.colfit );
      setlinewidth( g->plot.lwidthcur );    
      if (g->function == GAUSS)
      {                    
         if (ampfac > 0.0 && g->ncomp == 1)
         {
            y = zero + ampfac * amp;
            dblemove( center - dx, y );
            dbledraw( center + dx, y );
         }
         setlinestyle( DOTTED );
         setcolor( ORANGE );
         dblemove( center, yhi );
         dbledraw( center, ylo );
      }            
   }    
   setcolor( oldcol );     
   setlinewidth( oldwidth ); 
   setlinestyle( oldlinestyle );     
}   


                          
void plotfit( globaltype *g,
              int         color,
              int         wipe )
/*------------------------------------------------------------*/
/* PURPOSE: Plot a superposition of functions using the       */
/* current (fitted) estimates.                                */
/*------------------------------------------------------------*/
{
   int     i; 
   double  xstep;
   double  xx, xstart, xend;   
   fint    npar;
   fint    oldcol, oldwidth;
   fint    oldlinestyle;
   fint    opt;

   static  fint    npoints = 0;
   
  
   pgqlw_c( &oldwidth );
   pgqci_c( &oldcol );
   pgqls_c( &oldlinestyle );   
   setlinewidth( g->plot.lwidthcur );
   setlinestyle( FULL_LINE );
   setcolor( color );
   
   if (wipe)
   {
      setlinewidth( g->plot.lwidthcur );
      setcolor( color );
      pgline_c( &npoints, Xplot, Yplot ); 
      setcolor( oldcol );     
      setlinewidth( oldwidth ); 
      setlinestyle( oldlinestyle );  
      return;   
   }
  
   xstart = MYMIN( g->xphys[0], g->xphys[g->profilelen-1] );   
   xend   = MYMAX( g->xphys[0], g->xphys[g->profilelen-1] );
   xstep  = (xend - xstart) / (double) PLOTDENS; 
     
   npar = g->ncomp * g->nvar + 3;   /* Include background components */
   opt = FIEID*g->function + g->ncomp;
    
   i = 0;
   for (xx = xstart; xx <= xend; xx += xstep)
   {
      Xplot[i] = (float) xx;
      Yplot[i] = (float) funcd_c( &xx, g->estimates, &npar, &opt );
      i++;      
   }
   npoints = i;

   setlinewidth( g->plot.lwidthcur );
   setcolor( color );
   pgline_c( &npoints, Xplot, Yplot ); 

   setcolor( oldcol );     
   setlinewidth( oldwidth ); 
   setlinestyle( oldlinestyle );  
}





static void lsqfiterror( int errnum )
/*------------------------------------------------------------*/
/* PURPOSE: Display lsqfit error message.                     */
/*------------------------------------------------------------*/
{
   gui_error( "Cannot do a least squares fit on this data" );
   if (errnum == -4)
   {
      gui_status( "Maximum number of iterations too small", FIRSTLINE );
      gui_status( "increase tolerance or max. iterations", SECONDLINE );
   }
   else
   {
      gui_status( "If initial estimates are reasonable, fix more", FIRSTLINE );
      gui_status( "parameters or increase tolerance", SECONDLINE );   
   }
}



static int dolsqfit( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Do the real lsqfit.                               */
/*------------------------------------------------------------*/
{
   double       tolerance = g->tolerance;   
   double       mixingpar = g->lab;         
   fint         maxits = g->maxits;
   int          pnum = g->currentprofilenumber; 
   fint         fiecode;
   int          i;
   double       blank;
   fint         proflen = g->profilelen;
   int          Nsum = 0;
   fint         gpar, tpar;
   fint         xdim = 1;                       /* Dimension of fit */
   double       P0, Pmax;


   setdblank_c( &blank );   
   tolerance = MYMAX( tolerance, 0.0 );
   mixingpar = ABS( mixingpar );
   maxits    = MYMAX( 1, maxits );


   P0   = (double) g->xphys[0];
   Pmax = (double) g->xphys[g->profilelen-1];


   for (i = 0; i < g->ncomp; i++) 
   {
      /* Transform center and factor a to interval [0,1] */
      g->estimates[i*g->nvar+1]  = (g->estimates[i*g->nvar+1] - P0)/(Pmax - P0);   
      g->estimates[i*g->nvar+2] /= (Pmax - P0); 
      if (g->function == VOIGT)
      {
         g->estimates[i*g->nvar+3] /= (Pmax - P0);
      }
   }
   g->estimates[g->ncomp*g->nvar+1] *= (Pmax - P0); 
   g->estimates[g->ncomp*g->nvar+2] *= (Pmax - P0)*(Pmax - P0);
  
   gpar = g->ncomp * g->nvar;                 /* All the gaussian parameters */
   tpar = gpar + 3;                           /* Background pars added. */   

   /*--------------------------------------------------*/
   /* Copy amplitudes in double array and weight data  */
   /* using the median filtered array.                 */
   /*--------------------------------------------------*/   
   for (i = 0; i < proflen; i++) 
   { 
      if (g->profiles[pnum][i] != blank)
      {
         double Yi = g->profiles[pnum][i];
         double D;
         
         if (g->mask[i] || g->clipped[i])
         {
            g->wdat[i] = 0.0;
         }
         else
         {
            /* If the weigths are from file, we already have a wdatfile array */
            if (g->weights == UNIFORM_W)
               g->wdat[i] = 1.0;
            else if (g->weights == MEDIAN_W)
            {
               D = fabs( Yi - (double)g->filtered[i] );
               if (D == 0.0)
                  g->wdat[i] = 1.0;
               else
               {
                  g->wdat[i] = 1.0 / (D*D+1.0);     /* Not a blank ==> set weight*/
               }
            }
            else if (g->weights == FILE_W)
            {
               if (g->wdatfile[i] != 0.0 && g->wdatfile[i] != blank)
               {
                  g->wdat[i] = 1.0/g->wdatfile[i];    /* From error to weight */
                  g->wdat[i] *= g->wdat[i];           /* in two steps */
               }
               else 
               {                  
                  g->wdat[i] = 0.0;
                  Nsum--;                         /* Do not take into account */
               }
            }
            Nsum++;
         }
      }
      else
      {
         g->wdat[i] = 0.0;         
      }
   } 

   anyoutf( DEBUG, "xdim=%d, proflen=%d, tpar=%d, tolerance=%g, maxits=%d, mixing=%g",
            xdim,proflen,tpar, tolerance, maxits, mixingpar );
            
   fiecode = FIEID*g->function + g->ncomp;

                                          
   g->iters = lsqfitd_c( 
                     g->xphysscale,          /* The scaled [0,1] X-coordinates */
                     &xdim,                  /* Dimension of fit */
                     g->profiles[pnum],      /* Y data */
                     g->wdat,                /* Weights */
                     &proflen,               /* Number of data points */
                     g->estimates,           /* Initial values */
                     g->errorpar,            /* Error return values */
                     g->fixedfree,           /* Fixed or free */
                     &tpar,                  /* Total number of parameters */
                     &tolerance,             /* Tolerance */ 
                     &maxits,                /* Max. num. of iterations */
                     &mixingpar,             /* Mixing parameter */
                     &fiecode );             /* Number of gaussians & fie. id */


   if (g->iters < 0)
      return( (int) g->iters );
      
   /* Transform center and dispersion back to interval [physmin,physmax] */
   for (i = 0; i < g->ncomp; i++) 
   {
      g->estimates[i*g->nvar+1]  = g->estimates[i*g->nvar+1]*(Pmax - P0) + P0;
      g->estimates[i*g->nvar+2] *= (Pmax - P0); 
      g->errorpar[i*g->nvar+1]  *= (Pmax - P0);
      g->errorpar[i*g->nvar+2]  *= (Pmax - P0);
      if (g->function == VOIGT)
      {
         g->estimates[i*g->nvar+0] *= (Pmax - P0); 
         g->errorpar[i*g->nvar+0]  *= (Pmax - P0);          
         g->estimates[i*g->nvar+3] *= (Pmax - P0);
         g->errorpar[i*g->nvar+3]  *= (Pmax - P0);
      }         
   }
   /* Convert the background parameters B and A */
   g->estimates[g->ncomp*g->nvar+1] /= (Pmax - P0); 
   g->estimates[g->ncomp*g->nvar+2] /= (Pmax - P0)*(Pmax - P0);
   g->errorpar[g->ncomp*g->nvar+1]  /= (Pmax - P0); 
   g->errorpar[g->ncomp*g->nvar+2]  /= (Pmax - P0)*(Pmax - P0);

   updateparamwindow( g );   
   return( (int) g->iters ); 
}



void deschedulefields( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE:                                                   */
/*------------------------------------------------------------*/
{
   int         i;

   if (g->nids)
   {
      for (i = 0; i < g->nids; i++)   /* Components + background */
      {
         if (g->ids[i] != NULL) 
         {
            DescheduleKeyevent( &(g->ids[i]) );
         }
      }
   }
}




void schedulefields( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE:                                                   */
/*------------------------------------------------------------*/
{
   int    i, n;
   int    fie = g->function;


   for (i = 0, n = 0; i < g->ncomp; i++)
   {
      int   j;

      for (j = 0; j < g->nvar; j++) 
      {
         char  key[40];
         sprintf( key, "%s_EST%d=", prefix[fie][j], i );
         g->ids[n++] = ScheduleKeyevent( estimateplot, key, KEYCHANGE, g );
      }
   }
   /* Keywords for background */
   {
      int   j; 
      for (j = 0; j < 3; j++)
      {
         char  key[40];
         sprintf( key, "%s_EST=", prefix[MAXFUNCTIONS][j] );
         g->ids[n++] = ScheduleKeyevent( estimateplot, key, KEYCHANGE, g );
      }
   }
   g->nids = n;
}




static void setuserguess( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Set user's estimates and set fit parameters to    */
/*          fixed or free.                                    */
/*------------------------------------------------------------*/
{
   int        i;
   fint       nitems = 1;
   fint       dfault = HIDDEN;
   fint       r;
   double     userval;
   char       key[STRLEN];
   bool       fixed;
   int        sameprofile;
   int        fie = g->function;    
   double     sli_loval[MAXPAR];
   double     sli_hival[MAXPAR];   
   
   static int    oldprofnum = -1;                   /* A non existing profile */



   /* Set min. and max. values for the slider of each parameter */
   /* Amplitude */
   sli_loval[0] = g->yrange[0];
   sli_hival[0] = g->yrange[1];
   /* Mean */
   sli_loval[1] = g->xphys[0];
   sli_hival[1] = g->xphys[g->profilelen-1];
   /* Dispersion */
   sli_loval[2] = DBL_EPSILON;
   sli_hival[2] = 0.25 * ABS(g->xphys[g->profilelen-1] - 0.5*g->xphys[0]);
   /* h3 */
   sli_loval[3] = -0.5;
   sli_hival[3] =  0.5;
   /* h4 */
   sli_loval[4] = -0.5;
   sli_hival[4] =  0.5;

   if (g->function == VOIGT)
   {
      /* 4th parameter is Lorentz factor */
      sli_loval[3] = sli_loval[2];
      sli_hival[3] = sli_hival[2];
   }

   sameprofile = (oldprofnum == g->currentprofilenumber);
   for (i = 0; i < g->ncomp; i++)    
   {
      int   indx = i*g->nvar;
      int   j;

      for (j = 0; j < g->nvar; j++)
      {                  
         sprintf( key, "%s_FIX%d=", prefix[fie][j], i );
         fixed = Userlog( key );
         if (fixed) 
            g->fixedfree[indx+j] = 0;
         else
            g->fixedfree[indx+j] = 1;

         sprintf( key, "%s_EST%d=", prefix[fie][j], i );         
                           
         r = userdble_c( &userval, &nitems, &dfault, tofchar(key), tofchar(" ") );
        
         /*-----------------------------------------------------*/       
         /* A field must be filled if                           */
         /* 1) it is empty                                      */
         /* 2) a new profile enters and the field was not fixed */
         /*-----------------------------------------------------*/
/*         if (!r || (!sameprofile && !fixed) || g->refreshestimates)*/
         if (!fixed)
         {         
            wkeyf( "%s%g", key, g->estimates[indx+j] );

            sprintf( key, "%s_EST%d_MIN=", prefix[fie][j], i  );
            wkeyf( "%s%g", key, sli_loval[j] );
            sprintf( key, "%s_EST%d_MAX=", prefix[fie][j], i );
            wkeyf( "%s%g", key, sli_hival[j]  );            
         }
         else
            g->estimates[indx+j] = userval;
      }         
   }

   /* Background components */
   for (i = 0; i < 3; i++) 
   {
      int  indx = g->ncomp * g->nvar + i;
      
      sprintf( key, "%s_FIX=", prefix[MAXFUNCTIONS][i] );
      fixed = Userlog( key );
      if (fixed) 
         g->fixedfree[indx] = 0;
      else
         g->fixedfree[indx] = 1;
         
      sprintf( key, "%s_EST=", prefix[MAXFUNCTIONS][i] );
      r = userdble_c( &userval, &nitems, &dfault, tofchar(key), tofchar(" ") );
/*      if (!r || (!sameprofile && !fixed) || g->refreshestimates)      */
      if (!fixed)
      {
         wkeyf( "%s%g", key, g->estimates[indx] );
      }
      else
         g->estimates[indx] = userval;
   }   
   oldprofnum = g->currentprofilenumber;
}






static void getuserguess( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Get user's estimates and set fit parameters to    */
/*          fixed or free.                                    */
/*------------------------------------------------------------*/
{
   int        i;
   fint       nitems = 1;
   fint       dfault = HIDDEN;
   fint       r;
   double     userval;
   char       key[STRLEN];
   bool       fixed;
   int        fie = g->function;    
   int        sameprofile;
   
   static int        oldprofnum = -1;                      /* A non existing profile */


   /*----------------------------------------------------*/
   /* This routine updates some fields which trigger the */
   /* estimateplot routine. But this is an unwanted side */
   /* effect which can be avoided by descheduling the    */
   /* function and rescheduling them afterwards.         */
   /*----------------------------------------------------*/   
   
   sameprofile = (oldprofnum == g->currentprofilenumber);
   for (i = 0; i < g->ncomp; i++)    
   {
      int   indx = i*g->nvar;
      int   j;

      for (j = 0; j < g->nvar; j++)
      {
         sprintf( key, "%s_FIX%d=", prefix[fie][j], i );
         fixed = Userlog( key );
         if (fixed) 
            g->fixedfree[indx+j] = 0;
         else
            g->fixedfree[indx+j] = 1;

         sprintf( key, "%s_EST%d=", prefix[fie][j], i );         
                           
         r = userdble_c( &userval, &nitems, &dfault, tofchar(key), tofchar(" ") );                
         if (r)
            g->estimates[indx+j] = userval;
      }         
   }

   /* Background components */
   for (i = 0; i < 3; i++) 
   {
      int  indx = g->ncomp * g->nvar + i;
      
      sprintf( key, "%s_FIX=", prefix[MAXFUNCTIONS][i] );
      fixed = Userlog( key );
      if (fixed) 
         g->fixedfree[indx] = 0;
      else
         g->fixedfree[indx] = 1;
         
      sprintf( key, "%s_EST=", prefix[MAXFUNCTIONS][i]  );
      r = userdble_c( &userval, &nitems, &dfault, tofchar(key), tofchar(" ") );
      if (r)      
         g->estimates[indx] = userval;
   }   
   oldprofnum = g->currentprofilenumber;   
}





static void estimateplot( ident id,
                          char  *key,
                          int   code,
                          void  *arg )
/*------------------------------------------------------------*/
/* PURPOSE: *_ESTn= keywords handler.                         */
/*                                                            */
/*------------------------------------------------------------*/
{
   globaltype *g = (globaltype *) arg;
   

   GgiPlotXor( YES );     
   plotfit( g, g->plot.colest, YES );  /* Wipe first */
   getuserguess( g );      
   plotfit( g, g->plot.colest, NO );   /* Draw new points */
   GgiPlotXor( NO );   
}




static double getresidual( globaltype *g, 
                           double     *Destimates,
                           double     zerolev )
/*------------------------------------------------------------*/
/* PURPOSE: Routine to determine a chi2 for the estimates     */
/*          function. This function is called in a loop over  */
/*          Q, the smoothing parameter.                       */
/*------------------------------------------------------------*/
{
   fint    nvar = 3;            /* It is always a standard gauss -> nvar=3*/
   fint    npar, opt;
   int     i;
   int     profnum = g->currentprofilenumber;
   double  chi2 = 0.0;
   double  blank;


   setdblank_c( &blank );     
   
   /* Note that the number of gaussians found in the estimate */
   /* routine never exceeds the maximum number of components  */
   /* entered by the user */
   
   npar = g->gaussiansfound * nvar + 3;
   
   /* The estimate function is always a standard gauss */
   opt  = FIEID*GAUSS + g->gaussiansfound; 
   
   /* Add the parameters for the background. */
   Destimates[g->gaussiansfound * nvar+0] = zerolev;
   Destimates[g->gaussiansfound * nvar+1] = 0.0;
   Destimates[g->gaussiansfound * nvar+2] = 0.0;   

   
   for (i = 0; i < g->profilelen; i++)
   {
      double   delta;
      double   Yi = g->profiles[profnum][i];
      double   Xi = (double) i;    /*g->xphys[i];*/
    
      if (Yi != blank)
      {
         delta = Yi - funcd_c( &Xi, Destimates, &npar, &opt );
         chi2 += delta * delta;
      }
   }
   return( chi2 );
}




void getandplotestimates( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Prepare for lsqfit.                               */
/*------------------------------------------------------------*/
{
   fint         maxgaussians = g->ncomp;
   double       rms = g->rms;
   double       critamp = g->critamp;
   double       critdisp = g->critdisp;      /* In physical coordinates */
   double       zerolev = g->back_Z0;
   int          pnum = g->currentprofilenumber;
   fint         proflen = g->profilelen;
   int          sortedlen = 0;               /* Sorted profile without blanks */
   int          numblanks = 0;
   double       gridspac;                      
   fint         symbol = 23;                 /* Big circle */
   double       blank;


   setdblank_c( &blank );   
   clearguilog();                            /* Clear the previous results */


   /* Set the globals for limits handling in func and derv */
   maxarg  = log( sqrt(DBL_MAX) );           /* Limit range in exp function */


   if (g->importprofile && !g->cleanimport)
   {
      /* There are still blanks in this profile. */
      gui_status( "Cannot find initial estimates!", FIRSTLINE );      
      gui_status( "Import profile contains blanks", SECONDLINE );
      g->gaussiansfound = 0;
      return;  
   }

   /*--------------------------------------------------*/
   /* In most situations we need a sorted array to     */
   /* estimate values for the zero level or rms.       */
   /* The moments method uses also the average of the  */
   /* four highest amplitudes. The sorting is in       */
   /* DESCENDING order.                                */
   /*--------------------------------------------------*/      
   doqsort( g->profiles[pnum], g->work, proflen, &sortedlen, &numblanks );

   /*--------------------------------------------------*/
   /* Check whether user entered a value for the zero  */
   /* level. If not then estimate the zero level using */
   /* the median of the sorted profile.                */
   /*--------------------------------------------------*/
   {
      bool fixed;
      char key[20]; 
     
      sprintf( key, "%s_FIX=", prefix[MAXFUNCTIONS][0] );

      fixed = Userlog( key );
      if (!fixed)    
      {
         zerolev = g->work[sortedlen/2];                           /* median */
         if (zerolev == blank)
         {
            gui_status( "Too many blanks in profile to calculate zero level", 
                         FIRSTLINE );
            return;  
         }
      }
      else
      {
         fint   nitems = 1;
         fint   dfault = HIDDEN;
         fint   r;
         sprintf( key, "%s_EST=", prefix[MAXFUNCTIONS][0] );
         r = userdble_c( &g->back_Z0, &nitems, &dfault, tofchar(key), tofchar(" ") );
         zerolev = g->back_Z0;
      }
   }


   g->rms = ABS( g->rms  );
   rms = g->rms;

   if (g->plot.plotrms)
   {
      setcolor( FOREGROUND );
      setlinestyle( DOTTED );
      flmove( g->xphys[0], zerolev+rms );
      fldraw( g->xphys[proflen-1], zerolev+rms );
      flmove( g->xphys[0], zerolev-rms );
      fldraw( g->xphys[proflen-1], zerolev-rms );         
      setlinestyle( FULL_LINE );
   }
      
   /*--------------------------------------------------*/
   /* Next, check the other parameters.                */      
   /*--------------------------------------------------*/
   critamp      = ABS( critamp );
   maxgaussians = BETWEEN( maxgaussians, 1, MAXGAUSS );
   gridspac     = (double) (g->xphys[proflen-1]-g->xphys[0] ) / 
                  (double) (proflen - 1);
   anyoutf( DEBUG, "DEBUG: grid spacing = %f (units)", gridspac );
   critdisp    /= ABS(gridspac);                    /* Now it is in grids */
                      



   /* Perhaps user wants to (median) filter his data for the estimates */
   if (g->importprofile)    
   {
      if (g->estfilter)
      {
         medianfilter( g->spline, g->filtered, g->mask, proflen, zerolev );  
      }
      else
      {
         /* Copy spline into filtered */
         copyarray( g->spline, g->filtered, proflen );
      }
   }
   else  /* Data from a GIPSY set */
   {
      if (g->estfilter)
      {
         medianfilter( g->profiles[pnum], g->filtered, g->mask, proflen, zerolev );
         if (g->plot.plotmed)
         {
            plotarray( g->xphys, g->filtered, proflen, g->plot.colmed, symbol, 
                       g->plot.connect, g->plot.colcon );
         }
      }
      else
      {
         /* Copy profiles[pnum] into filtered */
         int     i;
         
         for (i = 0; i < proflen; i++)
         {         
            if (g->profiles[pnum][i] == blank || g->mask[i])
            {
               g->filtered[i] = blank;
            }
            else
            {
               g->filtered[i] = g->profiles[pnum][i];
            }
         }
      }
   }

   if (g->plot.plotmed && g->estfilter)
   {
      plotarray( g->xphys, g->filtered, proflen, g->plot.colmed, symbol, 
                 g->plot.connect, g->plot.colcon );
   }   

   setcolor( g->plot.colest );   
   g->gaussiansfound = 0;


   /*--------------------------------------------------*/ 
   /* The Ulrich Schwarz method is used to search for  */
   /* gaussian components in a profile:                */
   /* The routine uses first an automatic window method*/
   /* to define the signal region. Then the second     */
   /* derivative of the profile in the signal region   */
   /* is calculated by fitting a second degree         */
   /* polynomal. The smoothing parameter Q determines  */
   /* the number of points used for this (=2*Q+1).     */
   /*--------------------------------------------------*/ 
   {
      int     i;
      double  Destimates[MAXPARALL];
      fint    maxparameters = 3 * maxgaussians;  /* Ampl, center,disp only */
      double  residual;
      int     k, minindx = 0;
      int     specialindx = -1;
      int     special = NO;
      int     signal = 0;
     
      /*------------------------------*/
      /* Subtract zero level first    */
      /*------------------------------*/      
      for (i = 0; i < proflen; i++)              
      {

         if (g->filtered[i] != blank)
            g->filtered[i] -= zerolev;
         else
            g->filtered[i] = zerolev;
         if (g->filtered[i] != 0.0)
         {
            specialindx = i;
            signal++;
         }
      }
      if (signal == 0)
      {
         /* There is no hope for this profile */
         gui_status( "Cannot find any initial estimates: no signal", FIRSTLINE );
         return;
      }  
      if (signal == 1)
      {
         int     foundQis1 = NO;
         /*--------------------------------------------------*/
         /* This is a special case where all points are zero */
         /* except one. If this is a positive amplitude then */
         /* it is the maximum of a very small peak for which */
         /* gauest will not find initial estimates if Q == 1.*/
         /* Therefore we have to search for Q=1 in the array */
         /* of smoothing factors and if there is one, then   */
         /* it is automatically the best initial estimate Q  */
         /* and we can construct special estimates using     */
         /* FWHM == 1 pixel which is equivalent to a         */
         /* dispersion of 1/2.35 pixels.                     */
         /*--------------------------------------------------*/ 
         for (k = 0; k < g->numq; k++)
         {
            if (g->smoothingpar[k] == 1)
            {
               foundQis1 = YES;
               minindx = k;
               break;
            }            
         }
         if (foundQis1) 
         {            
            Destimates[0] = g->filtered[specialindx]; 
            Destimates[1] = specialindx;
            Destimates[2] = 1.0 / 2.35482;   /* FWHM --> dispersion */
            if (Destimates[0] < critamp || Destimates[2] < critdisp)
            {
               gui_status( "Rejected by estimates filter", FIRSTLINE );
               return;                   
            }
            else
            {
               g->gaussiansfound = 1;
               special = YES;  
            }
         }
      }
      
      if (g->numq > 1 && !special) 
      {
         double  minres = blank;         /* Initialize minimum residual */
         minindx = -1;                   /* Flag for not finding a Q that works */
         /*----------------------------------------*/
         /* We must try all Q factors.             */
         /*----------------------------------------*/
         for (k = 0; k < g->numq; k++)
         {
            fint Q = g->smoothingpar[k];
            if (2*Q+1 <= proflen)
            {
               double  zeroamp = 0.0, zerodisp = 0.0;
               g->gaussiansfound = gauestd_c( 
                   g->filtered,          /* Instead of  g->profiles[pnum] */
                   g->work,              /* Used here as a real work array */
                   &proflen,
                   Destimates,           /* Output parameter estimates */
                   &maxparameters,       /* 3 * ncomps */
                   &rms,
                   &zeroamp,
                   &zerodisp,
                   &Q );
               g->gaussiansfound = MYMIN( g->gaussiansfound, g->ncomp );
               if (g->gaussiansfound > 0)
               {
                  residual = getresidual( g, Destimates, zerolev );
                  anyoutf( DEBUG, "Residual for q[%d] = %d: %f", k, g->smoothingpar[k], residual );
                  if (minres == blank)                    /* Not yet a good Q */
                  {
                     minres = residual;
                     minindx = k;
                  }
                  else
                  {
                     if (residual < minres)
                     {
                        minres = residual;
                        minindx = k;
                     }
                  }
               }
            } /* End if proflen */
         } /* end loop over all Q's */
      } /* end if num Q's > 1 */
      
      /*--------------------------------------------------*/
      /* Now we have either the only Q in an array of 1   */
      /* smoothingfactor, or we have the 'best' Q in an   */
      /* array of 'numq' smoothingfactors. Then it could  */
      /* occur that the program did not find a valid Q    */
      /* which is set by minindx=-1 and there is no need  */
      /* to continue. For other indices we have to repeat */
      /* a call to 'gauest' to find the initial estimates */
      /* corresponding to the current value of Q.         */
      /*--------------------------------------------------*/
      if (minindx == -1)      
      {
         /* There is no hope for this profile */
         gui_status( "Cannot find any initial estimates", FIRSTLINE );
         return;
      }  
      
      if (!special)   /* For 'special' we already have estimates */
      {
         /* Now 'minindx' is in range 0..numq-1 */
               
         g->gaussiansfound = gauestd_c( 
                   g->filtered,          /* Instead of  g->profiles[pnum] */
                   g->work,              /* Used here as a real work array */
                   &proflen,
                   Destimates,           /* Output parameter estimates */
                   &maxparameters,       /* 3 * ncomps */
                   &rms,
                   &critamp,
                   &critdisp,
                   &(g->smoothingpar[minindx]) );
         g->gaussiansfound = MYMIN( g->gaussiansfound, g->ncomp );
               
         /* Correct number if more were found than wanted */
         if (g->gaussiansfound > maxgaussians)
            g->gaussiansfound = maxgaussians;
            
         if (g->gaussiansfound == 0)
         {
            /* If there is only one Q and no estimates were found: */
            gui_status( "Cannot find any initial estimates", FIRSTLINE );
            return;
         }
      }
               
      /* Copy the  estimates */         
      for (i = 0; i < g->gaussiansfound; i++)
      {
         g->estimates[i*g->nvar+0] = Destimates[i*3+0];
         g->estimates[i*g->nvar+1] = Destimates[i*3+1];
         g->estimates[i*g->nvar+2] = Destimates[i*3+2];
      }
      /* Fill with zero's if less gaussians were found */
      for (i = g->gaussiansfound; i < g->ncomp; i++)
      {
         g->estimates[i*g->nvar+0] = 0.0;
         g->estimates[i*g->nvar+1] = 0.0;
         g->estimates[i*g->nvar+2] = 0.0;            
      }
   }


   /*--------------------------------------------------*/ 
   /* Now we have estimates. It could be that the      */ 
   /* median filter was not set, but the user wants    */
   /* this filter as weights for the lsqfit routine.   */
   /*--------------------------------------------------*/
   if (g->weights == MEDIAN_W && !g->estfilter)
   {
      medianfilter( g->profiles[pnum], g->filtered, g->mask, proflen, zerolev );
   }

   
   /*--------------------------------------------------*/
   /* Transform x-axis related values from interval    */
   /* [0,profilelen] to interval                       */
   /* [physical_min, physical_max]                     */
   /* Don't do this for the estimates that were set to */
   /* 0.                                               */
   /*--------------------------------------------------*/
   {
      int k;
      for (k = 0; k < g->gaussiansfound; k++)
      {
         g->estimates[k*g->nvar+1] = g->xphys[0] + g->estimates[k*g->nvar+1] * gridspac;
         g->estimates[k*g->nvar+2] = g->estimates[k*g->nvar+2] * ABS(gridspac);
      }
   }
   
   /*--------------------------------------------------*/
   /* Adjust the the guesses into the estimates array  */
   /*--------------------------------------------------*/
   {
      int i;
      for (i = 0; i < g->gaussiansfound; i++)
      {
         int   offset = i*g->nvar;
         if (g->function == GAUSSHERMITE1)
            g->estimates[offset+3] = g->h3;
         if (g->function == GAUSSHERMITE2)
         {
            g->estimates[offset+3] = g->h3;
            g->estimates[offset+4] = g->h4;
         } 
         if (g->function == VOIGT)
         {
            /* First estimate is area instead of amplitude */
            double amp   = g->estimates[offset+0];
            double sigma = g->estimates[offset+2];
            g->estimates[offset+0] = amp * sigma * sqrt( 2.0*PI ); /* A->Area */
            disp2fwhm( &sigma );                                      /* FWHM */
            g->estimates[offset+2] = 0.5 * sigma;                     /* HWHM */
            g->estimates[offset+3] = g->lorentz;
         }
      }        
   }
 
   /*--------------------------------------------------*/ 
   /* The background parameters are always the last    */
   /*--------------------------------------------------*/ 

   g->estimates[g->ncomp*g->nvar+0] = zerolev;
   g->estimates[g->ncomp*g->nvar+1] = g->back_Z1;   
   g->estimates[g->ncomp*g->nvar+2] = g->back_Z2;   


   /*--------------------------------------------------*/ 
   /* Plot the initial estimates, but before that      */
   /* deschedule the keywords that correspond to these */
   /* estimates, otherwise you get a lot of            */
   /* unnecessary plot updates because a change in     */
   /* keyword value triggers the creation of a new     */
   /* plot.                                            */
   /*--------------------------------------------------*/ 
   if (g->plot.plotest)
   {   
      deschedulefields( g );
      setuserguess( g );      
      plotfit( g, g->plot.colest, NO );             
      /*--------------------------------------------------*/ 
      /* Events are triggered. Handle before scheduling   */
      /*--------------------------------------------------*/ 
      (void) GgiHandleEvents();
      schedulefields( g );
   }
}




void startfit( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Prepare for lsqfit.                               */
/*------------------------------------------------------------*/
{
   getuserguess( g );
   if ( dolsqfit(g) < 0 )
   {
      float   xloold, xhiold, yloold, yhiold;

      pgqwin_c( &xloold, &xhiold, &yloold, &yhiold );      /* Store old window */      
      /* Give failure message in gui */
      lsqfiterror( g->iters );
      /* Clear the residual plot */
      if (!g->hardcopy)
      {
         selectplot( g->plot.id2 );
         clearplot();
      }      
      /* Back to the main plot window */
      selectplot( g->plot.id1 );
      setwindow( xloold, yloold, xhiold, yhiold );      
   }
   else
   {
      plotfit( g, g->plot.colfit, NO );
      plotpars( g );
      plotresidual( g, g->plot.colfit );
      outputresults( g );
   }
}
#<

#>            allocs.c
#include    "stdio.h"
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/

#include    "xgauprof.h"   



int allocs( globaltype *g,
            int         len )
/*------------------------------------------------------------*/ 
/* PURPOSE: Allocate memory for profile arrays.               */ 
/*------------------------------------------------------------*/
{
   /*----------------------------------------*/
   /* Profile coordinates in subset indices. */
   /*----------------------------------------*/
   if (g->xgrids != NULL)    
      free( g->xgrids );   

   g->xgrids = (double *) calloc(len, sizeof(double) );
   if (g->xgrids == NULL)
   {
      return( 0 );
   }


   /*----------------------------------------*/
   /* Profile coordinates in physical        */
   /* coordinates.                           */
   /*----------------------------------------*/
   if (g->xphys != NULL)    
      free( g->xphys );

   g->xphys = (double *) calloc(len, sizeof(double) );
   if (g->xphys == NULL)
   {
      return( 0 );
   }

   
   /*----------------------------------------*/
   /* Work array of profile length.          */
   /*----------------------------------------*/   
   if (g->work != NULL)
      free( g->work ); 
   
   g->work = (double *) calloc(len, sizeof(double) );
   if (g->work == NULL)
   {
     return( 0 );
   }   

   /*----------------------------------------*/
   /* Median filtered version of prof. amps. */
   /*----------------------------------------*/
   if (g->filtered != NULL)
      free( g->filtered ); 
   
   g->filtered = (double *) calloc(len, sizeof(double) );
   if (g->filtered == NULL)
   {
     return( 0 );
   }   


   /*----------------------------------------*/
   /* Resampled profile (Spline).            */
   /*----------------------------------------*/
   if (g->spline != NULL)
      free( g->spline ); 
   
   g->spline = (double *) calloc(len, sizeof(double) );
   if (g->spline == NULL)
   {
     return( 0 );
   }   


   /*----------------------------------------*/ 
   /* Double precision weights array for     */
   /* lsqfit function.                       */
   /*----------------------------------------*/ 
   if (g->wdat != NULL)
      free( g->wdat ); 
   
   g->wdat = (double *) calloc(len, sizeof(double) );
   if (g->wdat == NULL)
   {
     return( 0 );
   }   

   /*----------------------------------------*/ 
   /* Double precision weights array from    */
   /* file.                                  */
   /*----------------------------------------*/ 
   if (g->wdatfile != NULL)
      free( g->wdat ); 
   
   g->wdatfile = (double *) calloc(len, sizeof(double) );
   if (g->wdatfile == NULL)
   {
     return( 0 );
   }   


   /*----------------------------------------*/
   /* Array to store scaled physical X-coord-*/
   /* inates. The scaled interval is -1<x<1  */
   /*----------------------------------------*/      
   if (g->xphysscale != NULL)    
      free( g->xphysscale );

   g->xphysscale = (double *) calloc(len, sizeof(double) );
   if (g->xphysscale == NULL)
   {
      return( 0 );
   }


   /*----------------------------------------*/
   /* Array to store mask for points that are*/
   /* excluded by user using mouse buttons.  */
   /*----------------------------------------*/      
   if (g->mask != NULL)    
      free( g->mask );

   g->mask = (int *) calloc(len, sizeof(int) );
   if (g->mask == NULL)
   {
      return( 0 );
   }

   /*----------------------------------------*/
   /* Array to store mask for points that are*/
   /* excluded by a clip.                    */
   /*----------------------------------------*/      
   if (g->clipped != NULL)    
      free( g->clipped );

   g->clipped = (int *) calloc(len, sizeof(int) );
   if (g->clipped == NULL)
   {
      return( 0 );
   }


   /*----------------------------------------*/
   /* Array to store median filtered profile.*/
   /*----------------------------------------*/      
   if (g->median != NULL)    
      free( g->median );

   g->median = (double *) calloc(len, sizeof(double) );
   if (g->median == NULL)
   {
      return( 0 );
   }

   return( 1 );
} 
#<

#>            import.c
/* import.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#define NAME "Import"

#define H_FILE "Text file name"
#define H_ROWS "Row numbers:\n\n first : last\n first :\n : last\n   :  (=all rows)"
#define H_FXC  "X column number"
#define H_FYC  "Y column number"
#define H_FEC  "Errors column number"
#define H_SET  "Set or subset containing table"
#define H_TAB  "Table name"
#define H_SXC  "X column name"
#define H_SYC  "Y column name"
#define H_SEC  "Errors column name"

#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "import.h"

static char *datanames[]={"PROFX", "PROFY", "PROFYERR", NULL};

/* -------------------------------------------------------------------------- */
/*                                 pop_compose                                */
/* -------------------------------------------------------------------------- */
/*  Keyword handler for popping up "inset composer"
 */
static void pop_compose(ident id, char *key, int code, void *arg)
{
   char *setkey=(char*)arg;
   char namekey[KEYLEN];
   bool button=toflog(FALSE);
   ident composer;

   (void)userflog(&button, 1, 2, key, " "); 
   if (button) {
      wkeyf(key);
      sprintf(namekey, "NAME_%s", setkey);
      composer = GgiInset(ggiIdent, namekey);
      if (composer) {
         (void)GgiInset(ggiDelete, composer);
      } else {
         composer = GgiInset(ggiCreate, namekey, setkey, NULL,
                             "Set or subset containing table");
      }
   }
}  

/* -------------------------------------------------------------------------- */
/*                                 pop_browse                                 */
/* -------------------------------------------------------------------------- */
/*  Keyword handler for popping up file browser.
 */
static void pop_browse(ident id, char *key, int code, void *arg)
{
   char *filekey=(char*)arg;
   bool button=toflog(FALSE);
   ident browser;

   (void)userflog(&button, 1, 2, key, " ");
   if (button) {
      wkeyf(key);
      browser = GgiFileBrowser(ggiIdent, filekey);
      if (browser) (void)GgiFileBrowser(ggiDelete, browser);
      else GgiFileBrowser(ggiCreate, filekey, "Select text file", NULL);
   }
}
   
/* -------------------------------------------------------------------------- */
/*                                 filedata                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler for IMP_FILE=, IMP_FROWS= and xxxCOL=.
 *  Convert file, row and column information to 'standard' keywords.
 */
static void filedata(ident id, char *key, int code, void *arg)
{
   static bool initialized=FALSE;
   static char file[64]="";
   static char rows[64]="";
   fchar  data;
   int    nc;
   char   **name;
   char   *dataname=(char*)arg;
   char keybuf[KEYLEN+1];
   char col[16+1];

   data.l = 63;
   if (!initialized) {
      data.a = file;
      nc = userftext(data, 2, "IMP_FILE=", " ");
      data.a[nc] = '\0';
      data.a = rows;
      nc = userftext(data, 2, "IMP_FROWS=", " ");
      data.a[nc] = '\0';
      initialized = TRUE;
   }
   data.a = NULL;
   if (!strcmp(key,"IMP_FILE=")) {
      data.a = file;
   } else if (!strcmp(key,"IMP_FROWS=")) {
      data.a = rows;
   }
   if (data.a) {
                                        /* IMP_FILE= or IMP_FROWS= keyword seen */
      nc = userftext(data, 2, key, " ");
      data.a[nc] = '\0';
      if (!nc && data.a==rows) strcpy(rows,":");
      if (*file && *rows) {
         data.l=16;
         data.a = col;
         for (name=datanames; *name; name++) {
            sprintf(keybuf,"%s_COL=", *name);
            nc = userftext(data, 2, keybuf, " ");
            if (nc) {
               col[nc] = '\0';
               wkeyf("%s=file(%s,%s,%s)", *name, file, col, rows);
            }
         }
      }
   } else {
                                          /* xxx_COL= keyword seen */
      if (*file && *rows) {
         data.l=16; 
         data.a = col;
         nc = userftext(data, 2, key, " ");
         if (nc) {
            col[nc] = '\0';
            wkeyf("%s=file(%s,%s,%s)", dataname, file, col, rows);
         } else {
            wkeyf("%s=", dataname);
         }
      }
   }
}

/* -------------------------------------------------------------------------- */
/*                                 tabledata                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler for IMP_SET=, IMP_TAB=, IMP_TROWS= and xxx_TCOL=.
 *  Convert set, table, row and column information to 'standard' keywords.
 */
static void tabledata(ident id, char *key, int code, void *arg)
{
   static bool initialized=FALSE;
   static char set[64]="";
   static char table[64]="";
   static char rows[64]="";
   fchar  data;
   int    nc;
   char   **name;
   char   *dataname=(char*)arg;
   char keybuf[KEYLEN+1];
   char col[16+1];

   data.l = 63;
   if (!initialized) {
      data.a = set;
      nc = userftext(data, 2, "IMP_SET=", " ");
      data.a[nc] = '\0';
      data.a = table;
      nc = userftext(data, 2, "IMP_TAB=", " ");
      data.a[nc] = '\0';
      data.a = rows;
      nc = userftext(data, 2, "IMP_TROWS=", " ");
      data.a[nc] = '\0';
      initialized = TRUE;
   }
   data.a = NULL;
   if (!strcmp(key,"IMP_SET=")) {
      data.a = set;
   } else if (!strcmp(key,"IMP_TAB=")) {
      data.a = table;
   } else if (!strcmp(key,"IMP_TROWS=")) {
      data.a = rows;
   }
   if (data.a) {
                                  /* IMP_SET, IMP_TAB or IMP_TROWS= keyword seen */
      nc = userftext(data, 2, key, " ");
      data.a[nc] = '\0';
      if (!nc && data.a==rows) strcpy(rows,":");
      if (*set && *table && *rows) {
         data.l=16;
         data.a = col;   
         for (name=datanames; *name; name++) {
            sprintf(keybuf,"%s_TCOL=", *name);
            nc = userftext(data, 2, keybuf, " ");
            if (nc) {
               col[nc] = '\0';
               wkeyf("%s=table(%s,%s,%s,%s)",  *name, set, table, col, rows);
            }
         }
      }
   } else {
                                          /* xxx_TCOL= keyword seen */
      if (*set && *table && *rows) {
         data.l=16;
         data.a = col;
         nc = userftext(data, 2, key, " ");
         if (nc) {
            col[nc] = '\0';
            wkeyf("%s=table(%s,%s,%s,%s)", dataname, set, table, col, rows);
         } else {
            wkeyf("%s=", dataname);
         }
      }
   }
}

/* -------------------------------------------------------------------------- */
/*                                 popshell                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler causing the shell to be popped up or down.
 */
static void popshell(ident id, char *key, int code, void *arg)
{  
   static bool state=FALSE;
   bool button=toflog(FALSE);
 
   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      GgiShowShell((ident)arg, !state);
      state = !state;
      wkeyf(key);
   }
}

/* ========================================================================== */
/*                                 Import                                     */
/* -------------------------------------------------------------------------- */
/*  Import() creates a pop-up shell with menus for obtaining imported data.
 */
void Import(char *key)
{
   static ident s_import;
   ident s_prev, frame_box, file_box, table_box, generic_box;
   ident closebut;
   char **name;
   char keybuf[KEYLEN+1];
    
   s_import = GgiShell(NAME);
   s_prev = GgiUseShell(s_import);
   frame_box = GgiForm(NAME, 2);
   closebut = GgiSetLabel(GgiButton(key, "Close window"), "CLOSE", 0);
   GgiSetPosition(frame_box, 0, NULL, 0, NULL);
   GgiSetPosition(closebut, 0, NULL, 0, frame_box);
   
   GgiUseShell(frame_box);
   file_box    = GgiForm(NAME, 1);
   table_box   = GgiForm(NAME, 1);
   generic_box = GgiForm(NAME, 1);
   GgiSetPosition(file_box, 0, NULL, 0, NULL);
   GgiSetPosition(table_box,   0, NULL, 0, file_box);
   GgiSetPosition(generic_box, 0, NULL, 0, table_box);

   {
      ident title, file, browse, rows, xcol, ycol, ecol;
      (void)GgiUseShell(file_box);
      title = GgiLabel("Input from text file\n ");
      file = GgiSetLabel(GgiTextField("IMP_FILE=", H_FILE, 40),
                             "Filename", 80);
      browse = GgiButton("BROWSE=", NULL);
      (void)ScheduleKeyevent(pop_browse, "BROWSE=", KEYCHANGE, "IMP_FILE=");
      xcol = GgiSetLabel(GgiTextField("PROFX_COL=", H_FXC, 2),
                          "Column X", 80);
      ycol = GgiSetLabel(GgiTextField("PROFY_COL=", H_FYC, 2),
                          "Y", 50);
      ecol = GgiSetLabel(GgiTextField("PROFYERR_COL=", H_FEC, 2),
                          "Errors", 50);
      rows = GgiSetLabel(GgiTextField("IMP_FROWS=", H_ROWS, 8),
                          "Rows", 80);

      GgiSetPosition(title, 0, NULL, 0, NULL);
      GgiSetPosition(browse, -GgiWidth(browse), file, 0, NULL);
      GgiSetPosition(file, 0, NULL, 0, title);
      GgiSetPosition(xcol, 0, NULL, 0, file);
      GgiSetPosition(ycol, 0, xcol, 0, file);
      GgiSetPosition(ecol, 0, ycol, 0, file);
      GgiSetPosition(rows, 0, NULL, 0, xcol);

      (void)ScheduleKeyevent(filedata, "IMP_FILE=", KEYCHANGE, NULL); 
      (void)ScheduleKeyevent(filedata, "IMP_FROWS=", KEYCHANGE, NULL);
      for (name=datanames; *name; name++) {
         sprintf(keybuf, "%s_COL=", *name);
         (void)ScheduleKeyevent(filedata, keybuf, KEYCHANGE, *name);
      }
   }

   {
      ident title, set, compose, table,  rows, xcol, ycol, ecol;
      (void)GgiUseShell(table_box);
      title = GgiLabel("Input from table\n ");
      set  = GgiSetLabel(GgiTextField("IMP_SET=", H_SET, 40),
                             "Set", 80);
      compose = GgiButton("COMPOSE=", NULL);
      (void)ScheduleKeyevent(pop_compose, "COMPOSE=", KEYCHANGE, "IMP_SET=");
      table= GgiSetLabel(GgiTextField("IMP_TAB=", H_TAB, 40),
                             "Table", 80);
      xcol = GgiSetLabel(GgiTextField("PROFX_TCOL=", H_SXC, 8),
                          "Column X", 80);
      ycol = GgiSetLabel(GgiTextField("PROFY_TCOL=", H_SYC, 8),
                          "Y", 0);
      ecol = GgiSetLabel(GgiTextField("PROFYERR_TCOL=", H_SEC, 8),
                          "Errors", 0);
      rows = GgiSetLabel(GgiTextField("IMP_TROWS=", H_ROWS, 8),
                          "Rows", 80);
       
      GgiSetPosition(title, 0, NULL, 0, NULL);
      GgiSetPosition(compose, -GgiWidth(compose), set, 0, NULL);
      GgiSetPosition(set,   0, NULL, 0, title);
      GgiSetPosition(table, 0, NULL, 0, set);
      GgiSetPosition(xcol,  0, NULL, 0, table);
      GgiSetPosition(ycol,  0, xcol, 0, table);
      GgiSetPosition(ecol,  0, ycol, 0, table);
      GgiSetPosition(rows,  0, NULL, 0, xcol);

      (void)ScheduleKeyevent(tabledata, "IMP_SET=",   KEYCHANGE, NULL);
      (void)ScheduleKeyevent(tabledata, "IMP_TAB=",   KEYCHANGE, NULL);
      (void)ScheduleKeyevent(tabledata, "IMP_TROWS=", KEYCHANGE, NULL);
      for (name=datanames; *name; name++) {
         sprintf(keybuf, "%s_TCOL=", *name);
         (void)ScheduleKeyevent(tabledata, keybuf, KEYCHANGE, *name);
      }
   }
   
   {
      ident title, xvalues, yvalues, errors;
      (void)GgiUseShell(generic_box);
      title = GgiLabel("Generic input format\n ");
      xvalues = GgiSetLabel(GgiTextField("PROFX=", NULL, 40),
                            "X values", 80);
      yvalues = GgiSetLabel(GgiTextField("PROFY=", NULL, 40),
                            "Y values", 80);
      errors  = GgiSetLabel(GgiTextField("PROFYERR=",  NULL, 40),
                            "Errors", 80);
      GgiSetPosition(title,   0, NULL, 0, NULL);
      GgiSetPosition(xvalues, 0, NULL, 0, title);
      GgiSetPosition(yvalues, 0, NULL, 0, xvalues);
      GgiSetPosition(errors,  0, NULL, 0, yvalues);
   }
   (void)GgiUseShell(s_import);
   (void)GgiUseShell(s_prev);
   ScheduleKeyevent(popshell, key, KEYCHANGE, s_import);
}
#<

#>            parcol.c
/* parcol.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "parcol.h"

#define H_EST "Estimate"
#define H_FIX "Fix parameter?"
#define H_FIT "Fit result"


ident BuildColumn(int nrows, char *title, char *parname)
{
   int i;
   ident column, current, prvform;
   char  estkey[KEYLEN], fixkey[KEYLEN], fitkey[KEYLEN];
   ident est, fix, fit;
   
#if 1
   column = GgiForm("column", 0);
   prvform = GgiUseShell(column);
#endif
   current = GgiLabel(title);
#if 1
   GgiSetPosition(current, 0, NULL, 0, NULL);
#else
   column = current;
#endif
   
   for (i=0; i<nrows; i++) {
      sprintf(estkey, "%s_EST%d=", parname, i);
      sprintf(fixkey, "%s_FIX%d=", parname, i);
      sprintf(fitkey, "%s_FIT%d=", parname, i);
      est = GgiSetLabel(GgiTextField(estkey, H_EST, 10), " ", 1);
      fix = GgiSetLabel(GgiButton(fixkey, H_FIX), "FIX", 0);
      fit = GgiSetLabel(GgiTextField(fitkey, H_FIT, 10), " ", 1);
      GgiSetPosition(est, 0, NULL, 0, current);
      GgiSetPosition(fix, 0, est,  0, current);
      GgiSetPosition(fit, 0, NULL, -1, est);
      current = fit;
   }
#if 1
   (void)GgiUseShell(prvform);
#endif
   return column;
}
#<

#>            pgutils.c
#include    "stdio.h"        /* Defines ANSI C input and output utilities */
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/
#include    "math.h"         /* Declares the mathematical functions and macros.*/
#include    "gipsyc.h"       /* Defines the ANSI-F77 types for Fortran to C intface */
                             /* including def. of char2str,str2char,tofchar,zadd */
                             /* and macros tobool and toflog */
#include    "float.h"        /* Definition of FLT_MAX etc.*/
#include    "ctype.h"        /* Declares ANSI C functions for testing characters */
                             /* like: isalpha, isdigit etc. also tolower, toupper.*/



/* PGPLOT includes */

#include    "pgplot.h"       /* All PGPLOT includes. */
#include    "setdblank.h"


#define VIEWPORT       0.15, 0.1, 0.95, 0.9


extern void setviewport( float xlo,
                         float ylo,
                         float xhi,
                         float yhi )
/*------------------------------------------------------------------*/
/* PURPOSE: Set PGPLOT viewport.                                    */
/*------------------------------------------------------------------*/
{
   pgsvp_c(&xlo, &xhi, &ylo, &yhi);   
} 



extern void setwindow( float xlo,
                       float ylo,
                       float xhi,
                       float yhi )
/*------------------------------------------------------------------*/
/* PURPOSE: Set PGPLOT viewport.                                    */
/*------------------------------------------------------------------*/
{
   pgswin_c(&xlo, &xhi, &ylo, &yhi);   
} 




extern void dsetwindow( double  xlo,
                        double  ylo,
                        double  xhi,
                        double  yhi )
/*------------------------------------------------------------------*/
/* PURPOSE: Set PGPLOT viewport.                                    */
/*------------------------------------------------------------------*/
{
   float xl = (float) xlo;
   float yl = (float) ylo;
   float xh = (float) xhi;
   float yh = (float) yhi;   
   
   pgswin_c(&xl, &xh, &yl, &yh);   
} 



extern int openplot( char *dev,
                     fint  subx,
                     fint  suby )
/*------------------------------------------------------------*/
/* PURPOSE: Initialize PGPLOT                                 */
/*------------------------------------------------------------*/
{
    fint r;
    
    r = pgopen_c( tofchar(dev) );
    if (r <= 0) 
       return( -1 );
    pgsubp_c( &subx, &suby );    
    return( (int) r );
}



extern void selectplot( int id )
/*------------------------------------------------------------*/
/* PURPOSE: Select plot                                       */
/*------------------------------------------------------------*/
{
   fint r = id;
   pgslct_c( &r );
   setviewport( VIEWPORT );
}



extern void clearplot( void )
/*------------------------------------------------------------------*/
/* PURPOSE: Clear current plot.                                     */
/*------------------------------------------------------------------*/
{
   pgpage_c();
}



extern void plotpoint( double xx,
                       double yy,
                       int    col,
                       int    sym )
/*------------------------------------------------------------------*/
/* PURPOSE: Plot one point.                                         */
/*------------------------------------------------------------------*/
{
   fint   symbol = sym;
   fint   one = 1;
   fint   oldcolor, color = col;
   float  x = (float) xx;
   float  y = (float) yy;

   pgqci_c( &oldcolor );
   pgsci_c( &color );
   pgpt_c( &one, &x, &y, &symbol );
   pgsci_c( &oldcolor );
}



extern void ploterrors( double *x,
                        double *y,
                        double *yerr,
                        int    ndat,
                        int    col )
/*------------------------------------------------------------------*/
/* PURPOSE: Plot errors ar positions x, y                           */
/*------------------------------------------------------------------*/
{
   int    i;
   fint   oldcolor, color = col;
   double blank;
   
   
   pgqci_c( &oldcolor );
   pgsci_c( &color );
       
   setdblank_c( &blank );
   for (i = 0; i < ndat; i++)
   {
      if (y[i] != blank && yerr[i] != blank)
      {
         fint    dir;
         fint    one = 1;
         float   termlen = 0.0;
         float   fx, fy, ey;
         
         fx = x[i]; fy = y[i]; ey = yerr[i];
         dir = 2;
         pgerrb_c( &dir, &one, &fx, &fy, &ey, &termlen );
         dir = 4;
         pgerrb_c( &dir, &one, &fx, &fy, &ey, &termlen );
      }
   }
   pgsci_c( &oldcolor );       
}




extern void plotarray( double *x,
                       double *y,
                       int    ndat,
                       int    col,
                       int    sym,
                       bool   connect,
                       fint   colcon )
/*------------------------------------------------------------------*/
/* PURPOSE: Plot array of positions.                                */
/*------------------------------------------------------------------*/
{
   int    i;
   double blank;
   float  wxlo, wxhi, wylo, wyhi; 
   float  loY;
   fint   color, oldcolor;
   
   pgqwin_c( &wxlo, &wxhi, &wylo, &wyhi );  
   loY = wylo + 0.05 * (wyhi-wylo);
   setdblank_c( &blank );
   for (i = 0; i < ndat; i++)
   {
      if (y[i] != blank)
      {
         plotpoint( x[i], y[i], col, sym );
      }
      else
      {
         float   a = (float) x[i];
         pgqci_c( &oldcolor );
         color = 2;                              /* red */
         pgsci_c( &color ); 
         pgtext_c( &a, &loY, tofchar("b") );
         pgsci_c( &oldcolor );                   /* Reset */
      }
   }
   if (connect)
   { 
      fint  N = (fint) ndat;
      float *X, *Y;
      
      pgqci_c( &oldcolor ); 
      pgsci_c( &colcon );        
      X = (float *) calloc( ndat, sizeof(float) ); 
      Y = (float *) calloc( ndat, sizeof(float) );       
      for (i = 0; i < ndat; i++)
      {
         X[i] = (float) x[i];
         Y[i] = (float) y[i];                  
      }
      pgline_c( &N, X, Y );
      pgsci_c( &oldcolor );                   /* Reset */
      free( X );
      free( Y );
   }
}




extern void plottext( float x,
                      float y,
                      char  *txt )
/*------------------------------------------------------------------*/
/* PURPOSE: Simple horizontal text plotting.                        */
/*------------------------------------------------------------------*/
{
   pgtext_c( &x, &y, tofchar(txt) );
}



extern void plotlabel( char *Xtitle, 
                       char *Ytitle,
                       char *Ttitle )
/*------------------------------------------------------------------*/
/* PURPOSE: Annnotate the plot axes.                                */ 
/*------------------------------------------------------------------*/
{
   pglab_c( tofchar(Xtitle), tofchar(Ytitle), tofchar(Ttitle) );
}




extern void setlinewidth( int lwidth )
/*------------------------------------------------------------------*/
/* PURPOSE: Set line width.                                         */
/*------------------------------------------------------------------*/
{
   fint  linewidth = lwidth;
   
   pgslw_c( &linewidth ); 
}



extern void setcharheight( float ch )
/*------------------------------------------------------------------*/
/* PURPOSE: Set character height.                                   */
/*------------------------------------------------------------------*/
{  
   pgsch_c( &ch ); 
}



extern void setlinestyle( int  style )
/*------------------------------------------------------------------*/
/* PURPOSE: Set line style                                          */
/*------------------------------------------------------------------*/
{
   fint  lstyle = style;
   pgsls_c( &lstyle );
}



extern void dblemove( double x,
                      double y )
/*-------------------------------------------------------------*/
/* PURPOSE: Alternative for pgmove.                            */
/*-------------------------------------------------------------*/               
{
   float a, b;
   
   a = (float) x; b = (float) y;
   pgmove_c( &a, &b );
}



extern void dbledraw( double x,
                      double y )
/*-------------------------------------------------------------*/
/* PURPOSE: Alternative for pgdraw.                            */
/*-------------------------------------------------------------*/               
{
   float a, b;
   
   a = (float) x; b = (float) y;
   pgdraw_c( &a, &b );
}



extern void flmove( float x,
                    float y )
/*-------------------------------------------------------------*/
/* PURPOSE: Alternative for pgmove.                            */
/*-------------------------------------------------------------*/               
{   
   pgmove_c( &x, &y );
}



extern void fldraw( float x,
                    float y )
/*-------------------------------------------------------------*/
/* PURPOSE: Alternative for pgdraw.                            */
/*-------------------------------------------------------------*/               
{
   pgdraw_c( &x, &y );
}



extern void setcolor( int col )
/*-------------------------------------------------------------*/
/* PURPOSE: Set color to 'col'.                                */
/* Alternative pgsci.                                          */
/*-------------------------------------------------------------*/
{
   fint    color = col;
   pgsci_c( &color );
}                     



#<

#>            utils.c
#include        "stdio.h"               /* <stdio.h> */
#include        "gipsyc.h"              /* GIPSY symbols and definitions */
#include        "setdblank.h"           /* define setfblank_c */ 

#include "stdlib.h"
#include "setfblank.h"
#include "setndblank.h"

#define OK		   0		/* no problems */
#define	NOMEMORY	  -1		/* no memory available for buffers */
#define EQALXES		  -2		/* two x-coordinates are equal */

#define true		   1
#define false		   0
#define MAXTXTLEN	  80

static fint klo = -1 ;
static fint khi = -1 ;



void dminmax( double *data, fint *n, double *amin, double *amax )
{
   fint   def = 0;                      /* define mode or not */
   fint   l;                            /* loop counter */
   double blank;                        /* BLANK value */

   setdblank_c( amin );                 /* set to blank, as initial value */
   setdblank_c( amax );                 /* set to blank, as initial value */
   setdblank_c( &blank );               /* set to blank for comparison */
   for (l = 0; l < *n; l++, data++) {   /* loop */
      if (*data != blank) {             /* no BLANK value */
         if (def) {                     /* min/max already defined */
            if (*amin > *data) {        /* new minimum ? */
               *amin = *data;           /* save new minimum */
            } else if (*amax < *data) { /* new maximum ? */
               *amax = *data;           /* save new maximum */
            }
         } else {                       /* define min and max */
            *amin = *amax = *data;      /* save new minimum and maximum */
            def = 1;                    /* turn on define mode */    
         }
      }
   }
} 


/*
    spline constructs a cubic spline given a set of x and y values, through
these values.

*/
static fint spline( double *x   , double *y   , fint  n   , 
                    double  yp1 , double  ypn , double *y2 )
{
	fint  i,k;
	double p,qn,sig,un,*u;

	u=(double *)malloc((unsigned) (n-1)*sizeof(double));
        if (!u) return( NOMEMORY ) ;
	if (yp1 > 0.99e30)
		y2[0]=u[0]=0.0;
	else {
		y2[0] = -0.5;
		u[0]=(3.0/(x[1]-x[0]))*((y[1]-y[0])/(x[1]-x[0])-yp1);
	}
	for (i=1;i<=n-2;i++) {
		sig=(x[i]-x[i-1])/(x[i+1]-x[i-1]);
		p=sig*y2[i-1]+2.0;
		y2[i]=(sig-1.0)/p;
		u[i]=(y[i+1]-y[i])/(x[i+1]-x[i]) - (y[i]-y[i-1])/(x[i]-x[i-1]);
		u[i]=(6.0*u[i]/(x[i+1]-x[i-1])-sig*u[i-1])/p;
	}
	if (ypn > 0.99e30)
		qn=un=0.0;
	else {
		qn=0.5;
		un=(3.0/(x[n-1]-x[n-2]))*(ypn-(y[n-1]-y[n-2])/(x[n-1]-x[n-2]));
	}
	y2[n-1]=(un-qn*u[n-2])/(qn*y2[n-2]+1.0);
	for (k=n-2;k>=0;k--)
		y2[k]=y2[k]*y2[k+1]+u[k];
	free(u);
        return( OK ) ;
}


/*
    splint uses the cubic spline generated with spline to interpolate values
in the XY  table.

*/
static fint splint( double *xa , double *ya , double *y2a , 
                    fint n    , double x   , double *y   )
{
        fint  r   = 0 ;
	fint  k;
	double h,b,a;

        if ( klo < 0 ){
  	   klo=0;
 	   khi=n-1;
        } else {
           if ( x < xa[klo] ) klo=0;
           if ( x > xa[khi] ) khi=n-1;
        }
	while (khi-klo > 1) {
		k=(khi+klo) >> 1;
		if (xa[k] > x) khi=k;
		else klo=k;
	}
	h=xa[khi]-xa[klo];
	if (h == 0.0) {
           setdblank_c( y ) ;
           r = EQALXES ;
        } else {
	   a=(xa[khi]-x)/h;
	   b=(x-xa[klo])/h;
	   *y=a*ya[klo]+b*ya[khi]+( (a*a*a-a)*y2a[klo]+
                                    (b*b*b-b)*y2a[khi] ) * (h*h) / 6.0;
        }
	return( r ) ;
}


fint dspline( double *xi , double *yi , fint *nin  ,
              double *xo , double *yo , fint *nout )
{
   double yp1 , ypn , *y2 , *xii , *yii , blank , alpha ;
   fint  error , n , m , nblank , niin ;

   setdblank_c( &blank ) ;
   nblank = 0 ;
   for ( n = 0 ; n < *nin ; n++ )
      if ( yi[ n ] == blank ) nblank++ ;

   niin = *nin - nblank ;
   if ( nblank == 0 ) {
      xii = xi ;
      yii = yi ;
   } else if ( nblank == *nin ) {
      for ( n = 0 ; n < *nout ; n++ ) 
         yo[ n ] = blank ;
      return( nblank ) ;
   } else {
      xii = (double *)malloc( ( niin ) * sizeof( double ) ) ;
      yii = (double *)malloc( ( niin ) * sizeof( double ) ) ;
      if ( !xii || !yii ) return( NOMEMORY ) ;
      for ( n = 0 , m = 0 ; ( n < *nin ) && ( m < niin ) ; n++ ) {
         if ( yi[ n ] != blank ) {
            xii[ m ] = xi[ n ] ;
            yii[ m ] = yi[ n ] ;
            m += 1 ;
         }
      }
   }

   y2 = (double *)malloc( ( niin ) * sizeof( double ) ) ;
   if ( !y2 ) return( NOMEMORY ) ;

   alpha = 1.0 ;
   yp1 = 3e30 * alpha ;
   ypn = 3e30 * alpha ;

   error = spline( xii , yii , niin , yp1 , ypn , y2 ) ;
   if ( error < 0 ) return( error ) ;
   
   klo = -1; /* Reset 'klo' before table interpolation */
   for ( n = 0  ; n < *nout ; n++ ) {
      error = splint( xii , yii , y2 , niin , xo[ n ] , &yo[ n ] ) ;
      if ( error < 0 ) return( error ) ;
   }

   if ( nblank != 0 ) {
      free( xii ) ;
      free( yii ) ;
   }
   free( y2  ) ;

#if (0)
   for ( n = 0  ; n < *nout ; n++ )
      anyoutf( 1, "xin, yin, xout, yout=%g %g %g %g", xi[n], yi[n], xo[n],yo[n] );
#endif

   return( nblank ) ;
}



int  deblank( double  *xin, 
              double  *yin, 
              
              int      len,
              double  *yout)
/*------------------------------------------------------------*/
/* PURPOSE: Remove blanks in a profile using spline           */
/*          interpolation.                                    */
/*------------------------------------------------------------*/
{
   int          num, numblanks;
   int          i;
   fint         flenI, flenO;    
   fint         r;
   double      *dummyX = NULL;
   double      *dummyY = NULL;
   double       dblank;
                                   
                                  
   dummyX = (double *) calloc( len, sizeof(double) );
   dummyY = (double *) calloc( len, sizeof(double) );      
   if (dummyX == NULL || dummyY == NULL)
   {
      return( -3 );
   }   

   setdblank_c( &dblank );

   num = numblanks = 0;
   for (i = 0; i < len; i++)
   {
      if (xin[i] != dblank)
      {
         dummyX[num] = xin[i];
         dummyY[num] = yin[i];
         num++;
      }
      else
         numblanks++;
   }

   flenI = (fint) num;   
   flenO = (fint) len;
   r = dspline( dummyX, dummyY, &flenI, 
                dummyX, yout,   &flenO );   

   free( dummyY );
   free( dummyX );
   
   /* Error in spline routine */
   if (r < 0)
      return( r );
      
   return( numblanks );
}



void copyarray( double   *x,
                double   *xcopy,
                int      ndat )
/*------------------------------------------------------------*/
/* PURPOSE: Copy array x to array xcopy.                      */
/*------------------------------------------------------------*/
{
   int    i;
   
   for(i = 0; i < ndat; i++)
      xcopy[i] = x[i];
}

#<

#>            param.c
/* param.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#define NAME "Parameters"

#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "radiogroup.h"
#include "slider.h"
#include "param.h"

#define H_EST "Estimate"
#define H_FIX "Fix parameter?"
#define H_SEL "Select for slider modification"
#define H_FIT "Fit result"
#define MARGIN 40

static char popkey[KEYLEN];

static char *gauss_title[]={"Amplitude", "Center", "Dispersion", NULL};
static char *gh1_title[]={"a", "b", "c", "h3", NULL};
static char *gh2_title[]={"a", "b", "c", "h3", "h4", NULL};
static char *voigt_title[]={"Area", "Center",
                            "Doppler half width", "Lorentz half width", NULL};
static char *back_title[]={"Constant term",
                           "Linear term",
                           "Quadratic term", NULL};
static char **titles[]={gauss_title, gh1_title, gh2_title, voigt_title};

static char *gauss_name[]={"AMP", "CENTER", "DISP"};
static char *gh1_name[]={"AMP", "CENTER", "DISP", "H3"};
static char *gh2_name[]={"AMP", "CENTER", "DISP", "H3", "H4"};
static char *voigt_name[]={"AMP", "CENTER", "DISP", "LORENTZ"};
static char *back_name[]={"Z0", "Z1", "Z2"};
static char **names[]={gauss_name, gh1_name, gh2_name, voigt_name};

static ident shell=NULL;
static ident funid=NULL, ncid=NULL;
static ident slgrp;  /* radio group for selecting parameter */


/* -------------------------------------------------------------------------- */
/*                                 obsolete                                   */
/* -------------------------------------------------------------------------- */
/*  Force shell to be popped down due to function or # of parameters change.
 */
static void obsolete(ident id, char *key, int code, void *arg)
{
   wkeyf("%sYES", popkey);
}

/* -------------------------------------------------------------------------- */
/*                                 createshell                                */
/* -------------------------------------------------------------------------- */
/*  Create the parameter pop-up shell.
 */
static void createshell(char *key)
{
   int i, j = 0;
   ident s_prev, f_box, colbox = 0, currel, currbox, topref;
   ident closebut, clearbut, fitbut;
   fint nread, fun, rows=0;
   char *parname, **title, **prefix;
   char  estkey[KEYLEN], fixkey[KEYLEN], selkey[KEYLEN], fitkey[KEYLEN];
   ident est, fix, sel, fit;
   bool selected;
    
   nread = userfint(&fun, 1, 2, "FUNCTION=", " ");
   if (!nread) return;
   (void)userfint(&rows, 1, 2, "NCOMP=", " ");
   if (rows<=0) return;
      
   slgrp = RadioGroup("PCHOICE=");
   title = titles[fun];
   prefix = names[fun];
   shell = GgiShell(NAME);
   s_prev = GgiUseShell(shell);
   closebut = GgiSetLabel(GgiButton(key, NULL), "CLOSE", 0);
   clearbut = GgiSetLabel(GgiButton("CLEARFIT=", "Clear graph"), "CLEAR", 0);
   fitbut   = GgiButton("FIT=", "Make fit");
   f_box = GgiForm(NAME, 2);

/*
 *   Parameter fields
 */
   currbox = NULL;
   for (i=0; title[i]; i++) {
      (void)GgiUseShell(f_box);
      colbox = GgiForm(" ", 0);
      GgiSetPosition(colbox, 0, currbox, 0, NULL);
      currbox = colbox;
      (void)GgiUseShell(colbox);
      parname = prefix[i];
      currel = GgiLabel(title[i]);
      GgiSetPosition(currel, i==0?MARGIN+4:0, NULL, 0, NULL);
      for (j=0; j<rows; j++) {
         sprintf(estkey, "%s_EST%d=", parname, j);
         sprintf(fixkey, "%s_FIX%d=", parname, j);
         sprintf(selkey, "%s_SEL%d=", parname, j);
         sprintf(fitkey, "%s_FIT%d=", parname, j);
         est = GgiSetLabel(GgiTextField(estkey, H_EST, 10), " ", 1);
         estkey[strlen(estkey)-1] = '\0'; /* chop equals sign */
         RadioAddKey(slgrp, selkey, estkey);
         selected = toflog(FALSE);
         (void)userflog(&selected, 1, 2, selkey, " ");
         if (tobool(selected)) TriggerKey(selkey);
         fix = GgiSetLabel(GgiButton(fixkey, H_FIX), "FIX", 0);
         sel = GgiSetLabel(GgiButton(selkey, H_SEL), "SLI", 0);
         fit = GgiSetLabel(GgiTextField(fitkey, H_FIT, 20), " ", 1);
         if (i==0) {
            GgiAlignLabel(GgiSetLabel(est, "In:",  MARGIN), ggiLeft);
            GgiAlignLabel(GgiSetLabel(fit, "Out:", MARGIN), ggiLeft);
         }
         GgiSetPosition(est, 0, NULL, 5, currel);
         GgiSetPosition(fix, 0, est,  5, currel);
         GgiSetPosition(sel, 0, fix,  5, currel);
         GgiSetPosition(fit, 0, NULL, 1, est);
         currel = fit;
      }
   }

/*
 *   Background fields
 */   
   (void)GgiUseShell(f_box);
   topref = colbox;
   title   = back_title;
   currbox = NULL;
   currel = GgiLabel("Background:");
   GgiSetPosition(currel, 0, NULL, 20, topref);
   topref = currel;
   for (i=0; title[i]; i++) {
      (void)GgiUseShell(f_box);
      colbox = GgiForm(" ", 0);
      GgiSetPosition(colbox, 0, currbox, 0, topref);
      currbox = colbox;
      (void)GgiUseShell(colbox);
      parname = back_name[i];
      currel = GgiLabel(title[i]);
      GgiSetPosition(currel, i==0?MARGIN+4:0, NULL, 0, NULL);
      sprintf(estkey, "%s_EST=", parname);
      sprintf(fixkey, "%s_FIX=", parname);
      sprintf(selkey, "%s_SEL=", parname, j);
      sprintf(fitkey, "%s_FIT=", parname);
      est = GgiSetLabel(GgiTextField(estkey, H_EST, 10), " ", 1);
      estkey[strlen(estkey)-1] = '\0';                 /* chop equals sign */
      RadioAddKey(slgrp, selkey, estkey);
      selected = toflog(FALSE);
      (void)userflog(&selected, 1, 2, selkey, " ");
      if (tobool(selected)) TriggerKey(selkey);
      fix = GgiSetLabel(GgiButton(fixkey, H_FIX), "FIX", 0);
      sel = GgiSetLabel(GgiButton(selkey, H_SEL), "SLI", 0);
      fit = GgiSetLabel(GgiTextField(fitkey, H_FIT, 20), " ", 1);
      if (i==0) {
         GgiAlignLabel(GgiSetLabel(est, "In:",  MARGIN), ggiLeft);
         GgiAlignLabel(GgiSetLabel(fit, "Out:", MARGIN), ggiLeft);
      }
      GgiSetPosition(est, 0, NULL, 5, currel);
      GgiSetPosition(fix, 0, est,  5, currel);
      GgiSetPosition(sel, 0, fix,  5, currel);
      GgiSetPosition(fit, 0, NULL, 1, est);
   }
   
   topref = colbox;
   (void)GgiUseShell(f_box);
   ncid   = ScheduleKeyevent(obsolete, "NCOMP=", KEYCHANGE, NULL);
   funid  = ScheduleKeyevent(obsolete, "FUNCTION=", KEYCHANGE, NULL);
   Slider("PCHOICE=", f_box, NULL, topref);
   
   (void)GgiUseShell(shell);
   GgiSetPosition(f_box, 0, NULL, 0, NULL);
   GgiSetPosition(closebut, 0, NULL, 0, f_box);
   GgiSetPosition(fitbut, -GgiWidth(fitbut)-2, f_box, 0, f_box);
   GgiSetPosition(clearbut, -GgiWidth(clearbut)-GgiWidth(fitbut)-4, fitbut,
                           0, f_box);
   (void)GgiUseShell(s_prev);
   GgiShowShell(shell, TRUE);
}

/* -------------------------------------------------------------------------- */
/*                                 popshell                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler causing the shell to be popped up or down.
 */
static void popshell(ident id, char *key, int code, void *arg)
{
   static bool state=FALSE;
   bool button=toflog(FALSE);

   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      if (state) {
         Slider(NULL, NULL, NULL, NULL);
         DescheduleKeyevent(&ncid);
         DescheduleKeyevent(&funid);
         GgiDelete(&shell);
         RadioDeleteGroup(&slgrp);
         shell = NULL;
         state = FALSE;
      } else {
         createshell(key);
         state = (bool)shell;
      }
      wkeyf(key);
   }
}

/* ========================================================================== */
/*                                 Param                                      */
/* -------------------------------------------------------------------------- */
/*  Initialize the parameter pop-up window.
 */
void Param(char *key)
{
   ScheduleKeyevent(popshell, key, KEYCHANGE, NULL);
   wkeyf(key);
   strcpy(popkey,key);
}
    
   
#<

#>            plotopt.c
/* plotopt.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#define NAME "Plot options"
#define  CLWID 100

#include "stddef.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "plotopt.h"

extern void gui_set_units(ident, char*, int, void*);

static char *widths[]={"_LINE", "1", "2", "3", "4", "5", "6", NULL};
static char *colors[]={"_LINE",
                       "White",
                       "Red",
                       "Green",
                       "Blue",
                       "Cyan",
                       "Magenta",
                       "Yellow",
                       "Orange",
                       "Greenyellow",
                       "Greencyan",
                       "Bluecyan",
                       "Bluemagenta",
                       "Redmagenta",
                       "Darkgray",
                       "Lightgray",
                       NULL}; 


/* -------------------------------------------------------------------------- */
/*                                 popshell                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler causing the shell to be popped up or down.
 */
static void popshell(ident id, char *key, int code, void *arg)
{  
   static bool state=FALSE;
   bool button=toflog(FALSE);
 
   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      GgiShowShell((ident)arg, !state);
      state = !state;
      wkeyf(key);
   }
}

/* -------------------------------------------------------------------------- */
/*                                 col_text                                   */
/* -------------------------------------------------------------------------- */
/* Keyword handler for setting labels in the color menus.
 */
static void col_text(ident id, char *key, int code, void *arg)
{
   fint index;
    
   (void)userfint(&index, 1, 2, key, " ");
   GgiSetLabel((ident)arg, colors[index], CLWID);
}

/* ========================================================================== */
/*                                 Plotopt                                    */
/* -------------------------------------------------------------------------- */
/*  Plotopt() creates a pop-up shell with plot options.
 */
void Plotopt(char *key)
{
   static ident s_plotopt;
   ident s_prev, f_box, f_tit, f_div, f_opt, f_col;
   ident closebut, applybut;
   
   ident l_titles;
   ident t_xtitle, t_ytitle, t_ttitle;
   ident t_viewp, t_ampr, l_dunit, b_fixr, t_pdens, t_csize, m_lwid, m_cwid;
   ident l_options;
   ident l_drawzero, b_drawzero, l_plotest, b_plotest, l_plotmed, b_plotmed,
         l_plotrms, b_plotrms, l_connect, b_connect;
   ident l_colors;
   ident l_colframe, m_colframe, l_colest, m_colest, l_colfit, m_colfit,
         l_colmed, m_colmed, l_colcon, m_colcon;

   s_plotopt = GgiShell(NAME);
   s_prev = GgiUseShell(s_plotopt);
   closebut = GgiSetLabel(GgiButton(key, "Close window"), "CLOSE", 0);
   applybut = GgiSetLabel(GgiButton("PLOTDATA=", "Re-draw plot"), "APPLY", 0);
   f_box = GgiForm(NAME, 2);
   GgiSetPosition(f_box, 0, NULL, 0, NULL);
   GgiSetPosition(closebut, 0, NULL, 0, f_box);
   GgiSetPosition(applybut, -GgiWidth(applybut)-4, f_box, 0, f_box);

   (void)GgiUseShell(f_box);
   f_tit = GgiForm(NAME,1);
   f_div = GgiForm(NAME,1);
   f_opt = GgiForm(NAME,1);
   f_col = GgiForm(NAME,1);
   GgiSetPosition(f_tit, 0, NULL,  0, NULL);
   GgiSetPosition(f_div, 0, NULL,  0, f_tit);
   GgiSetPosition(f_opt, 0, NULL,  0, f_div);
   GgiSetPosition(f_col, 0, f_opt, 0, f_div);
  
   (void)GgiUseShell(f_tit);
   l_titles   = GgiLabel("Titles:");
   t_ttitle   = GgiSetLabel(GgiTextField("TTITLE=", "Plot's top title", 35),
                            "Top ", 50);
   t_xtitle   = GgiSetLabel(GgiTextField("XTITLE=", "X-axis title", 35),
                            "X ", 50);
   t_ytitle   = GgiSetLabel(GgiTextField("YTITLE=", "Y-axis title", 35),
                            "Y ", 50);
   GgiSetPosition(l_titles, 0, NULL, 0, NULL);
   GgiSetPosition(t_ttitle, 0, NULL, 0, l_titles);
   GgiSetPosition(t_xtitle, 0, NULL, 0, t_ttitle);
   GgiSetPosition(t_ytitle, 0, NULL, 0, t_xtitle);
   GgiSetPosition(GgiCanvas(" ",1,1), 339, NULL, 0, NULL);


   (void)GgiUseShell(f_div);
   t_ampr  = GgiSetLabel(GgiTextField("AMPRANGE=",
             "Range in Y values", 10),
             "Ampl. range", 75);
   l_dunit =  GgiLabel("( )");
   b_fixr  = GgiSetLabel(GgiButton("FIXRANGE=", "Fix Y values range"),
                         "FIX", 0);
   (void)ScheduleKeyevent(gui_set_units, "DATAUNITS=", KEYCHANGE, l_dunit);
   t_viewp = GgiSetLabel(GgiTextField("VIEWPORT=", "Plot's viewport", 15),
                         "Viewport ", 75);
#if 0
   t_pdens = GgiSetLabel(GgiTextField("PLOTDENS=",
                         "Number of samples per curve", 5),
                         "Density ", 75);
#else
   t_pdens = NULL;
#endif
   t_csize = GgiSetLabel(GgiTextField("CHARSIZE=", "General character size", 5),
                         "Ch. size", 75);
   m_lwid  = GgiSetLabel(GgiMenu("LWIDTH=", "General line width", widths),
                         "Line width", 85);
   m_cwid  = GgiSetLabel(GgiMenu("LWIDTHCUR=", "Line width of curves", widths),
                         "Curve width", 85);
   GgiSetPosition(t_ampr,   0, NULL,    0, NULL);
   GgiSetPosition(l_dunit,  0, t_ampr,  0, NULL);
   GgiSetPosition(b_fixr, -GgiWidth(b_fixr), m_lwid, 0, NULL);
   GgiSetPosition(t_viewp,  0, NULL,    0, t_ampr);
#if 0
   GgiSetPosition(t_pdens,  0, NULL,    0, t_ampr);
#endif
   GgiSetPosition(t_csize,  0, t_pdens, 0, t_viewp);
   GgiSetPosition(m_lwid,  30, t_viewp, 0, t_ampr);
   GgiSetPosition(m_cwid,  30, t_viewp, 0, m_lwid);
   GgiSetPosition(GgiCanvas(" ",1,1), 339, NULL, 0, NULL);

   (void)GgiUseShell(f_opt);
   l_options  = GgiLabel("Options:");
   l_drawzero = GgiLabel("Draw zero level");
   b_drawzero = GgiSetLabel(GgiButton("DRAWZERO=", NULL), "", 0);
   l_plotest  = GgiLabel("Plot estimates");
   b_plotest  = GgiSetLabel(GgiButton("PLOTEST=", NULL), "", 0);
   l_plotmed  = GgiLabel("Plot MF profile");
   b_plotmed  = GgiSetLabel(GgiButton("PLOTMED=", NULL), "", 0);
   l_plotrms  = GgiLabel("Plot RMS levels");
   b_plotrms  = GgiSetLabel(GgiButton("PLOTRMS=", NULL), "", 0);
   l_connect  = GgiLabel("Connect data points");
   b_connect  = GgiSetLabel(GgiButton("CONNECT=", NULL), "", 0);
   GgiSetPosition(l_options,  0, NULL,       0, NULL);
   GgiSetPosition(b_drawzero, 0, NULL,       5, l_options);
   GgiSetPosition(l_drawzero, 0, b_drawzero, 5, l_options);
   GgiSetPosition(b_plotest,  0, NULL,       0, b_drawzero);
   GgiSetPosition(l_plotest,  0, b_plotest,  0, b_drawzero);
   GgiSetPosition(b_plotmed,  0, NULL,       0, b_plotest);
   GgiSetPosition(l_plotmed,  0, b_plotmed,  0, b_plotest);
   GgiSetPosition(b_plotrms,  0, NULL,       0, b_plotmed);
   GgiSetPosition(l_plotrms,  0, b_plotrms,  0, b_plotmed);
   GgiSetPosition(b_connect,  0, NULL,       0, b_plotrms);
   GgiSetPosition(l_connect,  0, b_connect,  0, b_plotrms);

   (void)GgiUseShell(f_col);
   l_colors = GgiLabel("Colors:");
   l_colframe = GgiLabel("Frame");
   m_colframe = GgiSetLabel(GgiMenu("COLFRAME=", NULL, colors), " ",CLWID);
   (void)ScheduleKeyevent(col_text, "COLFRAME=", KEYCHANGE, m_colframe);
   (void)TriggerKey("COLFRAME=");
   l_colest   = GgiLabel("Estimates");
   m_colest   = GgiSetLabel(GgiMenu("COLEST=", NULL, colors), " ", CLWID);
   (void)ScheduleKeyevent(col_text, "COLEST=", KEYCHANGE, m_colest);
   (void)TriggerKey("COLEST=");
   l_colfit   = GgiLabel("Fit");
   m_colfit   = GgiSetLabel(GgiMenu("COLFIT=", NULL, colors), " ", CLWID);
   (void)ScheduleKeyevent(col_text, "COLFIT=", KEYCHANGE, m_colfit);
   (void)TriggerKey("COLFIT=");
   l_colmed   = GgiLabel("MF profile");
   m_colmed   = GgiSetLabel(GgiMenu("COLMED=", NULL, colors), " ", CLWID);
   (void)ScheduleKeyevent(col_text, "COLMED=", KEYCHANGE, m_colmed);
   (void)TriggerKey("COLMED=");
   l_colcon   = GgiLabel("Conn. Lines");
   m_colcon   = GgiSetLabel(GgiMenu("COLCON=", NULL, colors), " ", CLWID);
   (void)ScheduleKeyevent(col_text, "COLCON=", KEYCHANGE, m_colcon);
   (void)TriggerKey("COLCON=");
   GgiSetPosition(l_colors,   0, NULL,       0, NULL);
   GgiSetPosition(m_colframe, 0, NULL,       5, l_colors);
   GgiSetPosition(l_colframe, 0, m_colframe, 5, l_colors);
   GgiSetPosition(m_colest,   0, NULL,       0, m_colframe);
   GgiSetPosition(l_colest,   0, m_colest,   0, m_colframe);
   GgiSetPosition(m_colfit,   0, NULL,       0, m_colest);
   GgiSetPosition(l_colfit,   0, m_colfit,   0, m_colest);
   GgiSetPosition(m_colmed,   0, NULL,       0, m_colfit);
   GgiSetPosition(l_colmed,   0, m_colmed,   0, m_colfit);
   GgiSetPosition(m_colcon,   0, NULL,       0, m_colmed);
   GgiSetPosition(l_colcon,   0, m_colmed,   0, m_colmed);

   (void)GgiUseShell(s_prev);
   ScheduleKeyevent(popshell, key, KEYCHANGE, s_plotopt);
}
#<

#>            outputresults.c
#include    "stdio.h"
#include    "stdlib.h"       /* Defines the ANSI C functions for number */
                             /* conversion, storage allocation, and similar tasks.*/
#include    "string.h"       /* Declares the ANSI C string functions*/
                             /* like:strcpy, strcat etc.*/
#include    "gipsyc.h"
#include    "math.h"         /* Declares the mathematical functions and macros.*/
#include    "float.h"
#include    "xgauprof.h"
#include    "keyevents.h"
#include    "setfblank.h"
#include    "time.h"
#include    "minmax1.h"
#include    "setdblank.h"
#include    "userfio.h"

#include    "gui.h"
#include    "ggi.h"
#include    "pgutils.h"
#include    "outputresults.h"


double gausshermiteh3h4( double, double *, int );



static void getredchi2( globaltype *g,
                        double     *chisq,
                        double     *redchisq )
/*------------------------------------------------------------*/
/* PURPOSE: Calculate Chi-squared for the gauss  parameters.  */
/*------------------------------------------------------------*/
{
   int     i;
   int     ndat = 0;
   fint    npar;
   int     freepars;
   fint    opt;
   double  chi2 = 0;


   npar = g->gaussiansfound * g->nvar + 3;

   freepars = 0;
   for (i = 0; i < npar; i++)
   {
      if (g->fixedfree[i] != 0)
         freepars++;
   }

   opt = FIEID*g->function  + g->gaussiansfound;

   for (i = 0; i < g->profilelen; i++)
   {
      double   delta;
      double   Yi = g->profiles[g->currentprofilenumber][i];
      double   Xi = g->xphys[i];      

      delta = Yi - funcd_c( &Xi, g->estimates, &npar, &opt );
      if (g->wdat[i] != 0.0)
      {
         chi2 += delta * delta * g->wdat[i];
         ndat++;
      }
   }

   *chisq   = chi2;
   /*----------------------------------------*/
   /* If the weights mode is uniform then    */
   /* the weights are equal to 1. For the    */
   /* chi2 reduced we have to modify the     */
   /* chi2 for sigma == rms.                 */
   /*----------------------------------------*/
   if (g->weights == UNIFORM_W)
      chi2 /= (g->rms)*(g->rms);
   
   *redchisq = chi2 / (ndat-freepars);
}




static double amp2area( double Amp,
                        double aD,
                        double aL )
/*------------------------------------------------------------*/
/* PURPOSE: Convert an amplitude to the area for a Voigt      */
/*          function.                                         */
/*------------------------------------------------------------*/
{
   double x, y, Rw, Iw;

   x = 0.0;
   y = aL * sqrt(log(2.0)) / aD;
   w( x, y, &Rw, &Iw );

   return(  aD * sqrt(PI/log(2.0)) / Rw );
}






static double fhergau( double  x,
                       double *A )
/*------------------------------------------------------------*/
/* PURPOSE: */
/*------------------------------------------------------------*/
{
    return( x*(x*(x*(x*(x*A[5]+A[4])+A[3])+A[2])+A[1])+A[0] );
}




static double bisection( double *A,
                         double x1,
                         double x2,
                         double xacc,
                         int    maxiters )
/*------------------------------------------------------------*/
/* PURPOSE: */
/*------------------------------------------------------------*/
{
   int    j;
   double dx, f, fmid, xmid, rtb;

   f = fhergau( x1, A);
   fmid = fhergau( x2, A );
   if (f*fmid >= 0.0)
   {
      gui_error( "Root must be bracketed for bisection" );
      return( 0.0 );
   }

   rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2);
   for (j = 1; j <= maxiters; j++)
   {
      fmid = fhergau( xmid=rtb+(dx *= 0.5), A );
      if (fmid <= 0.0)
         rtb = xmid;
      if (fabs(dx) < xacc || fmid == 0.0)
         return rtb;
   }
   gui_error( "Too many bisections in rtbis");
   return( 0.0 );
}



static void findhermitemax( double a,
                            double b,
                            double c,
                            double h3,
                            double h4,
                            double *gamp,
                            double *gcent )
/*------------------------------------------------------------*/
/* PURPOSE: Find the real max of the GH series.               */
/*                                                            */
/* We use the first derivative of the Gauss-Hermite function  */
/* to find the maximum around 'cent'.                         */
/* If F = (x-b)/c then the function for which we want the     */
/* the zero's is A0+A1*F+A2*F^2+A3*F^3+A4*F^4+A5*F^5 = 0      */
/* where A0 = -c1.h3  A1 = h4*(c0-2.0*c2) + 1.0               */
/* A2 = h3*(c1-3.0*c3) A3 = h4*(c2-4.0*c4) A4=c3.h3 A4=c4.h4  */
/*                                                            */
/* c0 = 1/4sqrt(6) c1 = -sqrt(3) c2 = -sqrt(6)                */
/* c3 = 2/3sqrt(3) c4 = 1/3sqrt(6)                            */
/*                                                            */
/*------------------------------------------------------------*/
{
   double  c0 = sqrt(6.0)/4.0, c1 = -sqrt(3.0), c2 = -sqrt(6.0);
   double  c3 = 2.0*sqrt(3.0)/3.0, c4 = sqrt(6.0)/3.0;
   double  A[6];
   double  xbix1 = b - c/2.0;
   double  xbis2 = b + c/2.0;
   double  acc = 1.0e-8;
   double  fpar[7];
   double  F = 0.0;
   int     maxiters = 100;

   A[0] = -c1*h3;
   A[1] = h4*(c0-2.0*c2) + 1.0;
   A[2] = h3*(c1-3.0*c3);
   A[3] = h4*(c2 - 4.0*c4);
   A[4] = c3*h3;
   A[5] = c4*h4;
   xbix1 = -0.5; xbis2 = 0.5;
   F = bisection( A, xbix1, xbis2, acc, maxiters );
   *gcent = c * F + b;
   fpar[0] = a; fpar[1] = b; fpar[2] = c; fpar[3] = h3; fpar[4] = h4;
   fpar[5] = fpar[6] = fpar[7] = 0.0;
   *gamp = gausshermiteh3h4( *gcent, fpar, 1 );              /* One component */
}




#ifdef IOIOIPIP
static void hermite2gauss( double a,
                           double b,
                           double c,
                           double h3,
                           double *gamp,
                           double *gcent,
                           double *gfwhm )
/*------------------------------------------------------------*/
/* PURPOSE: Convert Gauss-Hermite parameters to Gauss(like)   */
/*          parameters.                                       */
/*                                                            */
/* We use the first derivative of the Gauss-Hermite function  */
/* to find the maximum around 'cent'.                         */
/* If F = (x-b)/c then the function for which we want the     */
/* the zero's is A0+A1*F+A2*F^2+A3*F^3+A4*F^4+A5*F^5 = 0      */
/* where A0 = -c1.h3  B = -3A  D =-c2.h3 and C = -D-1         */
/* c1 = 2/3.sqrt(3) and c2 = sqrt(3)                          */
/*------------------------------------------------------------*/
{
   double  c1 = 2.0*sqrt(3.0)/3.0, c2 = sqrt(3.0);
   double  A, B, C, D;
   double  xbix1 = b - c/2.0;
   double  xbis2 = b + c/2.0;
   double  acc = 1.0e-8;
   double  fpar[7];
   double  F = 0.0;
   int     maxiters = 100;


   A = c1*h3;   B = -3.0*c1*h3-c2*h3;  C = 1.0;   D = c2*h3;
   xbix1 = -0.5; xbis2 = 0.5;
   F = bisection( A, xbix1, xbis2, acc, maxiters );
   *gcent = c * F + b;
   fpar[0] = a; fpar[1] = b; fpar[2] = c; fpar[3] = h3;
   fpar[4] = fpar[5] = fpar[6] = 0.0;
/*   *gamp = gausshermiteh3( *gcent, fpar, 1 );*/
   *gfwhm = a*c/(*gamp);
   /*anyoutf( 1, "amp cent fwhm=%g %g %g", *gamp, *gcent, *gfwhm );*/
}
#endif



static double getflux( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Get the area under the curves.                    */
/*------------------------------------------------------------*/
{
   double     flux= 0.0, sumflux = 0.0;
   double     dblank;
   int        i;


   setdblank_c( &dblank );


   for (i = 0; i < g->ncomp; i++)
   {
      int    offset = i*g->nvar;
      if (g->function == GAUSS)
      {
         /*--------------------------------------------------*/
         /* flux = area  = |disp| * Amp * sqrt(2PI)  or      */
         /* flux = 0.5 * A * FWHM * sqrt(PI/ln(2))           */
         /*--------------------------------------------------*/
         flux = g->estimates[offset+0] * ABS(g->estimates[offset+2])
                * sqrt(2.0*PI);
      }
      else if (g->function == GAUSSHERMITE1)
      {
         /*--------------------------------------------------*/
         /* Area = a.c.sqrt(2PI)                             */
         /*--------------------------------------------------*/
         flux = g->estimates[offset+0] * ABS(g->estimates[offset+2])
                * sqrt(2.0*PI);
      }
      else if (g->function == GAUSSHERMITE2)
      {
         /*--------------------------------------------------*/
         /* Area = a.c.sqrt(2PI) * (1+h4*sqrt(6)/4)          */
         /*--------------------------------------------------*/
         double a = g->estimates[offset+0];
         double c = g->estimates[offset+2];
         double h4 = g->estimates[offset+4];

         flux = a*c*sqrt(2.0*PI) * (1.0+h4*sqrt(6.0)/4.0);
      }
      if (g->function == VOIGT)
      {
         /*--------------------------------------------------*/
         /* First parameter is area                          */
         /*--------------------------------------------------*/
         flux = g->estimates[offset+0];
      }
      sumflux += flux;
   }
   return( sumflux );
}



void clearguilog( void )
/*------------------------------------------------------------*/
/* PURPOSE: Clear all the lines in the gui log. The max.      */
/* number of lines is defined by LOGLINES in gui.h            */
/*------------------------------------------------------------*/
{
   int i;
   for (i = 0; i < LOGLINES; i++)
   {
      gui_log( "", i );
   }
}



static void toguilog( char    *parname,
                      double  val,
                      double  err,
                      char    *units,
                      int     line )
/*------------------------------------------------------------*/
/* PURPOSE: Display fit results in gui log.                   */
/*------------------------------------------------------------*/
{
   int    p1;
   double power;
   double x = val;
   double dx = err;
   char   str[STRLEN];


   /* 'err' sets the precision */

   if (dx == 0.0)
      p1 = 0;
   else
      p1 = (int) log10( dx );
   if (p1 < 0) p1 -= 1;
   power = pow( 10.0, (double) p1);
   dx /= power;
   x /= power;
   if (p1 == 0)
      sprintf( str, "%-21s = %9.1f   +- %.1f (%s)",
               parname, x, dx, units );
   else
      sprintf( str, "%-21s = %6.1fe%+-4d +- %.1fe%+-d (%s)",
               parname, x, p1, dx, p1, units);
   gui_log( str, line );
}




static void myout( FILE  *fp,
                   char  *mes,
                   int   tofile,
                   int   line,
                   int   hardcopy )
/*------------------------------------------------------------*/
/* PURPOSE: Display text: GIPSY SCREEN, Ascii file or plot    */
/*------------------------------------------------------------*/
{   
   if (tofile < 0)
      return;
      
   if (hardcopy)
   {
      plottext( 0.0, line, mes );   
      return;
   }
      
   /* What if it is not for a hard copy? */
   if (tofile)
      fprintf( fp, "%s\n", mes );               /* To file */
   else 
      anyoutf( 3, mes );                        /* To GIPSY log and screen */
}




#define   MAXOUTPAR   40
#define   MAXPARLEN   15
extern void resulttolog( globaltype *g,
                         FILE       *fp )
/*------------------------------------------------------------*/
/* PURPOSE: Display fit results.                              */
/*------------------------------------------------------------*/
{
   char         *ptr;
   time_t       now;
   int          i, n;
   double       flux;
   double       chi2, rchi2;
   double       dblank;
   char         buf[256];
   int          tofile = (fp != NULL);
   int          guiline = 0;
   int          plotline = 0;
   int          hc = g->hardcopy;
   double       values[MAXGAUSS*MAXOUTPAR];
   char         hbuf[MAXGAUSS*MAXOUTPAR*MAXPARLEN];   /* Header buffer */
   int          tofileshort;


   strcpy( hbuf, "!" );   /* Start of comment == header of short format ascii file */
   setdblank_c( &dblank );
   now = time( NULL );
   ptr = ctime( &now );
   n = 0;
   tofileshort = (tofile && (g->fitfileformat == 0));
   if (tofileshort)
      tofile = -1;
   sprintf( buf, " " );
   myout( fp, buf, tofile, plotline++, hc );
   sprintf( buf, "=================== XGAUPROF FIT RESULTS ===================" );
   if (!hc)
      myout( fp, buf, tofile, plotline, hc );
   sprintf( buf, "Time & date         : %s", ptr );
   myout( fp, buf, tofile, plotline++, hc );
   
   if (g->importprofile)
   {
   sprintf( buf, "Data source         : File or table" );
   }
   else
   {
   sprintf( buf, "Set name            : %s", g->setname );
   myout( fp, buf, tofile, plotline++, hc );
   sprintf( buf, "Profile direction   : %s", g->profaxname );
   myout( fp, buf, tofile, plotline++, hc );
   sprintf( buf, "Profile position    : (%s) = (%s)", g->axisnames, g->positionstr );
   myout( fp, buf, tofile, plotline++, hc );
   }
   {
      char fname[STRLEN];
      if (g->function == GAUSS)         strcpy( fname, "Gauss function" );
      if (g->function == GAUSSHERMITE1) strcpy( fname, "Gauss-Hermite series with only h3!");
      if (g->function == GAUSSHERMITE2) strcpy( fname, "Gauss-Hermite series with h3 and h4" );
      if (g->function == VOIGT)         strcpy( fname, "Voigt line-shape" );
   sprintf( buf, "Fitted function     : %s", fname );
   myout( fp, buf, tofile, plotline++, hc );
   }

   /* No fit possible? Give message and return. */   
   if (g->iters < 0)
   {
      if (tofileshort)
      {
         fprintf( fp, "!No fit possible for this profile!\n" );
      }
      else
      {
         sprintf( buf, "       !!! No fit possible for this profile !!!" );
         myout( fp, buf, tofile, plotline++, hc ); 
         sprintf( buf, "==================== END OF FIT RESULTS ====================" );
         if (!hc)   
            myout( fp, buf, tofile, plotline, hc );
         sprintf( buf, " " );
         myout( fp, buf, tofile, plotline++, hc );
      }      
      return;      
   }
  

   flux = getflux( g );

   sprintf( buf, "Lsqfit iterations   : %d", g->iters );
   myout( fp, buf, tofile, plotline++, hc );
   
   getredchi2( g, &chi2, &rchi2 );  
   sprintf( buf, "Reduced Chi-squared : %g", rchi2 );
   myout( fp, buf, tofile, plotline++, hc );

   values[n++] = rchi2;
   strcat( hbuf, "RCHI2 |" );


   sprintf( buf, "Std. dev. residuals : %g", g->sigmaresidual );
   myout( fp, buf, tofile, plotline++, hc ); 
   values[n++] = g->sigmaresidual;
   strcat( hbuf, "SIG.RES |" ); 
   

   if (flux != dblank )
   {
   sprintf( buf, "Area                : %g", flux );
   myout( fp, buf, tofile, plotline++, hc );
   }
   sprintf( buf, " " );
   myout( fp, buf, tofile, plotline++, hc );


   for (i = 0; i < g->ncomp; i++)
   {
      int    offset = i*g->nvar;

      switch (g->function)
      {
         case GAUSS:
         {
            /*--------------------------------------------------*/
            /* Line strength Y:                                 */
            /* Y  = A.s.sqrt(2Pi)                               */
            /* dY = sqrt(2Pi) * sqrt{s^2.dA^2+A^2.ds^2}         */
            /*--------------------------------------------------*/
            {
               double A  = g->estimates[offset+0];
               double dA = ABS(g->errorpar[offset+0]);
               double s  = g->estimates[offset+2];
               double ds = ABS(g->errorpar[offset+2]);
               double Y, dY;

               Y  = A * s * sqrt(2.0*PI);
               dY = sqrt(2.0*PI) * sqrt( s*s*dA*dA + A*A*ds*ds );
               sprintf( buf, "%-22s = %10g +- %10g (%s x %s)",
                       "Line strength", Y, dY,
                        g->dataunits, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Line strength", Y, dY, "Area", guiline++ );
               values[n++] = Y;
               strcat( hbuf, "AREA | " );  
               values[n++] = dY;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Mean M = x0                                      */
            /*--------------------------------------------------*/
            {
               double M  = g->estimates[offset+1];
               double dM = ABS(g->errorpar[offset+1]);

               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Mean (center)", M, dM, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Mean (center)", M, dM, g->axunits, guiline++ );
               values[n++] = M;
               strcat( hbuf, "MEAN | " );  
               values[n++] = dM;               
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Dispersion D = s                                 */
            /*--------------------------------------------------*/
            {
               double D  = ABS(g->estimates[offset+2]);
               double dD = ABS(g->errorpar[offset+2]);
               double perc = ABS(g->ampperc);
               double lambda = perc/100.0;
               double w, dw;

               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Dispersion", D, dD, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = D;
               strcat( hbuf, "DISP. | " );
               values[n++] = dD;
               strcat( hbuf, "err | " );

               /*------------------------------*/
               /* Full Widths                  */
               /*------------------------------*/
               w = dw = 0.0;
               if (lambda != 0.0)
               {
                  double f = sqrt(2.0*log(1.0/lambda));
                  w  = 2.0 * D * f;
                  dw = 2.0 * dD * f;
               }
               if (lambda >= 1.0)
               {
                  w = dw = 0.0;
               }
               if (lambda <= 0.0)
               {
                  sprintf( buf, "%-22s = Infinity (%s)",
                          "Full Width at 0%", g->axunits );
                  myout( fp, buf, tofile, plotline++, hc );
                  toguilog( "Full Width at 0%", 0.0, 0.0, g->axunits, guiline++ );
                  values[n++] = -9999.9;                 
                  strcat( hbuf, "FW at 0% " );
               }
               else
               {
                  char  mes[30];
                  sprintf( mes, "Full Width at %g %", perc );
                  sprintf( buf, "%-22s = %10g +- %10g (%s)",
                           mes, w, dw, g->axunits );
                  myout( fp, buf, tofile, plotline++, hc );
                  toguilog( mes, w, dw, g->axunits, guiline++ );
                  values[n++] = w;  
                  {
                     char  xbuf[20];
                     sprintf( xbuf, "FW at %4.1f pct | ", perc );
                     strcat( hbuf, xbuf );
                  }
                  values[n++] = dw;
                  strcat( hbuf, "err | " );          
               }
            }
            /*--------------------------------------------------*/
            /* Amplitude = A                                    */
            /*--------------------------------------------------*/
            {
               double A  = g->estimates[offset+0];
               double dA = ABS(g->errorpar[offset+0]);

               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Amplitude", A, dA, g->dataunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Amplitude", A, dA, g->dataunits, guiline++ );
               values[n++] = A;
               strcat( hbuf, "AMPL. | " );
               values[n++] = dA;               
               strcat( hbuf, "err | " );
            }
            break;
         }
         case GAUSSHERMITE1:
         {
            sprintf( buf, "Function parameters  :" );
            myout( fp, buf, tofile, plotline++, hc );            
            /*--------------------------------------------------*/
            /* First list the parameters a,b,c & h3 of the      */
            /* function. Do NOT list in the gui.                */
            /*--------------------------------------------------*/
            {
               sprintf( buf, "%-22s = %10g +- %10g",
                        "a", g->estimates[offset+0], ABS(g->errorpar[offset+0]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+0];  
               strcat( hbuf, "a | " );
               values[n++] = ABS(g->errorpar[offset+0]);               
               strcat( hbuf, "err | " );
               
               sprintf( buf, "%-22s = %10g +- %10g",
                        "b", g->estimates[offset+1], ABS(g->errorpar[offset+1]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+1];
               strcat( hbuf, "b | " );
               values[n++] = ABS(g->errorpar[offset+1]);
               strcat( hbuf, "err | " );
               
               sprintf( buf, "%-22s = %10g +- %10g",
                        "c", g->estimates[offset+2], ABS(g->errorpar[offset+2]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+2];
               strcat( hbuf, "c | " );
               values[n++] = ABS(g->errorpar[offset+2]);               
               strcat( hbuf, "err | " );
               sprintf( buf, "%-22s = %10g +- %10g",
                        "h3", g->estimates[offset+3], ABS(g->errorpar[offset+3]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+3];
               strcat( hbuf, "h3 | " );
               values[n++] = ABS(g->errorpar[offset+3]);
               strcat( hbuf, "err | " );
            }
            sprintf( buf, " " );
            myout( fp, buf, tofile, plotline++, hc );
            sprintf( buf, "Profile parameters   :" );
            myout( fp, buf, tofile, plotline++, hc );            
            /*--------------------------------------------------*/
            /* Line strength Y:                                 */
            /* Y  = a.c.sqrt(2Pi) {1+h4.sqrt(6)/4} & h4 = 0     */
            /* dY = sqrt(2Pi) * sqrt{c^2.da^2+a^2.dc^2}         */
            /*--------------------------------------------------*/
            {
               double a = g->estimates[offset+0], c = g->estimates[offset+2];
               double da = ABS(g->errorpar[offset+0]), dc = ABS(g->errorpar[offset+2]);
               double Y, dY;

               Y  = a * c * sqrt(2.0*PI);
               dY =  sqrt(2.0*PI) * sqrt( c*c*da*da + a*a*dc*dc );
               sprintf( buf, "%-22s = %10g +- %10g (%s x %s)",
                       "Line strength", Y, dY, g->dataunits, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Line strength", Y, dY, "Area", guiline++ );
               values[n++] = Y;
               strcat( hbuf, "AREA | " );
               values[n++] = dY;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Mean M ~= b + h3*sqrt(3)                         */
            /*     dM  = sqrt{db^2+3h3^2dc^2}                   */
            /*--------------------------------------------------*/
            {
               double b = g->estimates[offset+1], c = g->estimates[offset+2];
               double db = ABS(g->errorpar[offset+1]), dc = ABS(g->errorpar[offset+2]);
               double h3 = g->estimates[offset+3], dh3 = ABS(g->errorpar[offset+3]);
               double M, dM;

               M  = b + sqrt(3.0)*h3*c;
               dM = sqrt( db*db + 3.0*h3*h3*dc*dc + 3.0*c*c*dh3*dh3 );
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Mean", M, dM, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Mean", M, dM, g->axunits, guiline++ );
               values[n++] = M;
               strcat( hbuf, "MEAN | " );
               values[n++] = dM;
               strcat( hbuf, "err | " );
            }

            /*--------------------------------------------------*/
            /* Dispersion D ~= c.{1-3h3^2},  h4 = 0. If we agree*/
            /* to give the values only to the lowest order of   */
            /* h3 then:                                         */
            /*            D = c                                 */
            /*           dD = dc                                */
            /*--------------------------------------------------*/
            {
               double c = g->estimates[offset+2], dc = ABS(g->errorpar[offset+2]);
               double D, dD;

               D = ABS(c);
               dD = dc;
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Dispersion", D, dD, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Dispersion", D, dD, g->axunits, guiline++ );
               values[n++] = D;
               strcat( hbuf, "DISP. | " );
               values[n++] = dD;
               strcat( hbuf, "err | " );            
            }

            /*--------------------------------------------------*/
            /* Coefficient of skewness: xi1 ~= 4*sqrt(3).h3     */
            /*--------------------------------------------------*/
            {
               double h3 = g->estimates[offset+3], dh3 = ABS(g->errorpar[offset+3]);
               double xi, dxi;
               double fac = 4.0 * sqrt(3.0);

               xi  = fac * h3;
               dxi = fac * dh3;
               sprintf( buf, "%-22s = %10g +- %10g",
                       "Coef. of Skewness", xi, dxi );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Coef. of Skewness", xi, dxi, "", guiline++ );
               values[n++] = xi;
               strcat( hbuf, "SKEW. | " );
               values[n++] = dxi;
               strcat( hbuf, "err | " );            
            }

            /*--------------------------------------------------*/
            /* Real maximum and position of real maximum.       */
            /* Use bisection of first derivative to x.          */
            /*--------------------------------------------------*/
            {
               double amp, cent;

               /* Max of function and position of max. */
               findhermitemax(g->estimates[offset+0],
                              g->estimates[offset+1],
                              g->estimates[offset+2],
                              g->estimates[offset+3],
                              0.0,
                              &amp, &cent );
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Amplitude", amp, ABS(g->errorpar[offset+0]), g->dataunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Amplitude", amp, ABS(g->errorpar[offset+0]), g->dataunits,
                         guiline++ );
               values[n++] = amp;
               strcat( hbuf, "AMPL. | " );
               values[n++] = ABS(g->errorpar[offset+0]);
               strcat( hbuf, "err | " );
               
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Position of max.", cent, ABS(g->errorpar[offset+1]), g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Position of max.", cent, ABS(g->errorpar[offset+1]),
                         g->axunits, guiline++ );
               values[n++] = cent;
               strcat( hbuf, "POS OF MAX. | " );
               values[n++] = ABS(g->errorpar[offset+1]);
               strcat( hbuf, "err | " );
            }
            break;
         }
         case GAUSSHERMITE2:
         {
            sprintf( buf, "Function parameters  :" );
            myout( fp, buf, tofile, plotline++, hc );            
            /*--------------------------------------------------*/
            /* First list the parameters a,b,c & h3 of the      */
            /* function. Do NOT list in the gui.                */
            /*--------------------------------------------------*/
            {
               sprintf( buf, "%-22s = %10g +- %10g",
                        "a", g->estimates[offset+0], ABS(g->errorpar[offset+0]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+0];
               strcat( hbuf, "a | " );
               values[n++] = ABS(g->errorpar[offset+0]);               
               strcat( hbuf, "err | " );
               
               sprintf( buf, "%-22s = %10g +- %10g",
                        "b", g->estimates[offset+1], ABS(g->errorpar[offset+1]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+1];
               strcat( hbuf, "b | " );
               values[n++] = ABS(g->errorpar[offset+1]);               
               strcat( hbuf, "err | " );
                              
               sprintf( buf, "%-22s = %10g +- %10g",
                        "c", g->estimates[offset+2], ABS(g->errorpar[offset+2]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+2];
               strcat( hbuf, "c | " );
               values[n++] = ABS(g->errorpar[offset+2]);               
               strcat( hbuf, "err | " );
                              
               sprintf( buf, "%-22s = %10g +- %10g",
                        "h3", g->estimates[offset+3], ABS(g->errorpar[offset+3]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+3];
               strcat( hbuf, "h3 | " );
               values[n++] = ABS(g->errorpar[offset+3]);               
               strcat( hbuf, "err | " );
                             
               sprintf( buf, "%-22s = %10g +- %10g",
                        "h4", g->estimates[offset+4], ABS(g->errorpar[offset+4]) );
               myout( fp, buf, tofile, plotline++, hc );
               values[n++] = g->estimates[offset+4];
               strcat( hbuf, "h4 | " );               
               values[n++] = ABS(g->errorpar[offset+4]);               
               strcat( hbuf, "err | " );                              
            }
            sprintf( buf, " " );
            myout( fp, buf, tofile, plotline++, hc );
            sprintf( buf, "Profile parameters   :" );
            myout( fp, buf, tofile, plotline++, hc );                        
            /*--------------------------------------------------*/
            /* Line strength Y:                                 */
            /* Y  = a.c.sqrt(2Pi) {1+h4.sqrt(6)/4}              */
            /* set f = {1+h4.sqrt(6)/4} then:                   */
            /* dY = sqrt(2Pi) * sqrt{c^2.f^2.da^2+a^2.f^2.dc^2+ */
            /*                       3/8*a^2.c^2.dh4^2 }        */
            /*--------------------------------------------------*/
            {
               double a = g->estimates[offset+0], c = g->estimates[offset+2];
               double da = ABS(g->errorpar[offset+0]), dc = ABS(g->errorpar[offset+2]);
               double h4 = g->estimates[offset+4], dh4 = ABS(g->errorpar[offset+4]);
               double Y, dY;
               double f;

               f = 1.0 + h4 * sqrt(6.0) / 4.0;
               Y  = a * c * f * sqrt(2.0*PI);
               dY = sqrt(2.0*PI) * sqrt( c*c*f*f*da*da + a*a*f*f*dc*dc +
                                         3.0*a*a*c*c*dh4*dh4/8.0 );
               sprintf( buf, "%-22s = %10g +- %10g (%s x %s)",
                       "Line strength", Y, dY, g->dataunits, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Line strength", Y, dY, "Area", guiline++ );
               values[n++] = Y;
               strcat( hbuf, "AREA | " );               
               values[n++] = dY;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Mean M ~= b + h3*sqrt(3)                         */
            /*     dM  = sqrt{db^2+3h3^2dc^2}                   */
            /*--------------------------------------------------*/
            {
               double b = g->estimates[offset+1], c = g->estimates[offset+2];
               double db = ABS(g->errorpar[offset+1]), dc = ABS(g->errorpar[offset+2]);
               double h3 = g->estimates[offset+3], dh3 = ABS(g->errorpar[offset+3]);
               double M, dM;

               M  = b + sqrt(3.0)*h3*c;
               dM = sqrt( db*db + 3.0*h3*h3*dc*dc + 3.0*c*c*dh3*dh3 );
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Mean", M, dM, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Mean", M, dM, g->axunits, guiline++ );
               values[n++] = M;
               strcat( hbuf, "MEAN | " );
               values[n++] = dM;
               strcat( hbuf, "err | " );               
            }

            /*--------------------------------------------------*/
            /* Disersion D ~= c.{1+h4*sqrt(6)}                  */
            /*          dD  = sqrt{ (1+h4.sqrt(6))^2.dc^2 +     */
            /*                       6c^2.dh4^2 }               */
            /*--------------------------------------------------*/
            {
               double c = g->estimates[offset+2], dc = ABS(g->errorpar[offset+2]);
               double h4 = g->estimates[offset+4], dh4 = ABS(g->errorpar[offset+4]);
               double D, dD;
               double fac;

               fac = 1.0 + h4*sqrt(6.0);
               D = ABS(c * fac);
               dD = sqrt( fac*fac*dc*dc + 6.0*c*c*dh4*dh4 );
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Dispersion", D, dD, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Dispersion", D, dD, g->axunits, guiline++ );
               values[n++] = D;
               strcat( hbuf, "DISP. | " );
               values[n++] = dD;
               strcat( hbuf, "err | " );            
            }

            /*--------------------------------------------------*/
            /* Coefficient of skewness: xi1 ~= 4*sqrt(3).h3     */
            /*--------------------------------------------------*/
            {
               double h3 = g->estimates[offset+3], dh3 = ABS(g->errorpar[offset+3]);
               double xi, dxi;
               double fac = 4.0 * sqrt(3.0);

               xi  = fac * h3;
               dxi = fac * dh3;
               sprintf( buf, "%-22s = %10g +- %10g",
                       "Coef. of Skewness", xi, dxi );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Coef. of Skewness", xi, dxi, "", guiline++ );
               values[n++] = xi;
               strcat( hbuf, "SKEW. | " );
               values[n++] = dxi;
               strcat( hbuf, "err | " );
            }

            /*----------------------------------------------------*/
            /* Coefficient of kurtosis: xi2 ~= 3 + 6.5*sqrt(6).h4 */
            /*----------------------------------------------------*/
            {
               double h4 = g->estimates[offset+4], dh4 = ABS(g->errorpar[offset+4]);
               double xi, dxi;
               double f = 8.0 * sqrt(6);

               xi  = f * h4;
               dxi = f * dh4;
               sprintf( buf, "%-22s = %10g +- %10g",
                       "Coef. of Kurtosis", xi, dxi );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Coef. of Kurtosis", xi, dxi, "", guiline++ );
               values[n++] = xi;
               strcat( hbuf, "KURT. | " );
               values[n++] = dxi;
               strcat( hbuf, "err | " );
            }

            /*--------------------------------------------------*/
            /* Real maximum and position of real maximum.       */
            /* Use bisection of first derivative to x.          */
            /*--------------------------------------------------*/
            {
               double amp, cent;
               findhermitemax(g->estimates[offset+0],
                              g->estimates[offset+1],
                              g->estimates[offset+2],
                              g->estimates[offset+3],
                              g->estimates[offset+4],
                              &amp, &cent );
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Amplitude", amp, ABS(g->errorpar[offset+0]), g->dataunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Amplitude", amp, ABS(g->errorpar[offset+0]), g->dataunits,
                         guiline++ );
               values[n++] = amp;
               strcat( hbuf, "AMPL. | " );
               values[n++] = ABS(g->errorpar[offset+0]); 
               strcat( hbuf, "err | " );
                        
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Pos. of max.", cent, ABS(g->errorpar[offset+1]), g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Pos. of max.", cent, ABS(g->errorpar[offset+1]),
                          g->axunits, guiline++ );
               values[n++] = cent;
               strcat( hbuf, "POS OF MAX. | " );               
               values[n++] = ABS(g->errorpar[offset+1]);
               strcat( hbuf, "err | " );
            }
            break;
         }
         case VOIGT:
         {
            /*--------------------------------------------------*/
            /* Line strength Y                                  */
            /*--------------------------------------------------*/
            {
               double Y  = g->estimates[offset+0];
               double dY = ABS(g->errorpar[offset+0]);
               sprintf( buf, "%-22s = %10g +- %10g (%s x %s)",
                       "Line strength", Y, dY,
                        g->dataunits, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Line strength", Y, dY, "Area", guiline++ );
               values[n++] = Y;
               strcat( hbuf, "AREA | " );
               values[n++] = dY;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Amplitude                                        */
            /* Transform Voigt Area to Amplitude                */
            /*--------------------------------------------------*/
            {
               double    aD    = g->estimates[offset+2];    /* The half widths */
               double    daD   = g->errorpar[offset+2];
               double    aL    = g->estimates[offset+3];
               double    Area  = g->estimates[offset+0];
               double    dArea = g->errorpar[offset+0];
               double    A, dA;

               A = Area / amp2area( Area, aD, aL );
               dA = A * sqrt( (daD*daD/aD/aD) + (dArea*dArea/Area/Area) );

               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                        "Amplitude", A, dA, g->dataunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Amplitude", A, dA, g->dataunits, guiline++ );
               values[n++] = A;
               strcat( hbuf, "AMPL. | " );
               values[n++] = dA;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Center                                           */
            /*--------------------------------------------------*/
            {
               double M  = g->estimates[offset+1];
               double dM = ABS(g->errorpar[offset+1]);
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                       "Position of max.", M, dM, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Mean (center)", M, dM, g->axunits, guiline++ );
               values[n++] = M;
               strcat( hbuf, "MEAN | " );
               values[n++] = dM;
               strcat( hbuf, "err | " );             
            }
            /*--------------------------------------------------*/
            /* Doppler FWHM                                     */
            /* Note that fit parameter was a Half Width         */
            /*--------------------------------------------------*/
            {
               double aD =  2.0*ABS(g->estimates[offset+2]);
               double daD = 2.0*ABS(g->errorpar[offset+2]);
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                        "Doppler FWHW!", aD, daD, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Doppler FWHW!", aD, daD, g->axunits, guiline++ );
               values[n++] = aD;
               strcat( hbuf, "DISP. | " );
               values[n++] = daD;
               strcat( hbuf, "err | " );
            }
            /*--------------------------------------------------*/
            /* Lorentz FWHM                                     */
            /* Note that fit parameter was a Half Width         */
            /*--------------------------------------------------*/
            {
               double aL =  2.0*ABS(g->estimates[offset+3]);
               double daL = 2.0*ABS(g->errorpar[offset+3]);
               sprintf( buf, "%-22s = %10g +- %10g (%s)",
                        "Lorentz FWHW!", aL, daL, g->axunits );
               myout( fp, buf, tofile, plotline++, hc );
               toguilog( "Lorentz FWHW!", aL, daL, g->axunits, guiline++ );
               values[n++] = aL;
               strcat( hbuf, "LORENTZ | " );
               values[n++] = daL;
               strcat( hbuf, "err | " );
            }
            break;
         }
         default:
         {
            anyoutf( 1, "Unknown function!" );
            gui_error( "Unknown function!" );
         }
      }
   }
   
   /*--------------------------------------------------*/
   /* Finally, list  the backround parameters.         */
   /*--------------------------------------------------*/
   sprintf( buf, " " );
   myout( fp, buf, tofile, plotline++, hc );
   sprintf( buf, "Background parameters:" );
   myout( fp, buf, tofile, plotline++, hc );
   sprintf( buf, "%-22s = %10g +- %10g (%s)",
            "Z0 (constant)",
            g->estimates[g->gaussiansfound*g->nvar],
            ABS(g->errorpar[g->gaussiansfound*g->nvar]),
            g->dataunits );
   myout( fp, buf, tofile, plotline++, hc );
   toguilog( "Z0 (constant)", g->estimates[g->gaussiansfound*g->nvar],
              ABS(g->errorpar[g->gaussiansfound*g->nvar]), g->dataunits,
              guiline++ );
   values[n++] = g->estimates[g->gaussiansfound*g->nvar];
   strcat( hbuf, "Z0 | " );
   values[n++] = ABS(g->errorpar[g->gaussiansfound*g->nvar]);
   strcat( hbuf, "err | " );

   sprintf( buf, "%-22s = %10g +- %10g (%s)",
            "Z1 (linear)",
            g->estimates[g->gaussiansfound*g->nvar+1],
            ABS(g->errorpar[g->gaussiansfound*g->nvar+1]),
            g->dataunits );
   myout( fp, buf, tofile, plotline++, hc );
   toguilog( "Z1 (linear)", g->estimates[g->gaussiansfound*g->nvar+1],
              ABS(g->errorpar[g->gaussiansfound*g->nvar+1]), g->dataunits,
              guiline++ );
   values[n++] = g->estimates[g->gaussiansfound*g->nvar+1];
   strcat( hbuf, "Z1 | " );
   values[n++] = ABS(g->errorpar[g->gaussiansfound*g->nvar+1]);              
   strcat( hbuf, "err | " );
   
   sprintf( buf, "%-22s = %10g +- %10g (%s)",
            "Z2 (quadratic)",
            g->estimates[g->gaussiansfound*g->nvar+2],
            ABS(g->errorpar[g->gaussiansfound*g->nvar+2]),
            g->dataunits );
   myout( fp, buf, tofile, plotline++, hc );
   toguilog( "Z2 (quadratic)", g->estimates[g->gaussiansfound*g->nvar+2],
              ABS(g->errorpar[g->gaussiansfound*g->nvar+2]), g->dataunits,
              guiline++ );
   values[n++] = g->estimates[g->gaussiansfound*g->nvar+2];
   strcat( hbuf, "Z2 | " );
   values[n++] = ABS(g->errorpar[g->gaussiansfound*g->nvar+2]);
   strcat( hbuf, "err | " );
                 
   sprintf( buf, "==================== END OF FIT RESULTS ====================" );
   if (!hc)   
      myout( fp, buf, tofile, plotline, hc );
   sprintf( buf, " " );
   myout( fp, buf, tofile, plotline++, hc );


   /*----------------------------------------*/
   /* Some messages for the gui only.        */
   /*----------------------------------------*/   
   {
      char mes[STRLEN];
      gui_error( "" );
      sprintf( mes, "Fit successful after %d iterations", g->iters );
      gui_status( mes, FIRSTLINE );
      if (flux != dblank)
         sprintf( mes, "Flux=%.4g   r.chi^2=%.4g   sig.res=%.4g   Tolerance=%.4g", 
                  flux, rchi2, g->sigmaresidual, g->tolerance );
      else
         sprintf( mes, "R-2chi^2=%.4g  sig.res=%.4g   Tolerance=%.4g", 
                  rchi2, g->sigmaresidual, g->tolerance );
      gui_status( mes, SECONDLINE );
   }


   /*----------------------------------------*/
   /* If user wants results in a file in so  */
   /* called short format, then put a table  */
   /* header only once in the file.          */
   /*----------------------------------------*/
   if (tofileshort && g->newheader)
   {
      /* Put the header in the file if this is the first line of output */
      fprintf( fp, "%s %s\n", hbuf, g->axisnames ); 
   }
   
   if (tofileshort && g->newheader)
      g->newheader = NO;   
   
   /*----------------------------------------*/ 
   /* If user wants results in a file in so  */
   /* called short format, then write the    */
   /* values of the parameters here.         */
   /*----------------------------------------*/ 
   if (tofileshort)
   {
      /* Max. 'MAXOUTPAR' variables for output. Field width is MAXPARLEN chars. */
      char   tbuf[MAXGAUSS*MAXOUTPAR*MAXPARLEN];
      strcpy( tbuf, "" );
      for (i = 0; i < n; i++)
      {
         char    sbuf[MAXPARLEN+1];
         sprintf( sbuf, "%10g ", values[i] );
         strcat( tbuf, sbuf );
      }
      fprintf( fp, "%s %s\n", tbuf, g->positionstr );
   }      
}
#undef   MAXPARLEN
#undef   MAXOUTPAR



extern void outputresults( globaltype *g )
/*------------------------------------------------------------*/
/* PURPOSE: Display fit results.                              */
/* This routine is called only for a hardcopy or if a user    */
/* wants to store the fit results to disk.                    */
/*------------------------------------------------------------*/
{
   resulttolog( g, NULL );
}
#<

#>            slider.c
/* slider.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands

Author: J.P. Terlouw
*/

#define NAME "Slider"

#include "gipsyc.h"
#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "ggi.h"
#include "slider.h"

static char  minpar[KEYLEN], maxpar[KEYLEN], valpar[KEYLEN];
static ident  minfun,  maxfun;

static ident t_min, gauge, t_max;
static float lowval=-1.0, highval=+1.0;
static bool active=FALSE;

/* -------------------------------------------------------------------------- */
/*                                 setlimit                                   */
/* -------------------------------------------------------------------------- */
/*  Keyword handler updating the gauge's limits.
 */
static void setlimit(ident id, char *key, int code, void *arg)
{
   (void)userfreal((float*)arg, 1, 2, key, " ");
   GgiSetRange(gauge, lowval, highval);
}

/* -------------------------------------------------------------------------- */
/*                                 selpar                                     */
/* -------------------------------------------------------------------------- */
/*  Keyword handler selecting the parameter to be manipulated.
 *  If the keyword value is empty, the elements are deactivated.
 */
static void selpar(ident id, char *key, int code, void *arg)
{
   char   cpar[KEYLEN+1];
   fchar  par;
   fint   nread;

   par.a = cpar; par.l = KEYLEN;
   nread = userftext(par, 2, key, " ");
   if (nread) {
      cpar[nread] = '\0';
      sprintf(valpar, "%s=",     cpar);       /* construct relevant keywords */
      sprintf(minpar, "%s_MIN=", cpar);
      sprintf(maxpar, "%s_MAX=", cpar);
      if (active) {
         DescheduleKeyevent(&minfun);         /* deschedule previous */
         DescheduleKeyevent(&maxfun);
      }
      GgiSetKeyword(t_min, minpar);           /* use new set of keywords */
      GgiSetKeyword(gauge, valpar);
      GgiSetKeyword(t_max, maxpar);
      TriggerKey(valpar);                     /* show value in gauge */
      GgiActivate(t_min);                     /* unlock elements */
      GgiActivate(gauge);
      GgiActivate(t_max);
      minfun = ScheduleKeyevent(setlimit, minpar, KEYCHANGE, &lowval);
      maxfun = ScheduleKeyevent(setlimit, maxpar, KEYCHANGE, &highval);
      (void)userfreal(&highval, 1, 2, maxpar, " ");
      (void)TriggerKey(minpar);               /* update limits */
      (void)TriggerKey(maxpar);
      active = TRUE;
   } else {
      if (active) {
         GgiDeactivate(t_max);                /* lock elements */
         GgiDeactivate(gauge);
         GgiDeactivate(t_min); 
         DescheduleKeyevent(&minfun);         /* deschedule min-max handlers */
         DescheduleKeyevent(&maxfun);
         active = FALSE;
      }
   }
}

/* ========================================================================== */
/*                                 Slider                                     */
/* -------------------------------------------------------------------------- */
/*  Slider() initializes the analog parameter control module.
 *  If the argument 'key' is NULL, the module is closed down.
 */
void Slider(char *key, ident shell, ident left, ident top)
{
   static ident reg=NULL;
   ident  s_prev;

   if (key) {
      s_prev  = GgiUseShell(shell);
      t_min   = GgiSetLabel(GgiTextField("SLI_DUM=", NULL, 6), "SLI:", 40);
      gauge   = GgiSetLabel(GgiGauge("SLI_DUM=", NULL, 200, -1.0, 1.0), " ", 1);
      GgiSetFormat(gauge, "%g");
      t_max   = GgiSetLabel(GgiTextField("SLI_DUM=", NULL, 6), " ", 1);
      GgiSetPosition(t_min,  8, left,  20, top);
      GgiSetPosition(gauge,  0, t_min, 20, top);
      GgiSetPosition(t_max,  0, gauge, 20, top);
      (void)GgiUseShell(s_prev);
      GgiDeactivate(t_min);                  /* elements initially locked */
      GgiDeactivate(gauge);
      GgiDeactivate(t_max);
      reg = ScheduleKeyevent(selpar, key, KEYCHANGE, NULL);
   } else {
      if (active) {
         DescheduleKeyevent(&minfun);
         DescheduleKeyevent(&maxfun);
         active = FALSE;
      }
      DescheduleKeyevent(&reg);
   }
}
#<

#>            hidden.c
/* hidden.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands


Author: J.P. Terlouw
*/

#define NAME "Miscellaneous options"

#define H_CRTA "Critical amplitude of gaussian. Estimates\n\
below this amplitude will be discarded."

#define H_CRTD "Critical dispersion (in physical coordinates) of gaussian.\n\
Smaller estimates will be discarded."

#define H_Q "Number of data points used for second order polynomial in \n\
'gauest' routine is 2Q + 1."

#define H_INCL "Only data along X axis within include range will\n\
be used for fit (default: use all data).\n\
Input in PHYSICAL coordinates."

#define H_CLIP "Only data along Y axis above clip (1 value) or\n\
data along Y axis within range (2 values) are\n\
used in fit."

#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "wkey.h"
#include "ggi.h"
#include "hidden.h"

#define New(type) ((type *)calloc(1,sizeof(type)))
#define NNew(n,type) ((type *)calloc(n,sizeof(type)))
#define Delete(x)  {free(x); x=NULL;}

static bool  initialized=FALSE;         /* initialized flag */
static ident s_hidden;                  /* hidden keywords shell     */
static ident i_box;

/* -------------------------------------------------------------------------- */
/*                                 initialize                                 */
/* -------------------------------------------------------------------------- */
/*  Create pop-up shell and its contents; schedule the appropriate handlers.
 */
static void initialize(char *key)
{
   ident closebut;
   ident l_lsq, l_est;
   ident tol, lab, mxit;
   ident incl, clip;
   ident crta, crtd, smf;
   ident l_ef, estf;

   s_hidden = GgiShell(NAME);
   (void)GgiUseShell(s_hidden);
   closebut = GgiSetLabel(GgiButton(key, "Close window"), "CLOSE", 0);
   i_box = GgiForm(NAME, 2);
   (void)GgiUseShell(i_box);
   l_lsq = GgiLabel("Least-squares options:");
   tol  = GgiSetLabel(GgiTextField("TOLERANCE=", "Convergence criterion", 9),
                      "Tolerance",85);
   lab  = GgiSetLabel(GgiTextField("LAB=", "Mixing parameter", 9),
                      "Lambda", 55);
   mxit = GgiSetLabel(GgiTextField("MAXITS=",
                                   "Max. number of iterations in lsq. fit", 5),
                      "Max. Its.",0);
   incl = GgiSetLabel(GgiTextField("INCLUDE=", H_INCL, 9), "Include range", 85);
   clip = GgiSetLabel(GgiTextField("CLIP=", H_CLIP, 9), "Clip", 55);   
   l_est = GgiLabel("Initial estimates options:");
   crta =  GgiSetLabel(GgiTextField("CRITAMP=", H_CRTA, 9), "Min. ampl.", 85);
   crtd =  GgiSetLabel(GgiTextField("CRITDISP=", H_CRTD, 9), "Min. disp.", 70);
   smf  =  GgiSetLabel(GgiTextField("Q=", H_Q, 9), "Q", 0);
   l_ef =  GgiSetLabel(GgiLabel(" "), "Median filter", 85);
   estf =  GgiSetLabel(GgiButton("ESTFILTER=", "(de)activate median filter for estimates"),
                       "  ",0);

   GgiSetPosition(l_lsq,  0, NULL,  0, NULL);
   GgiSetPosition(tol,    0, NULL,  0, l_lsq);
   GgiSetPosition(lab,    0, tol,   0, l_lsq);
   GgiSetPosition(mxit,   0, lab,   0, l_lsq);
   GgiSetPosition(incl,   0, NULL, 10, tol);
   GgiSetPosition(clip,   0, incl, 10, lab);   
   GgiSetPosition(l_est,  0, NULL, 10, incl);
   GgiSetPosition(crta,   0, NULL,  0, l_est);
   GgiSetPosition(crtd,   0, crta,  0, l_est);
   GgiSetPosition(smf ,   0, crtd,  0, l_est);
   GgiSetPosition(l_ef,   0, NULL,  0, crta);
   GgiSetPosition(estf,   0, l_ef,  0, crta);

   (void)GgiUseShell(s_hidden);
   GgiSetPosition(i_box,    0, NULL, 0, NULL);
   GgiSetPosition(closebut, 0, NULL, 0, i_box);
   (void)GgiUseShell(NULL);
   initialized = TRUE;
}

/* -------------------------------------------------------------------------- */
/*                                 hidden                                     */
/* -------------------------------------------------------------------------- */
/*  Keyword handler causing the shell to be popped up or down.
 */
static void hidden(ident id, char *key, int code, void *arg)
{
   static bool state=FALSE;
   bool button=FALSE;

   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      GgiShowShell(s_hidden, !state);
      state = !state;
      wkey_c(tofchar(key));
   }
}

/* ========================================================================== */
/*                                 Hidden                                     */
/* -------------------------------------------------------------------------- */
/*  Hidden() creates a pop-up shell for hidden keywords. The argument 'key'
 *  is the GIPSY keyword (type LOGICAL) which, when set to "YES", will
 *  cause the shell to be popped up or down.
 *  The same keyword is used for the <CLOSE> button in the shell.
 */
extern ident Hidden(char *key)
{
   initialize(key);
   ScheduleKeyevent(hidden, key, KEYCHANGE, NULL); 
   return s_hidden;
}

#<

#>            misopt.c
/* misopt.c
                              COPYRIGHT (c) 1999
                        Kapteyn Astronomical Institute
         University of Groningen  -  9700 AV Groningen, The Netherlands


Author: J.P. Terlouw
*/

#define NAME "Miscellaneous options"

#define H_AMPPERC "Widths are determined at this percentage of\n\
the maximum (only for standard gauss)."

#define H_RMS "R.m.s. of noise. Used only to\nscale reduced chi-squared."

#define H_FLIP "Flip data"

#include "stddef.h"
#include "stdio.h"
#include "gipsyc.h"
#include "userfio.h"
#include "wkey.h"
#include "ggi.h"
#include "misopt.h"

#define New(type) ((type *)calloc(1,sizeof(type)))
#define NNew(n,type) ((type *)calloc(n,sizeof(type)))
#define Delete(x)  {free(x); x=NULL;}

static bool  initialized=FALSE;         /* initialized flag */
static ident s_misopt;                  /* hidden keywords shell     */
static ident i_box;

/* -------------------------------------------------------------------------- */
/*                                 initialize                                 */
/* -------------------------------------------------------------------------- */
/*  Create pop-up shell and its contents; schedule the appropriate handlers.
 */
static void initialize(char *key)
{
   ident closebut;
   ident ampperc, flip;
   ident rms;

   s_misopt = GgiShell(NAME);
   (void)GgiUseShell(s_misopt);
   closebut = GgiSetLabel(GgiButton(key, "Close window"), "CLOSE", 0);
   i_box = GgiForm(NAME, 2);
   (void)GgiUseShell(i_box);
   ampperc = GgiSetLabel(GgiTextField("AMPPERC=", H_AMPPERC, 5), "Amp.%", 60);
   flip    = GgiButton("FLIP=", H_FLIP);
   rms     = GgiSetLabel(GgiTextField("RMS=", H_RMS, 5), "RMS", 60);

   GgiSetPosition(ampperc,  0, NULL,    0, NULL);
   GgiSetPosition(flip,    20, ampperc, 0, NULL);
   GgiSetPosition(rms,      0, NULL,    0, ampperc);


   (void)GgiUseShell(s_misopt);
   GgiSetPosition(i_box,    0, NULL, 0, NULL);
   GgiSetPosition(closebut, 0, NULL, 0, i_box);
   (void)GgiUseShell(NULL);
   initialized = TRUE;
}

/* -------------------------------------------------------------------------- */
/*                                 misopt                                     */
/* -------------------------------------------------------------------------- */
/*  Keyword handler causing the shell to be popped up or down.
 */
static void misopt(ident id, char *key, int code, void *arg)
{
   static bool state=FALSE;
   bool button=FALSE;

   (void)userflog(&button, 1, 2, key, " ");
   if (tobool(button)) {
      GgiShowShell(s_misopt, !state);
      state = !state;
      wkey_c(tofchar(key));
   }
}

/* ========================================================================== */
/*                                 Misopt                                     */
/* -------------------------------------------------------------------------- */
/*  Misopt() creates a pop-up shell for miscellaneous options. The argument
 *  is the GIPSY keyword (type LOGICAL) which, when set to "YES", will
 *  cause the shell to be popped up or down.
 *  The same keyword is used for the <CLOSE> button in the shell.
 */
extern ident Misopt(char *key)
{
   initialize(key);
   ScheduleKeyevent(misopt, key, KEYCHANGE, NULL); 
   return s_misopt;
}

#<
