text:
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @file tirific.c
   @brief Translation and recreation of tirific.f
   Is a code to apply simulated annealing fitting datacubes to a cube, currently in the gipsy environment.
   Guideline how to hack into it, without a guarantee:

   Check: interpinit, interpover

This was commented hdu stuff
   i) Introducing a new singular parameter:
   1. Chose a struct of the four loginf headerinf ringparms and fitparms to include the parameter as a component.
   2. Add the parameter into the identifyer list: Add the parameter identifyer as the last element in the first PRIMPOS list (after comment "Not in first header" but before "Third hdu"). Change all numbers in the PRIMPOS list (also after the comment) such that the numbers following the added identifyer are increased by 1. Increase the PRIMHDN_SINGLE symbolic constant by 1.
   3. Change the functions primpos_numtype() and primpos_value() hdl_init() by adding the new parameter at exactly the same place that it was added to the identifyer list.
   4. Go into the get_hdrinf(), get_loginf(), get_ringparms(), get_fitparms() functions and include the io of the parameter.
   5. Change the code as you like.

   ii) Introducing a new parameter for the second hdu (fit parameters)
   1. The place to add the parameter as a new component is the varlel struct
   2. Add the parameter into the identifyer list: Add the parameter identifyer as the last element in the second PRIMPOS list (before comment ""). Change all numbers in the PRIMPOS list (also after the comment) such that the numbers following the added identifyer are increased by 1. Include the parameter as a symbolic constant in the the _SECPOS list. Increase PRIMHDN_SINGLE symbolic constant by 1 and the SECHDN_MULTI by 1.
   3.  Change the functions primpos_numtype() and primpos_value() hdl_init() by adding the new parameter at exactly the same place that it was added to the identifyer list.
   4. Check the functions get_fitparms(), secpos_value(), fillhdvarele() for a correct handling of the new parameter, best by simply copying the lines concerning another parameter.
   5. That should be it. The parameter will be read and written and you can do what you like with it.

   iii) Introducing a new parameter for the third hdu
   1. Chose a struct of the four loginf headerinf ringparms and fitparms to include the parameter as a component, most likely to chose is the loginf struct that contains information about io.
   2. Add the parameter into the identifyer list: Add the parameter identifyer as the last element in the first PRIMPOS list (after comment "Third hdu"). Change all numbers in the PRIMPOS list (also after the comment) such that the numbers following the added identifyer are increased by 1. Increase the PRIMHDN_SINGLE symbolic constant by 1. Add in the same way a new identifyer to the _TABNR list and change the constant OUTTABNR
   3. Change the functions primpos_numtype() and primpos_value() hdl_init() by adding the new parameter at exactly the same place that it was added to the identifyer list.
   4. Check the functions prepout(), writeoutput(), open_hdu_3, create_hdu_3(), writeasctable() (Only a suggestion).
   5. Change the code as you like.

   iv) Adding a completely new ring parameter (such as dispersion)

   1. The place to add the parameter as a new component is the ringparms struct.
   2. Add the parameter into the identifyer list: Add the parameter identifyer as the last element in the  PXXXXX and XXXXX list. If it is a single parameter, change the NSPARAMS by adding 1, if it is a parameter for all rings, add 1 to the NPARAMS symbolic constant.
   3.  Change the function hdl_init() by adding the new parameter at exactly the same place that it was added to the identifyer list.
   4. Check the functions dparamtointern(), dinterntoparam(), simpleinterntoglob(), simpleglobtointern(), globtointern(), interntoglob(), changetointern(), get_ringparms(), writeoutarray() for a correct handling of the new parameter. Check the graphics descriptor functions gr_ ...
   5. That should be it. The parameter will be read and written and you can do what you like with it.

   @todo check if the position ange read from dataset is correct
   @todo think about the degrees of freedom at the start of metropolis
   @todo check for leakage about line 5000 (varlel ll may not be deallocated properly)
   @todo removed the automatic logfile length control in function open_hdu3() for stability reasons (it doesn't work) This has to be checked.
   @todo Made logfile specification necessary to run tirific, because it doesn't run properly without a logfile. Before searching bugs, check whether the possibility not to have a logfile should be removed entirely.
   @todo Error source sorting the file at the end of histout? Probably not...
   @todo coolgal was not working, for some inexplicable reason the program crashed calling convolgaussfft in gridnconvol. The temporal workaround is to accept a memory leak in the cubarithm routine padcubex (...)
   @todo There is a way to confuse the output routines for fitmode= 2. Take loops= 0. Then let it run once, then change the parameters and let it run a second time. Since I have no idea and this possibility is rather a relict, I leave it at that for now.

   @todo Last change was to include pointsource lists. The next thing
   to do is to get a generic enlargement of possible parameters. This
   will not happen for a while (the reason to write thigs down
   accurately). The new functions srprep() and srconst() gridpoint()
   that control the generation of a model already contain the
   parameter mode (which might be deleted, because there is a better
   variant). The plan is to run a check on starting time of the
   program, which calculations have to be done at runtime and control
   this by the use of pointers to functions that are in the ringparms
   struct. If e.g. a parameter is constant and will not be changed, a
   whole section of calculation can be omitted. The simplest example
   is the introduction of a vertical height of a disk. Calculations by
   adding something to z in srconst can be omitted, if the user has
   set this value uniformely to 0 and doesn't intend to change the
   height. The idea is to include a pointer to a function in the
   ringparms struct, that points to a function that either does the
   calculations or that does nothing. If now srprep or srconst is
   called, they will use the predefined pointers in a sensible series,
   doing either a calculation or nothing.

   @todo check for the necessity for a flushing of parameters in the function interpover

   $Source: /Volumes/DATA_J_II/data/CVS/tirific/src/tirific_new.c,v $
   $Date: 2011/05/25 22:25:26 $
   $Revision: 1.26 $
   $Author: jozsa $
   $Log: tirific_new.c,v $
   Revision 1.26  2011/05/25 22:25:26  jozsa
   Left work

   Revision 1.25  2011/05/11 13:37:12  jozsa
   Left work

   Revision 1.24  2011/05/10 00:30:16  jozsa
   Left work

   Revision 1.23  2011/05/04 01:51:03  jozsa
   test

   Revision 1.22  2011/05/04 01:08:25  jozsa
   Left work

   Revision 1.21  2011/05/04 01:03:41  jozsa
   several changes to make genfitting possible

   Revision 1.20  2011/03/23 22:32:29  jozsa
   removed hdu 1 and 2, with that all storage of input parameters, left simple check whether tirific has created the file

   Revision 1.19  2010/10/14 12:09:46  jozsa
   Bugfix: With multiple disks, chkchange did not recognise the disk number correctly

   Revision 1.18  2010/07/28 23:04:19  jozsa
   Left work

   Revision 1.17  2010/04/12 23:15:45  jozsa
   included a few things, next is correction of coolgal

   Revision 1.16  2010/04/01 09:24:19  jozsa
   included and hopefully debugged: radial/vertical movement/gradients of those in z/azimuthal harmonics in velocity and surface brightness. To do 1) subclouds 2) Gaussian variations in azimuth 3) portions of a disk 4) 4 disks

   Revision 1.15  2010/03/18 15:49:39  jozsa
   implemented interpolation over passive parameters: indexing; implemented new syntax for parameter specification

   Revision 1.14  2010/03/08 23:55:38  jozsa
   left work

   Revision 1.13  2010/03/02 08:23:08  jozsa
   several changes, from the following versions on hdu2 is only partially checked for changes against the .def file

   Revision 1.12  2009/08/04 16:28:33  jozsa
   Left work

   Revision 1.11  2009/05/27 15:07:38  jozsa
   Left work

   Revision 1.10  2008/10/10 15:42:40  jozsa
   Introduced radial motion VPS1=

   Revision 1.9  2008/07/30 16:22:42  jozsa
   Some issue with accuracy in fillhdvarele()

   Revision 1.8  2008/06/05 13:04:09  jozsa
   left work

   Revision 1.12  2008/02/18 16:47:23  gjozsa
   graphics SDIS output

   Revision 1.11  2008/02/13 16:43:47  gjozsa
   silly bug

   Revision 1.10  2008/01/16 11:17:24  gjozsa
   bugfix concerning sdis

   Revision 1.9  2008/01/09 17:50:50  gjozsa
   minor bug

   Revision 1.8  2008/01/09 17:25:52  gjozsa
   introduced ring-dependent dispersion without performance loss

   Revision 1.7  2007/08/23 15:23:26  gjozsa
   Left work

   Revision 1.5  2007/08/16 15:12:05  gjozsa
   Left work

   Revision 1.4  2007/08/15 16:28:23  gjozsa
   Left work

   Revision 1.3  2007/08/14 17:09:58  gjozsa
   Left work

   Revision 1.2  2007/07/25 17:17:09  gjozsa
   Left work

   Revision 1.1  2007/07/05 16:16:24  gjozsa
   added to cvs control

   Revision 1.66  2007/03/23 17:21:09  gjozsa
   Changed back the changes from rev. 1.64, instead corrected the gridding: If the velocity increases with channel number, the pa changes by 180 deg w.r.t version pre-1.64, otherways it stays. For post-1.64 one has to change the pa by changing its signum and adding or subtracting 180 deg.

   Revision 1.65  2007/02/23 10:28:10  gjozsa
   BUGFIX in tirout: Works now for TIRACC > 6. Enlargened accuracy in textlog.

   Revision 1.64  2007/01/17 15:54:52  gjozsa
   Changed coordinate system in srconst by mirroring pp[0] to get a right hand coordinate system. In order not to change the pa definition changed the conversion functions interntoglob globtointern etc. Also did some changes to the graphics functions of which I don't know the effect. One can spot the changes via searching for 180.0 and DEGTORAD in the source

   Revision 1.63  2006/12/11 12:42:07  gjozsa
   BUGFIX: removed reading beam from header: too much confusion

   Revision 1.62  2006/11/22 14:16:21  gjozsa
   Bugfix concerning RASH and horizontal/vertical lines

   Revision 1.61  2006/11/10 15:53:10  gjozsa
   minor bugfix

   Revision 1.60  2006/11/09 14:42:55  gjozsa
   minor change

   Revision 1.59  2006/11/08 14:05:03  gjozsa
   included line drawing with keywords GR_VERL_i GR_HORL_i GR_VLVA_i GR_HLVA_i GR_VLCA_i GR_HLCA_i

   Revision 1.58  2006/11/03 12:08:59  gjozsa
   Small bugfix

   Revision 1.57  2006/11/03 10:57:38  gjozsa
   Introduced logarithmic scaling keywords: GR_XLOG, GR_YLOG_i, introduced hms dms for xpos and ypos in graphics output, introduced keywords RFREQ (restfrequency in Hertz) and ITOU (conversion factor from intensity in Jy/squarearcsec in u/squarecentimeter), changed DOUBLE_ACCURACY to 3E-15 to account for near zero events

   Revision 1.56  2006/07/18 09:33:02  gjozsa
   Left work

   Revision 1.55  2006/04/11 11:46:00  gjozsa
   Removed the positive SBR restriction in input

   Revision 1.54  2006/04/06 10:40:25  gjozsa
   Bugfix: Call of engalmod_chflgs() after changing the input cube after chisquare initialisation

   Revision 1.53  2006/04/03 11:47:57  gjozsa
   Left work

   Revision 1.52  2005/10/12 14:50:59  gjozsa
   Not really a Bugfix: Corrected the calculation of the ring normal vector

   Revision 1.51  2005/10/12 09:53:45  gjozsa
   Included Brigg's plots

   Revision 1.50  2005/09/29 17:46:00  gjozsa
   BUGFIX in the golden_section() function: refreshing pointsource lists is a crucial point

   Revision 1.49  2005/08/25 10:15:05  gjozsa
   Slight bug in the plot routines

   Revision 1.48  2005/08/18 13:06:52  gjozsa
   Left work

   Revision 1.47  2005/08/15 13:15:03  gjozsa
   BUGFIX: At 12523, not copying to the par array will result in funny results, when the only output is a .def file. Don't know whether this will cause sequals

   Revision 1.45  2005/07/27 14:27:34  gjozsa
   Again improved the graphics output

   Revision 1.44  2005/07/27 14:01:30  gjozsa
   Improved the graphics output

   Revision 1.43  2005/06/28 13:28:08  gjozsa
   Changed the out of range behaviour in golden_section()

   Revision 1.42  2005/06/24 16:44:51  gjozsa
   added interpolation possibility for the TIRDEF= output, not yet for TIRSMOOTH=

   Revision 1.41  2005/06/24 12:00:30  gjozsa
   Left work

   Revision 1.43  2005/06/17 14:56:45  gjozsa
   Bugfix

   Revision 1.42  2005/06/17 14:50:45  gjozsa
   Bugfix

   Revision 1.41  2005/06/17 14:23:48  gjozsa
   Added penalty for outliers

   Revision 1.40  2005/06/13 10:40:29  gjozsa
   Added possibility just to examine results

   Revision 1.39  2005/06/09 14:07:45  gjozsa
   Left work

   Revision 1.38  2005/06/09 08:22:58  gjozsa
   BUGFIX: Multiple Parameter fitting was not working properly, fixed that
   Revision 1.37  2005/05/25 15:47:39  gjozsa
   Added inclinogram output

   Revision 1.36  2005/05/24 15:59:08  gjozsa
   Added LON and LMV to table output

   Revision 1.34  2005/05/24 10:42:03  gjozsa
   Included graphics

   Revision 1.33  2005/05/03 12:42:18  gjozsa
   Left work

   Revision 1.32  2005/04/28 12:44:44  gjozsa
   bugfix

   Revision 1.31  2005/04/28 10:13:47  gjozsa
   Full introduction of pointsource lists

   Revision 1.28  2005/04/26 11:44:53  gjozsa
   Seems to work

   Revision 1.25  2005/04/20 14:33:39  gjozsa
   bug

   Revision 1.24  2005/04/20 13:26:25  gjozsa
   Left work

   Revision 1.23  2005/04/19 13:58:50  gjozsa
   Left work

   Revision 1.22  2005/04/19 15:29:28  gjozsa
   Finished the output functions

   Revision 1.21  2005/04/19 10:59:13  gjozsa
   Extended the possibilities for the histogram output

   Revision 1.19  2005/04/19 07:44:43  gjozsa
   Left work

   Revision 1.18  2005/04/18 15:53:40  gjozsa
   Added histogram functions

   Revision 1.17  2005/04/18 15:02:02  gjozsa
   Included TIR functions

   Revision 1.16  2005/04/15 15:52:09  gjozsa
   Left work

   Revision 1.15  2005/04/15 15:39:13  gjozsa
   Bugfix: in fct get_ringparms, documented as BUGFIX , in fct decodestring, also reported

   Revision 1.14  2005/04/14 14:26:05  gjozsa
   Left work

   Revision 1.13  2005/04/14 10:32:16  gjozsa
   Left work

   Revision 1.10  2005/04/12 14:54:33  gjozsa
   Changed the character of PARMAX= and PARMIN=

   Revision 1.9  2005/04/11 14:23:37  gjozsa
   Left work

   Revision 1.8  2005/04/08 15:30:40  gjozsa
   Taking into account the whole cube now, no counting for the user

   Revision 1.7  2005/04/08 07:27:44  gjozsa
   Bugfixes

   Revision 1.6  2005/04/08 07:25:59  gjozsa
   Bugfixes

   Revision 1.5  2005/04/07 15:15:16  gjozsa
   Bugfix in galmod(): subring velocity was overwritten by a radius, I hacked a bit, not nic at the moment

   Revision 1.3  2005/04/06 15:46:25  gjozsa
   Bugfixes, included monitoring of golden_section

   Revision 1.2  2005/04/05 16:06:06  gjozsa
   Left work

   Revision 1.1  2005/04/05 11:07:37  gjozsa
   The former tiridev, officially release 1

   Revision 1.41  2005/04/04 08:42:09  gjozsa
   removed bug

   Revision 1.40  2005/04/01 15:31:54  gjozsa
   Introduced writecubup and a lot of debugging, check whether the output is not too large

   Revision 1.39  2005/03/29 15:56:24  gjozsa
   left work

   Revision 1.36  2005/03/25 18:17:20  gjozsa
   Left work

   Revision 1.35  2005/03/23 17:48:49  gjozsa
   Implemented hdu_3 support, seems to work

   Revision 1.32  2005/03/23 13:44:33  gjozsa
   Implemented and tested 2nd hdu i/o

   Revision 1.31  2005/03/22 17:48:07  gjozsa
   Left work

   Revision 1.30  2005/03/21 18:54:17  gjozsa
   Left work

   Revision 1.29  2005/03/19 17:55:52  gjozsa
   Left work

   Revision 1.26  2005/03/17 18:00:50  gjozsa
   Left work

   Revision 1.25  2005/03/16 17:52:00  gjozsa
   Left work

   Revision 1.23  2005/03/15 18:53:08  gjozsa
   Left work

   Revision 1.22  2005/03/15 17:28:59  gjozsa
   Last changes to get a clear program structure, not ideal, but ok. Some debugging, deleting the fortran thingies

   Revision 1.21  2005/03/12 16:48:33  gjozsa
   Removed all clutter from readringparms and associated structs

   Revision 1.19  2005/03/12 13:24:49  gjozsa
   Removed all clutter from hdrinit

   Revision 1.17  2005/03/12 11:37:46  gjozsa
   Rearranged completely galmod, debugged and tested version of new galmod, including convolution routines, changed position angle to angle with respect to minor

   Revision 1.16  2005/03/11 17:45:55  gjozsa
   Left work

   Revision 1.15  2005/03/10 17:56:39  gjozsa
   Left work

   Revision 1.13  2005/03/08 17:55:07  gjozsa
   Left work

   Revision 1.12  2005/03/05 17:56:09  gjozsa
   Left work

   Revision 1.11  2005/03/04 18:13:53  gjozsa
   Left work

   Revision 1.10  2005/03/03 18:00:49  gjozsa
   Left work

   Revision 1.9  2005/03/02 17:56:09  gjozsa
   Left work

   Revision 1.8  2005/03/01 17:46:21  gjozsa
   Left work

   Revision 1.6  2005/02/25 18:13:08  gjozsa
   Left work

   Revision 1.5  2005/02/25 13:34:29  gjozsa
   cube io finished

   Revision 1.4  2005/02/25 11:38:27  gjozsa
   Created a header struct

   Revision 1.3  2005/02/24 17:48:46  gjozsa
   Left work

*/
/* ------------------------------------------------------------ */

/*
               tirific.dc1

Program:       TIRIFIC (Version 2.3.11)

Purpose:       Fit a tilted-ring model to a datacube

Category:      FITTING

File:          tirific.c

Authors:       Gyula Jozsa
               Franz Kenn
               Tom Oosterloo
               Uli Klein

Tirific is a routine that fits a simple tilted-ring model to a
datacube INSET=. In this description we try to show all aspects of its
functionality, starting with a description how the program generates a
model datacube, how the goodness-of-fit is calculated, and what
possibilities exist to reach a "best-fit" model.

               ------------ !!!!NOTE!!!!  ------------

Tirific is still under construction and in a test phase and does not
yet implement all functionality that will be reached with time
moving. There are many betterments that are already on our todo list,
ranging from speed improvements to a completely different
user-interface. The tirific source is held extremely flexible, such
that any user can hack easily hack away, but in any case, we are open
for any suggestion (and one will of course be to introduce a
radius-dependent velocity dispersion) and wishes and especially, we
are happy about any bug report. For receiving update reports, critics,
wishes, bug reports, send a mail to:

jozsa@astron.nl

 */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* EXTERNAL INCLUDES */
/* ------------------------------------------------------------ */
#include <stdio.h>
#include <string.h>
#include <float.h>
#include <limits.h>
#include <sys/stat.h>
#include <gft.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_spline.h>
#ifdef OPENMPTIR
#include <omp.h>
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* INTERNAL INCLUDES */
/* ------------------------------------------------------------ */

/* This is generated by the makefile and contains the gipsy header
   files. I found no other than this disgusting way. If this module is
   being changed, the makefile has to be changed accordingly. I found
   no way around this */
/* #include "gipsylinc.c" */
#include <engalmod.h>
#include <maths.h>
#include <ftstab.h>
/* #include <ftsoutput.h> */
/* #include <gridnconvol.h> */
#include <cubarithm.h>
#include <pgp.h>
#include <simparse.h>
#include <fourat.h>
#include "opsystems.h"
#include <tirific_identifyers.h>
#include <tirific_defaults.h>

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @def _MEMORY_HERE_ON
   @brief Controls the use of the memory_here module

   If you don't want to use the memory_here facility comment this
   define, otherways it will be included.

*/
/* ------------------------------------------------------------ */
/* #define _MEMORY_HERE_ON */
/* #include <memory_here.h> */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* PRIVATE SYMBOLIC CONSTANTS */
/* ------------------------------------------------------------ */
#define MAXNUR 128
#define MAXNAX 5
#define MAXNSUBS 2048
#define MAXVARY MAXNUR*9+1

/* Primary beam correction, since I am not sure at all if this should end up in the final code ... */
/* #define PBCORR 1 */

#ifdef PBCORR

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PBNTELS
   @brief Number of telescopes for which primary beam correction can be done
*/
/* ------------------------------------------------------------ */
#define PBNTELS 2

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PBWSRT
   @brief Number of the WSRT for primary beam correction
*/
/* ------------------------------------------------------------ */
#define PBWSRT 1
#define PBWSRT_2 2

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PBWSRTCONST_1
   @brief Constant used for WSRT primary beam correction

   60.7492*pi/180/3600

*/
/* ------------------------------------------------------------ */
#define PBWSRTCONST_1 0.2945204323623329E-03

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PBWSRTCONST_2
   @brief Constant used for WSRT primary beam correction

   68*pi/180/3600

*/
/* ------------------------------------------------------------ */
#define PBWSRTCONST_2 0.3296733193565160E-03

/* primary beam correction end */
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define FLOAT_ACCURACY
   @brief Tolerance for floats
*/
/* ------------------------------------------------------------ */
#define FLOAT_ACCURACY 1.0E-7

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define DOUBLE_ACCURACY
   @brief Tolerance for floats
*/
/* ------------------------------------------------------------ */
#define DOUBLE_ACCURACY 4.0E-14

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define VARYSTRELES
   @brief Number of words in the varystr table in function readfit()
*/
/* ------------------------------------------------------------ */
#define VARYSTRELES 3000

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define VARYHSTRELES
   @brief Length of the varyhstr in function readfit()
*/
/* ------------------------------------------------------------ */
#define VARYHSTRELES 3000

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define MAXVERHOLINES
   @brief maximum of vertical and horizontal lines in graphout
*/
/* ------------------------------------------------------------ */
#define MAXVERHOLINES 10

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define NDISKS
   @brief Number of disks, given at compile time
*/
/* ------------------------------------------------------------ */
/* #define ndisks 2 */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define RA2AS
   @brief Conversion factor from rad to arcsec
*/
/* ------------------------------------------------------------ */
#define RA2AS 206264.8062470964

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define DEGTORAD
   @brief Conversion factor from deg to rad
*/
/* ------------------------------------------------------------ */
#define DEGTORAD 0.0174532925199433
#define RADTODEG 57.29577951308232
#define ARCSECTODEG  0.00027777777777777777778
#define DEGTOARCSEC 3600.

#define TWOPI 6.283185307179586
#define SQRTOFTWOPI 2.5066282746310005
#define PIHALF 1.570796326794897
#define SQRTOFPIHALF 0.886226925452758
#define HPBWTOSIGMATOFORTH 0.03252139032821276
#define SPEEDOFLIGHT 2.99792458E5
#define HIRESFREQ 1.420405751786E9
#define HICONVERSION 1.248683E24
#define UTOSOLAR 8.01325e-21
#define CONVTHREEDBEAM 2.412273945579840982
#define HUGE_DBL (DBL_MAX/100.)
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define BMAJ_PRIMPOS @brief Position of the value for BMAJ in the
   first description table, in case that it's not in the first header,
   identifyer for primpos_numtype()
*/
/* ------------------------------------------------------------ */
#define BMAJ_PRIMPOS      1
#define BMIN_PRIMPOS      2
#define BPA_PRIMPOS       3
#define RMS_PRIMPOS       4
#define NUR_PRIMPOS       5
#define RADSEP_PRIMPOS    6
#define WEIGHT_PRIMPOS    7
#define MODE_PRIMPOS      8
#define ISEED_PRIMPOS     9
#define LOOPS_PRIMPOS    10
#define NCORES_PRIMPOS   11
#define ISEED_2_PRIMPOS  12
#define ANSTART_PRIMPOS  13
#define ANEND_PRIMPOS    14
#define ANSTEPS_PRIMPOS  15
#define INIMODE_PRIMPOS  16
#define FITMODE_PRIMPOS  17
#define OUTCUBUP_PRIMPOS 18
#define DISTANCE_PRIMPOS 19
#define PENALTY_PRIMPOS  20
#define RFREQ_PRIMPOS    21
#define ITOU_PRIMPOS     22
#define MAXITER_PRIMPOS  23
#define CALLITE_PRIMPOS  24
#define SIZE_PRIMPOS     25
#define PSSE_PRIMPOS     26 /* PSWARM seed */
#define PSNP_PRIMPOS     27 /* PSWARM number of particles */
#define PSCO_PRIMPOS     28 /* PSWARM cognition parameter */
#define PSSO_PRIMPOS     29 /* PSWARM social parameter */
#define PSMV_PRIMPOS     30 /* PSWARM maximum velocity */
#define PSNF_PRIMPOS     31 /* PSWARM number of function evaluations to go from initial weight to final weight */
#define PSII_PRIMPOS     32 /* PSWARM initial weight */
#define PSFI_PRIMPOS     33 /* PSWARM final weight */
#define PSID_PRIMPOS     34 /* PSWARM increase delta */
#define PSDD_PRIMPOS     35 /* PSWARM decrease delta */
#define INTY_PRIMPOS     36 /* interpolation type */
#define INDINTY_PRIMPOS  37 /* interpolation type */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define LASTSING_PRIMPOS
   @brief Last entry in primpos not counted by disk
*/
/* ------------------------------------------------------------ */
#define LASTSING_PRIMPOS    37

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define #define LTYPE_MDPRIMPOS
   @brief Last entry in primpos not counted by disk
*/
/* ------------------------------------------------------------ */
#define LTYPE_MDPRIMPOS    1
#define CFLUX_MDPRIMPOS    2

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define NUMB_MDPRIMPOS
   @brief Number of primpos entries with multiple disks
*/
/* ------------------------------------------------------------ */
#define NUMB_MDPRIMPOS    2

/* #define cflux_primpos    (SIZE_PRIMPOS+LTYPE_MDPRIMPOS*ndisks) */

/* Not in first header */
/* #define PARMAX_PRIMPOS   (cflux_primpos+ndisks) */
/* #define PARMIN_PRIMPOS   (cflux_primpos+ndisks+1) */
/* #define MODERATE_PRIMPOS (cflux_primpos+ndisks+2) */
/* #define DELSTART_PRIMPOS (cflux_primpos+ndisks+3) */
/* #define DELEND_PRIMPOS   (cflux_primpos+ndisks+4) */
/* #define ITESTART_PRIMPOS (cflux_primpos+ndisks+5) */
/* #define ITEEND_PRIMPOS   (cflux_primpos+ndisks+6) */
/* #define SATDELT_PRIMPOS  (cflux_primpos+ndisks+7) */
/* #define MINDELTA_PRIMPOS (cflux_primpos+ndisks+8) */
/* #define ELEMENTS_PRIMPOS (cflux_primpos+ndisks+9) */

/* Third hdu */
/* #define CHISQ_PRIMPOS    (cflux_primpos+ndisks+10) */
/* #define RCHISQ_PRIMPOS   (cflux_primpos+ndisks+11) */
/* #define LOOPNR_PRIMPOS   (cflux_primpos+ndisks+12) */
/* #define ACCEPT_PRIMPOS   (cflux_primpos+ndisks+13) */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PRIMHDN_SINGLE
   @brief Number of first singular values in the first header
*/
/* ------------------------------------------------------------ */
/* #define PRIMHDN_SINGLE (LASTSING_PRIMPOS+NUMB_MDPRIMPOS*ndisks) */
/* #define PRIMHDN_SINGLE (cflux_primpos+ndisks) */
/* #define PRIMHDN_SINGLE (cflux_primpos+ndisks-1) */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PARMAX_SECPOS
   @brief Position of the value for BMAJ in the first description table
*/
/* ------------------------------------------------------------ */
/* #define PARMAX_SECPOS   1 */
/* #define PARMIN_SECPOS   2 */
/* #define MODERATE_SECPOS 3 */
/* #define DELSTART_SECPOS 4 */
/* #define DELEND_SECPOS   5 */
/* #define ITESTART_SECPOS 6 */
/* #define ITEEND_SECPOS   7 */
/* #define SATDELT_SECPOS  8 */
/* #define MINDELTA_SECPOS  9 */
/* #define ELEMENTS_SECPOS  10 */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define SECHDN_MULTI
   @brief Number of columns in the second header
*/
/* ------------------------------------------------------------ */
#define SECHDN_MULTI 10

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define CHISQ_TABNR
   @brief Position of the variable in the outarray after the par content
*/
/* ------------------------------------------------------------ */
#define CHISQ_TABNR  1
#define RCHISQ_TABNR 2
#define LOOPNR_TABNR 3
#define ACCEPT_TABNR 4

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define OUTTABNR
   @brief Number of additional entries in the outtab
*/
/* ------------------------------------------------------------ */
#define OUTTABNR 4

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define WANGLE_GRAPHNR
   @brief Description of a number of a special graphics output, note that the position in array is (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR), which is the old definition
*/
/* ------------------------------------------------------------ */
/* #define WA_GRAPHNR   (NPARAMS+(ndisks-1)*NDPARAMS+1) */
/* #define DENS_GRAPHNR (NPARAMS+(ndisks-1)*NDPARAMS+2) */
/* #define WOLD_GRAPHNR (NPARAMS+(ndisks-1)*NDPARAMS+3) */
/* #define TIP_GRAPHNR  (NPARAMS+(ndisks-1)*NDPARAMS+4) */
/* #define LON_GRAPHNR  (NPARAMS+(ndisks-1)*NDPARAMS+5) */
/* #define RASH_GRAPHNR (NPARAMS+(ndisks-1)*NDPARAMS+6) */
/* #define DESH_GRAPHNR (NPARAMS+(ndisks-1)*NDPARAMS+7) */

#define WA_GRAPHNR   1
#define DENS_GRAPHNR 2
#define WOLD_GRAPHNR 3
#define TIP_GRAPHNR  4
#define LON_GRAPHNR  5
#define RASH_GRAPHNR 6
#define DESH_GRAPHNR 7

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define MAXGRAPHS
   @brief Maximum allowed number of viewgraphs on one page
*/
/* ------------------------------------------------------------ */
#define MAXGRAPHS 20

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define GRAPHNR
   @brief Number of additional entries for graphics
*/
/* ------------------------------------------------------------ */
#define GRAPHNR 5

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define GR_INTERP_NUMLINES_DEFAULT
   @brief Number of interpolating lines in graphics when interpolating in a curved way (really not important)
*/
/* ------------------------------------------------------------ */
#define GR_INTERP_NUMLINES_DEFAULT 500

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define PSW_PSSE_DEF
   @brief Default value for PSSE parameter for pswarm

*/
/* ------------------------------------------------------------ */
#define PSW_PSSE_DEF 42    /* PSWARM seed */
#define PSW_PSNP_DEF 42	   /* PSWARM number of particles */
#define PSW_PSCO_DEF 0.5   /* PSWARM cognition parameter */
#define PSW_PSSO_DEF 0.5   /* PSWARM social parameter */
#define PSW_PSMV_DEF 0.5   /* PSWARM maximum velocity */
#define PSW_PSNF_DEF 8000  /* PSWARM number of function evaluations to go from initial weight to final weight */
#define PSW_PSII_DEF 0.9   /* PSWARM initial weight */
#define PSW_PSFI_DEF 0.4   /* PSWARM final weight */
#define PSW_PSID_DEF 2.	   /* PSWARM increase delta */
#define PSW_PSDD_DEF 0.5   /* PSWARM decrease delta */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define EXMAXMETRO
   @brief Maximum number of allowed attempts to make a model "out of range"

   The user has the possibility to give a minimum and a maximum for a
   given entry in the VARYSING and VARYMULT. If one of the parameters
   is changed to a value out of range, then the model will be
   discarded, and a new attempt will be done. To prevent an endless
   loop, the number of maximal attempts is given. chprm_metro will
   return 0 in that case.

*/
/* ------------------------------------------------------------ */
#define EXMAXMETRO 100000

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define MAGNIFICNR
   @brief The number with which the delta is multiplied with at most

   To make the iteration method a bit more effective, for each
   unsuccessful step to surround a minimum, the delta is multiplied
   with a number. After several steps, the number with which the
   original delta is multiplied is big. If we have repeated this enlargement
   MAGNIFICNR of times we won't do it anymore.
*/
/* ------------------------------------------------------------ */
#define MAGNIFICNR 100

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define AFAC
   @brief A constant needed for the golden section

   omega = (3-sqrt(5))/2 0.3819660112501052
   AFAC = (1-omega)/omega
   BFAC = 1-omega = omega/(1-omega)
*/
/* ------------------------------------------------------------ */
#define AFAC 1.618033988749894
#define BFAC 0.6180339887498948

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @define OUTRANGEFAC
   @brief Factor to multiply the chisquare by if out of range
*/
/* ------------------------------------------------------------ */
#define OUTRANGEFAC 2.0

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* PRIVATE MACROS */
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* PRIVATE STRUCTS */
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct loginf
   @brief Information about logfiles

   The struct contains all necessary information and the location of
   structures concerning logfiles.

*/
/* ------------------------------------------------------------ */
typedef struct loginf
{
  /** @brief Name of the logfile */
  char *logname;

  /** @brief Logfile present or not, 0 present, 1 not present */
  int logpres;

  /** @brief Name of the text logfile */
  char *textlog;

  /** @brief Name of the progress logfile Kamphuis addition*/
  char *progresslog;

  /** @brief Name of the output table */
  char *table;

  /** @brief Distance of object */
  double distance;

  /** @brief reference x position */
  double xref;

  /** @brief reference y position */
  double yref;

  /** @brief Stream of the text logfile */
  FILE *tstream;

  /** @brief An array of length nur*NPARAMS+nur*NDPARAMS+5 containing the output numbers */
  double *outarray;

  /** @brief An clone of outarray, supposed to contain any final values; the name is historical */
  double *grid;

  /** @brief An clone of outarray, supposed to contain any final errors; the name is historical */
  double *radius;

  /** @brief An clone of outarray */
  double *regist;

  /** @brief A signal for an encountered change */
  int changes;

  /** @brief Number of cores */
  int ncores;

} loginf;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct startinf
   @brief Information about the running status of the program

   The struct contains all control structures connected to rerunning
   tirific after a full fitting cycle. The idea is to check whether a
   file with the name startname has changed its last modified time
   stamp (most conveniently, the user can choose the .def file for
   that. Once this is done, tirific is rerun omitting the fft
   initialisation and the reading of inset and corresponding
   parameters.

*/
/* ------------------------------------------------------------ */
typedef struct startinf
{
  /** @brief all about text io */
  simparse_scn_arel **arel;

  /** @brief Name of the restart file */
  char *restartname;

  /** @brief Indicator if this is the first run or a consecutive one */
  int firstrun;

  /** @brief Indicator of the restartid */
  int restartid;

  /** @brief time stamp for file */
  time_t timestamp;

  /** @brief container for file statistics */
  struct stat *filestat;

} startinf;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct hdrinf
   @brief Information about a cube

   The struct contains all necessary information and the location of
   structures concerning a datacube that is needed by other functions
   in this module than hdr_init(). It is initialised by hdr_init. As
   memeory allocation has to take place as early as possible, this is
   done by hdr_init(). At the stage of hdr_init(), the chisquare
   evaluation will already being initialised, hence the struct
   contains the pointer to the chisquare, also.

*/
/* ------------------------------------------------------------ */
typedef struct hdrinf
{
  /** @brief O/I E The name of the input set */
  char *inset;

    /** @brief The outset name */
  char *outset;

  /** @brief Every outcubup loops there will be an update of the output cube */
  int outcubup;

  /** @brief axis numbers (obsolete) */
  /* int inaxperm[MAXNAX]; */

  /** @brief The reference pixels in the set */
  double setcrpix[3];

  /** @brief Conversion factor from grid units to userdeltunit */
  double deltgridtouser[3];

  /** @brief Conversion factor from grids to userglobunit */
  double globgridtouser[3];

  /** @brief Conversion factor from cuniti to userglobunit always [1., 1., 0.001] */
  double globsettouser[3];

  /** @brief The reference values in user units */
  double userglobcrval[3];

  /** @brief The cdelt values in user units */
  double userglobcdelt[3];

  /** @brief The signum of the velocity direction, this is positive if the velocity decreases with channels in the cube, since the internal velocity direction points to the observer */
  float signv;

  /** @brief Conversion factor from HI column density to intensity */
  double jygridtouser;

  /** @brief E O beam major and minor axis and beam position angle */
  float bmaj, bmin, bpa;

  /** @brief sigma rms in the map */
  float rms;

  /** @brief rest frequency */
  double rfreq;

  /** @brief conversion from Jy/sqarearcsecond to atoms per square centimeter */
  double itou;

  /** @brief E The size of the cube in axis 1 */
  int bsize1;

  /** @brief E The size of the cube in axis 1 */
  int bcsize1;

  /** @brief E The size of the cube in axis 2 */
  int bsize2;

  /** @brief The total number of pixels in one plane plus padding */
  int nprof;

  /** @brief E Number of subsets, that is the number of planes read */
  int nsubs;

   /** @brief So-called coordinate words describing axes (obsolete) */
  /* int *cwlo;  */

  /** @brief So-called coordinate words describing axes (obsolete) */
  /* int *cwhi; */

  /** @brief Coordinate description (coordinate words) of the subsets (planes) (obsolete) */
  /* int *insubs; */

  /** The input cube, full struct (done) */
  Cube *oric;

  /** The output cube, full struct (done) */
  Cube *modelc;

  /** The cool cube */
  Cube *coolcube;

  /** Half the size in z of the cool cube */
  float coolhalfc;

  /** nprof of the cool cube */
  int nprofcool;

  /** nprof of the cool cube */
  int coolbin;

  /** @brief The cube himself, pixels only (done) */
  /* float *ori; */

  /** @brief The model, pixels only (done) */
  /* float *model; */

  /** @brief The chisquare */
  double chi2;

  /** @brief An old chisquare */
  double oldchi2;

#ifdef PBCORR

  /** @brief Primary beam */
  float *primbeam;

#endif

} hdrinf;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct varlel
   @brief Element of a linked list, describing the change of the model

   varlel is an element of a linked list that describes the change of
   the model. Each element contains a list of numbers (int) that are
   the component numbers of the parameter in the par array of the
   ringparms struct, the number of adressed elements, and a delta
   which controls the variation of the parameters at a time.
*/
/* ------------------------------------------------------------ */
typedef struct varlel
{
  /** @brief The number of elements */
  int nelem;

  /** @brief numbers of the elements in the varlist */
  int *elements;

  /** @brief The parameter maximum */
  double parmax;

  /** @brief The parameter minimum */
  double parmin;

  /** @brief moderating steps */
  int moderate;

  /** @brief The starting delta */
  double delstart;

  /** @brief The end delta */
  double delend;

  /** @brief The starting number of iterations */
  double itestart;

  /** @brief The ending number of iterations */
  double iteend;

  /** @brief The delta for the satisfaction */
  double satdelt;

  /** @brief Delta to stop the iteration process */
  double mindelta;

  /** @brief Indicator for a change in genfit: 0 not changed, 1: change */
  int indicator;

  /** @brief The next element */
  struct varlel *next;
} varlel;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct srd
   @brief Sub-ring-descriptor

   Contains a preprocessed description of a subring, such as
   floating-point pre-calculations. Is touched by function srinit(),
 */
/* ------------------------------------------------------------ */
typedef struct srd
{
  /** @brief Sin of the inclination */
  float sini;

  /** @brief Cos of inclination */
  float cosi;

  /** @brief Sin of position angle */
  float sinp;

  /** @brief Cos of position angle */
  float cosp;

  /** @brief Sin velocity, 1st order */
  float vps1;

  /** @brief Cos velocity, 1st order */
  float vpc1;

  /** @brief Sin velocity, 2nd order */
  float vps2;

  /** @brief Cos velocity, 2nd order */
  float vpc2;

  /** @brief Sin velocity, 3rd order */
  float vps3;

  /** @brief Cos velocity, 3rd order */
  float vpc3;

  /** @brief Sin velocity, 4th order */
  float vps4;

  /** @brief Cos velocity, 4th order */
  float vpc4;

  /** @brief Sin velocity, 1st order */
  float ras1;

  /** @brief Cos velocity, 1st order */
  float rac1;

  /** @brief Sin velocity, 2nd order */
  float ras2;

  /** @brief Cos velocity, 2nd order */
  float rac2;

  /** @brief Sin velocity, 3rd order */
  float ras3;

  /** @brief Cos velocity, 3rd order */
  float rac3;

  /** @brief Sin velocity, 4th order */
  float ras4;

  /** @brief Cos velocity, 4th order */
  float rac4;

  /** @brief Sin velocity, 1st order */
  float ros1;

  /** @brief Cos velocity, 1st order */
  float roc1;

  /** @brief Sin velocity, 2nd order */
  float ros2;

  /** @brief Cos velocity, 2nd order */
  float roc2;

  /** @brief Sin velocity, 3rd order */
  float ros3;

  /** @brief Cos velocity, 3rd order */
  float roc3;

  /** @brief Sin velocity, 4th order */
  float ros4;

  /** @brief Cos velocity, 4th order */
  float roc4;

  /** @brief Sin warp, 1st order */
  float wps1;

  /** @brief Cos warp, 1st order */
  float wpc1;

  /** @brief Sin warp, 2nd order */
  float wps2;

  /** @brief Cos warp, 2nd order */
  float wpc2;

  /** @brief Sin warp, 3rd order */
  float wps3;

  /** @brief Cos warp, 3rd order */
  float wpc3;

  /** @brief Sin warp, 4th order */
  float wps4;

  /** @brief Cos warp, 4th order */
  float wpc4;

  /** @brief Inverse of the sum of absolute surface brightnesses, all modes */
  float sbrmax;

  /** @brief NORMALISED surface brightness, 0th order */
  float spb0;
  float sps1;
  float spc1;
  float sps2;
  float spc2;
  float sps3;
  float spc3;
  float sps4;
  float spc4;

  /** @brief Gaussian dispersion in radians */
  float gaudi[4];

  /** @brief allowed ranges in radians */
  float ranges[2][4];

  /** @brief indicator if out of range */
  int outofrange;

  /** @brief Number of pointsources */
  long n;

  /** @brief Number of pointsources from normal/harmonics calculation*/
  long nharmnorm;

  /** @brief Number of pointsources from Gaussian calculation */
  long ngaussian[4];

  /** @brief Number of pointsources with positive flux */
  long npos;

  /** @brief Number of pointsources with negative flux */
  long nneg;

  /** @brief Number of pointsources outside the cube */
  long outn;

  /** @brief Number of negative pointsources outside the cube */
/*   long outnpos; */

  /** @brief Number of positive pointsources outside the cube */
/*   long outnneg; */

#ifdef PBCORR
  /** @brief method to grid the point sources */
  void (*gridpoint)(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);

  /** @brief method to put the point sources onto the cube */
  int (*srput)(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid), struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#else
  /** @brief method to grid the point sources */
  void (*gridpoint)(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);

  /** @brief method to put the point sources onto the cube */
  int (*srput)(struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#endif

  /** @brief Flux of one pointsource */
  float pf;

  /** @brief Pointsource list, an array of pointers to points in the cube */
  float **pl;

#ifdef PBCORR
  /** @brief primary beam factor list, an array of floats, used for primary beam correction */
  float *pbfac;
#endif

  /** @brief length of pointsource list */
  long pllength;

  /** @brief Number of subclouds */
  int nsubcl;

  /** @brief Number of outliers (for parallel bookkeeping) */
  long outpoints;

  /** @brief Number of clouds equivalent to flux (positive minus negative, for parallel bookkeeping) */
  int allnpoints;

  /** @brief Number of clouds equivalent to flux (positive minus negative, for parallel bookkeeping) */
  long fluxpoints;

  /** @brief Number of subclouds, inverted */
  float nsubclinv;

  /** @brief The seed for random number generator (from ringparms) */
  int iseed2[2];

  /** @brief The seed for random number generator (from inf_smi) */
  int iseed[2];

  /** @brief The seed for random number generator (from inf_sdis) */
  int siseed[2];

  /** @brief The allocated permanent random generator (from inf_smi) */
  maths_rstrf *randstr;

  /** @brief The allocated permanent random generator (from inf_sdis) */
  maths_rstrf *srandstr;

  /** @brief The allocated permanent random generator (from ringparms) */
  maths_rstrf *permrandstr;

  /** @brief The allocated permanent random generator (from inf_gau) */
  maths_rstrf *grandstr[4];

  /** @brief Number saved for zprof */
  float y2;

} srd;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inlistel
   @brief A linked list of integers
 */
/* ------------------------------------------------------------ */
typedef struct inlistel
{
  int i;
  struct inlistel *next;
} inlistel;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_smi
   @brief struct to handle the harmonic terms in surface brightness
 */
/* ------------------------------------------------------------ */
typedef struct inf_smi {

  /** @brief The seed for random number generator */
  /* parallel changed this */ /* int iseed[2]; */

  /** @brief function initialising the rng */
  void (*rndmf_init)(void *rpm, int srnr, int disk);

  /** @brief The allocated permanent random generator */
  /* parallel changed this */   /* maths_rstrf *randstr; */

  /** @brief The function to prepare the subring variable sbrmax */
  void (*srprsbrmax)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, term zeroth order */
  void (*srprb0)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, sin term first order */
  void (*srprs1)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, cos term first order */
  void (*srprc1)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, sin term second order */
  void (*srprs2)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, cos term second order */
  void (*srprc2)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, sin term third order */
  void (*srprs3)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, cos term third order */
  void (*srprc3)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, sin term fourth order */
  void (*srprs4)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables, cos term fourth order */
  void (*srprc4)(void *rpm, int srnr, int disk);

  /** @brief The function to add the zeroth order term, sin component */
  void (*prb0)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the first order term, sin component */
  void (*prs1)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the first order term, cos component */
  void (*prc1)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the second order term, sin component */
  void (*prs2)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the second order term, cos component */
  void (*prc2)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the third order term, sin component */
  void (*prs3)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the third order term, cos component */
  void (*prc3)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the fourh order term, sin component */
  void (*prs4)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to add the fourth order term, cos component */
  void (*prc4)(void *rpm, float *flux, int srnr, float sinaz, float cosaz, int disk);

  /** @brief Function to determine the cloud number */
  void (*getcloudnumber) (void *rpm, int srnr, int disk);

  /** @brief Function returning azimuth and flux signum of new point source */
  void (*getaz)(void* rpm, float *az, float *cosaz, float *sinaz, int *signum, int srnr, int disk);

} inf_smi;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_gau
   @brief struct to handle the Gaussian terms in surface brightness
 */
/* ------------------------------------------------------------ */
typedef struct inf_gau {

  void (*srpr0) (void *rpm, int srnr, int i, int disk);
  void (*srpr1) (void *rpm, int srnr, int i, int disk);
  void (*srpr2) (void *rpm, int srnr, int i, int disk);
  void (*srpr3) (void *rpm, int srnr, int i, int disk);

  /** @brief function initialising the rng, nth Gaussian */
  void (*rndmf_init0)(void *rpm, int srnr, int i, int disk);
  void (*rndmf_init1)(void *rpm, int srnr, int i, int disk);
  void (*rndmf_init2)(void *rpm, int srnr, int i, int disk);
  void (*rndmf_init3)(void *rpm, int srnr, int i, int disk);

  /** @brief The allocated random generators */
     /* parallel changed this */ /* maths_rstrf *randstr[4]; */

  /** @brief Function to determine the cloud number */
  void (*getcloudnumber0) (void *rpm, int srnr, int i, int disk);
  void (*getcloudnumber1) (void *rpm, int srnr, int i, int disk);
  void (*getcloudnumber2) (void *rpm, int srnr, int i, int disk);
  void (*getcloudnumber3) (void *rpm, int srnr, int i, int disk);

} inf_gau;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_sdis
   @brief struct to handle the ring dependent dispersion
 */
/* ------------------------------------------------------------ */
typedef struct inf_sdis {

  /** @brief The seed for the velocity dispersional random number generator */
  /* parallel changed this */ /* int iseed[2]; */

  /** @brief The allocated permanent random generator */
  /* parallel changed this */ /* maths_rstrf *randstr; */

  /** @brief function initialising the dispersion rng */
  void (*rndmf_init)(void *rpm, int srnr, int disk);

  /** @brief The function to calculate the ring-dependent dispersion */
  void (*pr)(void *rpm, float *v, float *vold, int srnr, int disk);

  /** @brief The function to forward the rng */
  void (*pr_empty)(void *rpm, int srnr, int disk);

  /** @brief The function to calculate and grid the ring-dependent dispersion over and over again */
  void (*repeater)(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk);

  /** @brief The function to change the numbers of cloud flux and cloud number */
  void (*chclfl)(void *rpm, int srnr, int disk);

} inf_sdis;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_azi
   @brief struct to handle the ring dependent dispersion
 */
/* ------------------------------------------------------------ */
typedef struct inf_azi {

  /** @brief Preparing the ranges from the parameters and other things */
  void (*srpr0) (void *rpm, int srnr, int i, int disk);
  void (*srpr1) (void *rpm, int srnr, int i, int disk);

  /** @brief The function to check if a point source is accepted */
  void (*setoutrange)(int *outofrange);

  /** @brief The function to check if a point source is accepted */
  void (*pr0)(float *azi, float ranges[2][4], int *outofrange, int i);
  void (*pr1)(float *azi, float ranges[2][4], int *outofrange, int i);

  /** @brief The function to shape the point source */
  int (*srshape)(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk);

  /** @brief Function correcting for the point source number */
  void (*corrp)(void *rpm, int srnr, int *outofrange, int signum);
} inf_azi;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_vrad
   @brief struct to handle the vertical gradient in rotation velocity
 */
/* ------------------------------------------------------------ */
typedef struct inf_vrad {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

} inf_vrad;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_vver
   @brief struct to handle the vertical gradient in rotation velocity
 */
/* ------------------------------------------------------------ */
typedef struct inf_vver {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *v, int srnr, int disk);
  void (*pr_rota)(void *rpm, float *v, float *v2, int srnr, int disk);

} inf_vver;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_dvro
   @brief struct to handle the vertical gradient in rotation velocity
 */
/* ------------------------------------------------------------ */
typedef struct inf_dvro {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

} inf_dvro;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_dvra
   @brief struct to handle the vertical gradient in rotation velocity
 */
/* ------------------------------------------------------------ */
typedef struct inf_dvra {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

} inf_dvra;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_dvve
   @brief struct to handle the vertical gradient in rotation velocity
 */
/* ------------------------------------------------------------ */
typedef struct inf_dvve {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *point, int srnr, int disk);

} inf_dvve;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_vm0
   @brief struct to handle the planar s1 term
 */
/* ------------------------------------------------------------ */
typedef struct inf_vm0 {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

} inf_vm0;

typedef struct inf_vm1 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_vm1;

typedef struct inf_vm2 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_vm2;

typedef struct inf_vm3 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_vm3;

typedef struct inf_vm4 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_vm4;

typedef struct inf_ro1 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_ro1;

typedef struct inf_ro2 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_ro2;

typedef struct inf_ro3 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_ro3;

typedef struct inf_ro4 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_ro4;

typedef struct inf_ra1 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_ra1;

typedef struct inf_ra2 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_ra2;

typedef struct inf_ra3 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_ra3;

typedef struct inf_ra4 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_ra4;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @struct inf_wm0
   @brief struct to handle the planar s1 term
 */
/* ------------------------------------------------------------ */
typedef struct inf_wm0 {

  /** @brief The function to calculate the radial term */
  void (*pr)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
} inf_wm0;

typedef struct inf_wm1 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_wm1;

typedef struct inf_wm2 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);
} inf_wm2;

typedef struct inf_wm3 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_wm3;

typedef struct inf_wm4 {

  /** @brief The function to calculate the radial term, sin component */
  void (*prs)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to calculate the radial term, cos component */
  void (*prc)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprs)(void *rpm, int srnr, int disk);

  /** @brief The function to prepare the subring variables */
  void (*srprc)(void *rpm, int srnr, int disk);

} inf_wm4;

typedef struct inf_ls0 {

  /** @brief The function to calculate a shift along the major axis */
  void (*pr)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
} inf_ls0;

typedef struct inf_lc0 {

  /** @brief The function to calculate a shift along the major axis */
  void (*pr)(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
} inf_lc0;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @struct ringparms
   @brief All variables that are needed for the description of the rings

   @li @c float @c x  x position in arcsec (grids)
*/
/* ------------------------------------------------------------ */
typedef struct ringparms
{
  /** @brief Number of disks */
  int ndisks;

  /** @brief Number of rings */
  int nur;

  /** @brief Array of size nur*(NPARAMS+(ndisks-1)*NDPARAMS)+1 containing the parameters */
  double *par;

  /* Layer type */
  int *ltype;

  /** @brief Array of same size containing the previous parameters */
  double *oldpar;

  /** @brief Array tracking if a parameter has changed, for use in chkchange */
  int *chapar;

  /** @brief Subset separation in grids */
  double radsep;

  /** @brief number of subrings */
  int nr;

  /** @brief big version of par, for all subrings */
  float *modpar;

  /** @brief array of interpolation objects, for each parameter class one */
  gsl_interp **gsl_interparray;

  /** @brief array of interpolation lookup objects */
  gsl_interp_accel **gsl_interp_accelarray;

  /** @brief array of smoothing schemes for each parameter: 0: linear 1: spline 2: Akima */
  int *smothcar;

  /** @brief array of interpolation objects, for each parameter class one */
  gsl_interp **gsl_indinterparray;

  /** @brief array of interpolation lookup objects */
  gsl_interp_accel **gsl_indinterp_accelarray;

  /** @brief array of smoothing schemes for each parameter for indexing: 0: linear 1: spline 2: Akima */
  int *smothindcar;

  /** @brief dummy of size nur used in interpolation: array of binary values 1: active, 0: indexed */
  int *actarray;

  /** @brief dummy of size nur used in interpolation: array of indices of current parameter array */
  int *actindar;

  /** @brief dummy of size nur used in interpolation: input to interpolation function, y */
  double *interar;

  /** @brief dummy of size nur used in interpolation: input to interpolation function, x */
  double *radar;

  /** @brief Flux of one cloud */
  double *cflux;

  /** @brief Noise weighting */
  float weight;

  /** @brief Memory mode */
  int mode;

  /** @brief Initialisation mode */
  int inimode;

  /** @brief The allocated permanent random generator */
  /* parallel changed this */ /* maths_rstrf *permrandstr[ndisks]; */

  /** @brief One seed argument for the permanent random number generator */
  /* parallel changed this */ int iseed2;

  /** @brief A list of subring descriptors */
  srd **sd;

  /** @brief The number of pointsources outside the cube */
  long outpoints;

  /** @brief A dummy for use in writemodel */
  int *allnpoints;

  /** @brief A dummy for use in writemodel */
  long *fluxpoints;

  /** @brief The penalty for outlyers */
  double penalty;

  /** @brief The factor for penalties sigmax^2*sigmay^2/sigma_rms^2 */
  double penfact;

  /** @brief struct to handle the ring dispersion */
  inf_sdis **inf_sdisv;

  /** @brief structs to handle radial, vertical velocities and vertical gradients */
  inf_vrad  **inf_vradv;
  inf_vver  **inf_vverv;
  inf_dvro  **inf_dvrov;
  inf_dvra  **inf_dvrav;
  inf_dvve  **inf_dvvev;

  /** @brief struct to handle the planar s0 term */
  inf_vm0 **inf_vm0v;
  inf_vm1 **inf_vm1v;
  inf_vm2 **inf_vm2v;
  inf_vm3 **inf_vm3v;
  inf_vm4 **inf_vm4v;

  /** @brief struct to handle the planar s0 term */
  inf_ra1 **inf_ra1v;
  inf_ra2 **inf_ra2v;
  inf_ra3 **inf_ra3v;
  inf_ra4 **inf_ra4v;

  /** @brief struct to handle the planar s0 term */
  inf_ro1 **inf_ro1v;
  inf_ro2 **inf_ro2v;
  inf_ro3 **inf_ro3v;
  inf_ro4 **inf_ro4v;

  /** @brief struct to handle the warp s0 term */
  inf_wm0 **inf_wm0v;
  inf_wm1 **inf_wm1v;
  inf_wm2 **inf_wm2v;
  inf_wm3 **inf_wm3v;
  inf_wm4 **inf_wm4v;

  /** @brief struct to handle the lopsidedness sin and cos term */
  inf_ls0  **inf_ls0v;
  inf_lc0  **inf_lc0v;

  /** @brief struct to handle the surface brightness distribution */
  inf_smi  **inf_smiv;

  /** @brief struct to handle the surface brightness distribution, Gaussian arms */
  inf_gau  **inf_gauv;

  /** @brief struct to handle excluding ranges */
  inf_azi  **inf_aziv;

#ifdef PBCORR

  /** @brief Function to allocate the primary beam factor list */
  void (*alloc_pbcfac)(struct ringparms *rpm, int srnr, int disk);

  /** @brief Function to deallocate the primary beam factor list */
  void (*dealloc_pbcfac)(struct ringparms *rpm, int srnr, int disk);

  /** @brief Function to fill the primary beam factor list */
  void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid);

  /** @brief Function to fold in the primary beam factor list when constructing the cube*/
  void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid);

#endif

} ringparms;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @struct reg_cont
   @brief A container to handle regularisation

*/
/* ------------------------------------------------------------ */
typedef struct reg_cont
{
  /** @brief fourat container (see fourat.h) */
  fourat_container *fc;

  /** @brief Correct position in the par array */
  int posoffirst;

  /** @brief pointer to correct position in the par array */
  double *first;

  /** @brief start of the step for penalising */
  double regthre;

  /** @brief width of the step for penalising */
  double regwidt;

  /* amplitude of the step for penalising */
  double regampl;

  /* step for amplitude per loop */
  double regaste;

  /* step for amplitude per loop */
  double regampd;

  /** @brief ratio, for storage */
  double ratio;
} reg_cont;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @struct fitparms
   @brief All variables that are needed for the description of the fitting process

   @li @c float @c x  x position in arcsec (grids)
*/
/* ------------------------------------------------------------ */
typedef struct fitparms
{
  /** @brief The list for variation of parameters */
  varlel *varylist;

  /** @brief Number of models to compute */
  int loops;

  /** @brief Start annealing factor */
/*   double anstart; */

  /** @brief Stop annealing factor */
/*   double anend;  */

  /** @brief Annealing steps */
/*   int ansteps; */

  /** @brief The initialised normal random generator */
  maths_rstr *normrandstr;

  /** @brief Random number initialisation */
  int iseed[2];

  /** @brief The fitting procedure: 0: annealing, 1: golden section */
  int fitmode;

  /** @brief The number of the current loop minus one */
  long loopnr;

  /** @brief The number of models calculated, only in use for fitmode > 1 */
  long recnr;

  /** @brief An indicator if something is out of range */
  int outofrange;

  /** @brief The current number of pointsources */
  int *npoints;

  /** @brief The fitter */
  gft_mst *gft_mstv;

  /** @brief The container of additional arguments*/
  void *adar;

  /** @brief Total maximum iterations for gft */
  int maxiter;

  /** @brief Total maximum steps per iteration for gft */
  int callite;

  /** @brief Size of solution relative to minsteps (grid normalisation) */
  double size;

  /** @brief PSWARM seed */
  int psse;

  /** @brief PSWARM number of particles */
  int psnp;

  /** @brief PSWARM cognition parameter */
  double psco;

  /** @brief PSWARM social parameter */
  double psso;

  /** @brief PSWARM maximum velocity */
  double psmv;

  /** @brief PSWARM number of function evaluations to go from initial weight to final weight */
  int psnf;

  /** @brief PSWARM initial weight */
  double psii;

  /** @brief PSWARM final weight */
  double psfi;

  /** @brief PSWARM increase delta */
  double psid;

  /** @brief PSWARM decrease delta */
  double psdd;

  /** @brief The input of vary, saved for output */
  char *varyhstr;

  /** @brief  The index and dependencies*/
  decomp_inlist *index;

  /** @brief Monitoring: variable to report on the number of point sources contributing to flux*/
  long *fluxpoints;

  /** @brief  Container for regularisation */
  reg_cont **reg_contv;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_alloops;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_niters;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_iters;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_alliter;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_allcalls;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_calls_st;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_ncalls_st;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_maxiter;

  /** @brief Monitoring variable for use in genfit */
  size_t mon_loops;

  /** @brief Monitoring variable for use in genfit */
  double mon_bestchisq;

  /** @brief Monitoring variable for use in genfit */
  double mon_actchisq;

  /** @brief Monitoring variable for use in genfit */
  double mon_dsize;

  /** @brief Monitoring variable for use in genfit */
  double *mon_dpar;

  /** @brief Monitoring variable for use in genfit */
  double mon_stopsize;

  /** @brief Monitoring variable for use in genfit */
  double mon_size;

  /** @brief Monitoring variable for use in genfit */
  int mon_npar_cur;

  /** @brief Monitoring variable for use in genfit */
  int mon_npar;

  /** @brief Monitoring variable for use in genfit */
  int mon_ring;

  /** @brief Monitoring variable for use in genfit */
  int *mon_repnpoints;

  /** @brief Monitoring variable for use in genfit */
  double *mon_totalflux;

  /** @brief Monitoring variable for use in genfit */
  char mon_key[20];

  /** @brief degrees of freedom */
  double dof;

} fitparms;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @struct adar
   @brief additional arguments to be read by the fitting function passed to gft

   This is practically everything
*/
/* ------------------------------------------------------------ */
typedef struct adar
{
  /** @brief The startinf struct */
  startinf *startinfv;

  /** @brief The loginf struct */
  loginf *log;

  /** @brief The hdrinf struct */
  hdrinf *hdr;

  /* @brief The ring parameters */
  ringparms *rpm;

  /* @brief The fitparms struct */
  fitparms *fit;
} adar;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @struct vector
   @brief A threedimensional vector

   @li @c float @c x  x position in arcsec (grids)
*/
/* ------------------------------------------------------------ */
typedef struct vector
{
  /** @brief x component */
  double x;

  /** @brief y component */
  double y;

  /** @brief z component */
  double z;

} vector;

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* (PRIVATE) GLOBAL VARIABLES */
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @var errno
   @brief Needed by giplib for no obvious reason
*/
/* ------------------------------------------------------------ */
int errno;

/* Check for the beam read-in and the map unit read-in if changing this, also check function makecoolhdr() (obsolete) */
/* static char userdeltunit[] = "ARCSEC"; */
/* static char user3deltunit[] = "KM/S"; */
/* static char userglobunit[] = "DEGREE"; */
/* static char user3globunit[] = "KM/S"; */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* PRIVATE TYPEDEFS */
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* PRIVATE FUNCTION DECLARATIONS */
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int create_defaults_from_dcp(hdrinf * hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks, int fitmode)
   @brief Creates defaults from a decomp list

   The arrays need to be allocated and will be filled with the appropriate defaults depending on the contents of decomp_listelv.

   @param hdr (hdrinf *)    A header descriptor struct, properly filled.
   @param decomp_listelv (decomp_listel *) decomp array as returned by decomp_get() from the simparse module
   @param parmax         (double *)        Parameter maxima
   @param parmin         (double *)        Parameter minima
   @param moderate       (int *)           Moderate array
   @param delstart       (double *)        Delstart array
   @param delend         (double *)        Delend array
   @param itestart       (int *)           Itestart array
   @param iteend         (int *)           Iteend array
   @param satdelt        (double *)        Satdelt array
   @param mindelta       (double *)        Mindelta array
   @param nur            (int)             Number of rings
   @param ndisks         (int)             Number of disks
   @param fitmode        (int)             Fitmode

   @return (success) int create_varylist_from_dcp: 0
           (error)   1;
*/
/* ------------------------------------------------------------ */
static int create_defaults_from_dcp(hdrinf * hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks, int fitmode);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static  varlel *create_varylist_from_dcp(hdrinf * hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks)
   @brief Creates a varlel list from a decomp list

   The arrays need to be allocated and need to contain as many elements as input groups are recorded in decomp_listelv.

   @param hdr (hdrinf *)    A header descriptor struct, properly filled.
   @param decomp_listelv (decomp_listel *) decomp array as returned by decomp_get() from the simparse module
   @param parmax         (double *)        Parameter maxima
   @param parmin         (double *)        Parameter minima
   @param moderate       (int *)           Moderate array
   @param delstart       (double *)        Delstart array
   @param delend         (double *)        Delend array
   @param itestart       (int *)           Itestart array
   @param iteend         (int *)           Iteend array
   @param satdelt        (double *)        Satdelt array
   @param mindelta       (double *)        Mindelta array
   @param nur            (int)             Number of rings
   @param ndisks         (int)             Number of disks

   @return (success) varlel *create_varylist_from_dcp: NULL terminated varylist
           (error)   NULL;
*/
/* ------------------------------------------------------------ */
static  varlel *create_varylist_from_dcp(hdrinf * hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static char *gluetodecomp(char **inputofvarymult, char **inputofvarysing)
   @brief Creates a decomp-readable list from inputofvarymult and inputofvarysing

   For compatibility reasons, the VARYMULT= and VARYSING= parameters
   are still allowed. This creates a string from a char ** array as
   given by sparsenext that uses whitespaces to separate the input
   fields from varymult and varysing to create an equivalent string
   for the VARY= parameter.

   @param inputofvarysing  (char **) A NULL-terminated list of strings
   @param inputofvarymult  (char **) A NULL-terminated list of strings

   @return (success) gluetodecomp (char *) allocated array
           (error) NULL if memory allocation fails
*/
/* ------------------------------------------------------------ */
static char *gluetodecomp(char **inputofvarymult, char **inputofvarysing);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int writemodel(hdrinf *origin, ringparms *rpm, fitparms *fit, double *par, decomp_inlist *index);
   @brief Writes the model to the output

   @param origin (hdrinf *)       header info struct initialised by get_hdrinf()
   @param rpm    (ringparms *)    properly configured ringparms struct
   @param fit    (fitparms *)     properly configured fitparms struct
   @param par    (double *)       properly configured parameter list, the values of which get used
   @param index  (decomp_index *) index list as returned in simparse

   @return (success) 1;
           (error) 0;
*/
/* ------------------------------------------------------------ */
static int writemodel(hdrinf *origin, ringparms *rpm, fitparms *fit, double *par, decomp_inlist *index);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int anyout_tir(int *device, char *message)
   @brief wrapper to call anyout_c from gipsy

   For the description of the input parameters see GIPSY, char gets
   converted via fchar and int gets converted via cast to fint

   @param device       (int *) (dummy)
   @param message     (char *)
TIR_ONLY
  @return see anyout_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int anyout_tir(int *device, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int anyout_cor(FILE *device, char *message)
   @brief Print a message to device

   The function should be preferred to anyout_tir.

   @param device      (FILE *) the stream
   @param message     (char *) the message
TIR_ONLY
  @return compare anyout_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
/* static int anyout_cor(FILE *device, char *message); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int error_tir(int *device, char *message)
   @brief wrapper to call error_c from gipsy

   For the description of the input parameters see GIPSY, here: issue a message through stderr, abort only for *device == 4

   @param device       (int *)
   @param message     (char *)

TIR_ONLY

  @return see error_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int error_tir(int *device, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int cancel_tir(simparse_scn_arel **arel, char *parname, int depth)
   @brief cancelling user input

   This is basically synonymous to simparse_scn_arellist.

  @param simparse_scn_arellist (simparse_scn_arel **) Allocated simparse_scn_arel NULL-terminated list.
  @param key (char *) Key to remove
  @param depth (int)  Number of simparse_scn_arellist structs to correct, starting at 0. This can be used to e.g. correct the first two structs (e.g. user input and command line, but not any input file with depth = 1) only.

TIR_ONLY.

  @return see cancel_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int cancel_tir(simparse_scn_arel **arel, char *parname, int depth);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int userint_tir(simparse_scn_arel **arel, int *anarray, int *elements, int *defaultstat, char *keyword, char *message)
   @brief wrapper to call userchar_c from gipsy

   Attempt to get as close to the gipsy stuff as possible.

   @param arel        (simparse_scn_arel **)
   @param astring     (int *)
   @param elements    (int  *)
   @param defaultstat (int  *)
   @param keyword     (char *)
   @param message     (char *)

TIR_ONLY.

  @return see userint_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int userint_tir(simparse_scn_arel **arel, int *anarray, int *elements, int *defaultstat, char *keyword, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int userdble_tir(simparse_scn_arel **arel, double *anarray, int *elements, int *defaultstat, char *keyword, char *message)
   @brief wrapper to call userchar_c from gipsy

   Attempt to get as close to the gipsy stuff as possible.

   @param arel        (simparse_scn_arel **) Input struct.
   @param astring     (double *)
   @param elements    (int  *)
   @param defaultstat (int  *)
   @param keyword     (char *)
   @param message     (char *)

TIR_ONLY.

  @return see userint_c, return is casted to int, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int userdble_tir(simparse_scn_arel **arel, double *anarray, int *elements, int *defaultstat, char *keyword, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int userreal_tir(simparse_scn_arel **arel, float *anarray, int *elements, int *defaultstat, char *keyword, char *message)
   @brief wrapper to call userreal_c from gipsy

   For the description of the input parameters see GIPSY, char gets
   converted via fchar

   @param arel        (simparse_scn_arel **) Input struct.
   @param anarray     (float *)
   @param elements    (int  *)
   @param defaultstat (int  *)
   @param keyword     (char *)
   @param message     (char *)

TIR_ONLY.

  @return see userreal_c, -1 on memory problems
*/
/* ------------------------------------------------------------ */
static int userreal_tir(simparse_scn_arel **arel, float *anarray, int *elements, int *defaultstat, char *keyword, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double gchsq_gen_start(double *vector, void *rest);
   @brief function passed to gft

   The function receives a vector of fit parameters from the gft
   module and returns the chisquare. Used only once on initialisation of the fitter.

   @param vector (double *)  An array of fit parameters
   @param rest   (void *)    concealed adar struct
   @return double gchsq_gen  The chisquared
*/
/* ------------------------------------------------------------ */
static double gchsq_gen_start(double *vector, void *rest);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double gchsq_gen(double *vector, void *rest);
   @brief function passed to gft

   The function receives a vector of fit parameters from the gft
   module and returns the chisquare.  rest is a concealed adar struct
   that contains the necessary connections to the fit parameters. In
   case of an interrupted fitting process, this routine will read the
   logfile instead of producing a real fit. If the recovery of
   information has finished, the function replaces itself by
   gchsq_gen2, the "real" function to get the chisquare.

   @param vector (double *)  An array of fit parameters
   @param rest   (void *)    concealed adar struct
   @return double gchsq_gen  The chisquared
*/
/* ------------------------------------------------------------ */
static double gchsq_gen(double *vector, void *rest);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double gchsq_gen2(double *vector, void *rest);
   @brief function passed to gft

   The function receives a vector of fit parameters from the gft
   module and returns the chisquare (checking for constraints in
   parameter space), producing an appropriate output to the logfile,
   the textlog, the screen, and occasionally a best-fit data cube.
   rest is a concealed adar struct that contains the necessary
   connections to the fit parameters.

   @param vector (double *)  An array of fit parameters
   @param rest   (void *)    concealed adar struct
   @return double gchsq_gen  The chisquared
*/
/* ------------------------------------------------------------ */
static double gchsq_gen2(double *vector, void *rest);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static loginf *create_loginf(void)
   @brief Creates a loginf structure

   Creates a hdrinf structure allocating and if necessary initialising
   all structs and arrays.

   @return (success) hdrinf create_hdrinf: Allocated and initialised
   hdrinf struct\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static loginf *create_loginf(void);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_loginf(loginf *hdr, int ndisks)
   @brief Destroys a loginf structure

   Destroys a loginf structure deallocating all arrays. A
   non-allocated array has to be terminated (has to have a NULL value)
   to get the function work properly.

   @param hdr (loginf *) A loginf struct to be destroyed
   @param ndisks (int)   Number of disks, only used in function call hdl_init()

   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_loginf(loginf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static loginf *get_loginf(startinf *startinfv, loginf *loginfv)
   @brief Initialisation of the program concerning logfiles

   Takes over all logfile related io, returns an allocated loginf struct.

   @return (success) loginf *get_loginf: A loginf struct with the acquired info
           (error) NULL
*/
/* ------------------------------------------------------------ */
static loginf *get_loginf(startinf *startinfv, loginf *loginfv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static startinf *create_startinf(void)
   @brief Creates a startinf structure

   Creates a hdrinf structure allocating and if necessary initialising
   all structs and arrays.

   @return (success) startinf create_startinf: Allocated and initialised
   startinf struct\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static startinf *create_startinf(void);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_startinf(startinf *startinfv, int ndisks)
   @brief Destroys a startinf structure

   Destroys a startinf structure deallocating all arrays. A
   non-allocated array has to be terminated (has to have a NULL value)
   to get the function work properly.

   @param startinfv (startinf *) A startinf struct to be destroyed
   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_startinf(startinf *startinfv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static startinf *get_startinf(int argc, char **argv)
   @brief Initialisation of the program concerning restart information

   Takes over all startfile related io, returns an allocated startinf struct. Starts command line and file io.

   @param argc (int) Number of command line arguments (as argument to main)
   @param argv (char *) Array of command line arguments

   @return (success) startinf *get_startinf: A startinf struct with the acquired info
           (error) NULL
*/
/* ------------------------------------------------------------ */
static startinf *get_startinf(int argc, char **argv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static int check_restart(startinf *startinfv, hdrinf *hdr, ringparms *rpm, loginf *log)
   @brief Checks switches and returns an answer whether to restart

   Takes as an input a pointer to a (properly allocated) startinf
   struct and returns an answer whether to restart. If restart, checks
   if rpm -> par needs to be put into intern status. If NULL is passed
   for rpm, then this will not be done. If rpm is not NULL, then it
   needs to be properly allocated. hdr and log must be properly allocated and filled if rpm <> 0

   1: The restartfile is read out, and checked for existence or the firstrun switch is set to 1.
   0: If restartfile is not defined or not existent and firstrun = 0

   @param startinfv (startinf *) A startinf struct to be destroyed
   @param hdr (hdrinf *) A hdr descriptor struct, properly filled.
   @param rpm (ringparms *) A ring parameter descriptor struct, properly filled or NULL
   @param log (loginf *)    A log descriptor struct, properly filled or NULL

   @return (success) 1 if a restart is appropriate
           (error) 0 if stopping is recommended
*/
/* ------------------------------------------------------------ */
static int check_restart(startinf *startinfv, hdrinf *hdr, ringparms *rpm, loginf *log);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void loop_restart(startinf *startinfv)
   @brief Check if restartfile exists and loop until its last change time stamp has changed with respect to the value stored in startinfv, make some switches afterwards

   Set the value of firstrun in startinfv to 0. Check if restartfile
   has been defined in startinfv, and check if a time stamp can be
   retrieved. If either one or the other fails, return (leading to a
   breakout of the restart loop via function check_restart). If
   successful, repeat time stamp request, until the retrieved time
   stamp changes with respect to the one stored in startinfv ->
   timestamp. If that occurs, update startinfv -> startfile from the
   input (command line or .def file) of the parameter RESTARTNAME=.

   @param startinfv (startinf *) A startinf struct
   @return int loop_restart(): 0 all ok
                               1 malloc problems
*/
/* ------------------------------------------------------------ */
static int loop_restart(startinf *startinfv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static hdrinf *create_hdrinf()
   @brief Creates a hdrinf structure

   Creates a hdrinf structure allocating and if necessary initialising
   all arrays

   @return (success) hdrinf create_hdrinf: Allocated and initialised
   hdrinf struct\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static hdrinf *create_hdrinf(void);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_hdrinf(hdrinf *hdr)
   @brief Destroys a hdrinf structure

   Destroys a hdrinf structure deallocating all arrays. A
   non-allocated array has to be terminated (has to have a NULL value)
   to get the function work properly

   @param hdr (hdrinf *) A hdrinf struct to be destroyed

   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_hdrinf(hdrinf *hdr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static hdrinf *get_hdrinf(startinf *startinfv, loginf *log, hdrinf *hdrinfv)
   @brief Initialisation of the program concerning info from the dataset

   Takes over all dataset related io, returns an allocated hdrinf struct, with all the current rubbish.
   @param log (startinf *) A start descriptor struct, properly filled.
   @param log (loginf *) A log descriptor struct, properly filled.
   @param log (hdrinf *) A hdr descriptor struct, properly filled.

    @return (success) hdrinf *get_hdrinf: A hdrinf struct with the acquired info and rubbish
           (error) NULL
*/
/* ------------------------------------------------------------ */
static hdrinf *get_hdrinf(startinf *startinfv, loginf *log, hdrinf *hdrinfv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static int get_parameter_double(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, char *message, char *parname, int force)
   @brief Get a double parameter from the .def file

   Reads in and checks a double parameter from the .def file for consistency with the logfile.

   @param startinfv (startinf *) A startinf descriptor struct, properly filled.
   @param log (loginf *)    A log descriptor struct, properly filled.
   @param hdr (hdrinf *)    A header descriptor struct, properly filled.
   @param rpm (ringparms *) A ring parameter descriptor struct, properly filled.
   @param message (char *)  Message to display
   @param parname (char *)  The parameter name
   @param ident (int)       The parameter identification (PXXX)
   @param force (int)       same as def parameter from Gipsy. If 2, hidden, 4 not hidden.

  @return int get_parameter_double; 0(success) 1(error)
*/
/* ------------------------------------------------------------ */
static int get_parameter_double(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, char *message, char *parname, int ident, int force);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static srd *create_srd(int n)
   @brief Creates a list of subring descriptors with n elements

   The pointsource lists are terminated with NULL

   @param n (int) Number of subrings to allocate the list for

   @return (success) srd *create_srd: Allocated and initialised
   srd list\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static srd *create_srd(int n);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_srd(srd *sd, int n)
   @brief Destroys a list of subring descriptors

   The pointsource lists shold be terminated with NULL if they are
   deallocated

   @param sd (srd *) The list to destroy
   @param n (int)    Number of elements of the list.

   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_srd(srd *sd, int n);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static ringparms *create_ringparms(int ndisks)
   @brief Creates a ringparms structure

   Creates a ringparms structure allocating and if necessary initialising
   all arrays

   @param ndisks (int) number of disks

   @return (success) ringparms *create_ringparms: Allocated and initialised
   hdrinf struct\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static ringparms *create_ringparms(int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_ringparms(ringparms *hdr)
   @brief Destroys a ringparms structure

   Destroys a ringparms structure deallocating all arrays. A
   non-allocated array has to be terminated (has to have a NULL value)
   to get the function work properly

   @param hdr (ringparms *) A hdrinf struct to be destroyed

   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_ringparms(ringparms *hdr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static ringparms *get_ringparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *ringparmsv)
   @brief Fill the ringparms struct from the input

   Reads in properly the ringparms struct.

   @param startinfv (startinf *) A start descriptor struct, properly filled.
   @param hdr (hdrinf *) A header descriptor struct, properly filled.
   @param log (loginf *) A log descriptor struct, properly filled.
   @param ringparmsv (ringparms *) A ringparms descriptor struct, properly filled or NULL.

   @return    @return (success) ringparms *get_ringparms: A ringparms struct with the acquired info and rubbish
           (error) NULL
*/
/* ------------------------------------------------------------ */
static ringparms *get_ringparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *ringparmsv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static fitparms *create_fitparms(ringparms *rpm)
   @brief Creates a fitparms structure

   Creates a fitparms structure allocating and if necessary initialising
   all arrays

   @param rpm (ringparms *) A ring parameter descriptor struct, properly filled.

   @return (success) fitparms *create_fitparms: Allocated and initialised
   fitparms struct\n
           (error): NULL
*/
/* ------------------------------------------------------------ */
static fitparms *create_fitparms(ringparms *rpm);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroy_fitparms(fitparms *hdr)
   @brief Destroys a fitparms structure

   Destroys a fitparms structure deallocating all arrays. A
   non-allocated array has to be terminated (has to have a NULL value)
   to get the function work properly

   @param hdr (fitparms *) A hdrinf struct to be destroyed

   @return void
*/
/* ------------------------------------------------------------ */
static void destroy_fitparms(fitparms *hdr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static fitparms *get_fitparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fitparmsv)
   @brief Fill the fitparms struct from the input

   Reads in properly the fitparms struct. If run a second time only reads in the required parameters.

   @param startinfv (startinf *) A start descriptor struct, properly filled.
   @param log (hdrinf *) A log descriptor struct, properly filled.
   @param hdr (hdrinf *) A header descriptor struct, properly filled.
   @param rpm (ringparms *) A ring parameter descriptor struct, properly filled.
   @param fitparmsv (fitparms *) A fit descriptor struct, properly filled or NULL.

   @return    @return (success) fitparms *get_fitparms: A fitparms struct with the acquired info and rubbish
           (error) NULL
*/
/* ------------------------------------------------------------ */
static fitparms *get_fitparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fitparmsv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double dparamtointern(double value, int par, hdrinf *hdr, int ndisks)
   @brief conversion of some units

Converts the input as being coordinates given by the user to inernal (grid-) units. Caution!!! For the conversion of absolute map coordinates this function is not appropriate.
 Use globtointern instead!

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct
   @param ndisks   (int)   Number of disks

   @return double paramtointern: converted value
*/
/* ------------------------------------------------------------ */
static double dparamtointern(double value, int par, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double ddparamtointern(double value, int par, hdrinf *hdr, int ndisks)
   @brief conversion of some units

Converts the input as being coordinates given by the user to inernal (grid-) units, used only for differential quantities (as in the fitparms)
 Use globtointern instead!

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct
   @param ndisks   (int)   Number of disks

   @return double ddparamtointern: converted value
*/
/* ------------------------------------------------------------ */
static double ddparamtointern(double value, int par, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double dinterntoparam(double value, int par, hdrinf *hdr, int ndisks)
   @brief conversion of some units

Converts the input as being inernal (map-) coordinates to units as given by the user. Caution!!! For the conversion of map coordinates this function is, strictly speaking, not appropriate.
 Use globtointern instead!

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct
   @param ndisks   (int)   Number of disks

   @return double dinterntoparam: converted value
*/
/* ------------------------------------------------------------ */
static double dinterntoparam(double value, int par, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double ddinterntoparam(double value, int par, hdrinf *hdr, int ndisks)
   @brief conversion of some units

Converts the input as being inernal (map-) coordinates to units as given by the user, used only for differential quantities (as in the fitparms).

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct
   @param ndisks   (int)   Number of disks

   @return double ddinterntoparam: converted value
*/
/* ------------------------------------------------------------ */
static double ddinterntoparam(double value, int par, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double simpleinterntoglob(double value, int par, hdrinf *hdr)
   @brief conversion of some units

   Converts the input globals as being inernal (map-) coordinates to units as
   given by the user in a simple way for the use as min and max.

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct

   @return double simpleinterntoglob: converted value
*/
/* ------------------------------------------------------------ */
/* static double simpleinterntoglob(double value, int par, hdrinf *hdr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double simpleglobtointern(double value, int par, hdrinf *hdr, int ndisks)
   @brief conversion of some units

   Converts the input globals as being global coordinates to internal
   map units as given by the user in a simplified way, for the use as min and max.

   RADI    1
   VROT    2
   Z0      3
   SBR    4
   INCL    5
   PA      6
   XPOS    7
   YPOS    8
   VSYS    9
   CONDISP 10

   @param value (double)   value to convert
   @param par   (char)     type of parameter (see above)
   @param hdr   (hdrinf *) The properly configured header description struct
   @param ndisks   (int)   Number of disks

   @return double simpleglobtointern: converted value
*/
/* ------------------------------------------------------------ */
static double simpleglobtointern(double value, int par, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double vusertointern(double value, hdrinf *hdr)
   @brief conversion of absolute velocity units

Converts the input as being absolute velocity coordinates given by the user to inernal (grid-) units.

   @param value (double)   value to convert
   @param hdr   (hdrinf *) The properly configured header description struct

   @return double vusertointern: converted value
*/
/* ------------------------------------------------------------ */
/* static double vusertointern(double value, hdrinf *hdr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double vinterntouser(double value, hdrinf *hdr)
   @brief conversion of absolute velocity units

Converts the input as being absolute velocity coordinates in the internal map to units given by the user.

   @param value (double)   value to convert
   @param hdr   (hdrinf *) The properly configured header description struct

   @return double vinterntouser: converted value
*/
/* ------------------------------------------------------------ */
/* static double vinterntouser(double value, hdrinf *hdr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void globtointern(double *invalue, double *outvalue, hdrinf *hdr)
   @brief conversion of map units

   Converts the input as being (map-) coordinates to internal units.

   @param invalue (double *)  values to convert, x, y, v.
   @param outvalue (double *)  converted values, x, y, v.
   @param hdr   (hdrinf *) The properly configured header description struct

   @return double dinterntoparam: converted value
*/
/* ------------------------------------------------------------ */
static void globtointern(double *invalue, double *outvalue, hdrinf *hdr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void interntoglob(double *invalue, double *outvalue, hdrinf *hdr)
   @brief conversion of map units

   Converts the input as being internal units to (map-) coordinates.

   @param value (double *)  values to convert, x, y, v.
   @param outvalue (double *)  converted values, x, y, v.
   @param hdr   (hdrinf *) The properly configured header description struct

   @return double dinterntoparam: converted value
*/
/* ------------------------------------------------------------ */
static void interntoglob(double *invalue, double *outvalue, hdrinf *hdr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void changetointern(double *params, int nur, hdrinf *hdr, int ndisks)
   @brief Change the parameter list params to internal units as if being user units

   @param params (double *) parameter list, nur*(NPARAMS+(ndisks-1)*NDPARAMS)+NSPARAMS elements
   @param nur    (int)      number of rings
   @param hdr    (hdrinf *) A properly configured hdrinf struct
   @param ndisks (int)      Number of disks

   @return void
*/
/* ------------------------------------------------------------ */
static void changetointern(double *params, int nur, hdrinf *hdr, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @fn static int par2int(char *par);
   @brief Identification of string keywords with numbers

   Identifies the input string (No whitespaces to be passed) and
   returns it's identification. This is somewhat critical and
   dependent on the implementation of the ftstab module, call
   ftstab_hdlreset_() before using:

   default   par2int=0
   "RADI"    par2int=1
   "VROT"    par2int=2
   "Z0"      par2int=3
   "SBR"    par2int=4
   "INCL"    par2int=5
   "PA"      par2int=6
   "XPOS"    par2int=7
   "YPOS"    par2int=8
   "VSYS"    par2int=9
   "CONDISP"  par2int=10

   @param par (char *) A string to pass to the function
   @return int par2int: The identifyer as defined above.
*/
/* ------------------------------------------------------------ */
/*   int ftstab_gtitln_(char *titl); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/*
   @fn static void int2par(char *key, int par);
   @brief Identification of numbers with string keywords

   Identifies the input number and
   returns it's identification keyword in a string key. This is somewhat critical and
   dependent on the implementation of the ftstab module, call
   ftstab_hdlreset_() before using:

   "DEFAULT" par2int=0
   "RADI"    par2int=1
   "VROT"    par2int=2
   "Z0"      par2int=3
   "SBR"    par2int=4
   "INCL"    par2int=5
   "PA"      par2int=6
   "XPOS"    par2int=7
   "YPOS"    par2int=8
   "VSYS"    par2int=9
   "CONDISP  par2int=10

   @param par (char *) A string to pass to the function
   @return int par2int: The identifyer as defined above.
*/
/* ------------------------------------------------------------ */
/* int ftstab_putcoltitl(char *key, int coltitle); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static varlel *appendvarlel(varlel *last)
   @brief Constructor of an element of the varlel list

   Appends a varlel struct (terminated) to the last and returns a
   pointer to the appended element

   @param last (varlel *) The last varlel element (or NULL)

     @return (success) varlel *appendvarlel: The new element of the list
             (error) NULL
*/
/* ------------------------------------------------------------ */
static varlel *appendvarlel(varlel *last);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroyvarlel(varlel *first)
   @brief Destructor of a varlel list

   Destroys a varlel list from first on. The element before first will
   not be terminated, while the list has to be terminated. All
   elements arrays have to be dynamically allocated in case of nelem
   != 0.

   @param first (varlel *) The first varlel element to destroy(or NULL)

   @return void
*/
/* ------------------------------------------------------------ */
static void destroyvarlel(varlel *first);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static inlistel *appendinlistel(inlistel *last)
   @brief Constructor of an element of a inlistel list

   Appends a inlistel struct (terminated) to the last and returns a
   pointer to the appended element

   @param last (inlistel *) The last varlel element (or NULL)

     @return (success) inlistel *appendinlistel: The new element of the list
             (error) NULL
*/
/* ------------------------------------------------------------ */
/* static inlistel *appendinlistel(inlistel *last); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int galmod(hdrinf *hdr, ringparms *rpm, int fitmode, varlel *varele, decomp_index *index, long *fluxpoints, int *allnpoints)
   @brief Core to construct a pointsource cube from a parameter list

   This is the part where the things that are done with galmod are
   done. It is detached from the structure that passes packages of
   descriptors, because it can, in principle be used everywhere.  With
   the fitmode and varele, the interpolation of rings and the
   calculation of pointsources will be done only, if parameters have
   currently been changed. For this, the information contained in the
   varlel element is used. If NULL is passed, then everything will be
   calculated freshly. NULL should always be passed, if not sure
   whether the parameters have been interpolated correctly in a
   previous run or if interpover was used as a stand-alone or not at
   all before.

   @param hdr        (hdrinf *)    header information struct
   @param rpm        (ringparms *) Ring parameter information struct
   @param fit        (fitparms *)  Properly allocated fitparms struct
   @param varele     (varlel *)    Actual element that is processed in the varlel list
   @param index      (decomp_inlist *) An index- and dependency list as provided by simparse function decomp_get_inlist()
   @param fluxpoints (long *)          number of pointsources contributing to flux (in case of mixed negative and positive clouds this number is not identical to the number of point sources)
     @return (success) int galmod: 1
             (error) 0
*/
/* ------------------------------------------------------------ */
static int galmod(hdrinf *hdr, ringparms *rpm, int fitmode, varlel *varele, decomp_inlist *index, long *fluxpoints, int *allnpoints);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int changedependent(ringparms *rpm, double *par, decomp_inlist *index, varlel *varele, int fitmode, int *chapar)
   @brief Takes the parameter list and changes the parameters on the index

   Takes the parameter list and identifies parameters on the index in
   decomp_inlist, then interpolates between the parameters
   that the parameter on the index depends on

   @param rpm      (ringparms *)     Ring parameter information struct
   @param par      (double *)        Parameter list
   @param index    (decomp_inlist *) An index- and dependency list as provided by simparse function decomp_get_inlist()
   @param chapar   (int *)           array of parameters that change

   @return (success) int changedependent: number of indexed parameters
           (error) -1

*/
/* ------------------------------------------------------------ */
static int changedependent(ringparms *rpm, double *par, decomp_inlist *index, int *chapar);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void interpover(ringparms *rpm, double radsep, int fitmode, varlel *varele)
   @brief Constructs the modpar array by interpolating over the par array

   Constructs the modpar array by interpolating over the parameters,
   that are a content of the varlel item. If fitmode = 0, then varele
   is taken as the first item in a ll, and the function will scan
   through all elements of this ll, if fitmode = 1, then only the
   actually passed element will be scanned. If NULL is passed as a
   value of varele, then all parameters are changed or "touched" even
   if they stay the same value.

   @param rpm     (ringparms *)     Ring parameter information struct
   @param radsep  (double)          Radius separation of subring in appropriate units
   @param fitmode (int)             Fit mode to check for
   @param varele  (varlel *)        Parameter list element.
   @param index   (decomp_inlist *) an index list as defined in simparse
   @return void
*/
/* ------------------------------------------------------------ */
static void interpover(ringparms *rpm, double radsep, int fitmode, varlel *varele, decomp_inlist *index);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void interpinit(ringparms *rpm, double radsep, int disk)
   @brief Constructs the modpar array by interpolating over the par array

   This is the same as interpover but without checking the varlel
   list. Should always be used if the par parameter list has been
   changed without consulting the varlel list.

   @param rpm    (ringparms *) Ring parameter information struct
   @param radsep (double)      Radius separation of subring in appropriate units
   @param disk    (int)     disk number; if the disk is not fitted, 0 is returned.

   @return void
*/
/* ------------------------------------------------------------ */
static void interpinit(ringparms *rpm, double radsep, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int chkchangep(varlel *varele, int fitmode, int parnr, int nur)
  @brief Help function to interpover: Check if the modpar array has to be changed for a parameter

  If in the previous parameter change a change of the parameter has
   occured, this function will return 1, 0 otherways.

  @param varele (varlel *) Actual element of the varlel list, or the
  first element in case of fitmode = 0

  @param fitmode (int)     Fitmode 0: Metropolis, 1: Golden section
  parameter information struct
  @param ringnr  (int)     Number of ring to be checked
  @param nur      (int)     Number of rings

  @return int chkchange: 1 if change for parameter has occured, 0 if not
*/
/* ------------------------------------------------------------ */
static int chkchangep(varlel *varele, int fitmode, int parnr, int nur);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srprep(ringparms *rpm, int srnr, long mode, int disk)
  @brief Preparation of a srd struct

  Precalculations for the calculation of a ring.

  @param rpm  (ringparms *) Properly configured ringparms struct
  @param srnr (int *)       Number of the subring (start with 0)
  @param mode (long)        Dummy at the moment
  @param disk (int)         Disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srprep(ringparms *rpm, int srnr, long mode, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static long srconst(hdrinf *hdr, ringparms *rpm, int srnr, long mode, int disk)
  @brief Generation of a pointsource list

  Generates a pointsource list that is attached to the appropriate srd struct

  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param srnr (int *)       Number of the subring (start with 0)
  @param mode (long)        Dummy at the moment
  @param disk (int)         Disk number

  @return long srconst: Number of pointsources outside the cube
*/
/* ------------------------------------------------------------ */
static long srconst(hdrinf *hdr, ringparms *rpm, int srnr, long mode, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int srshape(hdrinf *hdr, ringparms *rpm, float sinaz, float cosaz, int srnr, long mode, int disk)
  @brief Determines the coordinates of a point source

  Subroutine to srconst. After the calculation of the azimuth of a
  point source, the coordinates are transformed according to the
  parameters in this function.

  @param rpm   (ringparms *) Properly configured ringparms struct
  @param pp    (float *)     Point source coordinates
  @param sinaz (float)       sine of azimuth
  @param cosaz (float)       cosine of azimuth
  @param srnr  (int *)       Number of the subring (start with 0)
  @param disk (int)         Disk number

  @return long srconst: Number of pointsources outside the cube
*/
/* ------------------------------------------------------------ */
static void srshape(ringparms *rpm, float *pp, float sinaz, float cosaz, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gridpoint_norm(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, float *primbeam, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
  @brief Grids a point to a pointsource list

  Grids the point point (6 phase-space coords) in a list of pointers to the cube hdr ->
  model. If the point doesn't fit the cube, the pointsource number of
  the subring will be redced by 1, if it fits, pnr will be increased
  by one. Called by srconst.
  This function changes only the n variable in the pointsource descriptor.

  @param hdr    (hdrinf *)    Properly configured hdrinf struct
  @param modpar (float *)     Properly configured array of subring descriptors
  @param nr     (int *)       Properly number of subrings
  @param sd     (srd **)       Properly configured subring descriptor
  @param srnr   (int)         Number of the subring (start with 0)
  @param pnr    (long *)       Number of the pointsource (start with 0)
  @param pp     (float *)     Number of the subring (start with 0)
  @param signum  (int)         Indicates negative point source, dummy in this function
  @param npoints (long *)     Number of maximal points in specific structure
  @param disk (int)         Disk number

  @return void
*/
/* ------------------------------------------------------------ */
#ifdef PBCORR
static void gridpoint_norm(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#else
static void gridpoint_norm(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gridpoint_mixed(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, float *primbeam, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
  @brief Grids a point to a pointsource list

  Grids the point point (6 phase-space coords) in a list of pointers
  to the cube hdr -> model. If the point doesn't fit the cube, the
  pointsource number of the subring will be redced by 1, if it fits,
  pnr will be increased by one. Called by srconst.  This function
  changes not only the n variable in the pointsource descriptor, but
  also the nneg and npos variable. Positive clouds are gridded on the
  beginning of the pl array, negative clouds at the end.

  @param hdr    (hdrinf *)    Properly configured hdrinf struct
  @param modpar (float *)     Properly configured array of subring descriptors
  @param nr     (int *)       Properly number of subrings
  @param sd     (srd **)       Properly configured subring descriptor
  @param srnr   (int)         Number of the subring (start with 0)
  @param pnr    (long *)       Number of the pointsource (start with 0)
  @param pp     (float *)     Number of the subring (start with 0)
  @param signum (int)         Indicates negative source, needed for this function
  @param npoints (long *)     Number of maximal points in specific structure
  @param disk (int)           Disk number

  @return void
*/
/* ------------------------------------------------------------ */
#ifdef PBCORR
static void gridpoint_mixed(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#else
static void gridpoint_mixed(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int srput_norm(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long *pnr, long grid), struct sdr **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
  @brief Puts a pointsource list on a cube

  Puts the srnrth pointsource list in rpm on the cube by adding the
  flux in the list pointwise. In case of exclusively positive or exclusively negative clouds.

  @param hdr    (hdrinf *) Properly configured hdrinf struct
  @param sd     (srd **)    Properly configured subring descriptor
  @param modpar (float *)  Properly configured subring parameter array
  @param nr     (int)      Number of subrings
  @param cflux  (double *) Cloudflux as determined in the ringparms struct
  @param radsep (double)   Separation of subrings in pixel
  @param srnr   (int)      Subring number
  @param disk (int)        Disk number

  @return void
*/
/* ------------------------------------------------------------ */
#ifdef PBCORR
static int srput_norm(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid), struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#else
static int srput_norm(struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int srput_mixed(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long *pnr, long grid), struct sdr **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
  @brief Puts a pointsource list on a cube

  Puts the srnrth pointsource list in rpm on the cube by adding the
  flux in the list pointwise. In case of mixed positive and negative clouds.

  @param hdr    (hdrinf *) Properly configured hdrinf struct
  @param sd     (srd *)    Properly configured subring descriptor
  @param modpar (float *)  Properly configured subring parameter array
  @param nr     (int)      Number of subrings
  @param cflux  (double *)   Cloudflux as determined in the ringparms struct
  @param radsep (double)   Separation of subrings in pixel
  @param srnr   (int)      Subring number
  @param disk (int)        Disk number

  @return void
*/
/* ------------------------------------------------------------ */
#ifdef PBCORR
static int srput_mixed(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid), struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#else
static int srput_mixed(struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk);
#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int metropolis(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
   @brief Metropolis algorithm

   This is the part where the Metropolis iterations are done.

   @param log      (loginf *)    log information struct
   @param hdr      (hdrinf *)    header information struct
   @param rpm      (ringparms *) Ring parameter information struct
   @param fit      (fitparms *)  fit parameter information struct

   @return (success) int metropolis: 1
           (error) 0
*/
/* ------------------------------------------------------------ */
/* static int metropolis(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int genfit(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
   @brief Generic gft fit algorithm

   This is the part where the generic fitting with gft is done.

   @param startifv    (startinf *)    Properly configured startinf struct
   @param log      (loginf *)    log information struct
   @param hdr      (hdrinf *)    header information struct
   @param rpm      (ringparms *) Ring parameter information struct
   @param fit      (fitparms *)  fit parameter information struct

   @return (success) int genfit: 1
           (error) 0
*/
/* ------------------------------------------------------------ */
static int genfit(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void destroyinlistel(inlistel *first)
   @brief Destructor of a inlistel list

   Destroys a inlistel list from first on. The element before first will
   not be terminated, while the list has to be terminated.

   @param first (inlistel *) The first inlistel element to destroy(or NULL)

   @return void
*/
/* ------------------------------------------------------------ */
static void destroyinlistel(inlistel *first);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int decodestr(char *string, int *array, int max)
   @brief decodes an input string

   The input string of varymult and varystr has to be a:b where a is
   less or equal b, b is less than the number of rings (in this
   function given by the max parameter), and a is greater than 0. If
   the string is of that structure, the function returns 1 and a and b
   are put into array as integers, 0 otherways.

   @param string (char *) Input string
   @int   array  (int *)  Array to contain a and b
   @param max    (int)    The maximum value that may be read

   @return (success) int decodestr 1
           (error) 0
*/
/* ------------------------------------------------------------ */
/* static int decodestr(char *string, int *array, int max); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void prepout(loginf *log, headerinf *hdr, ringparms *rpm)
   @brief Opens a file and puts an old-style ascii header to the top

   Opens a file and puts an ascii header to the top, as in the old
   version of tirific. This function needs ftstab to be initialised as
   is done in get_ringparms(). The result is put to the component tstream of log.

   @param log (loginf *)    Log description object
   @param hdr (hdrinf *)    header description object
   @param rpm (ringparms *) Ring parameter description object

   @return void
*/
/* ------------------------------------------------------------ */
static void prepout(loginf *log, hdrinf *hdr, ringparms *rpm);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void writeoutput(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq)
   @brief Writes the information contained in rpm -> oldpar to the output

   @param log      (loginf *)    log information struct
   @param hdr      (hdrinf *)    header information struct
   @param rpm      (ringparms *) Ring parameter information struct
   @param fit      (fitparms *)  Fit parameter information struct
   @param accept   (char)        Indicator whether the last model was accepted
   @param dof      (double)      Degrees of freedom
   @param modcount (int)         Number of the model
   @param rchisq   (double)      Reduced chi2

   @return void
*/
/* ------------------------------------------------------------ */
static void writeoutput(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void writeoutputread(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq)
   @brief Writes the information contained in rpm -> oldpar to the output

   @param log      (loginf *)    log information struct
   @param hdr      (hdrinf *)    header information struct
   @param rpm      (ringparms *) Ring parameter information struct
   @param fit      (fitparms *)  Fit parameter information struct
   @param accept   (char)        Indicator whether the last model was accepted
   @param dof      (double)         Degrees of freedom
   @param modcount (int)         Number of the model
   @param rchisq   (double)      Reduced chi2

   @return void
*/
/* ------------------------------------------------------------ */
static void writeoutputread(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void writeouttext(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, int dof, int modcount)
   @brief Writes the information contained in rpm -> oldpar to the text output only

   @param log      (loginf *)    log information struct
   @param hdr      (hdrinf *)    header information struct
   @param rpm      (ringparms *) Ring parameter information struct
   @param fit      (fitparms *)  Fit parameter information struct
   @param accept   (char)        Indicator whether the last model was accepted
   @param dof      (int)         Degrees of freedom
   @param modcount (int)         Number of the model
   @param proba    (double)      Probability of acceptance

   @return void
*/
/* ------------------------------------------------------------ */
/* static void writeouttext(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, int dof, int modcount, double proba); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static void writeoutarray(loginf *log, hdrinf *hdr, ringparms *rpm, double *par, char accept, double chisquare, int modcount, double dof, double chisquare_red)
   @brief Writes the information contained in par to the output array of rpm

   @param log       (loginf *)    log information struct
   @param hdr       (hdrinf *)    header information struct
   @param rpm       (ringparms *) Ring parameter information struct
   @param par       (double *)    The input parameter array
   @param accept    (char)        Indicator whether the last model was accepted
   @param chisquare (double)      Degrees of freedom
   @param modcount  (int)         Number of the model
   @param dof       (double)      Degrees of freedom
   @param chisquare_red  (double) reduced chisquare, direct input

   @return void
*/
/* ------------------------------------------------------------ */
static void writeoutarray(loginf *log, hdrinf *hdr, ringparms *rpm, double *par, char accept, double chisquare, int modcount, double dof, double chisquare_red);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static void writeoutarrayerr(hdrinf *hdr, ringparms *rpm, double *par, double *errors, char accept, double chisquare, int modcount, double dof)
   @brief Writes the information contained in rpm -> par to the output array errors

   @param hdr       (hdrinf *)    header information struct
   @param rpm       (ringparms *) Ring parameter information struct
   @param par       (double *)    array containing errors in intrinsic units, must have length of any output array
   @param errors    (double *)    output array, must have length of any output array
   @param accept    (char)        Indicator whether the last model was accepted
   @param chisquare (double)      Degrees of freedom
   @param modcount  (int)         Number of the model
   @param dof       (double)      Degrees of freedom

   @return void
*/
/* ------------------------------------------------------------ */
static void writeoutarrayerr(hdrinf *hdr, ringparms *rpm, double *par, double *errors, char accept, double chisquare, int modcount, double dof);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int chprm_metro(varlel *varylist, double *oldpar, double *newpar, maths_rstr *rnd, double deltfact)
   @brief Changes the parameters in par according to varylist

   Each parameter that is contained in the parameter lists of varylist
   will be changed randomly. It will be increased or diminished by a
   number in-between 0 and the delta of the element of the
   varylist. All parameters adressed in one varylist component will be
   changed by the same amount. The output is into newpar, while oldpar
   contains the input parameters to change.

   @param varylist (varlel *)     Information structure to vary the
   parameters (must be properly configured according to par)
   @param oldpar   (double *)     Old parameter list
   @param newpar   (double *)     New parameter list
   @param rnd      (maths_rstr *) An initialised random generator struct
   @param loopnr   (double)       Number of actual loop

   @return int chprm_metro: 1 if successful, 0 if a given number FALSEATTEMPTS of attempts to change the model towards an invalid value is exceeded.
*/
/* ------------------------------------------------------------ */
/* static int chprm_metro(varlel *varylist, double *oldpar, double *newpar, maths_rstr *rnd, long loopnr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int chprm_gen(double *parms; varlel *varylist, double *newpar)
   @brief Changes the parameters in par according to parms

   Each parameter that is contained in the parameter lists of varylist
   will be changed according to the parms array as passed by the gft
   fit routine. parms should contain as many parameters as varlel
   elements are present in the ll. Differences in the actual
   parameters are kept.

   @param parms (double *)        Parameters as passed by the gft routine
   @param varylist (varlel *)     Information structure to vary the
   parameters (must be properly configured according to par)
   @param newpar   (double *)     New parameter list

   @return int chprm_gen: 0 if successful, n>0 counting the parameters
   out-of-range. The changes will take place nevertheless.
*/
/* ------------------------------------------------------------ */
static int chprm_gen(double *parms, varlel *varylist, double *newpar);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static float zprof(int option, maths_rstrf *permrandstr)
   @brief Delivers a random variable according to a profile identifyer

   Function to get random deviates for various functions.  The double
   precision variable fdev contains the random deviate.  If nran is
   within a factor two of the largest possible integer then integer
   overflow could occur.  DOUBLE PRECISION FUNCTION
   fdev(option,nran,iran,idum) Type of distribution function for the
   random deviates.
   Options:

   option = 1 -- Gaussian deviates.
   option = 2 -- Sech2 deviates.
   option = 3 -- Exponential deviates.
   option = 4 -- Lorentzian deviates.
   option = 5 -- Box deviates. (is also default)
   option = 6 -- Reset the rng for gaussian

   @param option      (int)         The type of the random variate
   @param permrandstrf (maths_rstr *) An initialised random number control object from this module

   @return float zprof: A random number distributed specified by option
*/
/* ------------------------------------------------------------ */
static float zprof(int option, maths_rstrf *permrandstr, float *y2);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void hdl_init(int ndisks)
  @brief Initializes the standard header context table

  @param ndisks (int) Number of disks
*/
/* ------------------------------------------------------------ */
static int hdl_init(int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int create_hdu_3(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);
  @brief Opens if necessary creates the third hdu

  Will Create a third hdu of the logfile.

   @param log (loginf *)    log information struct
   @param hdr (hdrinf *)    header information struct
   @param rpm (ringparms *) Ring parameter information struct
   @param fit (fitparms *)  Fit parameter information struct

   @return (success) int create_hdu_3: 0\\
           (error) 1
*/
/* ------------------------------------------------------------ */
/* static int create_hdu_3(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int open_hdu_3(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);
  @brief Opens if necessary creates the third hdu

  Will Create a third hdu of the logfile.

  @param log (loginf *)    log information struct
  @param hdr (hdrinf *)    header information struct
  @param rpm (ringparms *) Ring parameter information struct
  @param fit (fitparms *)  Fit parameter information struct

   @return (success) int create_hdu_3: 0 \\
           (error) 1: Memory error
                   2: User decides not to fit
*/
/* ------------------------------------------------------------ */
static int open_hdu_3(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int create_hdu_1(log, hdr, rpm, fit)
  @brief Creates a fits table and puts the global information to the fits table

  Will create a ftstab fits table with the first hdu from the
  information acquired in the description objects.

   @param log       (loginf *)    log information struct
   @param hdr       (hdrinf *)    header information struct
   @param rpm       (ringparms *) Ring parameter information struct
   @param fit       (fitparms *)  Fit parameter information struct

   @return (success) int create_hdu_1: 0\\
           (error) 1
*/
/* ------------------------------------------------------------ */
/* static int create_hdu_1(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int create_hdu_2(char *logname, varlel *varylist, varlel **pointarray, int nur, hdrinf *hdr)

  @brief Creates a second hdu of a fits table and puts the fit
  information contained in the varlel ll to the fits table

  Creates a second hdu of a fits table (deleting consequent elements)
  and puts the fit information contained in the varlel ll to the fits
  table. For a proper functionality make sure that the first hdu is already created.

  @param logname    (char *)    The name of the logfile
  @param varylist   (varlel *)  A properly configured varylist
  @param pointarray (varlel **) Array with pointers to varlels of the size of elements of deltas given by the user
  @param nur        (int)       Number of rings
  @param hdr        (hdrinf *)  Properly configured headerinf struct

   @return (success) int create_hdu_1: 0\\
           (error) 1
*/
/* ------------------------------------------------------------ */
/* static int create_hdu_2(char *logname, varlel *varylist, varlel **pointarray, int nur, hdrinf *hdr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int change_hdu_2(varlel *varylist, varlel **pointarray, int nur, hdrinf *hdr)

  @brief Creates a second hdu of a fits table and puts the fit
  information contained in the varlel ll to the fits table

  Changes a second hdu of a fits table (deleting consequent elements)
  and puts the fit information contained in the varlel ll to the fits
  table. For a proper functionality make sure that the first hdu is already created and the second is opened. This is only of use if both tables have the identical size.

  @param varylist   (varlel *)  A properly configured varylist
  @param pointarray (varlel **) Array with pointers to varlels of the size of elements of deltas given by the user
  @param nur        (int)       Number of rings
  @param hdr        (hdrinf *)  Properly configured headerinf struct

   @return (success) int change_hdu_2: 0\\
           (error) 1
*/
/* ------------------------------------------------------------ */
/* static int change_hdu_2(varlel *varylist, varlel **pointarray, int nur, hdrinf *hdr); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int primpos_numtype(int ident)
  @brief Returns the ftstab numerical type of a PRIMPOS identifyer

  @param ident (int) PRIMPOS idendifyer

  @return int primpos_numtype: Numerical type identifyer as in ftstab module
*/
/* ------------------------------------------------------------ */
/* static int primpos_numtype(int ident); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static double primpos_value(int ident, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Returns the value of a PRIMPOS identifyer from a varele pointer

  @param ident      (int)        identifyer
  @param log       (loginf *)    log information struct
  @param hdr       (hdrinf *)    header information struct
  @param rpm       (ringparms *) Ring parameter information struct
  @param fit       (fitparms *)  Fit parameter information struct

  @return double primpos_value: value of a PRIMPOS identifyer
*/
/* ------------------------------------------------------------ */
/* static double primpos_value(int ident, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static double secpos_value(int ident, varele *varylist, int nur, hdrinf *hdr, int element)
  @brief Returns the value of a SECPOS identifyer from a varele pointer

  @param ident    (int)      SECPOS idendifyer
  @param varylist (varele *) pointer to the varele from which the values are extracted
  @param nur      (int)      Number of rings
  @param hdr      (hdrinf *) Properly configured headerinf struct
  @param element  (int)      Number of the element (start with 0) in case of ELEMENTS

  @return double secpos_value: value of a SECPOS identifyer
*/
/* ------------------------------------------------------------ */
/* static double secpos_value(int ident, varlel *varylist, int nur, hdrinf *hdr, int element); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int comparevarlel(varlel *varlel1, varlel *varlel2)
  @brief Checks if the varlels are identical

  @param varlel1 (varlel *) first varlel element
  @param varlel2 (varlel *) second varlel element

  @return int comparevarlel: 0 if they contain identical values, 1 if they are fatally different, -1, if they are different but contain the same number of elements
*/
/* ------------------------------------------------------------ */
/* static int comparevarlel(varlel *varlel1, varlel *varlel2); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int fillhdvarele(varlel *varele, int i, double *array,
  int parameter, double *parmax, double *parmin, int *moderate, double
  *delstart, double *delend, int *itestart, int *iteend, double
  *satdelt, double *mindelta, hdrinf *hdr, loginf *log)

  @brief Puts the values of the arrays into varele, checking for mismatch with array

  Puts the values of the global variables of a varele struct into
  varele from the single arrays, checking for mismatch with the
  content of array. If there is any mismatch the user will be
  prompted. Will return 1 if the user decides to abort. Will return 0
  if the user does not want to abort. The user is only prompted once
  and the keyword "proceed" has to be canceled afterwards.

  @param varele    (varlel *) An element of the varlist
  @param i         (int)      The position in the arrays
  @param parameter (int)      The parameter identification
  @param array     (double *) The array that will be checked
  @param parmax    (double *) Parameter list with maxima
  @param parmin    (double *) Parameter list with minima
  @param moderate  (int    *) Parameter list with moderate values
  @param delstart  (double *) Parameter list with delstart values
  @param delend    (double *) Parameter list with delend values
  @param itestart  (int    *) Parameter list with itestart values
  @param iteend    (int    *) Parameter list with iteend values
  @param satdelt   (double *) Parameter list with satdelt values
  @param mindelta  (double *) Parameter list with mindelta values
  @param hdr       (hdrinf *) Properly configured hdrinf struct
  @param log       (loginf *) Properly configured loginf struct

  @return int fillhdvarele 1 In case of an error, 0 if everything is ok
*/
/* ------------------------------------------------------------ */
/* static int fillhdvarele(varlel *varele, int i, double *array, int parameter, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, hdrinf *hdr, loginf *log); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int putmetresults(loginf *log, ringparms *rpm, fitparms *fit)
  @brief Calculates and puts the results of the fitting procedure

  This function needs the logfile opened by ftstab module at the third
  extension

  @param  log (loginf *)    Properly configured loginf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct

  @return (success) int putresults: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
/* static int putmetresults(loginf *log, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int putgenresults(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Calculates and puts the results of the fitting procedure

  This function needs the logfile opened by ftstab module at the third
  extension

  @param  startinfv (startinf *)    Properly configured loginf struct
  @param  log (hdrinf *)    Properly configured hdrinf struct
  @param  log (loginf *)    Properly configured loginf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct

  @return (success) int putresults: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int putgenresults(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int golden_section(startinf *startinfv, loginf *log, ringparms *rpm, fitparms *fit)
  @brief A golden section iteration

  The other working horse, a golden section iteration.

  @param  startinfv (startinf *)    Properly configured loginf struct
  @param  log (loginf *)    Properly configured loginf struct
  @param  hdr (hdrinf *)    Properly configured hdrinf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct

  @return int golden_section: Always 1...
*/
/* ------------------------------------------------------------ */
static int golden_section(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int putgoldresults(loginf *log, ringparms *rpm, fitparms *fit)
  @brief Calculates and puts the results of the fitting procedure

  This function needs the logfile opened by ftstab module at the third
  extension

  @param  log (loginf *)    Properly configured loginf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct

  @return (success) int putresults: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int putgoldresults(loginf *log, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int writeasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);
  @brief Writes an ascii table with the results

  This function needs the logfile opened by ftstab module at the third
  extension

  @param  startinfv (startinf *)    Properly configured loginf struct
  @param  log (loginf *)    Properly configured loginf struct
  @param  hdr (hdrinf *)    Properly configured hdrinf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct
  @return (success) int writeasctable: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int writeasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int writebigasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);
  @brief Writes an ascii table with the results

  This function needs the logfile opened by ftstab module at the third
  extension. This will list all properties for the subrings.

  @param  startinfv (startinf *)    Properly configured startinf struct
  @param  log (loginf *)    Properly configured loginf struct
  @param  hdr (hdrinf *)    Properly configured hdrinf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct
  @return (success) int writeasctable: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int writebigasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int coolgal(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Produces a 3d fits image of the model.

  Prompts the user for a name (hidden) of an output cube. This will be a 3d image of the galaxy. As a smoothing value the largest hpbw is used in all three directions. This function will deallocate and reallocate the model and the original cube, such that this function should be called last before the program is being left. The extension of the output cube in the third dimension is the largest dimension in x-y.

  @param  startinfv (startinf *)  Properly configured startinf struct
  @param  log (loginf *)    Properly configured loginf struct
  @param  hdr (hdrinf *)    Properly configured hdrinf struct
  @param  rpm (ringparms *) Properly configured ringparms struct
  @param  fit (fitparms *)  Properly configured fitparms struct
  @return (success) int coolgal: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int coolgal(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static qfits_header *makecoolhdr(hdrinf *hdr, double beamsizeindeg)
  @brief Produces a header struct for coolgal output

  Produces a qfits_header object suitable for the coolgal output.

  @param  hdr (hdrinf *)           Properly configured hdrinf struct
  @param  beamsizeindeg (double *) 1d beam size in degrees

  @return (success) qfits_header *makecoolhdr: The properly configured header
          (error)   NULL
*/
/* ------------------------------------------------------------ */
static qfits_header *makecoolhdr(hdrinf *hdr, double beamsizeindeg);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int makecoolpoints(Cube *cube, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Makes a 3d pointsource model and packs in on cube

  @param cube (Cube *)      The cube onto which the model is gridded
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param rpm  (fitparms *)  Properly configured fitparms struct
  @return (success) int makecoolpoints: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int makecoolpoints(Cube *cube, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void tirout_a(simparse_scn_arel **arel, FILE *stream, char *keyword, char *input, fitparms *fit)
  @brief Copies a part of the tirific input to a stream

  @param stream  (FILE *) An open stream
  @param keyword (char *) Name of the keyword as given in gipsy
  @param input   (char *) Allocated string of length VARYHSTRELES (including terminating '\0')
  @return tirout_a (success) 0
                   (error) 1
*/
/* ------------------------------------------------------------ */
static int tirout_a(simparse_scn_arel **arel, FILE *stream, char *keyword);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static int tirout(startinf *startinfv, loginf *log, ringparms *rpm, fitparms *fit, int nrplts)
  @brief Produces one or two tirific logfiles containing the results

  @param startifv    (startinf *)    Properly configured startinf struct
  @param log    (loginf *)    Properly configured loginf struct
  @param rpm    (ringparms *) Properly configured ringparms struct
  @param fit    (fitparms *)  Properly configured fitparms struct
  @param nrplts (int)         Number of plots as inquired with graphout()
  @return (success) int tirout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int tirout(startinf *startinfv, loginf *log, ringparms *rpm, fitparms *fit, int nrplts);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static int progressout(startinf *startinfv, char *message)
  @brief Produces a file containing only the message

  Kamphuis addition

  @param startifv    (startinf *)    Properly configured startinf struct
  @param message    (char *)
  @return (success) int progressout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int progressout(startinf *startinfv, char *message);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
@fn static int progressfinished(startinf *startinfv)
  @brief Appends a message to the progress file at the end of the fitting procedure.

  Kamphuis addition

  @param startifv    (startinf *)    Properly configured startinf struct
  @return (success) int tirout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int progressfinished(startinf *startinfv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int histout(ringparms *rpm)
  @brief Produces the histogram output of tirific

  @param rpm  (ringparms *) Properly configured ringparms struct
  @return (success) int tirout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
/* static int histout(ringparms *rpm); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int rectout(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Produces the rectify output of tirific

  @param log  (loginf *)    Properly configured loginf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param fit    (fitparms *)  Properly configured fitparms struct
  @return (success) int rectout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
/* static int rectout(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void rectout_a(FILE *stream)
  @brief Output of fixed stuff to a file

  @param stream  (FILE *) An open stream
  @return void
*/
/* ------------------------------------------------------------ */
/* static void rectout_a(FILE *stream); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void rectout_b(FILE *stream)
  @brief Output of fixed stuff to a file

  @param stream  (FILE *) An open stream
  @return void
*/
/* ------------------------------------------------------------ */
/* static void rectout_b(FILE *stream); */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int tiltout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Produces the tiltogram output of tirific

  @param startinfv  (startinf *)    Properly configured startinf struct
  @param log  (loginf *)    Properly configured loginf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param fit  (fitparms *)  Properly configured fitparms struct
  @return (success) int tiltout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int tiltout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int briggsout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Produces a tip-lon diagram

  @param startinfv  (startinf *)    Properly configured startinf struct
  @param log  (loginf *)    Properly configured loginf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param fit  (fitparms *)  Properly configured fitparms struct
  @return (success) int graphout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int briggsout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int graphout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
  @brief Produces the graphics output of tirific

  @param startinfv  (startinf *)    Properly configured startinf struct
  @param log  (loginf *)    Properly configured loginf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @param fit  (fitparms *)  Properly configured fitparms struct
  @return (success) int graphout: 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int graphout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int get_graphnr(char *string, int ndisks)
  @brief Identifies a graphics output number

  @param string (char *) String to identify
   @param ndisks (int)    Number of disks

  @return (success) int get_graphnr: Number of the graphics number as defined by _GRAPHNR plus NPARAMS
          (error)   0
*/
/* ------------------------------------------------------------ */
static int get_graphnr(char *string, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gr_fillscaling(loginf *log, hdrinf *hdr, int ident, float *scale, float *zero, int ndisks)
  @brief Returns the scale for one unit to the alternative unit

  The plot output of tirific imposes two axis descriptions on the
  plots. The scales are connected via valright =
  scale*valleft+zero. This function returns these values.

  @param log   (loginf *) Properly configured loginf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param ident (int)      Identification as output of ftstab_gtitln_ or get_graphnr
  @param scale (float *)  The scale from left hand border to right hand border of a plot (output)
   @param scale (float *) The zero from left hand border to right hand border of a plot (output)
   @param ndisks (int)    Number of disks

  @return (success) int get_graphnr: Number of the graphics number as defined by _GRAPHNR plus NPARAMS
          (error)   0
*/
/* ------------------------------------------------------------ */
static void gr_fillscaling(loginf *log, hdrinf *hdr, int ident, float *scale, float *zero, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gr_fillaxis(int ident, char *string, int ndisks)
  @brief Returns an axis descriptor string suitable for the use in the pgp module

  It is no error to pass NULL.

  @param ident  (int)    Identification as output of ftstab_gtitln_ or get_graphnr
  @param string (char *) String to fill (At least characters) or NULL
   @param ndisks (int)    Number of disks

  @return void
*/
/* ------------------------------------------------------------ */
static void gr_fillaxis(int ident, char *string, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gr_fillunit(int ident, char *string, int ndisks)
  @brief Returns an unit string suitable for the use in the pgp module

  It is no error to pass NULL.

  @param ident  (int)    Identification as output of ftstab_gtitln_ or get_graphnr
  @param string (char *) String to fill (At least characters) or NULL
   @param ndisks (int)    Number of disks

  @return void
*/
/* ------------------------------------------------------------ */
static void gr_fillunit(int ident, char *string, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gr_fillaltunit(int ident, char *string, int ndisks)
  @brief Returns an alternative unit string suitable for the use in the pgp module

  It is no error to pass NULL.

  @param ident  (int)    Identification as output of ftstab_gtitln_ or get_graphnr
  @param string (char *) String to fill (At least characters) or NULL
   @param ndisks (int)    Number of disks

  @return void
*/
/* ------------------------------------------------------------ */
static void gr_fillaltunit(int ident, char *string, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gr_filllegend(int ident, char *string, int ndisks)
  @brief Returns a legend string suitable for the use in the pgp module

  It is no error to pass NULL.

  @param ident  (int)    Identification as output of ftstab_gtitln_ or get_graphnr
  @param string (char *) String to fill (At least characters) or NULL
  @param ndisks (int)             Number of disks

  @return void
*/
/* ------------------------------------------------------------ */
static void gr_filllegend(int ident, char *string, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int fillgrapharray(startinf *startinfv, hdrinf *hdr, ringparms *rpm, decomp_inlist *index, int ident, float *array, float *larray, int ndisks)
  @brief Fills two arrays for graphics use

  The arrays array and larray are filled with the values contained in
  rpm -> par and rpm -> modpar according to the parameter
  required. par and modpar should contain the values in user
  units. The parameter is decoded via an integer ident as returned by
  get_graphident(). array and larray should be large enough.

  @param startinfv    (startinf *)        Properly configured startinf struct
  @param hdr    (hdrinf *)        Properly configured hdrinf struct
  @param rpm    (ringparms *)     Properly configured rinparms struct
  @param index  (decomp_inlist *) Index list as defined in simparse
  @param ident  (int)             Identity of the value asked for as given by get_graphident()
  @param array  (float *)         Array that contains the ring parameters
  @param errarr
  @param larray (float *)         Array containing the subring parameters
  @param ndisks (int)             Number of disks

  @return (success) 1
          (error)   0
*/
/* ------------------------------------------------------------ */
static int fillgrapharray(startinf *startinfv, hdrinf *hdr, ringparms *rpm, int ident, float *array, float *larray, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int gr_deleteindexed(int nur, int ident, float *xarray, float *yarray, float *yerrarray, decomp_inlist *index, int ndisks);
)
  @brief Deletes indexed points from three arrays

  Uses an index list as defined in simparse to identify indexed
  parameters in xarray, yarray, and yerrarray and deletes them. The
  arrays are not reallocated, but all parameters are shift towards a
  lower index if a data point is on the index. Returns the number of
  points that are not on the index.

  @param nur       (int)             Number of rings
  @param ident     (int)             Identity of the parameter asked for as returned by get_graphident()
  @param xarray    (float *)         Array, x-axis
  @param yarray    (float *)         Array, y-axis
  @param yerrarray (float *)         Array, errors
  @param index     (decomp_inlist *) index list as defined in simparse
  @param ndisks (int)    Number of disks

  @return int gr_deleteindexed: number of parameters not on the index
*/
/* ------------------------------------------------------------ */
static int gr_deleteindexed(int nur, int ident, float *xarray, float *yarray, float *yerrarray, decomp_inlist *index, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int get_graphident(char *string, char *axis, char *unit, char *altunit, char *legend, int ndisks)
  @brief Returns the identifyer of a graphics output

  The function returns the identifyer of a graphics output identifyer. The value is not negative if the string input is identified with a variable parameter, or with a valid other graphics output keystring. In case of a variable parameter identifyer, this is identical with the RADI, etc identifyer, otherways with the NPARAMS+WANGLE_GRAPHNR, ... . At the same time the strings axis unit and legend are filled with appropriate values to produce an output with the pgp module. If the value of axis, unit, and legend are NULL, this is no error. If, however, one of those is not NULL, the strings must have at least a minimum length as given below.

  @param string  (char *) Input string that should be scanned
  @param axis    (char *) Output, axis descriptor string (at least 4 characters)
  @param unit    (char *) Output, unit string (at least 30 characters)
  @param altunit (char *) Output, Alternative unit string to the right (top) axis (at least 30 characters)
  @param legend  (char *) Output, legend string (at least 80 characters)
  @param ndisks  (int)    Input, number of disks

  @return (success) int get_graphident: Identification for a graphics output
          (error)   -1 In case of an invalid string
*/
/* ------------------------------------------------------------ */
static int get_graphident(char *string, char *axis, char *unit, char *altunit, char *legend, int ndisks);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int renzo(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm)
  @brief Produces a renzogram with the rings

  @param startinfv  (startinf *)    Properly configured startinf struct
  @param hdr  (hdrinf *)    Properly configured hdrinf struct
  @param rpm  (ringparms *) Properly configured ringparms struct
  @return (success) int renzo: 0
          (error)   1
*/
/* ------------------------------------------------------------ */
static int renzo(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static qfits_header *makerenzohdr(hdrinf *hdr, int planes, int refine)
  @brief Produces a header struct for renzogram output

  Produces a qfits_header object suitable for the renzogram output.

  @param  hdr    (hdrinf *) Properly configured hdrinf struct
  @param  planes (int)      Number of planes
  @param  refine (int)      How many pixels in the outcube fit in one pixel of the incube.

  @return (success) qfits_header *makecoolhdr: The properly configured header
          (error)   NULL
*/
/* ------------------------------------------------------------ */
static qfits_header *makerenzohdr(hdrinf *hdr, int planes, int refine);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int destroy_inf_sdis(inf_sdis *int_sdisv)
  @brief deallocates an inf_sdis struct

  @param  int_sdisv (hdrinf *) sdis struct

  @return (success) 0
          (error)   1
*/
/* ------------------------------------------------------------ */
static int destroy_inf_sdis(inf_sdis *int_sdisv);
static int destroy_inf_vrad(inf_vrad *int_vradv);
static int destroy_inf_vver(inf_vver *int_vverv);
static int destroy_inf_dvro(inf_dvro *int_dvrov);
static int destroy_inf_dvra(inf_dvra *int_dvrav);
static int destroy_inf_dvve(inf_dvve *int_dvvev);
static int destroy_inf_vm0(inf_vm0 *int_vm0v);
static int destroy_inf_vm1(inf_vm1 *int_vm1v);
static int destroy_inf_vm2(inf_vm2 *int_vm2v);
static int destroy_inf_vm3(inf_vm3 *int_vm3v);
static int destroy_inf_vm4(inf_vm4 *int_vm4v);
static int destroy_inf_ra1(inf_ra1 *int_ra1v);
static int destroy_inf_ra2(inf_ra2 *int_ra2v);
static int destroy_inf_ra3(inf_ra3 *int_ra3v);
static int destroy_inf_ra4(inf_ra4 *int_ra4v);
static int destroy_inf_ro1(inf_ro1 *int_ro1v);
static int destroy_inf_ro2(inf_ro2 *int_ro2v);
static int destroy_inf_ro3(inf_ro3 *int_ro3v);
static int destroy_inf_ro4(inf_ro4 *int_ro4v);
static int destroy_inf_wm0(inf_wm0 *int_wm0v);
static int destroy_inf_wm1(inf_wm1 *int_wm1v);
static int destroy_inf_wm2(inf_wm2 *int_wm2v);
static int destroy_inf_wm3(inf_wm3 *int_wm3v);
static int destroy_inf_wm4(inf_wm4 *int_wm4v);
static int destroy_inf_ls0 (inf_ls0  *int_ls0v);
static int destroy_inf_lc0 (inf_lc0  *int_lc0v);
static int destroy_inf_smi (inf_smi  *inf_smiv);
static int destroy_inf_gau (inf_gau  *inf_gauv);
static int destroy_inf_azi (inf_azi  *inf_gauv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static inf_sdis *create_inf_sdis(void)
  @brief Allocates an sdis struct and substructures

  @param  void

  @return (success) pointer to inf_sdis struct
          (error)   NULL
*/
/* ------------------------------------------------------------ */
static inf_sdis *create_inf_sdis(void);
static inf_vrad *create_inf_vrad(void);
static inf_vver *create_inf_vver(void);
static inf_dvro *create_inf_dvro(void);
static inf_dvra *create_inf_dvra(void);
static inf_dvve *create_inf_dvve(void);
static inf_vm0 *create_inf_vm0(void);
static inf_vm1 *create_inf_vm1(void);
static inf_vm2 *create_inf_vm2(void);
static inf_vm3 *create_inf_vm3(void);
static inf_vm4 *create_inf_vm4(void);
static inf_ra1 *create_inf_ra1(void);
static inf_ra2 *create_inf_ra2(void);
static inf_ra3 *create_inf_ra3(void);
static inf_ra4 *create_inf_ra4(void);
static inf_ro1 *create_inf_ro1(void);
static inf_ro2 *create_inf_ro2(void);
static inf_ro3 *create_inf_ro3(void);
static inf_ro4 *create_inf_ro4(void);
static inf_wm1 *create_inf_wm1(void);
static inf_wm0 *create_inf_wm0(void);
static inf_wm2 *create_inf_wm2(void);
static inf_wm3 *create_inf_wm3(void);
static inf_wm4 *create_inf_wm4(void);
static inf_ls0  *create_inf_ls0 (void);
static inf_lc0  *create_inf_lc0 (void);
static inf_smi *create_inf_smi (void);
static inf_gau *create_inf_gau (void);
static inf_azi *create_inf_azi (void);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int chkb_zero(ringparms *rpm, fitparms *fit, int ident)
  @brief check if the function should be activated

  Basically checks if the parameter with the name ident is nonzero in the input and if it is fitted.

  @param rpm   (ringparms *) Properly configured ringparms struct
  @param fit   (ringparms *) Properly configured fitparms struct
  @param ident (int *)       identification (PXXX)

  @return 0: activate function (either nonzero or fitted)
          1: do not activate function
*/
/* ------------------------------------------------------------ */
static int chkb_zero(ringparms *rpm, fitparms *fit, int ident);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int chkb_val(ringparms *rpm, fitparms *fit, int ident, double val)
  @brief check if the function should be activated

  Basically checks if the parameter with the name ident is not val in the input and if it is fitted.

  @param rpm   (ringparms *) Properly configured ringparms struct
  @param fit   (ringparms *) Properly configured fitparms struct
  @param ident (int *)       identification (PXXX)
  @param val   (double *)    The value that every parameter should have

  @return 0: activate function (either non-90 or fitted)
          1: do not activate function
*/
/* ------------------------------------------------------------ */
static int chkb_val(ringparms *rpm, fitparms *fit, int ident, double val);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int chkb_sdis(ringparms *rpm, fitparms *fit)
  @brief Optionally allocates and puts correct switches in the sdis struct

  Basically checks in which way the ring-dependent dispersion is taken
  into account, allocates (or doesn't allocate) structures and sets
  the correct function pointers. If the dispersion is 0 throughout and
  is not fitted, no random component is added to the velocity of point
  sources (otherways, a random component is calculated, but it is 0
  anyway).

  @param rpm  (ringparms *) Properly configured ringparms struct
  @param fit  (ringparms *) Properly configured fitparms struct

  @return (success) 0
          (error)   1: memory problems
*/
/* ------------------------------------------------------------ */
static int chkb_sdis(ringparms *rpm, fitparms *fit);
static int chkb_vrad(ringparms *rpm, fitparms *fit);
static int chkb_vver(ringparms *rpm, fitparms *fit);
static int chkb_dvro(ringparms *rpm, fitparms *fit);
static int chkb_dvra(ringparms *rpm, fitparms *fit);
static int chkb_dvve(ringparms *rpm, fitparms *fit);
static int chkb_vm0 (ringparms *rpm, fitparms *fit);
static int chkb_vm1(ringparms *rpm, fitparms *fit);
static int chkb_vm2(ringparms *rpm, fitparms *fit);
static int chkb_vm3(ringparms *rpm, fitparms *fit);
static int chkb_vm4(ringparms *rpm, fitparms *fit);
static int chkb_ra1(ringparms *rpm, fitparms *fit);
static int chkb_ra2(ringparms *rpm, fitparms *fit);
static int chkb_ra3(ringparms *rpm, fitparms *fit);
static int chkb_ra4(ringparms *rpm, fitparms *fit);
static int chkb_ro1(ringparms *rpm, fitparms *fit);
static int chkb_ro2(ringparms *rpm, fitparms *fit);
static int chkb_ro3(ringparms *rpm, fitparms *fit);
static int chkb_ro4(ringparms *rpm, fitparms *fit);
static int chkb_wm0 (ringparms *rpm, fitparms *fit);
static int chkb_wm1(ringparms *rpm, fitparms *fit);
static int chkb_wm2(ringparms *rpm, fitparms *fit);
static int chkb_wm3(ringparms *rpm, fitparms *fit);
static int chkb_wm4(ringparms *rpm, fitparms *fit);
static int chkb_ls0 (ringparms *rpm, fitparms *fit);
static int chkb_lc0 (ringparms *rpm, fitparms *fit);
static int chkb_smi (ringparms *rpm, fitparms *fit);
static int chkb_gau (ringparms *rpm, fitparms *fit);
static int chkb_azi (ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void rndmf_init_sdis_pas(ringparms *rpm, int srnr, int disk)
  @brief Initialises the rng internal to the calulation of sdis

  @param rpm  (void *)   properly allocated ringparms struct
  @param srnr (int)      sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void rndmf_init_sdis_act(void *rpm, int srnr, int disk);
static void rndmf_init_gau_act(void *rpm, int srnr, int i, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void rndmf_init_sdis_pas(void *rpm, int srnr, int disk)
  @brief dummy function doing nothing instead of rndmf_init_sdis_act

  @param rpm  (void *)   meaningless
  @param srnr (int)      meaningless
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void rndmf_init_sdis_pas(void *rpm, int srnr, int disk);
static void rndmf_init_gau_pas(void *rpm, int srnr, int i, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void chclfl_sdis_act(void *rpm, int srnr, int disk)
  @brief Change the cloud flux and the cloud numbers depending on the number of subrings

  @param rpm  (void *)   properly configured ringparms struct, casted to void
  @param srnr (int)      subring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void chclfl_sdis_act(void *rpm, int srnr, int disk);
static void chclfl_sdis_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sdis_empty_act(void *rpm, int srnr, int disk)
  @brief Use the random number generator instead of creating point sources

  @param rpm  (void *)   properly configured ringparms struct, casted to void
  @param srnr (int)      subring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_sdis_empty_act(void *rpm, int srnr, int disk);
static void pr_sdis_empty_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sdis_repeater_act(void *rpm, int srnr, int disk)
  @brief Repeat a sequence of changing the velocity and gridding

  @param rpm     (void *)   properly configured ringparms struct, casted to void
  @param pp,     (float *)  point source coordinates
  @param vold    (float)    old velocity of point source
  @param srnr    (int)      subring number
  @param hdr     (hdrinf *) properly configured hdrinf struct
  @param j       (long *)   point source number
  @param signum  (int)      signum of flux of point source
  @param npoints (long *)   number of points
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void sdis_repeater_act(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk);
static void sdis_repeater_pas(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sdis_act(ringparms *rpm, float v, int srnr, int disk)
  @brief calculates random velocity component and adds it to the input

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param v       (float *)     Original velocity on input, will be changed
  @param vold    (float *)     Output: original velocity on input
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_sdis_act(void *rpm, float *v, float *vold, int srnr, int disk);
static void pr_vrad_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
/* Note that the whole 6d point must be passed */
static void pr_vver_act(void *rpm, float *point, int srnr, int disk);
static void pr_dvro_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvra_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvve_act(void *rpm, float *v, int srnr, int disk);
static void pr_dvro_act2(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvra_act2(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvve_act2(void *rpm, float *v, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gau_getcloudnumber_act(ringparms *rpm, int srnr, int number, int disk)
  @brief returns a cloud number solving an integral

  Gaussian spiral arm or bar, generating cloud number for Gaussian number

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param number  (int)         Number of arm
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void gau_getcloudnumber_act(void *rpm, int srnr, int number, int disk);
/* Dummy instead */
static void gau_getcloudnumber_pas(void *rpm, int srnr, int number, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void gau_getaz(ringparms *rpm, int pgaip, maths_rstrf *randstr, int pgaid, float *az, float *sinaz, float *cosaz, int srnr, int disk)
  @brief returns an azimuth

  Returns new azimuth of point source, for a given Gaussian

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param pgaip   (int)         Number of parameter for the Gaussian phase, PGA1P, PGA2P, PGA3P, or PGA4P
  @param randstr (maths_rstrf) Randum number generator struct, gau_inf -> randstr1/randstr2/randstr3/randstr4
  @param pgaid   (int)         Number of parameter for the Gaussian dispersion, 0, 1, 2, or 3
  @param az      (float *)     Output: azimuth
  @param cosaz   (float *)     Output: cosine of azimuth
  @param sinaz   (float *)     Output: sine of azimuth
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void gau_getaz(ringparms *rpm, int pgaip, maths_rstrf *randstr, int pgaid, float *az, float *sinaz, float *cosaz, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_vver_rota_act(void *rpm, float *vz, float *vz2, int srnr, int disk)
  @brief Adds the cosine component when rotating about
  inclination, in case that the vertical velocity is nonzero

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param vz      (float *)     Original velocity on input, z component
  @param vz2     (float *)     Original velocity on output, z-component, will be changed
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_vver_rota_act(void *rpm, float *vz, float *vz2, int srnr, int disk);
static void pr_vver_rota_pas(void *rpm, float *vz, float *vz2, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_vmi_pas(void *rpm, int srnr, int disk)
  @brief dummy instead of pr_m1_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param srnr    (int)     sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_vmi_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_wm1s_act(ringparms *rpm int srnr, int disk)
  @brief calculates warp sin component and adds it to the subring

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_wm1s_act(void *rpm, int srnr, int disk);
static void srpr_wm2s_act(void *rpm, int srnr, int disk);
static void srpr_wm3s_act(void *rpm, int srnr, int disk);
static void srpr_wm4s_act(void *rpm, int srnr, int disk);
static void srpr_wm1c_act(void *rpm, int srnr, int disk);
static void srpr_wm2c_act(void *rpm, int srnr, int disk);
static void srpr_wm3c_act(void *rpm, int srnr, int disk);
static void srpr_wm4c_act(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_wmi_pas(void *rpm, int srnr, int disk)
  @brief dummy instead of pr_m1_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param srnr    (int)     sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_wmi_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_vm1s_act(ringparms *rpm int srnr, int disk)
  @brief calculates velocity sin component and adds it to the subring

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_vm1s_act(void *rpm, int srnr, int disk);
static void srpr_vm2s_act(void *rpm, int srnr, int disk);
static void srpr_vm3s_act(void *rpm, int srnr, int disk);
static void srpr_vm4s_act(void *rpm, int srnr, int disk);
static void srpr_vm1c_act(void *rpm, int srnr, int disk);
static void srpr_vm2c_act(void *rpm, int srnr, int disk);
static void srpr_vm3c_act(void *rpm, int srnr, int disk);
static void srpr_vm4c_act(void *rpm, int srnr, int disk);

static void srpr_ra1s_act(void *rpm, int srnr, int disk);
static void srpr_ra2s_act(void *rpm, int srnr, int disk);
static void srpr_ra3s_act(void *rpm, int srnr, int disk);
static void srpr_ra4s_act(void *rpm, int srnr, int disk);
static void srpr_ra1c_act(void *rpm, int srnr, int disk);
static void srpr_ra2c_act(void *rpm, int srnr, int disk);
static void srpr_ra3c_act(void *rpm, int srnr, int disk);
static void srpr_ra4c_act(void *rpm, int srnr, int disk);

static void srpr_ro1s_act(void *rpm, int srnr, int disk);
static void srpr_ro2s_act(void *rpm, int srnr, int disk);
static void srpr_ro3s_act(void *rpm, int srnr, int disk);
static void srpr_ro4s_act(void *rpm, int srnr, int disk);
static void srpr_ro1c_act(void *rpm, int srnr, int disk);
static void srpr_ro2c_act(void *rpm, int srnr, int disk);
static void srpr_ro3c_act(void *rpm, int srnr, int disk);
static void srpr_ro4c_act(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_vmi_pas(void *rpm, float v, int srnr, float sinaz, float cosaz, int disk)
  @brief dummy instead of pr_vm1-4s/c_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param v       (float *) Original velocity on input, will be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_vmi_pas(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_vm1s_act(ringparms *rpm, float v, int srnr, float sinaz, float cosaz, int disk)
  @brief calculates s1 component and adds it to the input

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param v       (float *)     Original velocity on input, will be changed
  @param srnr    (int)         sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_vm1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_vm0_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

static void pr_ra1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ra4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

static void pr_ro1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
static void pr_ro4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_smi_pas(void *rpm, int srnr, int disk)
  @brief dummy instead of pr_m1_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param srnr    (int)     sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_smi_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_sm1s_act(ringparms *rpm int srn, int diskr)
  @brief calculates surface brightness sin component and adds it to the subring

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_sm0b_act(void *rpm, int srnr, int disk);
static void srpr_sm1s_act(void *rpm, int srnr, int disk);
static void srpr_sm2s_act(void *rpm, int srnr, int disk);
static void srpr_sm3s_act(void *rpm, int srnr, int disk);
static void srpr_sm4s_act(void *rpm, int srnr, int disk);
static void srpr_sm1c_act(void *rpm, int srnr, int disk);
static void srpr_sm2c_act(void *rpm, int srnr, int disk);
static void srpr_sm3c_act(void *rpm, int srnr, int disk);
static void srpr_sm4c_act(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_smi_pas(void *rpm, float v, int srnr, float sinaz, float cosaz, int disk)
  @brief dummy instead of pr_vm1-4s/c_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param sbr     (float *) Original surface brightness on input, will not be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_smi_pas(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sm0b_pas(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
  @brief dummy instead of pr_sm0b_act(), replaces *sbr with 0.0

  @param rpm     (void *)  Properly structured ringparms struct
  @param sbr     (float *) Original surface brightness on input, will not be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_sm0b_pas(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sm1s_act(ringparms *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
  @brief calculates s1 component and adds it to the input

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param sbr     (float *)     Original surface brightness on input, will be changed
  @param srnr    (int)         sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk    (int)     disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_sm0b_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm1s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm2s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm3s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm4s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm1c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm2c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm3c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);
static void pr_sm4c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void smi_sbrmax_act(void *rpm, int srnr, int disk)
  @brief calculates the sum of absolute amplitudes of surface brightness modes and puts that number in the sbrmax variable of the subring structure

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void smi_sbrmax_act(void *rpm, int srnr, int disk);
static void smi_sbrmax_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void smi_getaz_harm(void *rpm, float *az, float *cosaz, float *sinaz, int *signum, int srnr, int disk)
  @brief returns an azimuth

  If harmonics in the surface brightness are used, then the
  distribution of point sources is not uniform. The function will take
  care of a correct distribution of point sources returned.

  @param rpm     (void *)      Properly structured ringparms struct, casted to void
  @param cosaz   (float *)     Output: azimuth
  @param cosaz   (float *)     Output: cosine of azimuth
  @param sinaz   (float *)     Output: sine of azimuth
  @param signum  (int *)       Output: signum of point source flux
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void smi_getaz_harm(void *rpm, float *az, float *cosaz, float *sinaz, int *signum, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void smi_getaz_cons(void *rpm, float *az, float *cosaz, float *sinaz, int *signum, int srnr, int disk)
  @brief returns an azimuth

  Returns new azimuth of point source, without harmics

  @param rpm     (void *)      Properly structured ringparms struct, casted to void
  @param az   (float *)        Output: azimuth
  @param cosaz   (float *)     Output: cosine of azimuth
  @param sinaz   (float *)     Output: sine of azimuth
  @param signum  (int *)       Output: signum of point source flux
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void smi_getaz_cons(void *rpm, float *az, float *cosaz, float *sinaz, int *signum, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void smi_getcloudnumber_harm(ringparms *rpm, int srnr, int disk)
  @brief returns a cloud number solving an integral

  If harmonics in the surface brightness are used, then the
  distribution of point sources is not uniform. In the case of
  negative clouds, this function needs to be invoked to determine the
  cloud number instead of the much simpler smi_getcloudnumber_norm

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param disk    (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void smi_getcloudnumber_harm(void *rpm, int srnr, int disk);
static void smi_getcloudnumber_norm(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void rndmf_init_sdis_pas(ringparms *rpm, int srnr, int disk)
  @brief Initialises the rng internal to the calulation of sdis

  @param rpm  (void *)   properly allocated ringparms struct
  @param srnr (int)      sub-ring number
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void rndmf_init_smi_act(void *rpm, int srnr, int disk);
static void rndmf_init_smi_pas(void *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_gau_act(ringparms *rpm, int srnr, int number, int disk)
  @brief calculates surface brightness Gaussian dispersion in rad and adds it to the ring

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param number  (int)         number of Gaussian component
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_gau_act(void *rpm, int srnr, int number, int disk);
static void srpr_gau_pas(void *rpm, int srnr, int number, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srpr_azi_act(ringparms *rpm, int srnr, int number, int disk)
  @brief calculates ranges for the exclusion from the model

  @param rpm     (ringparms *) Properly structured ringparms struct
  @param srnr    (int)         sub-ring number
  @param number  (int)         number of segment
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void srpr_azi_act(void *rpm, int srnr, int number, int disk);
static void srpr_azi_pas(void *rpm, int srnr, int number, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void setoutrange_azi_act(int *outofrange)
  @brief sets outofrange to 1

  @param outofrnage (int *)       Output: outofrange changes to 1
  @return void
*/
/* ------------------------------------------------------------ */
static void setoutrange_azi_act(int *outofrange);
static void setoutrange_azi_pas(int *outofrange);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_azi_act(float *azi, float ranges[2][4], int *outofrange, int i)
  @brief calculates ranges for the exclusion from the model

  @param azi        (float *)     Azimuth
  @param ranges     (float[2][4]) the ranges to check (these are 8 ranges)
  @param outofrnage (int *)       Output: outofrange changes to 0 if the azimuth is in the range defined by ranges
  @param i          (int)         Sub-range to check 0 or 1
  @return void
*/
/* ------------------------------------------------------------ */
static void pr_azi_act(float *azi, float ranges[2][4], int *outofrange, int i);
static void pr_azi_pas(float *azi, float ranges[2][4], int *outofrange, int i);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srshape_azi_act(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk)
  @brief Shape the point source

  Changes the coordinates of the pointsource using srshape, if
  outofrange == 0, if outofrange == 1, pp[0] = -1 and nothing is done
  except for stepping forward in the rngs. The passive version only
  calls srshape.

  @param rpm        (void *)  Properly structured ringparms struct
  @param pp         (float *) Output: position of point source
  @param sinaz      (float)   sine of the azimuth
  @param cosaz      (float)   cosine of the azimuth
  @param srnr       (int)     sub-ring number
  @param outofrnage (int *)   outofrange 0 means do a normal shaping, 1 means do "nothing"
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static int srshape_azi_act(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk);
static int srshape_azi_pas(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void srshape_azi_act(void *rpm, int srnr, int outofrange, int signum)
  @brief Shape the point source

  Changes the coordinates of the pointsource using srshape, if
  outofrange == 0, if outofrange == 1, pp[0] = -1 and nothing is done
  except for stepping forward in the rngs. The passive version only
  calls srshape.

  @param rpm        (void *)  Properly structured ringparms struct
  @param srnr       (int)     sub-ring number
  @param outofrange (int)     outofrange 0 means do a normal shaping, 1 means do "nothing"
  @param signum     (int)     Dummy probably
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void corrp_azi_act(void *rpm, int srnr, int *outofrange, int signum);
static void corrp_azi_pas(void *rpm, int srnr, int *outofrange, int signum);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_wmi_pas(void *rpm, float v, int srnr, float sinaz, float cosaz, int disk)
  @brief dummy instead of pr_vm1-4s/c_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param z       (float *) Original heigt on input, will be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_wmi_pas(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_wm0_act(ringparms *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
  @brief calculates m0 component and adds it to the input

  @param rpm     (void *)  Properly structured ringparms struct
  @param z       (float *) Original height above plane, will be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static  void pr_wm0_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm1s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm2s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm3s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm4s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm1c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm2c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm3c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);
static void pr_wm4c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_ls0_pas(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk)
  @brief dummy instead of pr_ls0_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param x       (float *) Original height above plane, will be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_ls0_pas(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk);
static void pr_lc0_pas(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_ws1_act(ringparms *rpm, float *x, int srnr, float sinaz, float cosaz, int disk)
  @brief calculates shift component and adds it to the input

  @param rpm     (void *)  Properly structured ringparms struct
  @param x       (float *) Original height above plane, will be changed
  @param srnr    (int)     sub-ring number
  @param sinaz   (float)   sine of the azimuth
  @param cosaz   (float)   cosine of the azimuth
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_ls0_act(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk);
static void pr_lc0_act(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void pr_sdis_pas(void *rpm, float v, int srnr, int disk)
  @brief dummy instead of pr_sdis_act

  @param rpm     (void *)  Properly structured ringparms struct
  @param v       (float *) Original velocity on input, will be changed
  @param vold    (float *)     Output: original velocity on input
  @param srnr    (int)     sub-ring number
  @param disk (int)         disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void pr_sdis_pas(void *rpm, float *v, float *vold, int srnr, int disk);
static void pr_vrad_pas(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk);
/* Note that the whole 6d point must be passed */
static void pr_vver_pas(void *rpm, float *point, int srnr, int disk);
static void pr_dvro_pas(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvra_pas(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk);
static void pr_dvve_pas(void *rpm, float *point, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int activateftstab(startinf *startinfv, loginf *log, ringparms *rpm)
  @brief Starts up the ftstab machinery

  This sets up the ftstab module to work writing to (or appending to
  the existent) the logfile. It sets the logfile -> logpres parameter
  to 0 if the logfile is present, to 1 otherwise. An error is returned
  if the user interrupts the progress, the logfile is not a fits
  table, or if a logfile has been requested, but couldn't be
  opened. If no logfile is requested, no error is returned

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly allocated ringparms struct

  @return int activateftstab: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int activateftstab(startinf *startinfv, loginf *log, ringparms *rpm);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int int tir_get_grid(loginf *log, ringparms *rpm, double *array)
  @brief Copy log -> grid to array

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param array   (double *)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5

  @return int tir_get_grid: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int tir_get_grid(loginf *log, ringparms *rpm, double *array);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static double tir_get_colgrid(loginf *log, ringparms *rpm, int i)
  @brief Returns log -> grid[i-1]

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param i   (int *)  column number, starting at 1

  @return double tir_get_colgrid
*/
/* ------------------------------------------------------------ */
static double tir_get_colgrd(loginf *log, ringparms *rpm, int i);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static double tir_get_colrad(loginf *log, ringparms *rpm, int i)
  @brief Returns log -> radius[i-1]

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param i   (int *)  column number, starting at 1

  @return double tir_get_colrad
*/
/* ------------------------------------------------------------ */
static double tir_get_colrad(loginf *log, ringparms *rpm, int i);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int int tir_get_radius(loginf *log, ringparms *rpm, double *array)
  @brief Copy log -> radius to array

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param array   (double *)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5

  @return int tir_get_radius: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int tir_get_radius(loginf *log, ringparms *rpm, double *array);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int int tir_put_register(loginf *log, ringparms *rpm, double *array)
  @brief Copy array to log -> regist

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param array   (double *)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5

  @return int tir_get_radius: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int tir_put_register(loginf *log, ringparms *rpm, double *array);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int int tir_get_register(loginf *log, ringparms *rpm, double *array)
  @brief Copy log -> regist to array

  The arrays must have a dimension of nur*NPARAMS+nur*NDPARAMS+5

  @param log     (loginf *)  Properly structured loginf struct
  @param rpm     (ringparms *)  Properly structured ringparms struct
  @param array   (double *)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5

  @return int tir_get_radius: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int tir_get_register(loginf *log, ringparms *rpm, double *array);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int tir_fillhd(loginf *log, int i, double radius, double grid)
  @brief Fill the i-1 th position of log -> grid and log -> radius with grid and radius

  @param log      (loginf *)  Properly structured loginf struct
  @param i        (int)       Properly structured ringparms struct
  @param radius   (double)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5
  @param grid     (double)  Array of dimension nur*NPARAMS+nur*NDPARAMS+5

  @return int tir_get_radius: 0 (success)
                              >0 (error)
*/
/* ------------------------------------------------------------ */
static int tir_fillhd(loginf *log, int i, double radius, double grid);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static int dec_fill(ringparms *rpm, decomp_control *decomp_controlv)
  @brief Fill a simparse decomp struct with parameter information

  @param rpm                (ringparms) properly configured ringparms struct
  @param decomp_controlv    (decomp_control *)  Allocated simparse decomp control structure

  @return 0: success
          1: memory problems
*/
/* ------------------------------------------------------------ */
static int dec_fill(ringparms *rpm, decomp_control *decomp_controlv);

#ifdef PBCORR

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void alloc_pbcfac_act(ringparms *rpm, int srnr, int disk)
  @brief Allocate memory for primary beam factors

  same function pas doesn't do anything.

  @param rpm  (ringparms *)   properly allocated ringparms struct
  @param srnr (int)      sub-ring number
  @param disk (int)      disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void alloc_pbcfac_act(ringparms *rpm, int srnr, int disk);
static void alloc_pbcfac_pas(ringparms *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void dealloc_pbcfac_act(ringparms *rpm, int srnr, int disk)
  @brief Deallocate memory for primary beam factors

  same function pas doesn't do anything.

  @param rpm  (ringparms *)   properly allocated ringparms struct
  @param srnr (int)      sub-ring number
  @param disk (int)      disk number

  @return void
*/
/* ------------------------------------------------------------ */
static void dealloc_pbcfac_act(ringparms *rpm, int srnr, int disk);
static void dealloc_pbcfac_pas(ringparms *rpm, int srnr, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void fill_pbcfac_act((ringparms *rpm, struct srd **sd, int disk, int srnr, long *pnr, int *grid)
  @brief Fill the pbfac array with the right numbers

  same function pas doesn't do anything.

  @param hdr    (hdrinf *)                  properly allocated headerinf struct
  @param sd     (struct srd *[ndisks])      sub-ring array
  @param disk   (int)                       disk number
  @param srnr   (int)                       sub-ring number
  @param pnr    (long *)                      point number
  @param grid   (int *)                     grid position

  @return void
*/
/* ------------------------------------------------------------ */
static void fill_pbcfac_act(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid);
static void fill_pbcfac_pas(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void corr_pbcfac_act(struct srd **sd, int disk, int srnr, long pnr)
  @brief Apply the pbfac array with the right numbers

  same function pas doesn't do anything.

  @param sd     (struct srd **)      sub-ring array
  @param disk   (int)                disk number
  @param srnr   (int)                sub-ring number
  @param pnr    (long)               point number

  @return void
*/
/* ------------------------------------------------------------ */
/* static void corr_pbcfac_act(struct srd *sd[ndisks], int disk, int srnr, long pnr); */
/* static void corr_pbcfac_pas(struct srd *sd[ndisks], int disk, int srnr, long pnr); */
static void corr_pbcfac_act(struct srd **sd, int disk, int srnr, long pnr);
static void corr_pbcfac_pas(struct srd **sd, int disk, int srnr, long pnr);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
  @fn static void chkb_pbcorr(hdrinf *hdr, ringparms *rpm)
  @brief Link correct funtions for bpcorr

  same function pas doesn't do anything.

  @param hdr   (hdrinf *)    correctly allocated hdrinf struct
  @param rpm   (ringparms *) correctly allocated ringparms struct

  @return void
*/
/* ------------------------------------------------------------ */
static void chkb_pbcorr(hdrinf *hdr, ringparms *rpm);

#endif

/*************/
/* Addendums under construction */
/*************/
/* #include "constr.h" */
/*************/

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static reg_cont *reg_cont_const(int nregs)
   @brief Constructs a NULL-terminated array of n (empty) reg_containers

   Constructs a NULL-terminated array of n (empty) reg_containers. The fc members are allocated.

   @param  nregs (int)       number of single fc_containers

   @return (success) reg_cont *reg_cont_const Allocated array of reg_containers
           (error) NULL
*/
/* ------------------------------------------------------------ */
static reg_cont **reg_cont_const(int nregs);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static int reg_cont_destr(reg_cont **reg_contv)
   @brief Constructs a NULL-terminated array of n (empty) reg_containers

   Destructor of an array of pointers to regularisation containers as constructed with reg_cont_const().

   @param  reg_contv (reg_cont) regularisaton container to be destroyed.

   @return (success) reg_cont *reg_cont_const Allocated array of reg_containers
           (error) NULL
*/
/* ------------------------------------------------------------ */
static int reg_cont_destr(reg_cont **reg_contv);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static reg_cont **reg_cont_get(startinf *startinfv, ringparms *rpm, fitparms *fit)
   @brief Get the regularisation list from user input

   Reads in the regularisation information from the input.

   @param startinfv (startinf *)   A start descriptor struct, properly filled.
   @param rpm (ringparms *)   A ring parameter descriptor struct, properly filled.
   @param fit (fitparms *)    A fit parameter descriptor struct, properly filled.

   @return (success) reg_cont **reg_cont_get regularisation struct
           (error) 1: NULL memory problems
*/
/* ------------------------------------------------------------ */
static reg_cont **reg_cont_get(startinf *startinfv, hdrinf *hdr, ringparms *rpm, fitparms *fit);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/**
   @fn static double reg_do(reg_cont **reg_contv, int loop, double chisquare)
   @brief Change the chisquare penalising Fourier modes

   For each entry in the reg_contv list, the vector reg_contv[i] ->
   first that has been specified on input with the function
   reg_cont_get() will be read as an input vector into reg_contv[i] ->
   fc to then determine the ratio of the modes specified on
   input. This is done in the following way (see fourat.h):

   i) the input array is interpolated (or extrapolated) between the active elements as
   specified in REGPARA=.

   ii) The interpolated array is Fourier-transformed.

   iii) The amplitudes of the orders specified in numerator (REGNUME=) are summed
   and divided by the sum of the amplitudes of the orders specified in
   denominator (REGDENO=), or, if greater than zero, by the amplitudes specified in REGAMPD=,  the ratio being r.

   iv) r is used to determine an addition to the chisquare >= 0, following a smooth step
   determined by regthre (REGTHRE= threshold above which the result is
   > 1), regwidt (REGWIDT=, width of step, the maximum is reached if r
   = regthre+regwidt), regampl (REGAMPL=, amplitude of step in first
   loop), and regaste (REGASTE=, each loop the step amplitude is
   increased by this value).

   v) The factors for each regularised groups are added to 1 (, stored, ) and returned.

   @param reg_contv (reg_cont **)   A NULL-terminated list of regularisation structs
   @param loop      (int)           Loop number
   @param chisquare (double)        Input chisquare

   @return double reg_do: Product of ratios of modes
*/
/* ------------------------------------------------------------ */
static double reg_do(reg_cont **reg_contv, int loop, double chisquare);

static int writecoolmodel(startinf *startinfv, loginf *log, hdrinf *origin, ringparms *rpm, fitparms *fit, double *par, decomp_inlist *index);
static int galmodcool(hdrinf *hdr, ringparms *rpm, int fitmode, varlel *varele, decomp_inlist *index, long *fluxpoints, int *allnpoints);
static long srconstcool(hdrinf *hdr, ringparms *rpm, int srnr, long mode, int disk);
static int srshape_azi_pascool(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk);
static int srshape_azi_actcool(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk);
static void srshapecool(ringparms *rpm, float *pp, float sinaz, float cosaz, int srnr, int disk);
#ifdef PBCORR
static void gridpoint_mixedcool(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#else
static void gridpoint_mixedcool(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#endif
#ifdef PBCORR
static void gridpoint_normcool(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#else
static void gridpoint_normcool(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk);
#endif
static void sdis_repeater_actcool(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk);
static void sdis_repeater_pascool(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk);

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* FUNCTION CODE */
/* ------------------------------------------------------------ */

int main(int argc, char *argv[])
{
  startinf *startinfv = NULL;
  loginf *log = NULL;
  hdrinf *hdr = NULL;
  ringparms *rpm = NULL;
  fitparms *fit = NULL;
  int i = 0;
  int j;
  int nrplts;
  char mes[81];

  printf("\n");
  printf("#####################\n");
  printf("# TiRiFiC v. 2.3.11 #\n");
  printf("#####################\n");
  printf("\n");

  if (!(startinfv = get_startinf(argc, argv)))
    goto error;

  while (check_restart(startinfv, hdr, rpm, log)) {

    if (!(log = get_loginf(startinfv, log)))
      goto error;

    if (!(hdr = get_hdrinf(startinfv, log, hdr)))
      goto error;

    if (!(rpm = get_ringparms(startinfv, log, hdr, rpm)))
      goto error;

    if (!(fit = get_fitparms(startinfv, log, hdr, rpm, fit))) {
      goto error;
    }

    if ((j = open_hdu_3(log, hdr, rpm, fit)) == 1) {
      goto error;
    }

    /*   else if (j == 2) */
    /*     ; */
    /*   else if (j == 0)  */

    prepout(log, hdr, rpm);

    if (fit -> fitmode == METROPOLIS) {
    /*       if (!metropolis(log, hdr, rpm, fit)) { */
    /* 	goto error; */
    /*       } */
    /*       if (!putmetresults(log, rpm, fit)) { */
    /* 	goto error; */
    /*       } */
        ;
      }
      else if (fit -> fitmode == GOLDEN_SECTION) {
        if (!golden_section(startinfv, log, hdr, rpm, fit))
    	goto error;

        if (!putgoldresults(log, rpm, fit))
    	goto error;
      }
      else if (fit -> fitmode > GOLDEN_SECTION) {
        if (!genfit(startinfv, log, hdr, rpm, fit))
    	goto error;

        if (!putgenresults(startinfv, log, hdr, rpm, fit))
    	goto error;
      }

    /* put the results in an ascii table */
    writeasctable(startinfv, log, hdr, rpm, fit);

    /* Put the results for each subring in an ascii table */
    writebigasctable(startinfv, log, hdr, rpm, fit);

    /* Graphics */
    nrplts = graphout(startinfv, log, hdr, rpm, fit);

    nrplts = ((nrplts))?nrplts:1;

    briggsout(startinfv, log, hdr, rpm, fit);

    /* Output of a def file */
    tirout(startinfv, log, rpm, fit, nrplts);

    /* Output of a histogram */
    /*   histout(rpm); */

    /* Rectify output */
    /*   rectout(log, hdr, rpm, fit); */

    /* Tiltogram output */
    tiltout(startinfv, log, hdr, rpm, fit);

    /* Write the output cube */
    i = 1;
    if ((*hdr -> outset != '\0')) {

      /* We read all values into the par array */
      tir_get_grid(log, rpm, log -> outarray);

      for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
        rpm -> oldpar[i] = log -> outarray[i];

      changetointern(rpm -> oldpar, rpm -> nur, hdr, rpm -> ndisks);

      /* Now we write it */
      writemodel(hdr, rpm, fit, rpm -> oldpar, fit -> index);
    }

    /* Renzo */
    renzo(startinfv, log, hdr, rpm);

    /* Cool */
    coolgal(startinfv, log, hdr, rpm, fit);

    /* Cool again */
    writecoolmodel(startinfv, log, hdr, rpm, fit, rpm -> oldpar, fit -> index);

    if ((log -> tstream))
      fclose(log -> tstream);
    log -> tstream = NULL;

    /* Close the progress file, Kamphuis addition */
    progressfinished(startinfv);

    loop_restart(startinfv);
  }

  /* if ((*hdr -> outset != '\0')) */
  /*   gds_close_tir(hdr -> outset, &i); */

    /*   ftstab_putminmax_(); */
  ftstab_close_();
  ftstab_flush_();
  ftstab_hdlreset_();
  hdl_init(rpm -> ndisks);
  destroy_startinf(startinfv);
  destroy_loginf(log, rpm -> ndisks);
  destroy_hdrinf(hdr);
  destroy_fitparms(fit);
  destroy_ringparms(rpm);

  /* finis_c(); */

  /* fprintf(stderr,"Got here: end\n");*/

  return 1;

 error:
  i = 0;
  sprintf(mes, "ABORTING: Memory problems, unwise parameters, user abort");
  anyout_tir(&i, mes);

  if ((log))
    destroy_loginf(log, rpm -> ndisks);
  if ((hdr))
    destroy_hdrinf(hdr);
  if ((rpm))
    destroy_ringparms(rpm);
  if ((fit))
    destroy_fitparms(fit);

  ftstab_close_();
  ftstab_flush_();

  /* finis_c(); */
  return 0;
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns a gipsy compatible char array */

static int tir_get_grid(loginf *log, ringparms *rpm, double *array)
{
  int i;
  for (i = 0; i < (rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS+OUTTABNR); ++i)
    array[i] = log -> grid[i];
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns a gipsy compatible char array */

static double tir_get_colgrd(loginf *log, ringparms *rpm, int i)
{
  return log -> grid[i-1];
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns a gipsy compatible char array */

static double tir_get_colrad(loginf *log, ringparms *rpm, int i)
{
  return log -> radius[i-1];
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/*  */

static int tir_get_radius(loginf *log, ringparms *rpm, double *array)
{
  int i;
  for (i = 0; i < (rpm -> nur*(NPARAMS+(rpm -> ndisks -1)*NDPARAMS)+NSPARAMS+OUTTABNR); ++i)
    array[i] = log -> radius[i];
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/*  */

static int tir_get_register(loginf *log, ringparms *rpm, double *array)
{
  int i;
  for (i = 0; i < (rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS+OUTTABNR); ++i)
    array[i] = log -> regist[i];
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/*  */

static int tir_put_register(loginf *log, ringparms *rpm, double *array)
{
  int i;
  for (i = 0; i < (rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS+OUTTABNR); ++i)
    log -> regist[i] = array[i];
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns a gipsy compatible char array */

static int tir_fillhd(loginf *log, int i, double radius, double grid)
{
  log -> grid[i] = grid;
  log -> radius[i] = radius;
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* testing ftstab */

static int activateftstab(startinf *startinfv, loginf *log, ringparms *rpm)
{
  int def;
  char mes[101];
  char mon_key[20];
  char value[20];
  int anint = 0;
  int logfile_present = 0;
  int logfile_faulty = 0;
  int logfile_not_tir = 0;
  int nel = 1;

  /* If there is no logfile specified we simply terminate the logname */
  if (*log -> logname == '\0') {
    free(log -> logname);
    log -> logname = NULL;
  }

  log -> logpres = 1;

  /* Close and reopen ftstab */
  if (!startinfv -> firstrun)
    ftstab_close_();

  /* initialise */
  /* Initialise the table content object */
  ftstab_flush_();

  /* Virginalise the header information table */
  ftstab_hdlreset_();

  /* Initialising the logfile info: change */

  /* This defines possible table items, their numbers (PPARAM+1),
     type, unit, scaling, it does not create a table */
  hdl_init(rpm -> ndisks);

  if ((log -> logname)) {

    /* Check if the logfile already exists and tell the user if yes */
    if (!(rename(log -> logname, log -> logname))) {
      sprintf(mes, "LOGFILE present");
      anyout_tir(&anint,mes);
      logfile_present = 1;
    }

    if (!startinfv -> firstrun){
      sprintf(mes, "multiple runs, will overwrite LOGFILE");
      anyout_tir(&anint,mes);
      logfile_present = 1;
    }

    /* open */
    /* returns 0 if file is present and could not be opened, 2 if no file is present and could also not be opened, something else if there is an error. (name,
       extension, mode (2: append), extension, history header, don't
       care.) Have to admit that this is a bit obscure, so I hope it still works.*/
    log -> logpres = ftstab_fopen(log -> logname, 1, 2, 1);

    /* An error occured connected to the opening of the logfile, inform the user */
    if (log -> logpres && (log -> logpres != 2)) {
      sprintf(mes, "LOGFILE faulty");
      anyout_tir(&anint,mes);
      logfile_faulty = 1;
    }

    if (!(log -> logpres)) {
      sprintf(mon_key, "CREATOR");
      if (ftstab_getcard(0, mon_key, value, 1)) {
	if (strcmp(value, "'TIRIFIC '")){
	  logfile_not_tir = 1;
	}
      }
      else
	logfile_not_tir = 1;

      if (logfile_not_tir) {
	sprintf(mes, "LOGFILE not created by TiRiFiC");
	anyout_tir(&anint,mes);
      }
    }

    /* Ask what to do (only if this is a single run) */
    if ((logfile_present)) {
      if (startinfv -> firstrun) {
	sprintf(mes, "continue [0]");
	anyout_tir(&anint,mes);
	sprintf(mes, "delete logfile and continue [1]");
	anyout_tir(&anint,mes);
	sprintf(mes, "stop [everything else, e.g. 2]");
	anyout_tir(&anint,mes);
	def = 1;
	nel = 1;
	anint = 0;
	sprintf(mes, "0, 1, or 2 [0]?");
	userint_tir(startinfv -> arel, &anint, &nel, &def, "ACTION", mes);

	/* fprintf("", startinf -> arel -> keyvallipre -> key); */

	/* We proceed and at the moment reset PROCEED */
	/* cancel_tir(startinfv -> arel, "ACTION=", 0); */
      }
      else {
	anint = 1;
      }
      if (anint) {
	if (anint == 1) {
	  /* Close the file, delete it, and open it again */
	  ftstab_close_();
	  ftstab_flush_();
	  ftstab_hdlreset_();
	  hdl_init(rpm -> ndisks);
	  remove(log -> logname);
	  log -> logpres = ftstab_fopen(log -> logname, 1, 2, 1);
	}
	else {
	  /* Close the file, and stop */
	  ftstab_close_();
	  ftstab_flush_();
	  ftstab_hdlreset_();
	  hdl_init(rpm -> ndisks);
	  log -> logpres = 1;
	  goto error;
	}
      }

      /* If the logfile was faulty, we close anyway */
      else if (logfile_faulty) {
	ftstab_close_();
	ftstab_flush_();
	ftstab_hdlreset_();
	hdl_init(rpm -> ndisks);
	log -> logpres = 1;
	sprintf(mes, "LOGFILE faulty, this never works.");
	anyout_tir(&anint,mes);
	goto error;
      }
    }

    /* I think the following should only be done if a file is not present, in which case the answer is 2 */
    if (log -> logpres == 2) {

      /* create a column, check what happens if there is already a table
	 object, success is 1, not 0 (verra old code) */
      ftstab_inithd(1L);

      /* now fill the column with information, columns start at 0 */
/*       output = ftstab_fillhd(0L, NPARAMS+(rpm -> ndisks-1)*NDPARAMS+NSPARAMS+PRIMHDN_SINGLE+SECHDN_MULTI+CHISQ_TABNR, COLTYPE_DOUBLE, 0.0, -1.0); */
      ftstab_fillhd(0L, NPARAMS+(rpm -> ndisks-1)*NDPARAMS+NSPARAMS+(LASTSING_PRIMPOS+NUMB_MDPRIMPOS*rpm -> ndisks)+SECHDN_MULTI+CHISQ_TABNR, COLTYPE_DOUBLE, 0.0, -1.0);
    }

    /* Now open the file and put some text there (or vice versa) */
    if (log -> logpres) {
      ftstab_genhd(0);

      /* probably the only thing that we'll do */
      sprintf(mon_key, "CREATOR");
      sprintf(value, "TIRIFIC");

      ftstab_putcard(0, mon_key, value);

      if ((log -> logpres = ftstab_fopen(log -> logname, 1, 2, 1))) {
	goto error;
      }
    }

  }

  /* Logfile is open or not present */
  return 0;

 error:
  /* Whenever we got here, there was an error, such that we should stop. Logfile is closed */
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a startinf structure */

static startinf *create_startinf(void)
{
  startinf *startinfv;

  /* Allocate the struct */
  if (!(startinfv = (startinf *) malloc(sizeof(startinf))))
    return NULL;

  /* First set all pointers to 0 and initialise some pointers */
  startinfv -> arel = NULL;
  startinfv -> restartname = NULL;
  startinfv -> restartid = 0;
  startinfv -> firstrun = 1;
  /* if (!(startinfv -> restartname =  getfcharray(200, NULL))) */
  /*   goto error; */
  if (!((startinfv -> filestat) = (struct stat *) malloc(sizeof(struct stat)))) {
    goto error;
  }

  return startinfv;

 error:
  destroy_startinf(startinfv);
  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destroys a loginf structure */

static void destroy_startinf(startinf *startinfv)
{
  /* Make it safer against unwarranted use */
  if (!(startinfv))
    return;

  /* Deallocate */
  if ((startinfv -> arel)) {
    simparse_scn_arellist_dest(startinfv -> arel);
  }
  if (startinfv -> restartname) {
    free(startinfv -> restartname);
  }
  if (startinfv -> filestat) {
    free(startinfv -> filestat);
  }

  free(startinfv);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialisation of the program concerning info from the dataset */
static startinf *get_startinf(int argc, char **argv)
{
  startinf *startinfv;
  /* char mes[81]; */
  /* int def, nel; */
    int i, blen, blin;
  char *buffer = NULL;
  int nread, nreturned;
  char *returnedc;
  int *prompt = NULL, *restartid = NULL;
  int restartdef = 0;
  int promptdef = 0;
  int keypres;
  char **varystr = NULL;

  /* Try to allocate */
  if (!(startinfv = create_startinf()))
    goto error;

  /* Get the command line into a buffer */

  /* first count */
  blen = 0;
  for (i = 1; i < argc; ++i) {
    blen = blen + strlen(argv[i]) + 1;
  }

  ++blen;

  /* Then allocate */
  if (!(buffer = (char *) malloc(blen*sizeof(char))))
    goto error;

  /* Then fill */
  if (argc == 1) {
    buffer[0] = '\0';
  }

  blen = 0;
  for (i = 1; i < argc; ++i) {
    memcpy(buffer+blen, argv[i], blin = strlen(argv[i]));
    blen = blen + blin;
    if (i < (argc - 1))
      buffer[blen] = ' ';
    else
      buffer[blen] = '\0';

    ++blen;
  }

  /* Now get the key struct */
  if (!(startinfv -> arel = simparse_scn_arel_insert(NULL, "Command line", buffer, NULL)))
    goto error;

  /* An input of restartid != 0 on the command line is an error */
  if (simparse_scn_arel_readval_int(startinfv -> arel, "RESTARTID", "ID of restart process [0]", 1, &restartdef, 1, 1, 0, 0, &keypres, &nread, &nreturned, &restartid))
    goto error;

  if (*restartid) {
    fprintf(stderr, "Error: cannot define RESTARTID=%i, other than RESTARTID=0 on command line.\n(Would lead to an endless loop.)\n", *restartid);
    goto error;
  }

  free(restartid);

  /* Read out the file name */
  if (simparse_scn_arel_readval_string(startinfv -> arel, "DEFFILE", "Provide default file name (default: no file).", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &returnedc))
    goto error;

  if ((returnedc[0]))
    printf("Using default file with name: %s\n", returnedc);

  if (!(startinfv -> arel = simparse_scn_arel_insert(startinfv -> arel, NULL, NULL, returnedc)))
    goto error;

  free(returnedc);

  /* Check if prompting */
  if (simparse_scn_arel_readval_int(startinfv -> arel, "PROMPT", "Prompt on error or terminate on error (prompt: 1, terminate: 0)? [0]", 1, &promptdef, 1, 1, 0, 0, &keypres, &nread, &nreturned, &prompt))
    goto error;

  /* Switch prompting on or off */
  simparse_scn_arel_onerror_prompt(startinfv -> arel, *prompt);
  if ((*prompt))
    printf("Will prompt on error.\n");
  else
    printf("Will terminate on error.\n");

  free(prompt);

  /* The startfile */
  /* cancel_tir(startinfv -> arel, "RESTARTNAME"); */

  if ((startinfv -> restartname)) {
    free(startinfv -> restartname);
    startinfv -> restartname = NULL;
  }

  if (varystr) {
    freeparsed(varystr);
    varystr = NULL;
  }

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "RESTARTNAME", "Give restartfile name.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(startinfv -> restartname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(startinfv -> restartname = simparse_copystring(""))) {
      goto error;
    }
  }
  freeparsed(varystr);
  varystr = NULL;

  if (simparse_scn_arel_readval_int(startinfv -> arel, "RESTARTID", "ID of restart process [0]", 1, &restartdef, 1, 1, 0, 0, &keypres, &nread, &nreturned, &restartid))
    goto error;
  startinfv -> restartid = *restartid;

  /* The startfile */
  /* sprintf(mes, "Give restartfile name."); */
  /*   for (i = 0; i < 200; ++i) */
  /*   startinfv -> restartname[i] = ' '; */
  /* startinfv -> restartname[200] = '\0'; */

  /* def = 2; */
  /* nel = 1; */
  /* userchar_tir(startinfv -> restartname, &nel, &def, "RESTARTNAME=", mes); */
  /* termsinglestr(startinfv -> restartname); */

  free(buffer);
  free(restartid);
  return startinfv;

 error:
  if ((startinfv)) {
    /* Stop the logfile io, also put ndisks = 1, is irrelevant */
    destroy_startinf(startinfv);
  }

  if ((buffer))
    free(buffer);
  if ((prompt))
    free(prompt);
  if ((startinfv -> arel))
    simparse_scn_arellist_dest(startinfv -> arel);

  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Return 1 if restart, 0 else */

static int check_restart(startinf *startinfv, hdrinf *hdr, ringparms *rpm, loginf *log)
{
  int retval,i;

  if (strlen(startinfv -> restartname)) {

    /* Check if file information can be acquired and fill stuff */
    if (stat(startinfv -> restartname, startinfv -> filestat)) {
      retval = 0;
    }
    else {
      startinfv -> timestamp = startinfv -> filestat -> st_mtime;
      retval = 1;
    }
  }
  else {
    retval = 0;
  }

  if (startinfv -> firstrun)
    retval = 1;

  if ((retval)) {
    if ((rpm)) {

      /* We read all values into the par array and to be sure make oldpar and par equal */
      tir_get_grid(log, rpm, log -> outarray);

      for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
        rpm -> oldpar[i] = log -> outarray[i];

      changetointern(rpm -> oldpar, rpm -> nur, hdr, rpm -> ndisks);

      for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
        rpm -> par[i] = rpm -> oldpar[i];
    }
  }

  return retval;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Check if restartfile exists and loop until its last change time stamp has changed with respect to the value stored in startinfv, make some switches afterwards */

static int loop_restart(startinf *startinfv)
{
  /* char mes[81]; */
  /* int def, nel, i; */
  char **varystr = NULL;
  int *restartid = NULL;
  int keypres, nread, nreturned;
  simparse_scn_keyvalli **keyvallifile;

  /* If the function is called, this should be done */
  startinfv -> firstrun = 0;

  /* Check if file is named */
  if (strlen(startinfv -> restartname)) {

    /* Check if file information can be acquired and fill stuff */
    if (stat(startinfv -> restartname, startinfv -> filestat)) {

      /* Notice that tirific will not wait until the restartfile is created */
      return 0;
    }
    else {
      fflush(NULL);
      printf("Waiting for file %s to change", startinfv -> restartname);
      if (startinfv -> restartid) {
	/* GJnew */
	/* if ((keyvallifile = simparse_scn_keyvallilist_gfrfi(startinfv -> arel[2] -> orifilename))) { */
	    printf(" and RESTARTID= %i to change in %s.\n", startinfv -> restartid, startinfv -> arel[2] -> orifilename);
	    /*       } */
      }
      else {
	printf(".\n");
      }

      /* Run a loop until the timestamps are the same or the file becomes unreadable */
      while (startinfv -> timestamp >= startinfv -> filestat -> st_mtime) {
		  if (stat(startinfv -> restartname, startinfv -> filestat)) {
			 break;
		  }
      }
      printf("File %s has changed.", startinfv -> restartname);

      /* Now refresh the input name and read it in again (not sure if this works or if the .def file has to be reread into some buffer before */
		/* Changed this here */
      cancel_tir(startinfv -> arel, "RESTARTNAME=", 1);

      /* Just make sure that the file is re-read */

      /* This may add an extra layer of security of sync */
      do {
	if ((restartid))
	   free(restartid);
	if (startinfv -> arel && startinfv -> arel[1] && startinfv -> arel[2]) {
	  if ((keyvallifile = simparse_scn_keyvallilist_gfrfi(startinfv -> arel[2] -> orifilename))) {
	    simparse_scn_keyvallilist_dest(startinfv -> arel[2] -> keyvallifile);
	    startinfv -> arel[2] -> keyvallifile = keyvallifile;
	  }
	  else {
	    simparse_scn_arel_timestamp_early(startinfv -> arel[2]);
	  }
	}
	if (simparse_scn_arel_readval_int(startinfv -> arel, "RESTARTID=", "ID of restart process [0]", 1, &startinfv -> restartid, 1, 1, 0, 0, &keypres, &nread, &nreturned, &restartid))
	  goto error;
      } while ((*restartid == startinfv -> restartid) && (startinfv -> restartid != 0));

      startinfv -> restartid = *restartid;

      if ((startinfv -> restartname)) {
	free(startinfv -> restartname);
	startinfv -> restartname = NULL;
      }

      /* sprintf(mes, "Give restartfile name."); */
      /* for (i = 0; i < 200; ++i) */
      /* 	startinfv -> restartname[i] = ' '; */
      /* startinfv -> restartname[200] = '\0'; */

      /* def = 4; */
      /* nel = 1; */
      /* userchar_tir(startinfv -> restartname, &nel, &def, "RESTARTNAME=", mes); */
      /* termsinglestr(startinfv -> restartname); */

      /* Let's do this by default */
      if (varystr) {
		  freeparsed(varystr);
		  varystr = NULL;
      }

      if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "RESTARTNAME", "Give name of file to restart.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
		  goto error;

      if ((varystr[0])) {
		  if (!(startinfv -> restartname = simparse_copystring(varystr[0]))) {
			 goto error;
		  }
      }
      else {
		  if (!(startinfv -> restartname = simparse_copystring(""))) {
			 goto error;
		  }
      }
      freeparsed(varystr);
      varystr = NULL;

		/* *** */
/*       if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "BILLIBULLY", "Give name of file to restart.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr)) */
/* 		  goto error; */

/*       if ((varystr[0])) { */
/* 		  fprintf(stderr,"bill: |%s|\n",varystr[0]); */
/*       } */
/*       freeparsed(varystr); */
/*       varystr = NULL; */

/* 		fprintf(stderr, "RESTARTNAME: %s", startinfv -> restartname); */
		/* *** */
    }
  }
  else {
    return 0;
  }

  if ((varystr)) {
    freeparsed(varystr);
  }
  /* GJnew */
    if ((restartid))
      free(restartid);
  return 0;

 error:
  if ((varystr)) {
    freeparsed(varystr);
  }
  if ((restartid))
    free(restartid);
  return 1;

}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a loginf structure */

static loginf *create_loginf(void)
{
  loginf *log;

  /* Allocate the struct */
  if (!(log = (loginf *) malloc(sizeof(loginf))))
    return NULL;

  /* First set all pointers to 0 and initialise some pointers */
  log -> logname = NULL;
  log -> logpres = 1;
  log -> tstream = NULL;
  log -> textlog = NULL;

  /* Kamphuis addition */
  log -> progresslog = NULL;
  log -> table = NULL;
  log -> outarray = NULL;
  log -> grid = NULL;
  log -> radius = NULL;
  log -> regist = NULL;
  log -> changes = 0;

  /* Allocate and terminate */
  /* if (!(log -> logname =  getfcharray(200, NULL))) */
  /*   goto error; */
  /* if (!(log -> textlog =  getfcharray(200, NULL))) */
  /*   goto error; */
  /* if (!(log -> progresslog =  getfcharray(200, NULL))) */
  /*   goto error; */
  /* if (!(log -> table =  getfcharray(200, NULL))) */
  /*   goto error; */
  log -> logname = NULL;
  log -> textlog = NULL;
  log -> progresslog = NULL;
  log -> table = NULL;

  return log;

 /* error: */
  /* Note: at this point, number of disks is unknown, but also irrelevant */
  /* destroy_loginf(log, 1); */
  /* return NULL; */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destroys a loginf structure */

static void destroy_loginf(loginf *log, int ndisks)
{

  /* Make it safer against unwarranted use */
  if (!(log))
    return;

  /* Deallocate */
  if (log -> logname) {
    free(log -> logname);
    log -> logname = NULL;

    if (!(log -> logpres)) {
      ftstab_flush_();
      ftstab_hdlreset_();
      hdl_init(ndisks);
    }
  }

  if (log -> textlog != NULL) {
    free(log -> textlog);
    log -> textlog = NULL;
  }

  /* Kamphuis addition */
  if (log -> progresslog != NULL) {
    free(log -> progresslog);
    log -> progresslog = NULL;
  }
  if (log -> table != NULL) {
    free(log -> table);
    log -> table = NULL;
  }
  if (log -> grid != NULL) {
    free(log -> grid);
    log -> grid = NULL;
  }
  if (log -> radius != NULL) {
    free(log -> radius);
    log -> radius = NULL;
  }
  if (log -> regist != NULL) {
    free(log -> regist);
    log -> regist = NULL;
  }
  if (log -> outarray != NULL) {
    free(log -> outarray);
    log -> outarray = NULL;
  }
  free(log);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a hdrinf structure */

static hdrinf *create_hdrinf(void)
{
  hdrinf *create_hdrinf;

  /* Allocate the struct */
  if (!(create_hdrinf = (hdrinf *) malloc(sizeof(hdrinf))))
    return NULL;

  /* First set all pointers to 0 */
  create_hdrinf -> inset = NULL;
  /* create_hdrinf -> insubs = NULL; */
  /* create_hdrinf -> cwlo = NULL; */
  /* create_hdrinf -> cwhi = NULL; */
  /* create_hdrinf -> ori = NULL; */
  create_hdrinf -> oric = NULL;
  /* create_hdrinf -> model = NULL; */
  create_hdrinf -> modelc = NULL;
  create_hdrinf -> coolcube = NULL;
  create_hdrinf -> outset = NULL;
  create_hdrinf -> chi2 = DBL_MAX;
  create_hdrinf -> oldchi2 = DBL_MAX;
#ifdef PBCORR
  create_hdrinf -> primbeam = NULL;
#endif

  /* Allocate and initialise the arrays */

  /* Allocate inset, we allow for more than 18 characters */
  /* if (!(create_hdrinf -> inset = getfcharray(200, NULL)))
     goto error;*/

  /* Allocate coordinate descriptor array */
  /* GJnew: removed this, lead to leakage */
  /* if (!(create_hdrinf -> insubs = (int *) malloc(MAXNSUBS*sizeof(int)))) */
  /*   goto error; */

  /* Allocate outset, we allow for more than 18 characters */
  /* if (!(create_hdrinf -> outset =  getfcharray(200, NULL))) */
  /*   goto error; */

  return create_hdrinf;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destroys a hdrinf structure */

static void destroy_hdrinf(hdrinf *hdr)
{
  /* Make it safer against unwarranted use */
  if (!(hdr))
    return;

  if (hdr -> inset !=  NULL)
    free(hdr -> inset);
  /* if (hdr ->insubs != NULL) */
  /*   free(hdr -> insubs); */

  /* if (hdr -> cwhi != NULL) */
  /*   free(hdr -> cwhi); */
  /* if (hdr -> cwlo != NULL) */
  /*   free(hdr -> cwlo); */
  if (hdr -> oric != NULL)
    cubarithm_cube_destroy(hdr -> oric);
  if (hdr -> modelc != NULL)
    cubarithm_cube_destroy(hdr -> modelc);
  if (hdr -> coolcube != NULL)
    cubarithm_cube_destroy(hdr -> coolcube);
  /* These are just the same as the points array in oric and modelc */
  /* if (hdr -> ori != NULL) */
  /*   free_engalmod(hdr -> ori); */
  /* if (hdr -> model != NULL) */
  /*   free_engalmod(hdr -> model); */
  if (hdr -> outset != NULL)
    free(hdr -> outset);
#ifdef PBCORR
  if ((hdr -> primbeam))
    free((hdr -> primbeam));
#endif

  /* Deallocate the struct */
  free(hdr);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialisation of the program concerning info from the dataset */
static loginf *get_loginf(startinf *startinfv, loginf *loginfv)
{
  loginf *log;
  char mes[81];
  int def, nel;
  int nread, nreturned, keypres;

  /* There's two possibilities: this is the first pass, which means to create the loginf structure, or this is the second pass, in which case we don't do anything */

  if (!startinfv -> firstrun)
    return loginfv;

  /* Try to allocate */
  if (!(log = create_loginf()))
    goto error;

#ifdef OPENMPTIR
  /* The very first thing to do is to ask for the number of cores */
  log -> ncores = 1;
  def = 5;

  sprintf(mes, "Give maximum number of cores. [1]");

  nel = 1;
  userint_tir(startinfv -> arel, &log -> ncores, &nel, &def, "NCORES=", mes);
  while (log -> ncores < 1) {
    sprintf(mes, "Should be at least one, eh?");
    cancel_tir(startinfv -> arel, "NCORES=", 2);
    userint_tir(startinfv -> arel, &log -> ncores, &nel, &def, "NCORES=", mes);
  }
  omp_set_num_threads(log -> ncores);
#else
  log -> ncores = 1;
#endif

  /* First thing to do is the logfile and the text logfile */

  /* The logfile */
  if (simparse_scn_arel_readval_string(startinfv -> arel, "LOGNAME", "Provide logfile name (default: no file).", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &(log -> logname)))
    goto error;

  /* sprintf(mes, "Give logfile name."); */
  /* for (i = 0; i < 200; ++i) */
  /*   log -> logname[i] = ' '; */
  /* log -> logname[200] = '\0'; */

  /* Formerly def = 5 */
  /* def = 5; */
  /* nel = 1; */
  /* userchar_tir(log -> logname, &nel, &def, "LOGNAME=", mes); */

  /* This puts an \0 to the end of the text */
  /* termsinglestr(log -> logname); */

  /* The text logfile */
  if (simparse_scn_arel_readval_string(startinfv -> arel, "TEXTLOG", "Provide text logfile name (default: no file).", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &(log -> textlog)))
    goto error;

    /* for (i = 0; i < 200; ++i) */
    /*   log -> textlog[i] = ' '; */
    /* log -> textlog[200] = '\0'; */
    /* def = 2; */

    /* sprintf(mes, "Give text logfile name."); */
    /* nel = 1; */
    /* userchar_tir(log -> textlog, &nel, &def, "TEXTLOG=", mes); */

    /* This puts an \n to the end of the text */
    /* termsinglestr(log -> textlog); */

    /* The Prgress LOG  Kamphuis addition */
  if (simparse_scn_arel_readval_string(startinfv -> arel, "PROGRESSLOG", "Provide progress logfile name (default: no file).", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &(log -> progresslog)))
    goto error;

    /* for (i = 0; i < 200; ++i) */
    /*   log -> progresslog[i] = ' '; */
    /* log -> progresslog[200] = '\0'; */
    /* def = 2; */

    /* sprintf(mes, "Give progress logfile name."); */
    /* nel = 1; */
    /* userchar_tir(log -> progresslog, &nel, &def, "PROGRESSLOG=", mes); */

    /* This puts an \n to the end of the text */
    /* termsinglestr(log -> progresslog); */
    /* Kamphuis addition end */

    /* The result name */
  if (simparse_scn_arel_readval_string(startinfv -> arel, "TABLE", "Give output table name (default: no file).", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &(log -> table)))
    goto error;

    /* for (i = 0; i < 200; ++i) */
    /*   log -> table[i] = ' '; */
    /* log -> table[200] = '\0'; */

    /* sprintf(mes, "Give output table name."); */
    /* nel = 1; */
    /* def = 2; */

    /* userchar_tir(log -> table, &nel, &def, "TABLE=", mes); */

    /* This puts an \0 to the end of the text */
    /* termsinglestr(log -> table); */

    /* Now get the distance of the object */
    log -> distance = 10;
    def = 2;

    sprintf(mes,"Distance in Mpc [10]");
    nel = 1;
    userdble_tir(startinfv -> arel, &log -> distance, &nel, &def, "DISTANCE=", mes);
    while (log -> distance <= 0) {
      sprintf(mes,"DISTANCE must be greater than zero.");
      log -> distance = 10;
      cancel_tir(startinfv -> arel, "DISTANCE=", 2);
      userdble_tir(startinfv -> arel, &log -> distance, &nel, &def, "DISTANCE=", mes);
    }

  return log;

 error:
  if ((log)) {
    /* Stop the logfile io, also put ndisks = 1, is irrelevant */
    destroy_loginf(log, 1);
  }
  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialisation of the program concerning info from the dataset */
static hdrinf *get_hdrinf(startinf *startinfv, loginf *log, hdrinf *hdrinfv)
{
  hdrinf *hdr = NULL; /* The output */

  int dev;      /* Output device */
  int def;      /* Any default mode */
  int nel;      /* Number of elements */
  int class;    /* A class for the input of a set */
  /* int classdim; */ /* Some other thing necessary for io of datasets */
  /* int option; */   /* Input to gdsbox */
  int err;      /* Error code */
  int outerr;   /* Error heaviness for output */
  /* int level; */    /* Strange level thingy */
  char mes[81];  /* Any message */
  /* char manual = 0; */ /* Signal for manual input */

  /* char ciax[9]; */ /* Keyword holder */
  /* char value[21]; */ /* Value holder */
  /* int i,j; */         /* Control variable */

  /* double deltsettouser[3]; */ /* Conversion factor from cuniti to userdeltunit */
  /* double setcdelt[3]; */ /* The cdelts in the set */
  /* double setcrval[3]; */ /* The reference values in the set */
  /* double userdeltcdelt[3]; */ /* The cdelt in delta user units */

  /* dummies */
  /* int inaxcount[MAXNAX]; */
  /* int outaxperm[MAXNAX]; */
  /* int outaxcount[MAXNAX]; */
  /* int outsubs[MAXNSUBS]; */
  /* int blo[3]; */ /* Contains lower values for subset dimensions for 2 axes */
  /* int bhi[3]; */ /* Contains higher values for subset dimensions for 2 axes */
  /* double vardouble; */ /* Any double */

  /* Just to pass pointers (FORTRAN ...) */
  /* int maxnsubs = MAXNSUBS; */
  /* int maxnax = MAXNAX; */

  int nread, nreturned, keypres;
  char errormes[120];
  char **stringlist = NULL;
  simparse_scn_arel *temparel;

  /* Everything in the header will be read once and not multiple times */
  if (!startinfv -> firstrun) {
    if ((hdrinfv)) {

      if ((hdrinfv -> outset)) {
	free(hdrinfv -> outset);
	hdrinfv -> outset = NULL;
	if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "OUTSET", "Give output cube name.", 0, NULL, 0, 1, 0, 0, &keypres, &nread, &nreturned, &stringlist))
	  goto error;

	if ((stringlist[0])) {
	  if (!(hdrinfv -> outset = simparse_copystring(stringlist[0]))) {
	    goto error;
	}
	}
	else {
	  if (!(hdrinfv -> outset = simparse_copystring("")))
	    goto error;
	}

	freeparsed(stringlist);
	stringlist = NULL;
      }
    }
    return hdrinfv;
  }

  if (!(hdr = create_hdrinf()))
    goto error;

  /* Get cube name */
  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "INSET", "Give input cube name (no default).", 0, NULL, 1, 1, 1, 0, &keypres, &nread, &nreturned, &stringlist))
    goto error;

  if (!(hdr -> inset = simparse_copystring(stringlist[0])))
    goto error;

  freeparsed(stringlist);
  stringlist = NULL;

  /* Read the cube */

  /* This is a trick to temporarily disable any other than hand input */
  temparel = startinfv -> arel[1];
  startinfv -> arel[1] = NULL;

  while (cubarithm_readcube(hdr -> inset, &(hdr -> oric), errormes)) {

    /* There was an error */
    fprintf(stderr, "INSET %s\n", errormes);

    /* Free the name */
    free(hdr -> inset);
    hdr -> inset = NULL;

    /* Doe this */
    cancel_tir(startinfv -> arel, "INSET", 0);

    /* Read another name from prompt or stop */
    if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "INSET", "Give input cube name (no default).", 0, NULL, 1, 1, 1, 0, &keypres, &nread, &nreturned, &stringlist)) {
      startinfv -> arel[1] = temparel;
      goto error;
    }

    /* Put in the name */
    if (!(hdr -> inset = simparse_copystring(stringlist[0])))
      goto error;

    freeparsed(stringlist);
    stringlist = NULL;
  }

  /* Reverse trick */
  startinfv -> arel[1] = temparel;

  /* Getting a copy is easy */
  if (!(hdr -> modelc = cubarithm_copycube(hdr -> oric)))
    goto error;

  /* padding (don't forget!) */
  padcubex(hdr -> oric);
  padcubex(hdr -> modelc);

  /* Linking, too (is absolutely dangerous and should be removed) */
  /* hdr -> ori = hdr -> oric -> points; */
  /* hdr -> model = hdr -> modelc ->points; */

  /* Input set and subsets and box are in any case necessary, even with a present logfile */
  /* err = 0; */
  /* sprintf(mes, "Give input set and subsets."); */
  /* def = 0; */
  /* dev = 0; */
  /* class = 1; */
  /* classdim = 2; */

  /* Get information about input dataset */
  hdr -> nsubs = hdr -> oric -> size_v;

  /* hdr -> nsubs = gdsinp_tir(hdr -> inset, hdr -> insubs, &maxnsubs, &def, "INSET=", mes, &dev, hdr -> inaxperm, inaxcount, &maxnax, &class, &classdim); */
  /* termsinglestr(hdr -> inset); */

  /* A box has to be defined inside the specified set, on default whole dataset , not exactly understood */
  /* sprintf((mes), "Give area of operation."); */
  /* def = 1; */
  /* dev = 1; */
  /* option = 1; */
  /* gdsbox_tir(blo, bhi, hdr -> inset, hdr -> insubs, &maxnsubs, &def, "BOX=", mes, &dev, &option); */
  /* def = 0; */

  /* The degree of error is not warning (1) but fatal (4) */
  /* outerr = 4; */

  /* Check the dataset */
  /* for (i = 0; i < 3; ++i) { */

    /* This is a simple check if CTYPEi is present in the header */
    /* err = 0; */
    /* sprintf(ciax, "CTYPE%i", hdr -> inaxperm[i]); */

    /* /\* For level refer to the description *\/ */
    /* level = 0; */
    /* for (j = 0; j < 20; ++j) */
    /* 	value[j] = ' '; */
    /*   value[20] = '\0'; */
    /*   gdsd_rchar_tir(hdr -> inset, ciax, &level, value, &err); */
    /*   if (err < 0) { */
    /* 	sprintf(mes, "Header: CTYPE%i not found.", i); */
    /* 	error_tir(&outerr, mes); */
    /*   } */

      /* This is a simple check if CUNITi is present in the header */
      /* err = 0; */
      /* sprintf(ciax, "CUNIT%i", hdr -> inaxperm[i]); */
      /* for (j = 0; j < 20; ++j) */
      /* 	value[j] = ' '; */
      /* value[20] = '\0'; */
      /* gdsd_rchar_tir(hdr -> inset, ciax, &(level), value, &err); */
      /* if (err < 0) { */
      /* 	sprintf(mes, "Header: CUNIT%i not found.", i); */
      /* 	error_tir(&outerr, mes); */
      /* } */

      /* This is a check whether the cunit can be converted to modelspacunit, modelmapunit, respectively. At the same time deltsettouser and  globsettouser is filled with that conversion factor */
      /* if (i < 2) { */
      /* 	err = factor_tir(value, userdeltunit, deltsettouser+i); */
      /* 	if (err) { */
      /* 	  dev = 0; */
      /* 	  sprintf(mes, "Header: Invalid CUNIT%i", i); */
      /* 	  error_tir(&outerr, mes); */
      /* 	} */
      /* 	factor_tir(value, userglobunit, hdr -> globsettouser+i); */
      /* } */
      /* else { */
      /* 	err = factor_tir(value, user3deltunit, deltsettouser+i); */
      /* 	if (err) { */
      /* 	  sprintf(mes, "Header: Invalid CUNIT%i", i); */
      /* 	  error_tir(&outerr, mes); */
      /* } */
      /* 	factor_tir(value, user3globunit, hdr -> globsettouser+i); */
      /* 	err = 0; */
      /* } */

  hdr -> globsettouser[0] = 1.;
  hdr -> globsettouser[1] = 1.;
  hdr -> globsettouser[2] = 0.001;

      /* Now check the cdelt */
      /* sprintf(ciax, "CDELT%i",  hdr -> inaxperm[i]); */
      /* for (j = 0; j < 20; ++j) */
      /* 	value[j] = ' '; */
      /* value[20] = '\0'; */

      /* level = 0; */
      /* gdsd_rdble_tir(hdr -> inset, ciax, &level, setcdelt+i, &err); */
      /* if (err < 0) { */
      /* 	sprintf(mes, "Header: CDELT%i not found.", i); */
      /* 	error_tir(&outerr, mes); */
      /* } */
      /* err = 0; */

      /* Now the crpix */
      /* sprintf(ciax, "CRPIX%i",  hdr -> inaxperm[i]); */
      /* for (j = 0; j < 20; ++j) */
      /* 	value[j] = ' '; */
      /* value[20] = '\0'; */

      /* For level refer to the description */
      /* level = 0; */
      /* gdsd_rdble_tir(hdr -> inset, ciax, &level, hdr -> setcrpix+i, &err); */
      /* if (err < 0) { */
      /* 	sprintf(mes, "Header: CRPIX%i not found.", i); */
      /* 	error_tir(&dev, mes); */
      /* } */

  hdr -> setcrpix[0] = hdr -> oric -> refpix_x;
  hdr -> setcrpix[1] = hdr -> oric -> refpix_y;
  hdr -> setcrpix[2] = hdr -> oric -> refpix_v;

  /* Now the crval */
  /* sprintf(ciax, "CRVAL%i",  hdr -> inaxperm[i]); */
  /* for (j = 0; j < 20; ++j) */
  /* 	value[j] = ' '; */
  /* value[20] = '\0'; */

  /* For level refer to the description */
  /* level = 0; */
  /* gdsd_rdble_tir(hdr -> inset, ciax, &level, setcrval+i, &err); */
  /* if (err < 0) { */
  /* 	sprintf(mes, "Header: CRVAL%i not found.", i); */
  /* 	error_tir(&dev, mes); */
  /* } */

  /* hdr -> setcrval[0] = hdr -> oric -> refval_x;      */
  /* hdr -> setcrval[1] = hdr -> oric -> refval_y;      */
  /* hdr -> setcrval[2] = hdr -> oric -> refval_v;      */

  /* The cdelt of the axis in user units, the size of a grid in user units */
  /* userdeltcdelt[i] = setcdelt[i]*deltsettouser[i]; */
  hdr -> userglobcdelt[0] = hdr -> oric -> delt_x*hdr -> globsettouser[0];
  hdr -> userglobcdelt[1] = hdr -> oric -> delt_y*hdr -> globsettouser[1];
  hdr -> userglobcdelt[2] = hdr -> oric -> delt_v*hdr -> globsettouser[2];

      /* The conversion factors for the user */
  hdr -> deltgridtouser[0] = fabs(hdr -> oric -> delt_x*DEGTOARCSEC);
  hdr -> deltgridtouser[1] = fabs(hdr -> oric -> delt_y*DEGTOARCSEC);
  hdr -> deltgridtouser[2] = fabs(hdr -> oric -> delt_v*hdr -> globsettouser[2]);

  hdr -> globgridtouser[0] = fabs(hdr -> oric -> delt_x);
  hdr -> globgridtouser[1] = fabs(hdr -> oric -> delt_y);
  hdr -> globgridtouser[2] = fabs(hdr -> oric -> delt_v*hdr -> globsettouser[2]);

      /* hdr -> globgridtouser[i] = fabs(hdr -> userglobcdelt[i]); */

      /* The reference values of the axis in user units */
  hdr -> userglobcrval[0] = hdr -> oric -> refval_x*1.;
  hdr -> userglobcrval[1] = hdr -> oric -> refval_y*1.;
  hdr -> userglobcrval[2] = hdr -> oric -> refval_v*hdr -> globsettouser[2];

  hdr -> signv = -hdr -> oric -> delt_v/fabs(hdr -> oric -> delt_v);

  /* Calculate the size of the cube in grids along axis 1 and 2 */
  /* hdr -> bsize1=bhi[0]-blo[0]+1; */
  /* hdr -> bsize2=bhi[1]-blo[1]+1; */
  hdr -> bsize1 = hdr -> oric -> size_x;
  hdr -> bsize2 = hdr -> oric -> size_y;

  /* This is to make a bit more space, take care for allocation */
  hdr -> bcsize1= 2*(hdr -> bsize1/2+1);

    /* The size of the cube in grids along axis 3 is given by hdr -> nsubs, get the values of the max and min grid */
    /* i = 0; */
    /* blo[2] = gdsc_grid_tir(hdr -> inset, hdr -> inaxperm+2, hdr -> insubs+i, &err); */
    /* i = hdr -> nsubs-1; */
    /* bhi[2] = gdsc_grid_tir(hdr -> inset, hdr -> inaxperm+2, hdr -> insubs+i, &err); */

    /* Get beam properties */
    /* BUGFIX: removed the possibility to read beam properties from header */

    /* First check whether this goes automatic */
  err = 0;

    /* If the cdelt is the same for both spatial axes, go on */
  if (fabs(hdr -> userglobcdelt[0]) != fabs(hdr -> userglobcdelt[1])) {
    anyout_tir(&outerr, "cdelt of axis1 and axis2 are different");
    err = 1;
  }

  /* err = 0; */

  /* check if major axis can be read from the dataset */
  /* gdsd_rdble_tir(hdr -> inset, "BMAJ", &level, &vardouble, &err); */
  /* if (err < 0) */

  /* This is a signal have it manually */
  /* 	manual = 1; */
  /* else { */
  /* 	outerr = 0; */

  /* This is done under the assumption that the beam is given in set units, i.e. degrees */
  hdr -> bmaj = (float) hdr -> oric -> bmaj/fabs(hdr -> oric -> delt_y);
  /*       sprintf(mes, "Beam major axis in arcsec: %f", hdr -> bmaj*fabs(setcdelt[0])); */
  /*       anyout_tir(&outerr, mes); */
  /* } */
  /* err = 0; */

  /* check if minor axis can be read from the dataset */
  /* gdsd_rdble_tir(hdr -> inset, "BMIN", &level, &vardouble, &err); */
  /* if (err < 0) */

  /* This is a signal have it manually */
  /* 	manual = 1; */
  /* else { */
  /* 	outerr = 0; */
  /* This is done under the assumption that the beam is given in set units */
  /* hdr -> bmin = (float) vardouble/fabs(setcdelt[1]); */
  hdr -> bmin = (float) hdr -> oric -> bmin/fabs(hdr -> oric -> delt_y);
  /*       sprintf(mes, "Beam minor axis in arcsec: %f", hdr -> bmin*fabs(setcdelt[1])); */
  /*       anyout_tir(&outerr, mes); */
  /* } */
  /* err = 0; */

  /* check for the bpa */
  /* gdsd_rdble_tir(hdr -> inset, "BPA", &level, &vardouble, &err); */
  /* if (err < 0) */

  /* This is a signal have it manually */
  /* 	manual = 1; */
  /* else { */
      /* 	outerr = 0; */
  /* CAUTION !!!!! This is done under the assumption that the bpa is always in deg */
  hdr -> bpa = (float) hdr -> oric -> bpa;
  /*       sprintf(mes, "Beam position angle in degrees: %f", hdr -> bpa); */
  /*       anyout_tir(&outerr, mes); */
  /*   } */
  /* } */

  /* If the cdelts are different we pose a warning and enforce manual reading */
  /* else { */
  /*   outerr = 0; */
  /*   anyout_tir(&outerr, "cdelt of axis1 and axis2 are different"); */
  /* } */

  /* Read beam properties manually */

  /* BUGFIX: removed the possibility to read beam properties from header. This caused too much confusion */
  /* manual = 1; */

  /* The beam major and minor axis has to be read in manually */
  if ((hdr -> bmaj <= 0) || (err) ) {

    /* If a proper logfile is present, we set a default and the beam properties are hidden */
    def = 4;

    sprintf(mes, "Give HPBW of the gaussian beam, major axis, in arcsec.");
    nel = 1;
    userreal_tir(startinfv -> arel, &hdr -> bmaj, &nel, &def, "BMAJ=", mes);

    sprintf(mes, "Give HPBW of the gaussian beam, minor axis, in arcsec.");
    nel = 1;
    userreal_tir(startinfv -> arel, &hdr -> bmin, &nel, &def, "BMIN=", mes);

    sprintf(mes, "Give BPA of the gaussian beam in degrees.");
    nel = 1;
    userreal_tir(startinfv -> arel, &hdr -> bpa, &nel, &def, "BPA=", mes);

    /* Convert from arcsec to grids */
    hdr -> bmaj = hdr -> bmaj/hdr -> deltgridtouser[0];
    hdr -> bmin = hdr -> bmin/hdr -> deltgridtouser[0];
  }

  /* Check for the correct intensity units */
  err = 0;
  /* for (j = 0; j < 20; ++j) */
  /*   value[j] = ' '; */
  /* value[20] = '\0'; */
  /* gdsd_rchar_tir(hdr -> inset, "BUNIT", hdr -> insubs, value, &err); */
  /* if ((err == 0) || (err == hdr -> insubs[0])) { */
  if (!strcmp(hdr -> oric -> unit, "JY/BEAM") || !strcmp(hdr -> oric -> unit, "jy/beam")) {
    sprintf(mes,"Units in the maps should be JY/BEAM, found: |%s|", hdr -> oric -> unit);
    /* dev = 0; */
    anyout_tir(&dev, mes);
    /* outerr = 1; */
    anyout_tir(&outerr, "Check if that is ok.");
  }
  /* } */
  /* else { */
  /*   outerr = 1; */
  /*   error_tir(&outerr, "No units in the maps found."); */
  /* } */

  /* Allocate memory for cwlo and -hi */
  /* if (!(hdr -> cwhi = (int *) malloc(hdr -> nsubs*sizeof(int)))) */
  /*   goto error; */
  /* if (!(hdr -> cwlo = (int *) malloc(hdr -> nsubs*sizeof(int)))) */
  /*   goto error; */

  /* check the subset grid and set it: The grid value is the relative position with respect to the reference pixel as integer */
  /* for (i = 0; i < 0+hdr -> nsubs; ++i) { */
  /*   hdr -> cwlo[i] = gdsc_fill_tir(hdr -> inset,hdr -> insubs+i, blo); */
  /*   hdr -> cwhi[i] = gdsc_fill_tir(hdr -> inset,hdr -> insubs+i, bhi); */
  /* } */

  /* Input of rms */
  err = 0;
  /* level = 0 ; */
  /* gdsd_rreal_tir(hdr -> inset, "RMS", &level, &hdr -> rms, &err); */
  /* if (err < 0) { */
  def = 4;

  sprintf(mes, "Give sigma_rms for input map in map units. [Jy/beam]");
  nel = 1;
  userreal_tir(startinfv -> arel, &hdr -> rms, &nel, &def, "RMS=", mes);
  while (hdr -> rms <= 0) {
    sprintf(mes, "Sigma must be positive");
    anyout_tir(&nel, mes);
    cancel_tir(startinfv -> arel, "RMS", 2);
    sprintf(mes, "Give sigma_rms for input map in map units. [Jy/beam]");
    nel = 1;
    userreal_tir(startinfv -> arel, &hdr -> rms, &nel, &def, "RMS=", mes);
  }
  /* } */

  /* Determine conversion factor for HI column density => intensity */
  hdr -> itou = HICONVERSION;

  sprintf(mes, "Give intensity to surface density conversion");
  def = 2;
  nel = 1;
  err = 0;
  while (!(err)) {
    userdble_tir(startinfv -> arel, &hdr -> itou, &nel, &def, "ITOU=", mes);
    if (hdr -> itou <= 0.0) {
      sprintf(mes, "Must be positive! %f",hdr -> itou);
      cancel_tir(startinfv -> arel, "ITOU=", 2);
      def = 1;
    }
    else
      err = 1;
  }

  /* Get rest frequency */
  hdr -> rfreq = HIRESFREQ;

  sprintf(mes, "Give rest frequency");
  def = 2;
  nel = 1;
  err = 0;
  while (!(err)) {
    userdble_tir(startinfv -> arel, &hdr -> rfreq, &nel, &def, "RFREQ=", mes);
    if (hdr -> rfreq <= 0.0) {
      sprintf(mes, "Must be positive!");
      cancel_tir(startinfv -> arel, "RFREQ=", 2);
      def = 1;
    }
    else
      err = 1;
  }

  /*******************/
  /*******************/

  /* Don't try to do this again! */
  /*  hdr -> cd2i = 1.5147016e-21 + fabs(hdr -> cdelt3)*pow(hdr -> cdelt3*hdr -> midgrid/hdr -> freq0+2.9979246e5/hdr -> drval3, 2); */
  /* Determine conversion factor for Jy/arcsec^2 to Jy/pixel, deltgridtouser is in arcsec */
  hdr -> jygridtouser = hdr -> deltgridtouser[2]/fabs(hdr -> deltgridtouser[0]*hdr -> deltgridtouser[1]);

  /* This could in principle be done elsewhere..., but we can also place it here */
  hdr -> nprof = hdr -> bsize1*hdr -> bsize2;

  /* Reserve memory */
  /* if (!(hdr -> ori = (float *) malloc_engalmod(hdr -> bcsize1*hdr -> bsize2*hdr -> nsubs*sizeof(float)))) { */
  /*   dev = 0; */
  /*   anyout_tir(&dev, "Not enough memory to hold a single cube"); */
  /*   goto error; */
  /* } */

  /* if (!(hdr -> model = (float *) malloc_engalmod(hdr -> bcsize1*hdr -> bsize2*hdr -> nsubs*sizeof(float)))) { */
  /*   anyout_tir(&dev, "Not enough memory to hold two cubes"); */
  /*   goto error; */
  /* } */

  /* Default is nothing */
  /* for (i = 0; i < 200; ++i) */
  /*   hdr -> outset[i] = ' '; */
  /* hdr -> outset[200] = '\0'; */
  /* def = 5; */

  /* class = 1; */
  /* i = 0; */

  /* sprintf(mes, "Give output set"); */
  /* while(!(i)) { */
  /*   userchar_tir(hdr -> outset, &class, &def, "OUTSET=", mes); */
  /*   if (!strcmp(hdr -> inset, hdr -> outset)) { */
  /* 	dev = 0; */
  /* 	sprintf(mes, "Must differ from inset name %s", hdr -> inset); */
  /* 	anyout_tir(&dev, mes); */
  /* 	cancel_tir(startinfv -> arel, "OUTSET="); */
  /* 	def = 5; */
  /*   } */
  /*   else */
  /* 	++i; */
  /* } */
  /* termsinglestr(hdr -> outset); */

  /* If there is an outset, we will open it, else we terminate it */
  /* if ((hdr -> outset[0])) { */
  /*   i = 1; */
  /* Copy the information of inset to outset prior to reading it */
  /* gdsasn_tir("INSET=", "OUTSET", &i); */
  /* gdscss_tir("OUTSET", blo, bhi); */

  /* def = 102; */
  /* class = 0; */
  /* gdsout_tir(hdr -> outset, outsubs, &hdr -> nsubs, &def, "OUTSET", "mes", &class , outaxperm, outaxcount, &maxnax); */

  /* We want to get the number to refresh the output cube */
  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "OUTSET", "Give output cube name.", 0, NULL, 0, 1, 0, 0, &keypres, &nread, &nreturned, &stringlist))
    goto error;

  if ((stringlist[0])) {
    if (!(hdr -> outset = simparse_copystring(stringlist[0])))
      goto error;
  }
  else {
    if (!(hdr -> outset = simparse_copystring("")))
      goto error;
  }

  freeparsed(stringlist);

  /* Default */
  hdr -> outcubup = 1000000;

  def = 2;
  nel = 1;
  class = 0;

  while (!(class)) {
    userint_tir(startinfv -> arel, &(hdr -> outcubup), &nel, &def, "OUTCUBUP=", mes);

    if (hdr -> outcubup < 1) {
      sprintf(mes, "Outcubup is least 1!");
      cancel_tir(startinfv -> arel, "OUTCUBUP=", 2);
      def = 1;
      class = 0;
    }
    else {
      ++class;
    }
  }

  /* Finished */
  return hdr;

 error:
  if (hdr)
    destroy_hdrinf(hdr);
  if (log)
    /* Number of disks is irrelevant at this point */
    destroy_loginf(log, 1);
  if (stringlist)
    freeparsed(stringlist);

  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a ringparms structure */
static ringparms *create_ringparms(int ndisks)
{
  ringparms *create_ringparms;
  int i;

  if (!(create_ringparms = (ringparms *) malloc(sizeof(ringparms))))
    goto error;

  /* Put numbers in the size descriptors */

  /* put number to ndisks member */
  create_ringparms -> ndisks = ndisks;

  /* Initialise all the pointers */
  create_ringparms -> par = NULL;
  create_ringparms -> oldpar = NULL;
  create_ringparms -> chapar = NULL;
  create_ringparms -> modpar = NULL;
  create_ringparms -> gsl_interparray = NULL;
  create_ringparms -> gsl_interp_accelarray = NULL;
  create_ringparms -> smothcar = NULL;
  create_ringparms -> gsl_indinterparray = NULL;
  create_ringparms -> gsl_indinterp_accelarray = NULL;
  create_ringparms -> smothindcar = NULL;
  create_ringparms -> actarray = NULL;
  create_ringparms -> actindar = NULL;
  create_ringparms -> interar = NULL;
  create_ringparms -> radar = NULL;
  create_ringparms -> ltype = NULL;
  create_ringparms -> cflux = NULL;
  create_ringparms -> allnpoints = NULL;
  create_ringparms -> fluxpoints = NULL;

    create_ringparms -> sd        = NULL;
    create_ringparms -> inf_sdisv = NULL;
    create_ringparms -> inf_vradv = NULL;
    create_ringparms -> inf_vverv = NULL;
    create_ringparms -> inf_dvrov = NULL;
    create_ringparms -> inf_dvrav = NULL;
    create_ringparms -> inf_dvvev = NULL;
    create_ringparms -> inf_vm0v  = NULL;
    create_ringparms -> inf_vm1v  = NULL;
    create_ringparms -> inf_vm2v  = NULL;
    create_ringparms -> inf_vm3v  = NULL;
    create_ringparms -> inf_vm4v  = NULL;
    create_ringparms -> inf_ra1v  = NULL;
    create_ringparms -> inf_ra2v  = NULL;
    create_ringparms -> inf_ra3v  = NULL;
    create_ringparms -> inf_ra4v  = NULL;
    create_ringparms -> inf_ro1v  = NULL;
    create_ringparms -> inf_ro2v  = NULL;
    create_ringparms -> inf_ro3v  = NULL;
    create_ringparms -> inf_ro4v  = NULL;
    create_ringparms -> inf_wm0v  = NULL;
    create_ringparms -> inf_wm1v  = NULL;
    create_ringparms -> inf_wm2v  = NULL;
    create_ringparms -> inf_wm3v  = NULL;
    create_ringparms -> inf_wm4v  = NULL;
    create_ringparms -> inf_ls0v  = NULL;
    create_ringparms -> inf_lc0v  = NULL;
    create_ringparms -> inf_smiv  = NULL;
    create_ringparms -> inf_gauv  = NULL;
    create_ringparms -> inf_aziv  = NULL;

    if (!(create_ringparms -> sd        = (srd       **) malloc(create_ringparms -> ndisks*sizeof(srd      *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->       sd[i] = NULL;}
    if (!(create_ringparms -> inf_sdisv = (inf_sdis **) malloc(create_ringparms -> ndisks*sizeof(inf_sdis *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_sdisv[i] = NULL;}
    if (!(create_ringparms -> inf_vradv = (inf_vrad **) malloc(create_ringparms -> ndisks*sizeof(inf_vrad *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_vradv[i] = NULL;}
    if (!(create_ringparms -> inf_vverv = (inf_vver **) malloc(create_ringparms -> ndisks*sizeof(inf_vver *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_vverv[i] = NULL;}
    if (!(create_ringparms -> inf_dvrov = (inf_dvro **) malloc(create_ringparms -> ndisks*sizeof(inf_dvro *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_dvrov[i] = NULL;}
    if (!(create_ringparms -> inf_dvrav = (inf_dvra **) malloc(create_ringparms -> ndisks*sizeof(inf_dvra *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_dvrav[i] = NULL;}
    if (!(create_ringparms -> inf_dvvev = (inf_dvve **) malloc(create_ringparms -> ndisks*sizeof(inf_dvve *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms -> inf_dvvev[i] = NULL;}
    if (!(create_ringparms -> inf_vm0v  = (inf_vm0  **) malloc(create_ringparms -> ndisks*sizeof(inf_vm0  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_vm0v[i] = NULL;}
    if (!(create_ringparms -> inf_vm1v  = (inf_vm1  **) malloc(create_ringparms -> ndisks*sizeof(inf_vm1  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_vm1v[i] = NULL;}
    if (!(create_ringparms -> inf_vm2v  = (inf_vm2  **) malloc(create_ringparms -> ndisks*sizeof(inf_vm2  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_vm2v[i] = NULL;}
    if (!(create_ringparms -> inf_vm3v  = (inf_vm3  **) malloc(create_ringparms -> ndisks*sizeof(inf_vm3  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_vm3v[i] = NULL;}
    if (!(create_ringparms -> inf_vm4v  = (inf_vm4  **) malloc(create_ringparms -> ndisks*sizeof(inf_vm4  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_vm4v[i] = NULL;}

    if (!(create_ringparms -> inf_ra1v  = (inf_ra1  **) malloc(create_ringparms -> ndisks*sizeof(inf_ra1  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ra1v[i] = NULL;}
    if (!(create_ringparms -> inf_ra2v  = (inf_ra2  **) malloc(create_ringparms -> ndisks*sizeof(inf_ra2  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ra2v[i] = NULL;}
    if (!(create_ringparms -> inf_ra3v  = (inf_ra3  **) malloc(create_ringparms -> ndisks*sizeof(inf_ra3  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ra3v[i] = NULL;}
    if (!(create_ringparms -> inf_ra4v  = (inf_ra4  **) malloc(create_ringparms -> ndisks*sizeof(inf_ra4  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ra4v[i] = NULL;}
    if (!(create_ringparms -> inf_ro1v  = (inf_ro1  **) malloc(create_ringparms -> ndisks*sizeof(inf_ro1  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ro1v[i] = NULL;}
    if (!(create_ringparms -> inf_ro2v  = (inf_ro2  **) malloc(create_ringparms -> ndisks*sizeof(inf_ro2  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ro2v[i] = NULL;}
    if (!(create_ringparms -> inf_ro3v  = (inf_ro3  **) malloc(create_ringparms -> ndisks*sizeof(inf_ro3  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ro3v[i] = NULL;}
    if (!(create_ringparms -> inf_ro4v  = (inf_ro4  **) malloc(create_ringparms -> ndisks*sizeof(inf_ro4  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ro4v[i] = NULL;}

    if (!(create_ringparms -> inf_wm0v  = (inf_wm0  **) malloc(create_ringparms -> ndisks*sizeof(inf_wm0  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_wm0v[i] = NULL;}
    if (!(create_ringparms -> inf_wm1v  = (inf_wm1  **) malloc(create_ringparms -> ndisks*sizeof(inf_wm1  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_wm1v[i] = NULL;}
    if (!(create_ringparms -> inf_wm2v  = (inf_wm2  **) malloc(create_ringparms -> ndisks*sizeof(inf_wm2  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_wm2v[i] = NULL;}
    if (!(create_ringparms -> inf_wm3v  = (inf_wm3  **) malloc(create_ringparms -> ndisks*sizeof(inf_wm3  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_wm3v[i] = NULL;}
    if (!(create_ringparms -> inf_wm4v  = (inf_wm4  **) malloc(create_ringparms -> ndisks*sizeof(inf_wm4  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_wm4v[i] = NULL;}
    if (!(create_ringparms -> inf_ls0v  = (inf_ls0  **) malloc(create_ringparms -> ndisks*sizeof(inf_ls0  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_ls0v[i] = NULL;}
    if (!(create_ringparms -> inf_lc0v  = (inf_lc0  **) malloc(create_ringparms -> ndisks*sizeof(inf_lc0  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_lc0v[i] = NULL;}
    if (!(create_ringparms -> inf_smiv  = (inf_smi  **) malloc(create_ringparms -> ndisks*sizeof(inf_smi  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_smiv[i] = NULL;}
    if (!(create_ringparms -> inf_gauv  = (inf_gau  **) malloc(create_ringparms -> ndisks*sizeof(inf_gau  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_gauv[i] = NULL;}
    if (!(create_ringparms -> inf_aziv  = (inf_azi  **) malloc(create_ringparms -> ndisks*sizeof(inf_azi  *)))) goto error; for (i = 0; i < create_ringparms -> ndisks; ++i) {create_ringparms ->  inf_aziv[i] = NULL;}

  /* Now allocate more memory */
  if (!(create_ringparms -> ltype = (int *) malloc(create_ringparms -> ndisks*sizeof(int))))
    goto error;

  if (!(create_ringparms -> cflux = (double *) malloc(create_ringparms -> ndisks*sizeof(double))))
    goto error;
  if (!(create_ringparms -> allnpoints = (int *) malloc(create_ringparms -> ndisks*sizeof(int))))
    goto error;
  if (!(create_ringparms -> fluxpoints = (long *) malloc(create_ringparms -> ndisks*sizeof(long))))
    goto error;

  return create_ringparms;

 error:
  destroy_ringparms(create_ringparms);
  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destroys a ringparms structure */
void destroy_ringparms(ringparms *prm)
{

  int i;

  /* Check if it is there */
  if (!(prm))
    return;

  if ((prm -> par))
    free(prm -> par);
  if ((prm -> oldpar))
    free(prm -> oldpar);
  if ((prm -> chapar))
    free(prm -> chapar);

  if ((prm -> gsl_interparray)) {
    for (i = 0; i < prm -> ndisks*NDPARAMS; ++i) {
	if ((prm -> gsl_interparray[i]))
	  gsl_interp_free(prm -> gsl_interparray[i]);
    }
    free(prm -> gsl_interparray);
  }
  if ((prm -> gsl_interp_accelarray)) {
    for (i = 0; i < prm -> ndisks*NDPARAMS; ++i) {
      if ((prm -> gsl_interp_accelarray[i]))
	gsl_interp_accel_free(prm -> gsl_interp_accelarray[i]);
    }
    free(prm -> gsl_interp_accelarray);
  }

  if ((prm -> smothcar))
    free(prm -> smothcar);
  if ((prm -> gsl_indinterparray)) {
    for (i = 0; i < prm -> ndisks*NDPARAMS; ++i) {
	if ((prm -> gsl_indinterparray[i]))
	  gsl_interp_free(prm -> gsl_indinterparray[i]);
    }
    free(prm -> gsl_indinterparray);
  }
  if ((prm -> gsl_indinterp_accelarray)) {
    for (i = 0; i < prm -> ndisks*NDPARAMS; ++i) {
      if ((prm -> gsl_indinterp_accelarray[i]))
	gsl_interp_accel_free(prm -> gsl_indinterp_accelarray[i]);
    }
    free(prm -> gsl_indinterp_accelarray);
  }
  if ((prm -> smothindcar))
    free(prm -> smothindcar);
  if ((prm -> actarray))
    free(prm -> actarray);
  if ((prm -> actindar))
    free(prm -> actindar);
  if ((prm -> interar  ))
    free(prm -> interar  );
  if ((prm -> radar   ))
    free(prm -> radar   );

  if (prm -> ltype)
    free(prm -> ltype);
  if (prm -> cflux)
    free(prm -> cflux);

  /* GJnew */
  if (prm -> allnpoints)
    free(prm -> allnpoints);
  if (prm -> fluxpoints)
    free(prm -> fluxpoints);

  if (prm -> sd        != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> sd[i]        != NULL) destroy_srd(prm ->  sd[i], prm -> nr);}  free(prm -> sd);}
  if (prm -> inf_sdisv != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_sdisv[i] != NULL) destroy_inf_sdis(prm -> inf_sdisv[i]);}  free(prm -> inf_sdisv);}
  if (prm -> inf_vradv != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_vradv[i] != NULL) destroy_inf_vrad(prm -> inf_vradv[i]);}  free(prm -> inf_vradv);}
  if (prm -> inf_vverv != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_vverv[i] != NULL) destroy_inf_vver(prm -> inf_vverv[i]);}  free(prm -> inf_vverv);}
  if (prm -> inf_dvrov != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_dvrov[i] != NULL) destroy_inf_dvro(prm -> inf_dvrov[i]);}  free(prm -> inf_dvrov);}
  if (prm -> inf_dvrav != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_dvrav[i] != NULL) destroy_inf_dvra(prm -> inf_dvrav[i]);}  free(prm -> inf_dvrav);}
  if (prm -> inf_dvvev != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm -> inf_dvvev[i] != NULL) destroy_inf_dvve(prm -> inf_dvvev[i]);}  free(prm -> inf_dvvev);}
  if (prm -> inf_vm0v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_vm0v[i] != NULL) destroy_inf_vm0(prm ->   inf_vm0v[i]);}  free(prm -> inf_vm0v);}
  if (prm -> inf_vm1v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_vm1v[i] != NULL) destroy_inf_vm1(prm ->   inf_vm1v[i]);}  free(prm -> inf_vm1v);}
  if (prm -> inf_vm2v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_vm2v[i] != NULL) destroy_inf_vm2(prm ->   inf_vm2v[i]);}  free(prm -> inf_vm2v);}
  if (prm -> inf_vm3v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_vm3v[i] != NULL) destroy_inf_vm3(prm ->   inf_vm3v[i]);}  free(prm -> inf_vm3v);}
  if (prm -> inf_vm4v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_vm4v[i] != NULL) destroy_inf_vm4(prm ->   inf_vm4v[i]);}  free(prm -> inf_vm4v);}

  if (prm -> inf_ra1v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ra1v[i] != NULL) destroy_inf_ra1(prm ->   inf_ra1v[i]);}  free(prm -> inf_ra1v);}
  if (prm -> inf_ra2v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ra2v[i] != NULL) destroy_inf_ra2(prm ->   inf_ra2v[i]);}  free(prm -> inf_ra2v);}
  if (prm -> inf_ra3v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ra3v[i] != NULL) destroy_inf_ra3(prm ->   inf_ra3v[i]);}  free(prm -> inf_ra3v);}
  if (prm -> inf_ra4v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ra4v[i] != NULL) destroy_inf_ra4(prm ->   inf_ra4v[i]);}  free(prm -> inf_ra4v);}
  if (prm -> inf_ro1v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ro1v[i] != NULL) destroy_inf_ro1(prm ->   inf_ro1v[i]);}  free(prm -> inf_ro1v);}
  if (prm -> inf_ro2v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ro2v[i] != NULL) destroy_inf_ro2(prm ->   inf_ro2v[i]);}  free(prm -> inf_ro2v);}
  if (prm -> inf_ro3v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ro3v[i] != NULL) destroy_inf_ro3(prm ->   inf_ro3v[i]);}  free(prm -> inf_ro3v);}
  if (prm -> inf_ro4v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ro4v[i] != NULL) destroy_inf_ro4(prm ->   inf_ro4v[i]);}  free(prm -> inf_ro4v);}
  if (prm -> inf_wm0v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_wm0v[i] != NULL) destroy_inf_wm0(prm ->   inf_wm0v[i]);}  free(prm -> inf_wm0v);}
  if (prm -> inf_wm1v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_wm1v[i] != NULL) destroy_inf_wm1(prm ->   inf_wm1v[i]);}  free(prm -> inf_wm1v);}
  if (prm -> inf_wm2v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_wm2v[i] != NULL) destroy_inf_wm2(prm ->   inf_wm2v[i]);}  free(prm -> inf_wm2v);}
  if (prm -> inf_wm3v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_wm3v[i] != NULL) destroy_inf_wm3(prm ->   inf_wm3v[i]);}  free(prm -> inf_wm3v);}
  if (prm -> inf_wm4v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_wm4v[i] != NULL) destroy_inf_wm4(prm ->   inf_wm4v[i]);}  free(prm -> inf_wm4v);}
  if (prm -> inf_ls0v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_ls0v[i] != NULL) destroy_inf_ls0(prm ->   inf_ls0v[i]);}  free(prm -> inf_ls0v);}
  if (prm -> inf_lc0v  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_lc0v[i] != NULL) destroy_inf_lc0(prm ->   inf_lc0v[i]);}  free(prm -> inf_lc0v);}
  if (prm -> inf_smiv  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_smiv[i] != NULL) destroy_inf_smi(prm ->   inf_smiv[i]);}  free(prm -> inf_smiv);}
  if (prm -> inf_gauv  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_gauv[i] != NULL) destroy_inf_gau(prm ->   inf_gauv[i]);}  free(prm -> inf_gauv);}
  if (prm -> inf_aziv  != NULL) {for (i = 0; i < prm -> ndisks; ++i) {if (prm ->  inf_aziv[i] != NULL) destroy_inf_azi(prm ->   inf_aziv[i]);}  free(prm -> inf_aziv);}

  for (i = 0; i < prm -> ndisks; ++i) {
/*     if((prm -> permrandstr[i])) */
/*       free(prm -> permrandstr[i]); */
/*     if((prm -> inf_sdisv[i])) */
/*       destroy_inf_sdis(prm -> inf_sdisv[i]); */
/*      if((prm -> inf_vradv[i])) */
/*       destroy_inf_vrad(prm -> inf_vradv[i]); */
/*     if((prm -> inf_vverv[i])) */
/*       destroy_inf_vver(prm -> inf_vverv[i]); */
/*     if((prm -> inf_dvrov[i])) */
/*       destroy_inf_dvro(prm -> inf_dvrov[i]); */
/*     if((prm -> inf_dvrav[i])) */
/*       destroy_inf_dvra(prm -> inf_dvrav[i]); */
/*     if((prm -> inf_dvvev[i])) */
/*       destroy_inf_dvve(prm -> inf_dvvev[i]); */
/*     if((prm ->  inf_vm1v[i])) */
/*       destroy_inf_vm1(prm ->  inf_vm1v[i]); */
/*     if((prm ->  inf_vm0v[i] )) */
/*       destroy_inf_vm0 (prm ->  inf_vm0v[i] ); */
/*    if((prm ->  inf_vm2v[i])) */
/*       destroy_inf_vm2(prm ->  inf_vm2v[i]); */
/*     if((prm ->  inf_vm3v[i])) */
/*       destroy_inf_vm3(prm ->  inf_vm3v[i]); */
/*     if((prm ->  inf_vm4v[i])) */
/*       destroy_inf_vm4(prm ->  inf_vm4v[i]); */
/*     if((prm ->  inf_wm1v[i])) */
/*       destroy_inf_wm1(prm ->  inf_wm1v[i]); */
/*     if((prm ->  inf_wm0v[i] )) */
/*       destroy_inf_wm0 (prm ->  inf_wm0v[i] ); */
/*     if((prm ->  inf_wm2v[i])) */
/*       destroy_inf_wm2(prm ->  inf_wm2v[i]); */
/*     if((prm ->  inf_wm3v[i])) */
/*       destroy_inf_wm3(prm ->  inf_wm3v[i]); */
/*     if((prm ->  inf_wm4v[i])) */
/*       destroy_inf_wm4(prm ->  inf_wm4v[i]); */
/*     if((prm ->  inf_ls0v[i] )) */
/*       destroy_inf_ls0 (prm ->  inf_ls0v[i] ); */
/*     if((prm ->  inf_lc0v[i] )) */
/*       destroy_inf_lc0 (prm ->  inf_lc0v[i] ); */
/*     if((prm ->  inf_smiv[i] )) */
/*       destroy_inf_smi (prm ->  inf_smiv[i] ); */
/*     if((prm ->  inf_gauv[i] )) */
/*       destroy_inf_gau (prm ->  inf_gauv[i] ); */
/*     if((prm ->  inf_aziv[i] )) */
/*       destroy_inf_azi (prm ->  inf_aziv[i] );    */
  }
  if (prm -> modpar != NULL)
    free(prm -> modpar);
  free(prm);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a list of subring descriptors with n elements */
static srd *create_srd(int n)
{
  int i;

  srd *sd;
  if (!(sd = (srd *) malloc(n*sizeof(srd))))
    return NULL;

  for (i = 0; i < n; ++i) {
    (sd+i) -> pl = NULL;
#ifdef PBCORR
    (sd+i) -> pbfac = NULL;
#endif
    (sd+i) -> permrandstr = NULL;
    (sd+i) -> randstr = NULL;
    (sd+i) -> grandstr[0] = NULL;
    (sd+i) -> grandstr[1] = NULL;
    (sd+i) -> grandstr[2] = NULL;
    (sd+i) -> grandstr[3] = NULL;
    (sd+i) -> srandstr = NULL;

    /* There is only one dispersion */
    (sd+i) -> nsubcl = 1;
    (sd+i) -> nsubclinv = 1.0;
    (sd+i) -> y2 = -1024.0;
  }
  return sd;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a list of subring descriptors with n elements */
static void destroy_srd(srd *sd, int n)
{
  int i;

  if (!(sd))
    return;

  for (i = 0; i < n; ++i) {
    free(sd[i].pl);

#ifdef PBCORR
    if (sd[i].pbfac)
      free(sd[i].pbfac);
#endif

    if (sd[i].permrandstr)
      free(sd[i].permrandstr);
    if (sd[i].randstr)
      free(sd[i].randstr);
    if (sd[i].grandstr[0])
      free(sd[i].grandstr[0]);
    if (sd[i].grandstr[1])
      free(sd[i].grandstr[1]);
    if (sd[i].grandstr[2])
      free(sd[i].grandstr[2]);
    if (sd[i].grandstr[3])
      free(sd[i].grandstr[3]);
    if (sd[i].srandstr)
      free(sd[i].srandstr);
  }
  free(sd);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Fill the ringparms struct from the input */
static ringparms *get_ringparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *ringparmsv)
{
  ringparms *rpm;
  double globin[3];  /* For the conversion of coordinates in map units */
  double globout[3]; /* For the conversion of coordinates in map units */

  /* Private control and changing variables */
  int def;      /* Any default mode */
  int nel;      /* Number of elements */
  int err;      /* Error code */
  int dummy;
  char mes[81];  /* Any message */
  char placer[10];
  int inty, indinty; /* interpolation type */
  const gsl_interp_type * intytype; /* same, only internal to gsl */
  const gsl_interp_type * indintytype; /* same, only internal to gsl */

  int i,j = 0; /* Simple control variables */
  int disk; /* number of the disk */
  /* Read values that are needed only in this module */
  int mode; /* For memory handling */
  int ndisks;
  int pcondisp, condisp;

/* primary beam stuff */
#ifdef PBCORR
  int pbtel;
  double pbrefpix[2];
  double pbreffreq;
  double pbdoublev1, pbdoublev2, pbradius, pbwsrtconst;
  int dev = 1;
#endif

  /* Get the number of disks */
  /* Default */
  if (startinfv -> firstrun) {
  def = 2;
  ndisks = 0;
  nel = 1;

  userint_tir(startinfv -> arel, &ndisks, &nel, &def, "NDISKS=", mes);

  if (ndisks < 1)
    ndisks = NDISKS;

  /* Get the struct */
  if (!(rpm = create_ringparms(ndisks)))
    goto error;
  }
  else {
    rpm = ringparmsv;
  }

  /* Activate the logfile info, the reason that the function is called here is that the number of disks is required */

  /* Now we try to open the table object with the logfile name */
  if (activateftstab(startinfv, log, rpm)) {
    goto error;
  }

  if (startinfv -> firstrun) {
    /* Get the number of rings */
    /* Default */
    def = 0;

    i = 0;
    sprintf(mes, "Give number of rings.");
    while (!(i)) {
      nel = 1;
      userint_tir(startinfv -> arel, &rpm -> nur, &nel, &def, "NUR=", mes);

      if (rpm -> nur < 2) {
	sprintf(mes, "At least 2!");
	cancel_tir(startinfv -> arel, "NUR=", 2);
	i = 0;
      }
      else {

	/* Do some allocation that hides some variables in this function */
	if (!(rpm -> par = (double *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(double))))
	  goto error;
	/* Do some allocation that hides some variables in this function */
	if (!(rpm -> oldpar = (double *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(double))))
	  goto error;
	/* Do some allocation that hides some variables in this function, same size as par and oldpar to ease indexing */
	if (!(rpm -> chapar = (int *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(int))))
	  goto error;
	for (j = 0; j < (rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS); ++j)
	  rpm -> chapar[j] = 0;

	/* Allocate the interpolation structures */
	if (!(rpm -> gsl_interparray = (gsl_interp **) malloc(rpm -> ndisks*NDPARAMS*sizeof(gsl_interp *))))
	  goto error;
	for (j = 0; j < rpm -> ndisks*NDPARAMS; ++j)
	  rpm -> gsl_interparray[j] = NULL;
	if (!(rpm -> gsl_interp_accelarray = (gsl_interp_accel **) malloc(rpm -> ndisks*NDPARAMS*sizeof(gsl_interp_accel *))))
	      goto error;
	for (j = 0; j < rpm -> ndisks*NDPARAMS; ++j)
	  rpm -> gsl_interp_accelarray[j] = NULL;
	if (!(rpm -> smothcar = (int *) malloc(rpm -> ndisks*NDPARAMS*sizeof(int))))
	      goto error;
	if (!(rpm -> gsl_indinterparray = (gsl_interp **) malloc(rpm -> ndisks*NDPARAMS*sizeof(gsl_interp *))))
	  goto error;
	for (j = 0; j < rpm -> ndisks*NDPARAMS; ++j)
	  rpm -> gsl_indinterparray[j] = NULL;
	if (!(rpm -> gsl_indinterp_accelarray = (gsl_interp_accel **) malloc(rpm -> ndisks*NDPARAMS*sizeof(gsl_interp_accel *))))
	      goto error;
	for (j = 0; j < rpm -> ndisks*NDPARAMS; ++j)
	  rpm -> gsl_indinterp_accelarray[j] = NULL;
	if (!(rpm -> smothindcar = (int *) malloc(rpm -> ndisks*NDPARAMS*sizeof(int))))
	      goto error;
	if (!(rpm -> actarray = (int *) malloc(rpm -> nur * sizeof(int))))
	  goto error;
	if (!(rpm -> actindar = (int *) malloc(rpm -> nur * sizeof(int))))
	  goto error;
	if (!(rpm -> interar = (double *) malloc(rpm -> nur * sizeof(double))))
	  goto error;
	if (!(rpm -> radar = (double *) malloc(rpm -> nur * sizeof(double))))
	  goto error;

	++i;
      }
    }

    /* The output array contains rpm -> maxparnur + 3 fields (3 -> chisquare, accept, number) */
    if (!(log -> outarray = (double *) malloc (((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR) * sizeof(double))))
      goto error;
    if (!(log -> grid     = (double *) malloc (((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR) * sizeof(double))))
      goto error;
    if (!(log -> radius   = (double *) malloc (((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR) * sizeof(double))))
      goto error;
    if (!(log -> regist   = (double *) malloc (((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR) * sizeof(double))))
      goto error;

    /* Get the subring width in grid units */
    /* Default */
    rpm -> radsep = 0.75;

    sprintf(mes, "Give subring width (grids)");
    def = 2;
    nel = 1;
    err = 0;
    while (!(err)) {
      userdble_tir(startinfv -> arel, &rpm -> radsep, &nel, &def, "RADSEP=", mes);
      if (rpm -> radsep <= 0.0) {
	sprintf(mes, "Must be positive!");
	cancel_tir(startinfv -> arel, "RADSEP=", 2);
	def = 1;
      }
      else
	err = 1;
    }

    /* Get the default interpolation method */
    /* 0: linear, 1: natural spline, default 0 */
    inty = INTERP_LINEAR;

    sprintf(mes, "Give default interpolation type");
    def = 2;
    nel = 1;
    err = 0;
    while (!(err)) {
      userint_tir(startinfv -> arel, &inty, &nel, &def, "INTY=", mes);
      if (inty < 0 || inty >= INTERP_NUMBER) {
	sprintf(mes, "Must lie between %i and %i!", 0, INTERP_NUMBER-1);
	cancel_tir(startinfv -> arel, "INTY=", 2);
	def = 1;
      }
      else
	err = 1;
    }

    /* Now allocate all the interpolation structs and "accelerators" */
    switch (inty) {
    case INTERP_LINEAR:
      intytype = gsl_interp_linear;
      break;

    case INTERP_CSPLINE:
      if (rpm -> nur > 2){
	intytype = gsl_interp_cspline;
      }
      else {
	sprintf(mes, "Must have at least 3 radii for spline, using linear");
	anyout_tir(&err, mes);
	intytype = gsl_interp_linear;
      }
      break;

    case INTERP_AKIMA:
      if (rpm -> nur > 4) {
	intytype = gsl_interp_akima;
      }
      else {
	sprintf(mes, "Must have at least 5 radii for Akima");
	anyout_tir(&err, mes);
	if (rpm -> nur > 2) {
	  sprintf(mes, "Using natural cubic spline");
	  anyout_tir(&err, mes);
	  intytype = gsl_interp_cspline;
	}
	else {
	  sprintf(mes, "Using linear");
	  anyout_tir(&err, mes);
	  intytype = gsl_interp_linear;
	}
      }
      break;

    /* No real default */
    default:
      break;
    }

    /* Real allocation here */
    for (i = 0; i < rpm -> ndisks*NDPARAMS; ++i) {
      if (!(rpm -> gsl_interparray[i] = gsl_interp_alloc(intytype, rpm -> nur)))
	goto error;
      /* printf("%s"); */

      if (!(rpm -> gsl_interp_accelarray[i] = gsl_interp_accel_alloc()))
	goto error;
      rpm -> smothcar[i] = inty;
    }

        /* Get the default interpolation method */
    /* 0: linear, 1: natural spline, default 0 */
    indinty = inty;

    sprintf(mes, "Give default interpolation type");
    def = 2;
    nel = 1;
    err = 0;
    while (!(err)) {
      userint_tir(startinfv -> arel, &indinty, &nel, &def, "INDINTY=", mes);
      if (indinty < 0 || indinty >= INTERP_NUMBER) {
	sprintf(mes, "Must lie between %i and %i!", 0, INTERP_NUMBER-1);
	cancel_tir(startinfv -> arel, "INDINTY=", 2);
	def = 1;
      }
      else
	err = 1;
    }

    /* Now allocate all the interpolation structs and "accelerators" */
    switch (indinty) {
    case INTERP_LINEAR:
      indintytype = gsl_interp_linear;
      break;

    case INTERP_CSPLINE:
      if (rpm -> nur > 2)
	indintytype = gsl_interp_cspline;
      else {
	sprintf(mes, "Must have at least 3 radii for spline, using linear");
	anyout_tir(&err, mes);
	indintytype = gsl_interp_linear;
      }
      break;

    case INTERP_AKIMA:
      if (rpm -> nur > 4) {
	indintytype = gsl_interp_akima;
      }
      else {
	sprintf(mes, "Must have at least 5 radii for Akima");
	anyout_tir(&err, mes);
	if (rpm -> nur > 2) {
	  sprintf(mes, "Using natural cubic spline");
	  anyout_tir(&err, mes);
	  indintytype = gsl_interp_cspline;
	}
	else {
	  sprintf(mes, "Using linear");
	  anyout_tir(&err, mes);
	  indintytype = gsl_interp_linear;
	}
      }
      break;

    /* No real default */
    default:
      break;
    }

    /* Real allocation here */
    for (i = 0; i < rpm -> ndisks*NDPARAMS; ++i) {
      if (!(rpm -> gsl_indinterparray[i] = gsl_interp_alloc(indintytype, rpm -> nur)))
	goto error;
      /* printf("%s"); */

      if (!(rpm -> gsl_indinterp_accelarray[i] = gsl_interp_accel_alloc()))
	goto error;
      rpm -> smothindcar[i] = indinty;
    }

    /* Now get all sorts of parameters */

    /* Radii is the most complicated */
    err = 0;
    while (!(err)) {
      get_parameter_double(startinfv, log, hdr, rpm, "Give Radii. (arcsec)", "RADI=", PRADI, 4);

      /* Enforce the first radius to be 0 */
      if (rpm -> par[0] != 0.0) {
		  sprintf(mes, "First radius has to be 0.0");
		  anyout_tir(&err, mes);

		  /* The difference to reject is unclear to me */
		  cancel_tir(startinfv -> arel, "RADI=", 2);
      }
      else {

		  /* Now check whether the modpar array can be constructed */
		  /* Identify the number of subrings, the max radius of a subring is the max radius in parameter struct plus the half of the width of a subring, which is ususally 0.75 pixels  */
		  rpm -> nr = ((int) (rpm -> par[(PRADI+1)*rpm -> nur-1]/rpm -> radsep-0.5))+1;

		  /* ndisk construction */
		  /* Allocation of subring array */
		  if (!(rpm -> modpar = (float *) malloc((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nr*sizeof(float))))
			 goto error;

		  err = 1;
		  for (i = 1; i < rpm -> nur; ++i) {

			 /* Check if the choice of radii is sensible */
			 if ((rpm -> par[PRADI*rpm -> nur+i-1]+rpm -> radsep) >= (rpm -> par[PRADI*rpm -> nur+i])) {
				sprintf(mes, "Radius separation too small or radii not in increasing order.");
				err = 0;
				anyout_tir(&err, mes);
				cancel_tir(startinfv -> arel, "RADI=", 2);
				break;
			 }
		  }
      }
    }
  }
  /* other parameters */
  get_parameter_double(startinfv, log, hdr, rpm, "Give circular velocities. (km/s)",                                "VROT=", PVROT, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocities. (km/s)",                                  "VRAD=", PVRAD, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give vertical velocities. (km/s)",                                "VVER=", PVVER, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of circular velocities. (km/s)",           "DVRO=", PDVRO, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of radial velocities. (km/s)",             "DVRA=", PDVRA, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of vertical velocities. (km/s)",           "DVVE=", PDVVE, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of circular velocities. (km/s)",     "ZDRO=", PZDRO, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of radial velocities. (km/s)",       "ZDRA=", PZDRA, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of vertical velocities. (km/s)",     "ZDVE=", PZDVE, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion (SDIS) of rings. (km/s)",                         "SDIS=", PSDIS, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give number of sub-clouds",                                       "CLNR=", PCLNR, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity term",                                       "VM0A=", PVM0A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m1 term, amp  ",                                    "VM1A=", PVM1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m1 term, phase",                                    "VM1P=", PVM1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m2 term, amp  ",                                    "VM2A=", PVM2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m2 term, phase",                                    "VM2P=", PVM2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m3 term, amp  ",                                    "VM3A=", PVM3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m3 term, phase",                                    "VM3P=", PVM3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m4 term, amp  ",                                    "VM4A=", PVM4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m4 term, phase",                                    "VM4P=", PVM4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m1 term, phase",                         "RO1A=", PRO1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m1 term, phase",                         "RO1P=", PRO1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m2 term, amp  ",                         "RO2A=", PRO2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m2 term, phase",                         "RO2P=", PRO2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m3 term, amp  ",                         "RO3A=", PRO3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m3 term, phase",                         "RO3P=", PRO3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m4 term, amp  ",                         "RO4A=", PRO4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m4 term, phase",                         "RO4P=", PRO4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m1 term, phase",                             "RA1A=", PRA1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m1 term, phase",                             "RA1P=", PRA1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m2 term, amp  ",                             "RA2A=", PRA2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m2 term, phase",                             "RA2P=", PRA2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m3 term, amp  ",                             "RA3A=", PRA3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m3 term, phase",                             "RA3P=", PRA3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m4 term, amp  ",                             "RA4A=", PRA4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m4 term, phase",                             "RA4P=", PRA4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give 0th order warp term",                                        "WM0A=", PWM0A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m1 term, amp  ",                                        "WM1A=", PWM1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m1 term, phase",                                        "WM1P=", PWM1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m2 term, amp  ",                                        "WM2A=", PWM2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m2 term, phase",                                        "WM2P=", PWM2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m3 term, amp  ",                                        "WM3A=", PWM3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m3 term, phase",                                        "WM3P=", PWM3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m4 term, amp  ",                                        "WM4A=", PWM4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give warp m4 term, phase",                                        "WM4P=", PWM4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give S0 lopsided term",                                           "LS0=",  PLS0,  2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give C0 lopsided term",                                           "LC0=",  PLC0,  2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give scale-height (Z0) of rings. (arcsec)",                       "Z0=",   PZ0,   2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface-brightness of rings. (Jy/(arcsec*arcsec))",          "SBR=",  PSBR,  2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m1 term, amp   (Jy/(arcsec*arcsec))",     "SM1A=", PSM1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m1 term, phase (deg)",                    "SM1P=", PSM1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m2 term, amp   (Jy/(arcsec*arcsec))",     "SM2A=", PSM2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m2 term, phase (deg)",                    "SM2P=", PSM2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m3 term, amp   (Jy/(arcsec*arcsec))",     "SM3A=", PSM3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m3 term, phase (deg)",                    "SM3P=", PSM3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m4 term, amp   (Jy/(arcsec*arcsec))",     "SM4A=", PSM4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m4 term, phase (deg)",                    "SM4P=", PSM4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 1 (Jy/(arcsec*arcsec))", "GA1A",  PGA1A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 1 (deg)",                                "GA1P",  PGA1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 1 (arcsec)",                          "GA1D",  PGA1D, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 2 (Jy/(arcsec*arcsec))", "GA2A",  PGA2A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 2 (deg)",                                "GA2P",  PGA2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 2 (arcsec)",                          "GA2D",  PGA2D, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 3 (Jy/(arcsec*arcsec))", "GA3A",  PGA3A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 3 (deg)",                                "GA3P",  PGA3P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 3 (arcsec)",                          "GA3D",  PGA3D, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 4 (Jy/(arcsec*arcsec))", "GA4A",  PGA4A, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 4 (deg)",                                "GA4P",  PGA4P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 4 (arcsec)",                          "GA4D",  PGA4D, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of simulted range 1 (deg)",                          "AZ1P",  PAZ1P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give width of simulted range 1 (deg)",                            "AZ1W",  PAZ1W, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of simulted range 2 (deg)",                          "AZ2P",  PAZ2P, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give width of simulted range 2 (deg)",                            "AZ2W",  PAZ2W, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give inclinations of rings. (degrees)",                           "INCL=", PINCL, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give position angle of rings. (degrees)",                         "PA=",   PPA,   2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give Right Ascensions of ring centres. (degrees)",                "XPOS=", PXPOS, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give Declinations of ring centres. (degrees)",                    "YPOS=", PYPOS, 2);
  get_parameter_double(startinfv, log, hdr, rpm, "Give systemic velocities of rings in (km/s).",                    "VSYS=", PVSYS, 2);

  /* We do this ndisks time */
  for (disk = 1; disk < rpm -> ndisks; ++disk) {
    sprintf(placer, "VROT_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give circular velocities. (km/s)",                                placer, PRPARAMS+disk*NDPARAMS+PVROT, 2);
    sprintf(placer, "VRAD_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocities. (km/s)",                                  placer, PRPARAMS+disk*NDPARAMS+PVRAD, 2);
    sprintf(placer, "VVER_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give vertical velocities. (km/s)",                                placer, PRPARAMS+disk*NDPARAMS+PVVER, 2);
    sprintf(placer, "DVRO_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of circular velocities. (km/s)",           placer, PRPARAMS+disk*NDPARAMS+PDVRO, 2);
    sprintf(placer, "DVRA_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of radial velocities. (km/s)",             placer, PRPARAMS+disk*NDPARAMS+PDVRA, 2);
    sprintf(placer, "DVVE_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give vertical gradient of vertical velocities. (km/s)",           placer, PRPARAMS+disk*NDPARAMS+PDVVE, 2);
    sprintf(placer, "ZDRO_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of circular velocities. (km/s)",     placer, PRPARAMS+disk*NDPARAMS+PZDRO, 2);
    sprintf(placer, "ZDRA_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of velocities. (km/s)",              placer, PRPARAMS+disk*NDPARAMS+PZDRA, 2);
    sprintf(placer, "ZDVE_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give start height for change of vertical velocities. (km/s)",     placer, PRPARAMS+disk*NDPARAMS+PZDVE, 2);
    sprintf(placer, "SDIS_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion (SDIS) of rings. (km/s)",                         placer, PRPARAMS+disk*NDPARAMS+PSDIS, 2);
    sprintf(placer, "CLNR_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give number of sub-clouds",                                       placer, PRPARAMS+disk*NDPARAMS+PCLNR, 2);
    sprintf(placer, "VM0A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity term",                                       placer, PRPARAMS+disk*NDPARAMS+PVM0A, 2);
    sprintf(placer, "VM1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m1 term, amp  ",                                    placer, PRPARAMS+disk*NDPARAMS+PVM1A, 2);
    sprintf(placer, "VM1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m1 term, phase",                                    placer, PRPARAMS+disk*NDPARAMS+PVM1P, 2);
    sprintf(placer, "VM2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m2 term, amp  ",                                    placer, PRPARAMS+disk*NDPARAMS+PVM2A, 2);
    sprintf(placer, "VM2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m2 term, phase",                                    placer, PRPARAMS+disk*NDPARAMS+PVM2P, 2);
    sprintf(placer, "VM3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m3 term, amp  ",                                    placer, PRPARAMS+disk*NDPARAMS+PVM3A, 2);
    sprintf(placer, "VM3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m3 term, phase",                                    placer, PRPARAMS+disk*NDPARAMS+PVM3P, 2);
    sprintf(placer, "VM4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m4 term, amp  ",                                    placer, PRPARAMS+disk*NDPARAMS+PVM4A, 2);
    sprintf(placer, "VM4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give velocity m4 term, phase",                                    placer, PRPARAMS+disk*NDPARAMS+PVM4P, 2);
    sprintf(placer, "RA1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m1 term, amp  ",                             placer, PRPARAMS+disk*NDPARAMS+PRA1A, 2);
    sprintf(placer, "RA1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m1 term, phase",                             placer, PRPARAMS+disk*NDPARAMS+PRA1P, 2);
    sprintf(placer, "RA2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m2 term, amp  ",                             placer, PRPARAMS+disk*NDPARAMS+PRA2A, 2);
    sprintf(placer, "RA2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m2 term, phase",                             placer, PRPARAMS+disk*NDPARAMS+PRA2P, 2);
    sprintf(placer, "RA3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m3 term, amp  ",                             placer, PRPARAMS+disk*NDPARAMS+PRA3A, 2);
    sprintf(placer, "RA3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m3 term, phase",                             placer, PRPARAMS+disk*NDPARAMS+PRA3P, 2);
    sprintf(placer, "RA4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m4 term, amp  ",                             placer, PRPARAMS+disk*NDPARAMS+PRA4A, 2);
    sprintf(placer, "RA4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give radial velocity m4 term, phase",                             placer, PRPARAMS+disk*NDPARAMS+PRA4P, 2);
    sprintf(placer, "RO1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m1 term, amp  ",                         placer, PRPARAMS+disk*NDPARAMS+PRO1A, 2);
    sprintf(placer, "RO1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m1 term, phase",                         placer, PRPARAMS+disk*NDPARAMS+PRO1P, 2);
    sprintf(placer, "RO2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m2 term, amp  ",                         placer, PRPARAMS+disk*NDPARAMS+PRO2A, 2);
    sprintf(placer, "RO2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m2 term, phase",                         placer, PRPARAMS+disk*NDPARAMS+PRO2P, 2);
    sprintf(placer, "RO3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m3 term, amp  ",                         placer, PRPARAMS+disk*NDPARAMS+PRO3A, 2);
    sprintf(placer, "RO3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m3 term, phase",                         placer, PRPARAMS+disk*NDPARAMS+PRO3P, 2);
    sprintf(placer, "RO4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m4 term, amp  ",                         placer, PRPARAMS+disk*NDPARAMS+PRO4A, 2);
    sprintf(placer, "RO4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give tangential velocity m4 term, phase",                         placer, PRPARAMS+disk*NDPARAMS+PRO4P, 2);
    sprintf(placer, "WM0A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give 0th order warp term",                                        placer, PRPARAMS+disk*NDPARAMS+PWM0A, 2);
    sprintf(placer, "WM1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m1 term, amp  ",                                        placer, PRPARAMS+disk*NDPARAMS+PWM1A, 2);
    sprintf(placer, "WM1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m1 term, phase",                                        placer, PRPARAMS+disk*NDPARAMS+PWM1P, 2);
    sprintf(placer, "WM2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m2 term, amp  ",                                        placer, PRPARAMS+disk*NDPARAMS+PWM2A, 2);
    sprintf(placer, "WM2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m2 term, phase",                                        placer, PRPARAMS+disk*NDPARAMS+PWM2P, 2);
    sprintf(placer, "WM3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m3 term, amp  ",                                        placer, PRPARAMS+disk*NDPARAMS+PWM3A, 2);
    sprintf(placer, "WM3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m3 term, phase",                                        placer, PRPARAMS+disk*NDPARAMS+PWM3P, 2);
    sprintf(placer, "WM4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m4 term, amp  ",                                        placer, PRPARAMS+disk*NDPARAMS+PWM4A, 2);
    sprintf(placer, "WM4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give warp m4 term, phase",                                        placer, PRPARAMS+disk*NDPARAMS+PWM4P, 2);
    sprintf(placer, "LS0_%i=" , disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give S0 lopsided term",                                           placer, PRPARAMS+disk*NDPARAMS+PLS0,  2);
    sprintf(placer, "LC0_%i=" , disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give C0 lopsided term",                                           placer, PRPARAMS+disk*NDPARAMS+PLC0,  2);
    sprintf(placer, "Z0_%i="  , disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give scale-height (Z0) of rings. (arcsec)",                       placer, PRPARAMS+disk*NDPARAMS+PZ0,   2);
    sprintf(placer, "SBR_%i=" , disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface-brightness of rings. (Jy/(arcsec*arcsec))",          placer, PRPARAMS+disk*NDPARAMS+PSBR,  2);
    sprintf(placer, "SM1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m1 term, amp   (Jy/(arcsec*arcsec))",     placer, PRPARAMS+disk*NDPARAMS+PSM1A, 2);
    sprintf(placer, "SM1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m1 term, phase (deg)",                    placer, PRPARAMS+disk*NDPARAMS+PSM1P, 2);
    sprintf(placer, "SM2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m2 term, amp   (Jy/(arcsec*arcsec))",     placer, PRPARAMS+disk*NDPARAMS+PSM2A, 2);
    sprintf(placer, "SM2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m2 term, phase (deg)",                    placer, PRPARAMS+disk*NDPARAMS+PSM2P, 2);
    sprintf(placer, "SM3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m3 term, amp   (Jy/(arcsec*arcsec))",     placer, PRPARAMS+disk*NDPARAMS+PSM3A, 2);
    sprintf(placer, "SM3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m3 term, phase (deg)",                    placer, PRPARAMS+disk*NDPARAMS+PSM3P, 2);
    sprintf(placer, "SM4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m4 term, amp   (Jy/(arcsec*arcsec))",     placer, PRPARAMS+disk*NDPARAMS+PSM4A, 2);
    sprintf(placer, "SM4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give surface brightness m4 term, phase (deg)",                    placer, PRPARAMS+disk*NDPARAMS+PSM4P, 2);
    sprintf(placer, "GA1A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 1 (Jy/(arcsec*arcsec))", placer, PRPARAMS+disk*NDPARAMS+PGA1A, 2);
    sprintf(placer, "GA1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 1 (deg)",                                placer, PRPARAMS+disk*NDPARAMS+PGA1P, 2);
    sprintf(placer, "GA1D_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 1 (arcsec)",                          placer, PRPARAMS+disk*NDPARAMS+PGA1D, 2);
    sprintf(placer, "GA2A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 2 (Jy/(arcsec*arcsec))", placer, PRPARAMS+disk*NDPARAMS+PGA2A, 2);
    sprintf(placer, "GA2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 2 (deg)",                                placer, PRPARAMS+disk*NDPARAMS+PGA2P, 2);
    sprintf(placer, "GA2D_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 2 (arcsec)",                          placer, PRPARAMS+disk*NDPARAMS+PGA2D, 2);
    sprintf(placer, "GA3A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 3 (Jy/(arcsec*arcsec))", placer, PRPARAMS+disk*NDPARAMS+PGA3A, 2);
    sprintf(placer, "GA3P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 3 (deg)",                                placer, PRPARAMS+disk*NDPARAMS+PGA3P, 2);
    sprintf(placer, "GA3D_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 3 (arcsec)",                          placer, PRPARAMS+disk*NDPARAMS+PGA3D, 2);
    sprintf(placer, "GA4A_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give peak surface brigtness for Gaussian 4 (Jy/(arcsec*arcsec))", placer, PRPARAMS+disk*NDPARAMS+PGA4A, 2);
    sprintf(placer, "GA4P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of Gaussian 4 (deg)",                                placer, PRPARAMS+disk*NDPARAMS+PGA4P, 2);
    sprintf(placer, "GA4D_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give dispersion of Gaussian 4 (arcsec)",                          placer, PRPARAMS+disk*NDPARAMS+PGA4D, 2);
    sprintf(placer, "AZ1P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of simulted range 1 (deg)",                          placer, PRPARAMS+disk*NDPARAMS+PAZ1P, 2);
    sprintf(placer, "AZ1W_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give width of simulted range 1 (deg)",                            placer, PRPARAMS+disk*NDPARAMS+PAZ1W, 2);
    sprintf(placer, "AZ2P_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give azimuth of simulted range 2 (deg)",                          placer, PRPARAMS+disk*NDPARAMS+PAZ2P, 2);
    sprintf(placer, "AZ2W_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give width of simulted range 2 (deg)",                            placer, PRPARAMS+disk*NDPARAMS+PAZ2W, 2);
    sprintf(placer, "INCL_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give inclinations of rings. (degrees)",                           placer, PRPARAMS+disk*NDPARAMS+PINCL, 2);
    sprintf(placer, "PA_%i="  , disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give position angle of rings. (degrees)",                         placer, PRPARAMS+disk*NDPARAMS+PPA,   2);
    sprintf(placer, "XPOS_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give Right Ascensions of ring centres. (degrees)",                placer, PRPARAMS+disk*NDPARAMS+PXPOS, 2);
    sprintf(placer, "YPOS_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give Declinations of ring centres. (degrees)",                    placer, PRPARAMS+disk*NDPARAMS+PYPOS, 2);
    sprintf(placer, "VSYS_%i=", disk+1);get_parameter_double(startinfv, log, hdr, rpm, "Give systemic velocities of rings in (km/s).",                    placer, PRPARAMS+disk*NDPARAMS+PVSYS, 2);
  }

  /* Now, we have to convert the triplets into internal units */
  for (disk = 0; disk < rpm -> ndisks; ++disk){
    for (i = 0; i < rpm -> nur; ++i) {
      globin[0] = rpm -> par[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i];
      globin[1] = rpm -> par[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i];
      globin[2] = rpm -> par[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i];

      globtointern(globin, globout, hdr);

      rpm -> par[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i] = globout[0];
      rpm -> par[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i] = globout[1];
      rpm -> par[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i] = globout[2];
    }
  }

  /* Global velocity dispersion */
  /* Default */
    def = 0;

  sprintf(mes, "Give global velicity dipersion (km/s)");
  nel = 1;

  /* this is variable with disk */
  pcondisp = (NPARAMS + (rpm -> ndisks - 1)*NDPARAMS);
  condisp = pcondisp+1;

  /* This is the ninth parameter sequence */
  if (!startinfv -> firstrun) {
    cancel_tir(startinfv -> arel, "CONDISP=", 0);
  }
  userdble_tir(startinfv -> arel, rpm -> par+(pcondisp)*rpm -> nur, &nel, &def, "CONDISP=", mes);

  /* it should be positive */
  while (rpm -> par[(pcondisp)*rpm -> nur] < 0) {
    sprintf(mes, "Negative velocity dispersion not allowed.");
    cancel_tir(startinfv -> arel, "CONDISP", 2);
    userdble_tir(startinfv -> arel, rpm -> par+(pcondisp)*rpm -> nur, &nel, &def, "CONDISP=", mes);
  }

  /* Change the value to grid units */
  rpm -> par[(pcondisp)*rpm ->nur] = dparamtointern(rpm -> par[(pcondisp)*rpm ->nur], condisp, hdr, rpm -> ndisks);

  /* The layer type */
    rpm -> ltype[0] = 0;
    def = 5;

  sprintf(mes, "Give type of layer. [list options]");
  nel = 1;

  if (!startinfv -> firstrun) {
    cancel_tir(startinfv -> arel, "LTYPE=", 0);
  }

  while(!rpm -> ltype[0]) {
    userint_tir(startinfv -> arel, rpm -> ltype+0, &nel, &def, "LTYPE=", mes);
    if((rpm -> ltype[0]) < 1 || (rpm -> ltype[0] > 5)) {
      rpm -> ltype[0] = 0;
      anyout_tir(rpm -> ltype+0, " Ltype:");
      anyout_tir(rpm -> ltype+0, " 1 -- Gaussian layer");
      anyout_tir(rpm -> ltype+0, " 2 -- Sech2 layer");
      anyout_tir(rpm -> ltype+0, " 3 -- Exponential layer");
      anyout_tir(rpm -> ltype+0, " 4 -- Lorentzian layer");
      anyout_tir(rpm -> ltype+0, " 5 -- Box layer");
      cancel_tir(startinfv -> arel, "LTYPE=", 2);
    }
  }

  /* Do this ndisks-1 times more */
  for (i = 1; i < rpm -> ndisks; ++i) {

    sprintf(placer, "LTYPE_%i=", i+1);
    if (!startinfv -> firstrun) {
      cancel_tir(startinfv -> arel, placer, 0);
    }

    /* The layer type */
    rpm -> ltype[i] = rpm -> ltype[i-1];
    def = 2;

    sprintf(mes, "Give type of layer %i. [list options]", i+1);
    nel = 1;

    dummy = 0;

    while(!(dummy)) {
      userint_tir(startinfv -> arel, rpm -> ltype+i, &nel, &def, placer, mes);
      dummy = 1;
      if((rpm -> ltype[i]) < 1 || (rpm -> ltype[i] > 5)) {
	def = 5;
	dummy = 0;
	anyout_tir(rpm -> ltype+i, " Ltype:");
	anyout_tir(rpm -> ltype+i, " 1 -- Gaussian layer");
	anyout_tir(rpm -> ltype+i, " 2 -- Sech2 layer");
	anyout_tir(rpm -> ltype+i, " 3 -- Exponential layer");
	anyout_tir(rpm -> ltype+i, " 4 -- Lorentzian layer");
	anyout_tir(rpm -> ltype+i, " 5 -- Box layer");
	cancel_tir(startinfv -> arel, placer, 2);
      }
    }
  }

  /* cloud flux */
    rpm -> cflux[0] = 1e-5;
    def = 5;

  sprintf(mes,"Cloud flux in (Jy*km/s) [1E-5]");
  nel = 1;
  if (!startinfv -> firstrun) {
    cancel_tir(startinfv -> arel, "CFLUX=", 0);
  }
  userdble_tir(startinfv -> arel, rpm -> cflux+0, &nel, &def, "CFLUX=", mes);
  while (rpm ->cflux[0] <= 0) {
    sprintf(mes,"CFLUX must be greater than zero.");
    rpm -> cflux[0] = 1e-5;
    cancel_tir(startinfv -> arel, "CFLUX=", 2);
    userdble_tir(startinfv -> arel, rpm -> cflux+0, &nel, &def, "CFLUX=", mes);
  }

  for (i = 1; i < rpm -> ndisks; ++i) {

    sprintf(placer, "CFLUX_%i=", i+1);
    if (!startinfv -> firstrun) {
      cancel_tir(startinfv -> arel, placer, 0);
    }

      rpm -> cflux[i] = rpm -> cflux[i-1];
      def = 2;

    sprintf(mes,"Cloud flux (%i) in (Jy*km/s) [1E-5]", i+1);
    nel = 1;
    userdble_tir(startinfv -> arel, rpm -> cflux+i, &nel, &def, placer, mes);
    while (rpm ->cflux[i] <= 0) {
      def = 5;
      sprintf(mes,"CFLUX must be greater than zero.");
      rpm -> cflux[i] = 1e-5;
      cancel_tir(startinfv -> arel, placer, 2);
      userdble_tir(startinfv -> arel, rpm -> cflux+i, &nel, &def, placer, mes);
    }
  }

  /* Initialise the io */
 /* Now initialise the chisquare derivation (convolution) routines */

  if (startinfv -> firstrun) {

  /* Input noiseweight */
    rpm -> weight = 1.0;
    def = 5;

  sprintf(mes, "Give noise weighting (0.0 means inf). [%f]", rpm -> weight);
  nel = 1;
  userreal_tir(startinfv -> arel, &rpm -> weight, &nel, &def, "WEIGHT=", mes);

  /* Input PENALTY */
    rpm -> penalty = 1.0;
    def = 2;

    sprintf(mes, "Give Penalty for outlyers [%f]", rpm -> penalty);
  nel = 1;
  userdble_tir(startinfv -> arel, &rpm -> penalty, &nel, &def, "PENALTY=", mes);

  /* Now we recalculate the penalty */
  rpm -> penalty = rpm -> cflux[0]*rpm -> penalty*SQRTOFPIHALF*((double) hdr -> bmaj)*((double) hdr -> bmaj)*((double) hdr -> bmin)*((double) hdr -> bmin)*HPBWTOSIGMATOFORTH/((double)(hdr -> rms*hdr -> rms));

  /* Input inimode */
    rpm -> inimode = 1;
    def = 5;

#ifdef PBCORR

  /* Primary beam correction */

  def = 2;
  nel = 1;
  pbtel = 0;

  userint_tir(startinfv -> arel, &pbtel, &nel, &def, "PBTEL=", mes);

  /* We only take action if something gets specified */
  if ((pbtel > 0) && (pbtel <= PBNTELS)) {

    if (!(hdr -> primbeam = (float *) malloc(hdr -> bsize1*hdr -> bsize2*sizeof(float)))) {
      anyout_tir(&dev, "Not enough memory");
      goto error;
    }

    /* Ask for reference pixel and frequency */
    sprintf(mes, "Give pbc reference pixel, starting at 0 0 in the lower left corner [centre]");
    pbrefpix[0] = hdr -> bsize1/2-0.5;
    pbrefpix[1] = hdr -> bsize2/2-0.5;
    def = 2;
    nel = 2;
    userdble_tir(startinfv -> arel, pbrefpix, &nel, &def, "PBREFPIX=", mes);

    /* Ask for reference frequency */
    sprintf(mes, "Give pbc reference frequency (GHz) [1.4]");
    pbreffreq = HIRESFREQ*1.0E-9;
    def = 2;
    nel = 2;
    err = 1;

    userdble_tir(startinfv -> arel, &pbreffreq, &nel, &def, "PBREFFREQ=", mes);

    switch(pbtel) {
    case PBWSRT:
    case PBWSRT_2:
      while ((err)) {
	if ((pbreffreq < 8) && (pbreffreq > 0.5)) {
	  --err;
	}
	else {
	  def = 1;
	  anyout_tir(&dev, "Must lie between 0.5 and 8.0");
	  cancel_tir(startinfv -> arel, "PBREFFREQ=", 2);
	  pbreffreq = HIRESFREQ*1.0E-9;
	  userdble_tir(startinfv -> arel, &pbreffreq, &nel, &def, "PBREFFREQ=", mes);
	}
      }
      break;

    default:
      ;
    }

    switch(pbtel) {
    case PBWSRT:
    case PBWSRT_2:

      /* (cos((pi/180)*c * nu/GHz * r/deg ))^6, c = 60.7492, (cos(c1* nu/GHz * r/deg))^6, c1 = 1.0602735280990601 (estimated from HPBW in Miriad), nu: frequency in GHz, r: radius in deg */
      /* hdr -> deltgridtouser[0,1] gives conversion from pixel to arcsec */
      /* rp = sqrt((x-refpixx)^2+(y-refpixy)^2): radius in pixel */
      /* r = sqrt(((x-refpixx)*hdr->deltgridtouser[0])^2+((y-refpixy)*hdr->deltgridtouser[1])^2)/3600.0 */
      /* neclecting the frequency dependency results in an error of 1-2/1000 at half power. The uncertainty in the parameters is much larger */
      /* An experiment shows that this conforms with the miriad primary beam correction for the WSRT at a level of 0.002 percent, so to float precision level */
      /* A communication with T.A. results in the fact that one should use c = 68 instead. Details are here:  Popping & Braun 2008, A&A 479, 903 */

      switch(pbtel) {
      case PBWSRT:
	pbwsrtconst = PBWSRTCONST_1;
	break;
      case PBWSRT_2:
	pbwsrtconst = PBWSRTCONST_2;
	break;
      }

      for (i = 0; i < hdr -> bsize1; ++i) {
#ifdef OPENMPTIR
#pragma omp parallel for private(pbdoublev1,pbdoublev2,pbradius)
#endif
	for (j = 0; j < hdr -> bsize2; ++j) {
	   pbdoublev1 = (((double) i)-pbrefpix[0])*hdr->deltgridtouser[0];
	   pbdoublev2 = (((double) j)-pbrefpix[1])*hdr->deltgridtouser[1];
	   pbradius = (pbwsrtconst*pbreffreq*sqrt(pbdoublev1*pbdoublev1+pbdoublev2*pbdoublev2));
	  if (pbradius < PIHALF)
	    hdr -> primbeam[i+hdr -> bsize1*j] = pow(cos(pbradius),6);
	  else
	    hdr -> primbeam[i+hdr -> bsize1*j] = 0.0;
	}
      }
      break;

    default:
      break;
    }
  }

  /* Now arrange for the correct links */
  chkb_pbcorr(hdr, rpm);
#endif

  sprintf(mes, "Give initialisation time 0 short, 3 long [1]");
  nel = 1;
  err = 0;
  while (!(err)) {
    userint_tir(startinfv -> arel, &(rpm -> inimode), &nel, &def, "INIMODE=", mes);
    if (rpm -> inimode < 0 || rpm -> inimode > 3) {
      sprintf(mes, "Out of range %i", rpm -> inimode);
      cancel_tir(startinfv -> arel, "INIMODE=", 2);
      rpm -> inimode = 1;
      def = 5;
    }
    else
      err = 1;
  }

  /* Input mode */
    rpm -> mode = 3;
    def = 5;

/*   sprintf(mes, "Give memory consumption mode. [list options]"); */
/*   nel = 1; */
/*   i = 0; */
/*   while (!(i)) { */
/*     userint_tir(&rpm -> mode, &nel, &def, "MEMMODE=", mes); */
/*     if (rpm -> mode < 0 || rpm -> mode > 3) { */
/*       anyout_tir(&i, " MemMode:"); */
/*       anyout_tir(&i, "       0 -- in-place, no boost."); */
/*       anyout_tir(&i, "       1 -- in-place, using boost."); */
/*       anyout_tir(&i, "       2 -- out-place, no boost."); */
/*       anyout_tir(&i, "       3 -- out-place, using boost."); */
/*       cancel_tir(startinfv -> arel, "MEMMODE="); */
/*       rpm -> mode = 3; */
/*       def = 5; */
/*     } */
/*     else */
/*       i = 1; */
/*   } */
  mode = rpm -> mode*2;
  if ((rpm -> weight))
    ++mode;

/*   sprintf(obsmes, */
/* 	  "ori[0]:   %f\n" */
/* 	  "model[0]: %f\n" */
/* 	  "bsize1:   %i\n" */
/* 	  "bsize2:   %i\n" */
/* 	  "nsubs:    %i\n" */
/*           "bmaj:     %f\n" */
/* 	  "bmin:     %f\n" */
/*           "bpa:      %f\n" */
/* 	  "cflux[0]: %f\n" */
/* 	  "rms:      %f\n" */
/*           "mode:     %i\n" */
/*           "2*(bsize1/2+1): %i\n" */
/* 	  "chi2 (random):  %f\n" */
/* 	  "weight:         %f\n" */
/* 	  "inimode:        %i\n" */
/* 	  "ncores:         %i\n",  */
/* hdr -> oric -> points[0], hdr -> modelc -> points[0], hdr -> bsize1, hdr -> bsize2, hdr -> nsubs, hdr -> bmaj, hdr -> bmin, hdr -> bpa, rpm -> cflux[0], hdr -> rms, mode, 2*(hdr -> bsize1/2+1), hdr -> chi2, rpm -> weight, rpm -> inimode, log -> ncores */
/* 	  ); */
/*   anyout_tir(&obsint, obsmes); */

  /* Try to initialise the chisquare machinery */
  while (mode >= 0 && mode < 8) {
    if (!initchisquare_c(hdr -> oric -> points, hdr -> modelc -> points, hdr -> bsize1, hdr -> bsize2, hdr -> nsubs, hdr -> bmaj, hdr -> bmin, hdr -> bpa, 1, rpm -> cflux[0], hdr -> rms, mode, 2*(hdr -> bsize1/2+1), &hdr -> chi2, rpm -> weight, rpm -> inimode, log -> ncores)) {
    mode = mode-2;
    j = 0;
    }
    else {
      mode = 8;
    }
  }

  j = 4;
  if (mode < 8)
    error_tir(&j,"Error initializing chi^2 derivation control.");

  /* Write inset data into ori array  (has been done since long)*/
  /* nel = 0; */
  /* def = 4; */

  /* for (i = 0; i < hdr -> nsubs; ++i) { */
  /*   j=i*hdr -> nprof; */
  /*   gdsi_read_tir(hdr -> inset, hdr -> cwlo+i, hdr -> cwhi+i, hdr -> ori+j, &hdr -> nprof, &k, &nel); */
  /*   if ((nel)) { */
  /*     error_tir(&def, "Unable to read inset."); */
  /*   } */
  /* } */

  /* close inset (not needed anymore ?) */
  /* gds_close_tir(hdr -> inset, &def); */

  /* Now the cube has to be rearranged, because it is padded */
  /* for(k = hdr -> nsubs-1; k >= 0; --k) { */
  /*   for(j = hdr -> bsize2-1; j >= 0; --j) { */
  /*     for(i = hdr -> bsize1-1; i >= 0; --i) { */
  /* 	hdr -> ori[i+2*(hdr -> bsize1/2+1)*(j+hdr -> bsize2*k)] = hdr -> ori[i+hdr -> bsize1*(j+hdr -> bsize2*k)]; */
  /*     } */
  /*   } */
  /* } */

  /* The cube has changed, therefore we need to do this */
  engalmod_chflgs();

  /* Also, we change the nprof */
  hdr -> nprof = hdr -> bcsize1*hdr -> bsize2;

  /* We initialise the sd array */
  for (i = 0; i < rpm -> ndisks; ++i) {
    if (!(rpm -> sd[i] = create_srd(rpm -> nr)))
      goto error;
    for (j = 0; j < rpm -> nr; ++j) {
      if (!(rpm -> sd[i][j].permrandstr = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
		  goto error;
      rpm -> sd[i][j].randstr = NULL;
      rpm -> sd[i][j].grandstr[0] = NULL;
      rpm -> sd[i][j].grandstr[1] = NULL;
      rpm -> sd[i][j].grandstr[2] = NULL;
      rpm -> sd[i][j].grandstr[3] = NULL;
      rpm -> sd[i][j].srandstr = NULL;
    }
  }
  }
  /* Get the info for the single-model random-number generator */
  /* First from the log if present */
    rpm -> iseed2 = 1803;
    def = 2;

  sprintf(mes, "Give one integer to initialize RNG. [1803]");

  if (!startinfv -> firstrun)
    cancel_tir(startinfv -> arel, "ISEED=", 0);

  nel = 1;
  userint_tir(startinfv -> arel, &rpm -> iseed2, &nel, &def, "ISEED=", mes);
  while (rpm -> iseed2 < 0 || rpm -> iseed2 > 31328) {
    sprintf(mes, "Iseed out of range.");
    cancel_tir(startinfv -> arel, "ISEED=", 2);
    def = 5;
    userint_tir(startinfv -> arel, &rpm -> iseed2, &nel, &def, "ISEED=", mes);
  }

  for (i = 0; i < rpm -> ndisks; ++i) {

    for (j = 0; j < rpm -> nr; ++j) {
      rpm -> sd[i][j].iseed2[0] = rpm -> iseed2;
    }
  }

  return rpm;

  error:
  destroy_ringparms(rpm);
  if (hdr)
    destroy_hdrinf(hdr);
  if (log)
    destroy_loginf(log, rpm -> ndisks);

  return NULL;

  }

  /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a fitparms structure */
static fitparms *create_fitparms(ringparms *rpm)
{
  fitparms *fit;

  if (!(fit = (fitparms *) malloc(sizeof(fitparms))))
    return NULL;

  fit -> varylist = NULL;
  fit -> normrandstr = NULL;
  fit -> gft_mstv = NULL;
  fit -> varyhstr = NULL;
  fit -> index = NULL;
  fit -> mon_dpar = NULL;
  fit -> reg_contv = NULL;
  fit -> npoints = NULL;

  /* Allocate the memory */
  if (!(fit -> normrandstr = (maths_rstr *) malloc(sizeof(maths_rstr))))
     goto error;

  if (!(fit -> npoints = (int *) malloc(rpm -> ndisks*sizeof(int))))
     goto error;
  if (!(fit -> fluxpoints = (long *) malloc(rpm -> ndisks*sizeof(long))))
     goto error;
  if (!(fit -> mon_repnpoints = (int *) malloc(rpm -> ndisks*sizeof(int))))
     goto error;
  if (!(fit -> mon_totalflux = (double *) malloc(rpm -> ndisks*sizeof(double))))
     goto error;

  return fit;

 error:
  destroy_fitparms(fit);
  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destroys a fitparms structure */
void destroy_fitparms(fitparms *fit)
{
  /* Check if it is there */
  if (!(fit))
    return;

  if ((fit -> varylist))
    destroyvarlel(fit -> varylist);
  if((fit -> normrandstr))
    free(fit -> normrandstr);
  if((fit -> npoints))
    free(fit -> npoints);
  if((fit -> fluxpoints))
    free(fit -> fluxpoints);
  if((fit -> mon_repnpoints))
    free(fit -> mon_repnpoints);
  if((fit -> mon_totalflux))
    free(fit -> mon_totalflux);
  if((fit -> gft_mstv))
    gft_mst_destr(fit -> gft_mstv);
  if((fit -> varyhstr))
    free(fit -> varyhstr);
  if((fit -> mon_dpar))
    free(fit -> mon_dpar);
  if((fit -> index))
    decomp_inlist_dest(fit->index);
  if ((fit -> reg_contv))
    reg_cont_destr(fit -> reg_contv);
  if ((fit -> adar))
    free(fit -> adar);

  free(fit);
    return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Fill the fitparms struct from the input */
static fitparms *get_fitparms(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fitparmsv)
{
  fitparms *fit;

  /* Private control and changing variables */
  int def;      /* Any default mode */
  int nel;      /* Number of elements */
  int nread;    /* Number of read elements */
  char mes[81];  /* Any message */
  int errcode = 1; /* another error code */
  int anint;

  int i, j, k; /* Simple control variables */

  /* Private input lists */
  varlel **pointarray = NULL;
  double *parmax = NULL;
  double *parmin = NULL;
  int *moderate = NULL;
  double *delstart = NULL;
  double *delend = NULL;
  int *itestart = NULL;
  int *iteend = NULL;
  double *satdelt = NULL;
  double *mindelta = NULL;

  char *varyhstr = NULL;
  char **varystr= NULL; /* An array of short strings to hold some input strings */
  char **inputofvarysing = NULL;
  char **inputofvarymult = NULL;
  char *dcperr;

  decomp_control decomp_controlv = NULL;
  decomp_listel *decomp_listelv = NULL;

  inlistel *flistel = NULL;
  varlel *varele;
  varlel *varylist = NULL;
  size_t size_tv; /* dummy */

  /* diverse */
  adar *adarv = NULL;

  double *array = NULL; /* An array to contain a row */

  /* arel output */
  int nreadl, nreturned, keypres;

  int neill;

  /* Get the struct */
  if (!startinfv -> firstrun) {
    destroy_fitparms(fitparmsv);

    /* These are all the parameters that need to be re-read */
    cancel_tir(startinfv -> arel, "FITMODE=", 0);
    cancel_tir(startinfv -> arel, "LOOPS=", 0);
    cancel_tir(startinfv -> arel, "MAXITER=", 0);
    cancel_tir(startinfv -> arel, "CALLITE=", 0);
    cancel_tir(startinfv -> arel, "SIZE=", 0);
    cancel_tir(startinfv -> arel, "PSSE=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSNP=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSCO=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSSO=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSMV=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSNF=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSIW=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSFW=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSID=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "PSDD=", 0); /* only fitmode = PSWARM */
    cancel_tir(startinfv -> arel, "VARINDX=", 0);
    cancel_tir(startinfv -> arel, "VARY=", 0);
    cancel_tir(startinfv -> arel, "VARYSING=", 0);
    cancel_tir(startinfv -> arel, "VARYMULT=", 0);
    cancel_tir(startinfv -> arel, "PARMAX=", 0);
    cancel_tir(startinfv -> arel, "PARMIN=", 0);
    cancel_tir(startinfv -> arel, "MODERATE=", 0);
    cancel_tir(startinfv -> arel, "DELSTART=", 0);
    cancel_tir(startinfv -> arel, "DELEND=", 0);
    cancel_tir(startinfv -> arel, "ITESTART=", 0); /* (only fitmode = golden section) */
    cancel_tir(startinfv -> arel, "ITEEND=", 0); /* (only fitmode = golden section) */
    cancel_tir(startinfv -> arel, "MINDELTA=", 0);
  }

  if (!(fit = create_fitparms(rpm))) {
    goto error;
  }

  /* Input fitmode */
    fit -> fitmode = 2;
    def = 1;

  sprintf(mes, "Give fitting mode 2: golden section, 3: simplex [2]");
  nel = 1;
  userint_tir(startinfv -> arel, &fit -> fitmode, &nel, &def, "FITMODE=", mes);

  if ((fit -> fitmode == METROPOLIS)) {
    sprintf(mes, "Method not existent (currently no Metropolis)");
    anyout_tir(&def, mes);
    goto error;
  }

  /* now we plug in the next generation fit codes */
  if (fit -> fitmode > 1) {

    /* Allocate the fit control object */
    if (!(fit -> gft_mstv = gft_mst_const()))
      goto error;

    /* Try to specify method */
    i = fit -> fitmode-1;

    if ((j = gft_mst_put(fit -> gft_mstv, &i, GFT_INPUT_METHOD))) {
      if (j & 64) {
	def = 1;
	sprintf(mes, "Method not existent");
	anyout_tir(&def, mes);
	goto error;
      }
    }
    gft_mst_putf(fit -> gft_mstv, &gchsq_gen_start, GFT_INPUT_GCHSQ);

    /* Try to allocate the arguments struct and link */
    if (!(adarv = (adar *) malloc(sizeof(adar))))
      goto error;

    fit -> adar = (void *) adarv;
    adarv -> startinfv = startinfv;
    adarv -> log = log;
    adarv -> hdr = hdr;
    adarv -> rpm = rpm;
    adarv -> fit = fit;

    /* Pack it into gft */
    gft_mst_put(fit -> gft_mstv, fit -> adar, GFT_INPUT_ADAR);

  }

  /* Input loops */
    fit -> loops = 500000;
    def = 1;

  sprintf(mes, "Give number of loops to process. [500000]");
  nel = 1;
  userint_tir(startinfv -> arel, &fit -> loops, &nel, &def, "LOOPS=", mes);

  /* Get the total maximum number of iterations */
  if (fit -> fitmode > GOLDEN_SECTION) {
    fit -> maxiter = 5000000;
    def = 1;

    sprintf(mes, "Give maximum number of total iterations. [5000000]");
    nel = 1;
    userint_tir(startinfv -> arel, &fit -> maxiter, &nel, &def, "MAXITER=", mes);

    fit -> callite = 5000000;
    def = 1;

    sprintf(mes, "Give maximum number of steps per iteration. [5000000]");
    nel = 1;
    userint_tir(startinfv -> arel, &fit -> callite, &nel, &def, "CALLITE=", mes);

    fit -> size = 1.0;
    def = 1;

    sprintf(mes, "Give stop size relative to minsteps. [1.0]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> size, &nel, &def, "SIZE=", mes);
  }

  /* in case of PSWARM, we need these here, again propagating the defaults */
  if (fit -> fitmode == PSWARM) {
    fit -> psse = PSW_PSSE_DEF;
    def = 2;
    sprintf(mes, "Give seed for PSWARM rng. [42]");
    nel = 1;
    userint_tir(startinfv -> arel, &fit -> psse, &nel, &def, "PSSE=", mes);

    fit -> psnp = PSW_PSNP_DEF;
    def = 2;
    sprintf(mes, "Give swarm size for PSWARM. [42]");
    nel = 1;
    userint_tir(startinfv -> arel, &fit -> psnp, &nel, &def, "PSNP=", mes);

    fit -> psco = PSW_PSCO_DEF;
    def = 2;
    sprintf(mes, "Give cognition parameter for PSWARM. [0.5]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psco, &nel, &def, "PSCO=", mes);

    fit -> psso = PSW_PSSO_DEF;
    def = 2;
    sprintf(mes, "Give social parameter for PSWARM. [0.5]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psso, &nel, &def, "PSSO=", mes);

    fit -> psmv = PSW_PSMV_DEF;
    def = 2;
    sprintf(mes, "Give maximum velocity for PSWARM. [1.0]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psmv, &nel, &def, "PSMV=", mes);

    fit -> psnf = PSW_PSNF_DEF;
    def = 2;
    sprintf(mes, "Number of Evaluations from initial inertia to final inertia for PSWARM. [8000]");
    nel = 1;
    userint_tir(startinfv -> arel, &fit -> psnf, &nel, &def, "PSNF=", mes);

    fit -> psii = PSW_PSII_DEF;
    def = 2;
    sprintf(mes, "Give initial inertia for PSWARM. [0.9]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psii, &nel, &def, "PSII=", mes);

    fit -> psfi = PSW_PSFI_DEF;
    def = 2;
    sprintf(mes, "Give final inertia for PSWARM. [0.4]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psfi, &nel, &def, "PSFI=", mes);

    fit -> psid = PSW_PSID_DEF;
    def = 2;
    sprintf(mes, "Give increase factor for delta for grid search. [2.0]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psid, &nel, &def, "PSID=", mes);

    fit -> psdd = PSW_PSDD_DEF;
    def = 2;
    sprintf(mes, "Give decrease factor for delta for grid search. [2.0]");
    nel = 1;
    userdble_tir(startinfv -> arel, &fit -> psdd, &nel, &def, "PSDD=", mes);
  }
  /* We are through with the first hdu, so it will be created if not already existent */
  /******************/
  /******************/
  /* This was commented hdu stuff */
  /*   if ((log -> logname) && (log -> logpres)) { */
  /*     if ((create_hdu_1(log, hdr, rpm, fit))) */
  /*       goto error; */
  /*   } */
  /*   ftstab_close_(); */
  /******************/
  /******************/

  /* Make a flush and don't forget to recreate the hdrlist */
/*   ftstab_flush_(); */
/*   ftstab_hdlreset_(); */
/*   hdl_init(); */

  /* Now open the second hdu, if possible and if we expect one */
/*   if ((log -> logname) && !(log -> logpres)) { */

/*      Try to open the file to check if it is already present */
/*     log -> logpres = ftstab_fopen(log -> logname, 2, 2, 1); */

/*     Furthermore we will simply overwrite the extension  */
/*     ftstab_close_(); */
/*     ftstab_flush_();   */
/*     ftstab_hdlreset_(); */
/*     hdl_init(); */
/*     log -> logpres = 1; */

/*   } */

  /*****************************/
  /******* new way to read parameters ********/
  /*****************************/

  /* The complicated varystr */
  /* Finally, no static arrays any more */
  /* if (!(varystr = (char **) malloc(VARYSTRELES*sizeof(char *)))) */
  /*   goto error; */
  /* if (!(varyhstr = getfcharray(VARYHSTRELES, NULL))) */
  /*   goto error; */

  /* get the dcp control structure */
  if (!(decomp_controlv = decomp_init()))
    goto error;

  /* Fill the dcp control structure with parameter information */
  if ((dec_fill(rpm, decomp_controlv)))
    goto error;

    /* Now get the indexed parameters, for that we know only one group */
  decomp_putsep(decomp_controlv, '\0', '\0', ':');

  errcode = 2;

  /* Get the index array */
  neill = 0;
  while (errcode) {

    def = 1;

    /* nel = usertext_tir(varyhstr, &def, "VARINDX=",mes); */
    /* varyhstr[nel] = '\0'; */
    if (simparse_scn_arel_readval_string(startinfv -> arel, "VARINDX", "Give fitting index.", 0, "", 0, -1, neill, 0, &keypres, &nreadl, &nreturned, &varyhstr)) {
      goto error;
    }
    /* Interlude: Change the case if it is lower case */
    i = 0;
    while (varyhstr[i]) {
      if (varyhstr[i] >= 'a' && varyhstr[i] <= 'z')
	varyhstr[i] = varyhstr[i]+'A'-'a';
      ++i;
    }

    /* Interpret this */
    if ((errcode = decomp_get(decomp_controlv, varyhstr, &decomp_listelv, 0))){
      if (errcode == 1)
	goto error;
      else {
	sprintf(mes, "VARINDX: ");
	if (decomp_errmsg(decomp_controlv))
	  strncpy(mes+9,decomp_errmsg(decomp_controlv),72);
	cancel_tir(startinfv -> arel, "VARINDX=", 2);
	printf("report err here\n");
	anyout_tir(&def, mes);
	printf("report err here\n");
	neill = 1;
      }
    }
  }

  /* Now use this to prepare an index and change the input method */
  decomp_index(decomp_controlv, (decomp_listelv) -> nuel, (decomp_listelv) -> poli);

  /* Deallocate what we don't need anymore, or rather, again */
  decomp_list_dest(decomp_listelv);
  decomp_listelv = NULL;

  errcode = 1;
  k = 0;

  /* Get the vary array */
  neill = 0;
  while (errcode) {
    nel = 0;
    def = 1;

    if (errcode == 2)
      cancel_tir(startinfv -> arel, "VARY=", 2);
    sprintf(mes, "Give fit parameters");
    if ((varyhstr))
      free(varyhstr);

    /* flushfcharray(VARYHSTRELES, varyhstr); */
    /* nel = usertext_tir(varyhstr, &def, "VARY=", mes); */
    if (simparse_scn_arel_readval_string(startinfv -> arel, "VARY", "Give fitting index.", 0, "", 0, -1, neill, 0, &keypres, &nreadl, &nreturned, &varyhstr)) {
      goto error;
    }

    /* only if this is 0, we ask (completely hidden) for an input in the old style */
    if (!strlen(varyhstr)) {

      /* Read in and make a decomp-interpretable string of varysing and varymult */
      nel = 0;

      if ((errcode == 2) && (k == 1))
	cancel_tir(startinfv -> arel, "VARYSING=", 2);
      /* sprintf(mes, "Give fit parameters, single"); */
      /* flushfcharray(VARYHSTRELES, varyhstr); */
      /* nel = usertext_tir(varyhstr, &def, "VARYSING=",mes); */
      if ((varyhstr)) {
	free(varyhstr);
	varyhstr = NULL;
      }

      if (simparse_scn_arel_readval_string(startinfv -> arel, "VARYSING", "Give fit parameters, single.", 0, "", 0, -1, 0, 0, &keypres, &nreadl, &nreturned, &varyhstr))
	goto error;

      if (!(inputofvarysing = sparsenext(" \t", "", "", "", "", "", -1, &varyhstr, &anint, 1, 1)))
	goto error;

      if (errcode == 2 && (k == 1))
	cancel_tir(startinfv -> arel, "VARYMULT=", 2);
      /* sprintf(mes, "Give fit parameters, multi"); */
      /* flushfcharray(VARYHSTRELES, varyhstr); */
      /* nel = usertext_tir(varyhstr, &def, "VARYMULT=",mes); */
      /* varyhstr[nel] = '\0'; */
      if ((varyhstr)) {
	free(varyhstr);
	varyhstr = NULL;
      }

      if (simparse_scn_arel_readval_string(startinfv -> arel, "VARYMULT", "Give fit parameters, multi.", 0, "", 0, -1, 0, 0, &keypres, &nreadl, &nreturned, &varyhstr))
	goto error;

      if (!(inputofvarymult = sparsenext(" \t", "", "", "", "", "", -1, &varyhstr, &anint, 1, 1)))
	goto error;

      /* flushfcharray(VARYHSTRELES, varyhstr); */
      if ((varyhstr)) {
	free(varyhstr);
	varyhstr = NULL;
      }
      if (!(varyhstr = gluetodecomp(inputofvarymult, inputofvarysing)))
	goto error;

      if (inputofvarysing)
	freeparsed(inputofvarysing);
      inputofvarysing = NULL;

      if (inputofvarymult)
	freeparsed(inputofvarymult);
      inputofvarymult = NULL;

      k = 1;
    }

    /* Interlude: Change the case if it is lower case */
    i = 0;
    while (varyhstr[i]) {
      if (varyhstr[i] >= 'a' && varyhstr[i] <= 'z')
	varyhstr[i] = varyhstr[i]+'A'-'a';
      ++i;
    }

    decomp_putsep(decomp_controlv, ',', '!', ':');

    /* Interpret this */
    if ((errcode = decomp_get(decomp_controlv, varyhstr, &decomp_listelv, 0))){
      if (errcode == 1)
	goto error;
      else {
	sprintf(mes, "VARY (error also occurs for VARYSING and VARYMULT): ");
	if ((dcperr = decomp_errmsg(decomp_controlv)))
	  strncpy(mes+6, dcperr, 74);
	anyout_tir(&def, mes);
	neill = 1;
      }
    }
  }

  /* We safe the varyhstr */
  fit -> varyhstr = varyhstr;
  varyhstr = NULL;

  /* We create the index list */
  if (!(fit -> index = decomp_inlist_init()))
    goto error;
  if ((neill = decomp_get_inlist(decomp_controlv, fit -> index))) {
    if (neill == 2)
      printf("Syntax error in VARINDX\n");
    goto error;
  }

  /* Now that we have that array, we can get the other parameters, allocate space for that: count the numbers of parameters needed */
  k = 0;
  /* m = 0; */

  if (decomp_listelv) {
    i = 0;
    while ((decomp_listelv+i) -> nuel != -1) {
      k = (decomp_listelv+i) -> grnr+1;
      ++i;
    }
  }

  if (varyhstr) {
    free(varyhstr);
    varyhstr = NULL;
  }

  /* I think this makes no sense, except to make it freeable at the end of this function */
  /* if (!(varyhstr = getfcharray(VARYHSTRELES, NULL))) */
  /*   goto error; */

  /* Do some allocations */

  /* Allocate the pointarray */
  if (!(pointarray = (varlel **) malloc(k*sizeof(varlel *))))
    goto error;

  /* Allocate the other stuff */
  if (!(parmax = (double *) malloc(k*sizeof(double))))
    goto error;
  if (!(parmin = (double *) malloc(k*sizeof(double))))
    goto error;
  if (!(moderate = (int *) malloc(k*sizeof(int))))
    goto error;
  if (!(delstart = (double *) malloc(k*sizeof(double))))
    goto error;
  if (!(delend = (double *) malloc(k*sizeof(double))))
    goto error;
  if (!(itestart = (int *) malloc(k*sizeof(int))))
    goto error;
  if (!(iteend = (int *) malloc(k*sizeof(int))))
    goto error;
  if (!(satdelt = (double *) malloc(k*sizeof(double))))
    goto error;
  if (!(mindelta = (double *) malloc(k*sizeof(double))))
    goto error;

  /* Read in all the stuff from the logfile */
  nel = k;

  /* Create defaults for the case that the user is too lazy */
  if (create_defaults_from_dcp(hdr, decomp_listelv, parmax, parmin, moderate, delstart, delend, itestart, iteend, satdelt, mindelta, rpm -> nur, rpm -> ndisks, fit -> fitmode))
    goto error;

  /* Now read in everything from the input */

  /* Get the steps */
  /*   sprintf(mes, "Give maximal variation deltas (in the same order)"); */
  /*   def = 4; */
  /*   userdble_tir(startinfv -> arel, steps, &nel, &def, "STEPS=", mes); */

  /* Now read in everything from the user input */

  /* The default is +inf */
  /* for (i = 0; i < k; ++i) { */
  /*   parmax[i] = DBL_MAX; */
  /*   parmin[i] = -DBL_MAX; */
  /*   moderate[i] = 0; */

  /* } */

  /* We have created defaults, and the user is allowed to make use of them, hence no longer def = 4, but def = 2 */
  def = 2;

  /* Get the parmax */
  sprintf(mes, "Give parameter maximum (in the same order)");
  userdble_tir(startinfv -> arel, parmax, &nel, &def, "PARMAX=", mes);

  /* Get the parmin */
  sprintf(mes, "Give parameter minimum (in the same order)");
  userdble_tir(startinfv -> arel, parmin, &nel, &def, "PARMIN=", mes);

  /* Get the moderating steps */
  if (fit -> fitmode != PSWARM) {
    sprintf(mes, "Give moderating steps (in the same order)");
    userint_tir(startinfv -> arel, moderate, &nel, &def, "MODERATE=", mes);

    /* I have no patience programming a warning. If a negative value is
       given, it will be changed to positive */
    for (i = 0; i < k; ++i) {
      if (moderate[i] < 0)
	moderate[i] = -moderate[i];
    }

    /* Get the start delta */
    sprintf(mes, "Give the start delta (in the same order)");
    userdble_tir(startinfv -> arel, delstart, &nel, &def, "DELSTART", mes);

    /* Get the end delta */

    /* No longer defaults to startdelta, but to defaults */
    /* if (def == 5) { */
    /*   for (i = 0; i < k; ++i) */
    /* 	delend[i] = delstart[i]; */
    /* } */
    sprintf(mes, "Give the end delta (in the same order)");
    userdble_tir(startinfv -> arel, delend, &nel, &def, "DELEND", mes);
  }
  else {
    for (i = 0; i < k; ++i) {
      moderate[i] = 0;
    }
  }
  /* These are not required for fitmode metropolis (which currently does not exist) */

  if (fit -> fitmode >= GOLDEN_SECTION) {
    /* Get the itestart */
    /* defaul = defaul%4; */

    if (fit -> fitmode == GOLDEN_SECTION) {
      sprintf(mes, "Give starting number of iterations");
      nread = userint_tir(startinfv -> arel, itestart, &nel, &def, "ITESTART", mes);

      /* I have no patience programming a warning. If a negative value is
	 given, it will be changed to positive and 0 will be changed to 1 */
      for (i = 0; i < k; ++i) {
	if (itestart[i] < 0)
	  itestart[i] = -itestart[i];
	if (itestart[i] == 0)
	  itestart[i] = 1;
	if (i >= nread || fit -> fitmode > GOLDEN_SECTION) {
	  if (i > 0)
	    itestart[i] = itestart[i-1];
	}
      }

      /* Get the iteend */
      /* Defaults to itestart */
      /* if (def%4 == 1) {  */
      /* 	for (i = 0; i < k; ++i) */
      /* 	  iteend[i] = itestart[i]; */
      /* } */

      /* def = def%4; */
      sprintf(mes, "Give final number of iterations (in the same order)");
      nread = userint_tir(startinfv -> arel, iteend, &nel, &def, "ITEEND", mes);

      /* I have no patience programming a warning. If a negative value is
	 given, it will be changed to positive and 0 will be changed to 1 */
      for (i = 0; i < k; ++i) {
	if (iteend[i] < 0)
	  iteend[i] = -iteend[i];
	if (iteend[i] == 1)
	  iteend[i] = 1;
	if (i >= nread || fit -> fitmode > GOLDEN_SECTION) {
	  if (i > 0)
	    iteend[i] = iteend[i-1];
	}
      }

      /* if (defaul != 2) */
      /* 	defaul |= 4; */
      /* if (def != 2) */
      /* 	def |= 4; */

      /* Get the satisfaction delta*/
      sprintf(mes, "Give the satisfaction deltas (in the same order)");
      userdble_tir(startinfv -> arel, satdelt, &nel, &def, "SATDELT=", mes);

      /* dito */
      for (i = 0; i < k; ++i) {
	if (satdelt[i] < 0)
	  satdelt[i] = -satdelt[i];
      }
    }
    else {
      for (i = 0; i < k; ++i) {
	itestart[i] = 0;
	iteend[i] = 0;
	satdelt[i] = 0.0;
      }
    }

    /* if (defaul != 2) */
    /*   defaul |= 4; */
    /* if (def != 2) */
    /*   def |= 4; */

    /* Get the minimum deltas */
    sprintf(mes, "Give the minimum deltas (in the same order)");
    userdble_tir(startinfv -> arel, mindelta, &nel, &def, "MINDELTA=", mes);

    /* dito */
    for (i = 0; i < k; ++i) {
      if (mindelta[i] < 0)
	mindelta[i] = -mindelta[i];
    }
  }
  /* else { */
  /*   for (i = 0; i < k; ++i) { */
  /*     mindelta[i] = 0.0; */
  /*   } */
  /* } */

  /* We create a varylist linked list from the input and link it into fit -> varylist */
  /* ndisk construction */
  /* The only possibility for an error is memory problems */

  if (!(fit -> varylist = create_varylist_from_dcp(hdr, decomp_listelv, parmax, parmin, moderate, delstart, delend, itestart, iteend, satdelt, mindelta, rpm -> nur, rpm -> ndisks)))
    goto error;

  /* At the end we will check out and initialise certain behaviour dependent on the choice of parameters */

  /* ndisk construction */
  chkb_sdis(rpm,fit);
  chkb_vrad(rpm,fit);
  chkb_vver(rpm,fit);
  chkb_dvro(rpm,fit);
  chkb_dvra(rpm,fit);
  chkb_dvve(rpm,fit);
  chkb_vm0(rpm,fit);
  chkb_vm1(rpm,fit);
  chkb_vm2(rpm,fit);
  chkb_vm3(rpm,fit);
  chkb_vm4(rpm,fit);
  chkb_ra1(rpm,fit);
  chkb_ra2(rpm,fit);
  chkb_ra3(rpm,fit);
  chkb_ra4(rpm,fit);
  chkb_ro1(rpm,fit);
  chkb_ro2(rpm,fit);
  chkb_ro3(rpm,fit);
  chkb_ro4(rpm,fit);
  chkb_wm0(rpm,fit);
  chkb_wm1(rpm,fit);
  chkb_wm2(rpm,fit);
  chkb_wm3(rpm,fit);
  chkb_wm4(rpm,fit);
  chkb_ls0(rpm,fit);
  chkb_lc0(rpm,fit);
  chkb_smi(rpm,fit);
  chkb_gau(rpm,fit);
  chkb_azi(rpm,fit);

  /* These are now not necessary anymore, they exist in any case */
  free(parmax);
  parmax = NULL;
  free(parmin);
  parmin = NULL;
  free(moderate);
  moderate = NULL;
  free(delstart);
  delstart = NULL;
  free(delend);
  delend = NULL;
  free(itestart);
  itestart = NULL;
  free(iteend);
  iteend = NULL;
  free(satdelt);
  satdelt = NULL;
  free(mindelta);
  mindelta = NULL;
  if (array)
    free(array);
  array = NULL;

  /* Now write the second hdu if warranted */
  /* We are thru with the second hdu, so it will be created if not already existent */
/******************/
/******************/
  /* This was commented hdu stuff */
/*   if ((log -> logname) && (log -> logpres)) { */
/*     if ((create_hdu_2(log -> logname, fit -> varylist, pointarray, rpm -> nur, hdr))) */
/*       goto error; */
/*   } */
/*   ftstab_close_(); */

  /* Make a flush and don't forget to recreate the hdrlist */
/*   ftstab_flush_(); */
/*   ftstab_hdlreset_(); */
/*   hdl_init(); */

  /* Calculate degrees of freedom here */
  /* Count the number of parameters and put them in */
  varele = fit -> varylist;
  i = 0;
  while (varele) {
    ++i;
    varele = varele -> next;
  }
  fit -> dof = ((double) (hdr -> bsize1*hdr -> bsize2*hdr -> nsubs)/(CONVTHREEDBEAM*hdr -> bmaj*hdr -> bmin))-((double) i);

  /* Now make the arrangements for the minimiser */
  if (fit -> fitmode > GOLDEN_SECTION) {

    /* Count the number of parameters and put them in */
    varele = fit -> varylist;
    i = 0;
    while (varele) {
      ++i;
      varele = varele -> next;
    }

    fit -> mon_npar = i;

    size_tv = i;
    gft_mst_put(fit -> gft_mstv, &size_tv, GFT_INPUT_NPAR);

    /* Allocate the mon_dpar array and initialise */
    if (!i)
      ++i;

    if (!(fit -> mon_dpar = (double *) malloc (i*sizeof(double))))
      goto error;

    fit -> mon_dpar[0] = 0.0;

    /* Allocate a double array for generic use */
/*     if (!(array = (double *) malloc (i*sizeof(double)))) */
/*       goto error; */

    /* Now put in the start parameters, is done in genfit */
/*     i = 0; */
/*     varele = fit -> varylist; */
/*     while (varele) { */
/*       array[i] = rpm -> par[varele -> elements[0]]; */
/*       ++i; */
/*       varele = varele -> next; */
/*     } */
/*     gft_mst_put(fit -> gft_mstv, array, GFT_INPUT_SPAR); */
  }

  /* Reset the touched array */
  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i) {
    rpm -> chapar[i] = 1;
  }

  /* Count the number of parameters and put them in */
  /* varele = fit -> varylist; */
  /* i = 0; */
  /* while (varele) { */
  /*   printf("varylist entry: %i\n",i); */
  /*   printf("elements:"); */
  /*   for (j = 0; j < varele -> nelem; ++j) { */
  /*     printf(" %i", varele -> elements[j]); */
  /*   } */
  /*     printf("\n         "); */
  /*   for (j = 0; j < varele -> nelem; ++j) { */
  /*     printf(" %i", varele -> elements[j]%rpm -> nur); */
  /*   } */
  /*     printf("\n"); */
  /*     printf("\n"); */
  /*   ++i; */
  /*   varele = varele -> next; */
  /* } */

  /* Interpolate over the index once */
  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  /* Deallocate things */
  if ((array))
    free(array);

  if ((pointarray))
    free(pointarray);

  if (varylist && varylist != fit -> varylist)
    destroyvarlel(varylist);

  /* if ((varystr)) { */
  /*   free(varystr); */
  /* } */

  if ((varyhstr))
    free(varyhstr);

  if ((flistel))
    destroyinlistel(flistel);

  if ((decomp_controlv))
    decomp_dest(decomp_controlv);

  if ((decomp_listelv))
    decomp_list_dest(decomp_listelv);

  if (inputofvarysing)
    freeparsed(inputofvarysing);

  if (inputofvarymult)
    freeparsed(inputofvarymult);

  if (!(fit -> reg_contv =  reg_cont_get(startinfv, hdr, rpm, fit)))
    goto error;

  return fit;

 error:
  destroy_fitparms(fit);

  if ((adarv))
    free(adarv);

  if (varylist)
    destroyvarlel(varylist);

  if ((flistel))
    destroyinlistel(flistel);

  if ((varystr)) {
    free(varystr);
  }
  if ((varyhstr))
    free(varyhstr);

  /* Allocate the pointarray */
  if ((pointarray))
    free(pointarray);

  /* Allocate the */
  if ((parmax))
    free(parmax);

  /* Allocate the */
  if ((parmin))
    free(parmin);

  /* Allocate the */
  if ((moderate))
    free(moderate);

  /* Allocate the */
  if ((delstart))
    free(delstart);

  /* Allocate the */
  if ((delend))
    free(delend);

  /* Allocate the */
  if ((itestart))
    free(itestart);

  /* Allocate the */
  if ((iteend))
    free(iteend);

  if ((satdelt))
    free(satdelt);

  if ((mindelta))
    free(mindelta);

  if ((array))
    free(array);

  if (inputofvarysing)
    freeparsed(inputofvarysing);

  if (inputofvarymult)
    freeparsed(inputofvarymult);

  if ((decomp_controlv))
    decomp_dest(decomp_controlv);

  if ((decomp_listelv))
    decomp_list_dest(decomp_listelv);

  /*   if ((elements)) */
  /*     free(elements); */
      /******/

  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

static  varlel *create_varylist_from_dcp(hdrinf *hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks)
{
  varlel *varylist = NULL, *varyfirst = NULL;
  int i = 0, j;
  /******/
  /******/
/*   int obsint = 0; */
/*   char obsmes[200]; */
  /******/

  if (!(decomp_listelv))
    goto error;

  if (!(varyfirst = appendvarlel(NULL)))
    goto error;

  varylist = varyfirst;

  while (((decomp_listelv+i) -> nuel) != -1) {
    varylist -> nelem = (decomp_listelv + i) -> nuel;

    if (varylist -> nelem > 0) {
      if (!((varylist -> elements) = (int *) malloc(varylist -> nelem * sizeof(int))))
		  goto error;

      for (j = 0; j < varylist -> nelem; ++j)
		  varylist -> elements[j] = (decomp_listelv+i) -> poli[j];

      /* poli[j] is the list of elements PXPOS etc., meaning that poli[0] points to the appropriate parameter */

      varylist -> parmax   = simpleglobtointern(parmax[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> parmin   = simpleglobtointern(parmin[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> moderate = moderate[(decomp_listelv + i) -> grnr];
      varylist -> delstart = ddparamtointern(delstart[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> delend   = ddparamtointern(delend[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> itestart = itestart[(decomp_listelv + i) -> grnr];
      varylist -> iteend   = iteend[(decomp_listelv + i) -> grnr];
      varylist -> satdelt  = ddparamtointern(satdelt[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> mindelta = ddparamtointern(mindelta[(decomp_listelv + i) -> grnr], varylist -> nelem > 0?varylist -> elements[0]/nur+1:0, hdr, ndisks);
      varylist -> indicator = 0;

      varylist = appendvarlel(varylist);
    }
    ++i;
  }

  varylist -> nelem = -1;
  varylist -> elements = NULL;

  /* The next stuff is a bit unfortunate, but we need a NULL-terminated list */
  varylist = varyfirst;

  if (varylist)
    while (varylist -> nelem > -1 && varylist -> next -> nelem > -1)
      varylist = varylist -> next;

  if (varylist -> nelem > -1) {
    free(varylist -> next);
    varylist -> next = NULL;
  }
  else {
    free(varylist);
    return NULL;
  }

  return varyfirst;

 error:
  destroyvarlel(varyfirst);
  return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

static int create_defaults_from_dcp(hdrinf *hdr, decomp_listel *decomp_listelv, double *parmax, double *parmin, int *moderate, double *delstart, double *delend, int *itestart, int *iteend, double *satdelt, double *mindelta, int nur, int ndisks, int fitmode)
{
  int i = 0, parnum;
  double value;
  /******/
  /******/
/*   int obsint = 0; */
/*   char obsmes[200]; */
  /******/

  if (!(decomp_listelv))
    goto error;

  while (((decomp_listelv+i) -> nuel) != -1) {

    if ((decomp_listelv + i) -> nuel > 0) {

      parnum = (decomp_listelv+i) -> poli[0];

      /* poli[j] is the list of elements PXPOS etc., meaning that poli[0] points to the appropriate parameter */

      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_PARMAX  , &value)) return 1; parmax  [(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_PARMIN  , &value)) return 1; parmin  [(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_MODERATE, &value)) return 1; moderate[(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_DELSTART, &value)) return 1; delstart[(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_DELEND  , &value)) return 1; delend  [(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_ITESTART, &value)) return 1; itestart[(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_ITEEND  , &value)) return 1; iteend  [(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_SATDELT , &value)) return 1; satdelt [(decomp_listelv + i) -> grnr] = value;
      if (tirific_defaults_fitdefromident(parnum, nur, ndisks, fitmode, TIRIDENT_MINDELTA, &value)) return 1; mindelta[(decomp_listelv + i) -> grnr] = value;
    }
    ++i;
  }

  return 0;

 error:
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Conversion of some units */
static double simpleglobtointern(double value, int par, hdrinf *hdr, int ndisks)
{
  int condisp;

  condisp = (NPARAMS + (ndisks - 1)*NDPARAMS)+1;

  if (par == RADI)
    return value/hdr -> deltgridtouser[0];

  if (par == (condisp))
    return value/hdr -> deltgridtouser[2];

  par = (par-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;
  if (par == VROT)
    return value/hdr -> deltgridtouser[2];
  if (par == VRAD)
    return value/hdr -> deltgridtouser[2];
  if (par == VVER)
    return value/hdr -> deltgridtouser[2];
  if (par == DVRO)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (par == DVRA)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (par == DVVE)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (par == ZDRO)
    return value/hdr -> deltgridtouser[0];
  if (par == ZDRA)
    return value/hdr -> deltgridtouser[0];
  if (par == ZDVE)
    return value/hdr -> deltgridtouser[0];
  if (par == Z0)
     /* Formerly) deltgridtouser[2]; */
    return value/hdr -> deltgridtouser[0];
  if (par == SBR)
    return value/hdr -> jygridtouser;
  if (par == SM1A)
    return value/hdr -> jygridtouser;
  if (par == SM1P)
    return DEGTORAD*value;
  if (par == SM2A)
    return value/hdr -> jygridtouser;
  if (par == SM2P)
    return DEGTORAD*value;
  if (par == SM3A)
    return value/hdr -> jygridtouser;
  if (par == SM3P)
    return DEGTORAD*value;
  if (par == SM4A)
    return value/hdr -> jygridtouser;
  if (par == SM4P)
    return DEGTORAD*value;

  if (par == GA1A)
    return value/hdr -> jygridtouser;
  if (par == GA1P)
    return DEGTORAD*value;
  if (par == GA1D)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (par == GA2A)
    return value/hdr -> jygridtouser;
  if (par == GA2P)
    return DEGTORAD*value;
  if (par == GA2D)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (par == GA3A)
    return value/hdr -> jygridtouser;
  if (par == GA3P)
    return DEGTORAD*value;
  if (par == GA3D)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (par == GA4A)
    return value/hdr -> jygridtouser;
  if (par == GA4P)
    return DEGTORAD*value;
  if (par == GA4D)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (par == AZ1P)
    return DEGTORAD*value;
  if (par == AZ1W)
    return DEGTORAD*value;
  if (par == AZ2P)
    return DEGTORAD*value;
  if (par == AZ2W)
    return DEGTORAD*value;
  if (par == INCL)
    return DEGTORAD*value;
  if (par == PA)
    return DEGTORAD*(value+180);
    /* globtointern */
  if (par == XPOS)
    return (value - hdr -> userglobcrval[0])/hdr -> userglobcdelt[0]+(hdr -> setcrpix[0]-1.0);
  if (par == YPOS)
    return (value - hdr -> userglobcrval[1])/hdr -> userglobcdelt[1]+(hdr -> setcrpix[1]-1.0);
  if (par == VSYS)
    return (value - hdr -> userglobcrval[2])/hdr -> userglobcdelt[2]+(hdr -> setcrpix[2]-1.0);
  if (par == SDIS)
    return value/hdr -> deltgridtouser[2];
  if (par == CLNR)
    return value;
  if (par == VM0A)
    return value/hdr -> deltgridtouser[2];
  if (par == VM1A)
    return value/hdr -> deltgridtouser[2];
  if (par == VM1P)
    return DEGTORAD*value;
  if (par == VM2A)
    return value/hdr -> deltgridtouser[2];
  if (par == VM2P)
    return DEGTORAD*value;
  if (par == VM3A)
    return value/hdr -> deltgridtouser[2];
  if (par == VM3P)
    return DEGTORAD*value;
  if (par == VM4A)
    return value/hdr -> deltgridtouser[2];
  if (par == VM4P)
    return DEGTORAD*value;
  if (par == RA1A)
    return value/hdr -> deltgridtouser[2];
  if (par == RA1P)
    return DEGTORAD*value;
  if (par == RA2A)
    return value/hdr -> deltgridtouser[2];
  if (par == RA2P)
    return DEGTORAD*value;
  if (par == RA3A)
    return value/hdr -> deltgridtouser[2];
  if (par == RA3P)
    return DEGTORAD*value;
  if (par == RA4A)
    return value/hdr -> deltgridtouser[2];
  if (par == RA4P)
    return DEGTORAD*value;
  if (par == RO1A)
    return value/hdr -> deltgridtouser[2];
  if (par == RO1P)
    return DEGTORAD*value;
  if (par == RO2A)
    return value/hdr -> deltgridtouser[2];
  if (par == RO2P)
    return DEGTORAD*value;
  if (par == RO3A)
    return value/hdr -> deltgridtouser[2];
  if (par == RO3P)
    return DEGTORAD*value;
  if (par == RO4A)
    return value/hdr -> deltgridtouser[2];
  if (par == RO4P)
    return DEGTORAD*value;
  if (par == WM0A)
    return value/hdr -> deltgridtouser[0];
  if (par == WM1A)
    return value/hdr -> deltgridtouser[0];
  if (par == WM1P)
    return DEGTORAD*value;
  if (par == WM2A)
    return value/hdr -> deltgridtouser[0];
  if (par == WM2P)
    return DEGTORAD*value;
  if (par == WM3A)
    return value/hdr -> deltgridtouser[0];
  if (par == WM3P)
    return DEGTORAD*value;
  if (par == WM4A)
    return value/hdr -> deltgridtouser[0];
  if (par == WM4P)
    return DEGTORAD*value;
  if (par == LS0)
    return value/hdr -> deltgridtouser[0];
  if (par == LC0)
    return value/hdr -> deltgridtouser[0];

      return value;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Conversion of some units */
static double dparamtointern(double value, int par, hdrinf *hdr, int ndisks)
{
  int condisp;
  condisp = (NPARAMS + (ndisks - 1)*NDPARAMS)+1;

    if (RADI == par)
    return value/hdr -> deltgridtouser[0];
  if (condisp == par)
    return value/hdr -> deltgridtouser[2];

  par = (par-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS+1;

  if (VROT == par)
    return value/hdr -> deltgridtouser[2];
  if (VRAD == par)
    return value/hdr -> deltgridtouser[2];
  if (VVER == par)
    return value/hdr -> deltgridtouser[2];
  if (DVRO == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (DVRA == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (DVVE == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (ZDRO == par)
    return value/hdr -> deltgridtouser[0];
  if (ZDRA == par)
    return value/hdr -> deltgridtouser[0];
  if (ZDVE == par)
    return value/hdr -> deltgridtouser[0];
  if (Z0 == par)
    return value/hdr -> deltgridtouser[0];
  if (SBR == par)
    return value/hdr -> jygridtouser;
  if (SM1A == par)
    return value/hdr -> jygridtouser;
  if (SM1P == par)
    return DEGTORAD*value;
  if (SM2A == par)
    return value/hdr -> jygridtouser;
  if (SM2P == par)
    return DEGTORAD*value;
  if (SM3A == par)
    return value/hdr -> jygridtouser;
  if (SM3P == par)
    return DEGTORAD*value;
  if (SM4A == par)
    return value/hdr -> jygridtouser;
  if (SM4P == par)
    return DEGTORAD*value;
  if (GA1A == par)
    return value/hdr -> jygridtouser;
  if (GA1P == par)
    return DEGTORAD*value;
  if (GA1D == par)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (GA2A == par)
    return value/hdr -> jygridtouser;
  if (GA2P == par)
    return DEGTORAD*value;
  if (GA2D == par)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (GA3A == par)
    return value/hdr -> jygridtouser;
  if (GA3P == par)
    return DEGTORAD*value;
  if (GA3D == par)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (GA4A == par)
    return value/hdr -> jygridtouser;
  if (GA4P == par)
    return DEGTORAD*value;
  if (GA4D == par)
    return value/hdr -> deltgridtouser[0];
/*     return DEGTORAD*value; */
  if (AZ1P == par)
    return DEGTORAD*value;
  if (AZ1W == par)
    return DEGTORAD*value;
  if (AZ2P == par)
    return DEGTORAD*value;
  if (AZ2W == par)
    return DEGTORAD*value;
  if (INCL == par)
    return DEGTORAD*value;
  if (PA == par)
    return DEGTORAD*(value+180);
  if (XPOS == par)
    return value/hdr -> globgridtouser[0];
  if (YPOS == par)
    return value/hdr -> globgridtouser[1];
  if (VSYS == par)
    return value/hdr -> globgridtouser[2];
  if (SDIS == par)
    return value/hdr -> deltgridtouser[2];
  if (CLNR == par)
    return value;
  if (VM0A == par)
    return value/hdr -> deltgridtouser[2];
    /* These are the new ones */
  if (VM1A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM1P == par)
    return DEGTORAD*value;
  if (VM2A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM2P == par)
    return DEGTORAD*value;
  if (VM3A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM3P == par)
    return DEGTORAD*value;
  if (VM4A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM4P == par)
    return DEGTORAD*value;
  if (RA1A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA1P == par)
    return DEGTORAD*value;
  if (RA2A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA2P == par)
    return DEGTORAD*value;
  if (RA3A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA3P == par)
    return DEGTORAD*value;
  if (RA4A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA4P == par)
    return DEGTORAD*value;
  if (RO1A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO1P == par)
    return DEGTORAD*value;
  if (RO2A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO2P == par)
    return DEGTORAD*value;
  if (RO3A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO3P == par)
    return DEGTORAD*value;
  if (RO4A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO4P == par)
    return DEGTORAD*value;
  if (WM0A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM1A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM1P == par)
    return DEGTORAD*value;
  if (WM2A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM2P == par)
    return DEGTORAD*value;
  if (WM3A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM3P == par)
    return DEGTORAD*value;
  if (WM4A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM4P == par)
    return DEGTORAD*value;
  if (LC0 == par)
    return value/hdr -> deltgridtouser[0];
  if (LS0 == par)
    return value/hdr -> deltgridtouser[0];
    return value;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Conversion of some units */
static double ddparamtointern(double value, int par, hdrinf *hdr, int ndisks)
{
  int condisp;
  condisp = (NPARAMS + (ndisks - 1)*NDPARAMS)+1;

  if (RADI == par)
    return value/hdr -> deltgridtouser[0];
  if ((condisp) == par)
    return value/hdr -> deltgridtouser[2];

   par = (par-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS+1;
  if (VROT == par)
    return value/hdr -> deltgridtouser[2];
  if (VRAD == par)
    return value/hdr -> deltgridtouser[2];
  if (VVER == par)
    return value/hdr -> deltgridtouser[2];
  if (DVRO == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (DVRA == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (DVVE == par)
    return value/hdr -> deltgridtouser[2]*hdr -> deltgridtouser[0];
  if (Z0 == par)
    return value/hdr -> deltgridtouser[0];
  if (ZDRO == par)
    return value/hdr -> deltgridtouser[0];
  if (ZDRA == par)
    return value/hdr -> deltgridtouser[0];
  if (ZDVE == par)
    return value/hdr -> deltgridtouser[0];
  if (SBR == par)
    return value/hdr -> jygridtouser;
  if (SM1A == par)
    return value/hdr -> jygridtouser;
  if (SM1P == par)
    return DEGTORAD*value;
  if (SM2A == par)
    return value/hdr -> jygridtouser;
  if (SM2P == par)
    return DEGTORAD*value;
  if (SM3A == par)
    return value/hdr -> jygridtouser;
  if (SM3P == par)
    return DEGTORAD*value;
  if (SM4A == par)
    return value/hdr -> jygridtouser;
  if (SM4P == par)
    return DEGTORAD*value;
  if (GA1A == par)
    return value/hdr -> jygridtouser;
  if (GA1P == par)
    return DEGTORAD*value;
  if (GA1D == par)
    return value/hdr -> deltgridtouser[0];
    /*     return DEGTORAD*value; */
  if (GA2A == par)
    return value/hdr -> jygridtouser;
  if (GA2P == par)
    return DEGTORAD*value;
  if (GA2D == par)
    return value/hdr -> deltgridtouser[0];
    /*     return DEGTORAD*value; */
  if (GA3A == par)
    return value/hdr -> jygridtouser;
  if (GA3P == par)
    return DEGTORAD*value;
  if (GA3D == par)
    return value/hdr -> deltgridtouser[0];
    /*     return DEGTORAD*value; */
  if (GA4A == par)
    return value/hdr -> jygridtouser;
  if (GA4P == par)
    return DEGTORAD*value;
  if (GA4D == par)
    return value/hdr -> deltgridtouser[0];
    /*     return DEGTORAD*value; */
  if (AZ1P == par)
    return DEGTORAD*value;
  if (AZ1W == par)
    return DEGTORAD*value;
  if (AZ2P == par)
    return DEGTORAD*value;
  if (AZ2W == par)
    return DEGTORAD*value;
  if (INCL == par)
    return DEGTORAD*value;
  if (PA == par)
    return DEGTORAD*(value);
  if (XPOS == par)
    return value/hdr -> globgridtouser[0];
  if (YPOS == par)
    return value/hdr -> globgridtouser[1];
  if (VSYS == par)
    return value/hdr -> globgridtouser[2];
  if (SDIS == par)
    return value/hdr -> deltgridtouser[2];
  if (CLNR == par)
    return value;
  if (VM0A == par)
    return value/hdr -> deltgridtouser[2];
    /* These are the new ones */
  if (VM1A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM1P == par)
    return DEGTORAD*value;
  if (VM2A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM2P == par)
    return DEGTORAD*value;
  if (VM3A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM3P == par)
    return DEGTORAD*value;
  if (VM4A == par)
    return value/hdr -> deltgridtouser[2];
  if (VM4P == par)
    return DEGTORAD*value;
  if (RA1A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA1P == par)
    return DEGTORAD*value;
  if (RA2A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA2P == par)
    return DEGTORAD*value;
  if (RA3A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA3P == par)
    return DEGTORAD*value;
  if (RA4A == par)
    return value/hdr -> deltgridtouser[2];
  if (RA4P == par)
    return DEGTORAD*value;
  if (RO1A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO1P == par)
    return DEGTORAD*value;
  if (RO2A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO2P == par)
    return DEGTORAD*value;
  if (RO3A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO3P == par)
    return DEGTORAD*value;
  if (RO4A == par)
    return value/hdr -> deltgridtouser[2];
  if (RO4P == par)
    return DEGTORAD*value;
  if (WM0A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM1A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM1P == par)
    return DEGTORAD*value;
  if (WM2A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM2P == par)
    return DEGTORAD*value;
  if (WM3A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM3P == par)
    return DEGTORAD*value;
  if (WM4A == par)
    return value/hdr -> deltgridtouser[0];
  if (WM4P == par)
    return DEGTORAD*value;
  if (LC0 == par)
    return value/hdr -> deltgridtouser[0];
  if (LS0 == par)
    return value/hdr -> deltgridtouser[0];

    return value;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Conversion of some units */
static double dinterntoparam(double value, int par, hdrinf *hdr, int ndisks)
{
  int condisp;
  condisp = (NPARAMS + (ndisks - 1)*NDPARAMS)+1;

  if (RADI == par)
    return value*hdr -> deltgridtouser[0];
  if ((condisp) == par)
    return value*hdr -> deltgridtouser[2];

  par = (par-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;

  if (VROT == par)
    return value*hdr -> deltgridtouser[2];
  if (VRAD == par)
    return value*hdr -> deltgridtouser[2];
  if (VVER == par)
    return value*hdr -> deltgridtouser[2];
  if (DVRO == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (DVRA == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (DVVE == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (Z0 == par)
    return value*hdr -> deltgridtouser[1];
  if (ZDRO == par)
    return value*hdr -> deltgridtouser[1];
  if (ZDRA == par)
    return value*hdr -> deltgridtouser[1];
  if (ZDVE == par)
    return value*hdr -> deltgridtouser[1];
  if (SBR == par)
    return value*hdr -> jygridtouser;
  if (SM1A == par)
    return value*hdr -> jygridtouser;
  if (SM1P == par)
    return RADTODEG*value;
  if (SM2A == par)
    return value*hdr -> jygridtouser;
  if (SM2P == par)
    return RADTODEG*value;
  if (SM3A == par)
    return value*hdr -> jygridtouser;
  if (SM3P == par)
    return RADTODEG*value;
  if (SM4A == par)
    return value*hdr -> jygridtouser;
  if (SM4P == par)
    return RADTODEG*value;
  if (GA1A == par)
    return value*hdr -> jygridtouser;
  if (GA1P == par)
    return RADTODEG*value;
  if (GA1D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA2A == par)
    return value*hdr -> jygridtouser;
  if (GA2P == par)
    return RADTODEG*value;
  if (GA2D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA3A == par)
    return value*hdr -> jygridtouser;
  if (GA3P == par)
    return RADTODEG*value;
  if (GA3D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA4A == par)
    return value*hdr -> jygridtouser;
  if (GA4P == par)
    return RADTODEG*value;
  if (GA4D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (AZ1P == par)
    return RADTODEG*value;
  if (AZ1W == par)
    return RADTODEG*value;
  if (AZ2P == par)
    return RADTODEG*value;
  if (AZ2W == par)
    return RADTODEG*value;
  if (INCL == par)
    return RADTODEG*value;
  if (PA == par)
    return RADTODEG*value-180;
  if (XPOS == par)
    return value*hdr -> globgridtouser[0];
  if (YPOS == par)
    return value*hdr -> globgridtouser[1];
  if (VSYS == par)
    return value*hdr -> globgridtouser[2];
  if (condisp == par)
    return value*hdr -> deltgridtouser[2];
  if (SDIS == par)
    return value*hdr -> deltgridtouser[2];
  if (CLNR == par)
    return value;
    /* These are the new ones */
  if (VM1A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM1P == par)
    return RADTODEG*value;
  if (VM2A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM2P == par)
    return RADTODEG*value;
  if (VM3A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM3P == par)
    return RADTODEG*value;
  if (VM4A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM4P == par)
    return RADTODEG*value;
  if (RA1A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA1P == par)
    return RADTODEG*value;
  if (RA2A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA2P == par)
    return RADTODEG*value;
  if (RA3A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA3P == par)
    return RADTODEG*value;
  if (RA4A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA4P == par)
    return RADTODEG*value;
  if (RO1A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO1P == par)
    return RADTODEG*value;
  if (RO2A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO2P == par)
    return RADTODEG*value;
  if (RO3A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO3P == par)
    return RADTODEG*value;
  if (RO4A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO4P == par)
    return RADTODEG*value;
  if (VM0A == par)
    return value*hdr -> deltgridtouser[2];
  if (WM0A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM1A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM1P == par)
    return RADTODEG*value;
  if (WM2A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM2P == par)
    return RADTODEG*value;
  if (WM3A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM3P == par)
    return RADTODEG*value;
  if (WM4A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM4P == par)
    return RADTODEG*value;
  if (LC0 == par)
    return value*hdr -> deltgridtouser[0];
  if (LS0 == par)
    return value*hdr -> deltgridtouser[0];

    return value;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Conversion of some units */
static double ddinterntoparam(double value, int par, hdrinf *hdr, int ndisks)
{
  int condisp;
  condisp = (NPARAMS + (ndisks - 1)*NDPARAMS)+1;

  if (RADI == par)
    return value*hdr -> deltgridtouser[0];
  if ((condisp) == par)
    return value*hdr -> deltgridtouser[2];

  par = (par-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;

  if (VROT == par)
    return value*hdr -> deltgridtouser[2];
  if (VRAD == par)
    return value*hdr -> deltgridtouser[2];
  if (VVER == par)
    return value*hdr -> deltgridtouser[2];
  if (DVRO == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (DVRA == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (DVVE == par)
    return value*hdr -> deltgridtouser[2]/hdr -> deltgridtouser[0];
  if (ZDRO == par)
    return value*hdr -> deltgridtouser[1];
  if (ZDRA == par)
    return value*hdr -> deltgridtouser[1];
  if (ZDVE == par)
    return value*hdr -> deltgridtouser[1];
  if (Z0 == par)
    return value*hdr -> deltgridtouser[1];
  if (SBR == par)
    return value*hdr -> jygridtouser;
  if (SM1A == par)
    return value*hdr -> jygridtouser;
  if (SM1P == par)
    return RADTODEG*value;
  if (SM2A == par)
    return value*hdr -> jygridtouser;
  if (SM2P == par)
    return RADTODEG*value;
  if (SM3A == par)
    return value*hdr -> jygridtouser;
  if (SM3P == par)
    return RADTODEG*value;
  if (SM4A == par)
    return value*hdr -> jygridtouser;
  if (SM4P == par)
    return RADTODEG*value;
  if (GA1A == par)
    return value*hdr -> jygridtouser;
  if (GA1P == par)
    return RADTODEG*value;
  if (GA1D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA2A == par)
    return value*hdr -> jygridtouser;
  if (GA2P == par)
    return RADTODEG*value;
  if (GA2D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA3A == par)
    return value*hdr -> jygridtouser;
  if (GA3P == par)
    return RADTODEG*value;
  if (GA3D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (GA4A == par)
    return value*hdr -> jygridtouser;
  if (GA4P == par)
    return RADTODEG*value;
  if (GA4D == par)
    return value*hdr -> deltgridtouser[0];
/*     return RADTODEG*value; */
  if (AZ1P == par)
    return RADTODEG*value;
  if (AZ1W == par)
    return RADTODEG*value;
  if (AZ2P == par)
    return RADTODEG*value;
  if (AZ2W == par)
    return RADTODEG*value;
  if (INCL == par)
    return RADTODEG*value;
  if (PA == par)
    return RADTODEG*value;
  if (XPOS == par)
    return value*hdr -> globgridtouser[0];
  if (YPOS == par)
    return value*hdr -> globgridtouser[1];
  if (VSYS == par)
    return value*hdr -> globgridtouser[2];
  if (condisp == par)
    return value*hdr -> deltgridtouser[2];
  if (SDIS == par)
    return value*hdr -> deltgridtouser[2];
  if (CLNR == par)
    return value;
  if (VM1A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM1P == par)
    return RADTODEG*value;
    /* These are the new ones */
  if (VM1A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM1P == par)
    return RADTODEG*value;
  if (VM2A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM2P == par)
    return RADTODEG*value;
  if (VM3A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM3P == par)
    return RADTODEG*value;
  if (VM4A == par)
    return value*hdr -> deltgridtouser[2];
  if (VM4P == par)
    return RADTODEG*value;
  if (RA1A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA1P == par)
    return RADTODEG*value;
  if (RA2A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA2P == par)
    return RADTODEG*value;
  if (RA3A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA3P == par)
    return RADTODEG*value;
  if (RA4A == par)
    return value*hdr -> deltgridtouser[2];
  if (RA4P == par)
    return RADTODEG*value;
  if (RO1A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO1P == par)
    return RADTODEG*value;
  if (RO2A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO2P == par)
    return RADTODEG*value;
  if (RO3A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO3P == par)
    return RADTODEG*value;
  if (RO4A == par)
    return value*hdr -> deltgridtouser[2];
  if (RO4P == par)
    return RADTODEG*value;
  if (VM0A == par)
    return value*hdr -> deltgridtouser[2];
  if (WM0A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM1A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM1P == par)
    return RADTODEG*value;
  if (WM2A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM2P == par)
    return RADTODEG*value;
  if (WM3A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM3P == par)
    return RADTODEG*value;
  if (WM4A == par)
    return value*hdr -> deltgridtouser[0];
  if (WM4P == par)
    return RADTODEG*value;
  if (LC0 == par)
    return value*hdr -> deltgridtouser[0];
  if (LS0 == par)
    return value*hdr -> deltgridtouser[0];

    return value;

}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* conversion of map units */
static void globtointern(double *invalue, double *outvalue, hdrinf *hdr)
{
  /* int transformation = 0; */
  double world[3];
  /* double proutvalue[3]; */

  /* int vint; */

  /* For the sake of velocity, we know the following transformations, if we'd know that we would not require invalue, we could be even faster */
  world[0] = invalue[0]; /* deg */
  world[1] = invalue[1]; /* deg */
  world[2] = invalue[2]*1000.; /* m/s from km/s, I hope */

  /*The function converts directly from w to absolute pixels */
  cubarithm_w2p(hdr -> oric -> wcs, world, outvalue);

  /* cubarithm_w2p(hdr -> oric -> wcs, world, proutvalue); */

  /* outvalue[0] = proutvalue[0]+hdr -> setcrpix[0]-1; */
  /* outvalue[1] = proutvalue[1]+hdr -> setcrpix[1]-1; */
  /* outvalue[2] = proutvalue[2]+hdr -> setcrpix[2]-1; */

  /* below that line, it's very old stuff */
  /*********************/

  /* Transform the map units into grids */
  /* dbldbl[0] = invalue[0]/hdr -> globsettouser[0]; */
  /* dbldbl[1] = invalue[1]/hdr -> globsettouser[1]; */

  /* Get the map unit belonging to velocity */
  /* outvalue[2] = (invalue[2] - hdr -> userglobcrval[2])/hdr -> userglobcdelt[2]+(hdr -> setcrpix[2]-1.0); */

  /* We assign this to a grid position */
  /* vint = roundnormal(outvalue[2]); */

  /* There are maximal and minimal values that can be set */
  /* if (vint < 0) */
  /*   vint = 0; */
  /* if (vint >= hdr -> nsubs) */
  /*   vint =  hdr -> nsubs-1; */

  /* Now do the transformation, it should work */
  /* cotrans_tir(hdr -> inset, &hdr -> insubs[vint], dbldbl, outvalue, &transformation); */

 /* Now we have grids that we have to transform to maps */
  /* outvalue[0] = outvalue[0]+hdr -> setcrpix[0]-1; */
  /* outvalue[1] = outvalue[1]+hdr -> setcrpix[1]-1; */

  /* Again, the map unit belonging to velocity, because cotrans does a nasty thing */
  /* outvalue[2] = (invalue[2] - hdr -> userglobcrval[2])/hdr -> userglobcdelt[2]+(hdr -> setcrpix[2]-1.0); */

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* conversion of map units */
static void interntoglob(double *invalue, double *outvalue, hdrinf *hdr)
{
  /* int transformation = 1; */
  /* double dbldbl[2]; */
  /* int vint; */
  /* double relpix[3]; */
  double abspix[3];

  /* Transform the map units into grid units, this is absolute pixel values, starting at 0 */
  abspix[0] = invalue[0];
  abspix[1] = invalue[1];
  abspix[2] = invalue[2];

  /* This would be relative values, as formerly required by gipsy */
  /* relpix[0] = invalue[0]-hdr -> setcrpix[0]+1; */
  /* relpix[1] = invalue[1]-hdr -> setcrpix[1]+1; */
  /* relpix[2] = invalue[2]-hdr -> setcrpix[2]+1; */

  /* cubarithm_p2w(hdr -> oric -> wcs, relpix, outvalue); */
  cubarithm_p2w(hdr -> oric -> wcs, abspix, outvalue);

  /* This is to take into account that the global units are always degrees (as in tirific) and m/s (which is 1/1000 the tirific unit) */
  outvalue[2] = outvalue[2]*0.001;

  /* We assign the velocity to a map position */
  /* vint = roundnormal(invalue[2]); */

  /* There are maximal and minimal values that can be set */
  /* if (vint < 0) */
  /*   vint = 0; */
  /* if (vint >= hdr -> nsubs) */
  /*   vint =  hdr -> nsubs-1; */

  /* Now do the transformation, it should work */
  /* cotrans_tir(hdr -> inset, &hdr -> insubs[vint], dbldbl, outvalue, &transformation); */

  /* Get the user unit belonging to velocity */
  /* outvalue[0] = outvalue[0]*hdr -> globsettouser[0]; */
  /*   outvalue[1] = outvalue[1]*hdr -> globsettouser[1]; */
  /* outvalue[2] = (invalue[2]-hdr -> setcrpix[2]+1)*hdr -> userglobcdelt[2]+hdr -> userglobcrval[2]; */

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Change the parameter list params to internal units as if being user units */
static void changetointern(double *params, int nur, hdrinf *hdr, int ndisks)
{
  /* OK */
  int i,j,k,disk;
  double globin[3];
  double globout[3];
  int condisp, pcondisp;

/*   for (i = 0; i < nur; ++i) { */

    /* Some of the easily convertable thingies */
/*     params[PRADI*nur+i] = dparamtointern(params[PRADI*nur+i], RADI, hdr); */
/*   } */

  /* This is all very simple */
  for (disk = 0; disk < ndisks; ++disk){
    j = PRPARAMS+disk*NDPARAMS;

    for (i = 0; i < nur; ++i) {
      for (k = 0; k < NDPARAMS; ++k) {
	if ((k != PXPOS) && (k != PYPOS) &&(k != PVSYS))
	  params[(j+k)*nur+i] = dparamtointern(params[(j+k)*nur+i], j+k+1, hdr, ndisks);
      }

      /* Now, we have to convert the triplets into internal units */
      globin[0] = params[(j+PXPOS)*nur+i];
      globin[1] = params[(j+PYPOS)*nur+i];
      globin[2] = params[(j+PVSYS)*nur+i];

      globtointern(globin, globout, hdr);

      params[(j+PXPOS)*nur+i] = globout[0];
      params[(j+PYPOS)*nur+i] = globout[1];
      params[(j+PVSYS)*nur+i] = globout[2];
    }
  }
  pcondisp = (NPARAMS + (ndisks - 1)*NDPARAMS);
  condisp = pcondisp + 1;
  params[pcondisp*nur] = dparamtointern(params[pcondisp*nur], condisp, hdr, ndisks);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Constructor of an element of the varlel list */
static varlel *appendvarlel(varlel *last)
{
  varlel *out;

  if (!(out = (varlel *) malloc(sizeof(varlel))))
    return NULL;

  if ((last))
    last -> next = out;

  /* "Terminate" */
  out -> elements = NULL;
  out -> nelem = 0;
  out -> next = NULL;

  return out;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destructor of a varlel list */
static void destroyvarlel(varlel *first)
{
  varlel *next;

  while ((first)) {
    /* Convention is that elements is dynamically allocated */
    if ((first -> nelem) > 0)
      free(first -> elements);
    next = first -> next;
    free(first);
    first = next;
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* write the output cube */

static int writemodel(hdrinf *origin, ringparms *rpm, fitparms *fit, double *par, decomp_inlist *index)
{
  int i=0;
  /* char mes[200]; */
  int pcondisp;
  /* int checki = 0, checkia = 0; */

/*   int allnpoints[ndisks]; */

  pcondisp = (NPARAMS + (rpm -> ndisks - 1)*NDPARAMS);

  /* If outset is not defined, we stop here */
  if (*origin -> outset == '\0') {
    return 1;
  }

  /* We have to put the current best values to the cube */
  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i) {
    rpm -> par[i] = par[i];

  }

  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = 1;

  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  /* Testing */
  /* for(k = 0; k < origin -> nsubs; ++k) */
  /*   for(j = 0; j < origin -> bsize2; ++j) */
  /*     for(i = 0; i < origin -> bsize1; ++i) */
  /* 	if (origin -> modelc -> points[i+2*(origin -> bsize1/2+1)*(j+origin -> bsize2*k)] > 0.) */
  /* 	  checkia = 1; */
  /* if (checkia == 1) */
  /*   printf("Is not empty\n"); */
  /* else { */
  /*   printf("Is empty\n"); */
  /* } */

  /* Then we generate the cube and convolve it */
  galmod(origin, rpm, 1, NULL, index, rpm -> fluxpoints, rpm -> allnpoints);

  origin -> chi2 = getchisquare_c(rpm -> par[(pcondisp)*rpm -> nur]);

  /* Regularise */
  origin -> chi2 = reg_do(fit -> reg_contv, (fit -> mon_alloops == fit -> loops)?fit -> loops - 1:fit -> mon_alloops, origin -> chi2);

  /* Correct the chisquare taking into account the outliers, don't know if that is necessary here... */
  origin -> chi2 = origin -> chi2+((double) rpm -> outpoints)*rpm -> penalty;

  /* Now rearrange the cube */
  /* for(k = 0; k < origin -> nsubs; ++k) */
  /*   for(j = 0; j < origin -> bsize2; ++j) */
  /*     for(i = 0; i < origin -> bsize1; ++i) */
  /* 	origin -> model[i+origin -> bsize1*(j+origin -> bsize2*k)] = origin -> model[i+2*(origin -> bsize1/2+1)*(j+origin -> bsize2*k)]; */
  /* origin -> primbeam[i+origin -> bsize1*(j)]; */

  /* Write the cube plane by plane, really too lazy to track min and max */

  /* change this first */
  /* origin -> nprof = origin -> bsize1*origin -> bsize2; */

 /* for (i = 0; i < origin -> nsubs; ++i) { */
 /*   j=i*origin -> nprof; */

   /* My god, this has to be set, otherways: crash... */
 /*   l = 0; */
 /*   gdsi_write_tir(origin -> outset, origin -> cwlo+i, origin -> cwhi+i, origin -> model+j, &origin -> nprof, &k, &l); */
 /*   if (l) { */
 /*     i = 1; */
 /*     sprintf(mes, "Unable to write outset with error %i.", l); */
 /*     error_tir(&i, mes); */
 /*     return 0; */
 /*   } */
 /* } */

  /* This should do */
  cubarithm_writecube(origin -> modelc, origin -> outset, NULL);

 /* Now change this back */
 /* origin -> nprof = origin -> bcsize1*origin -> bsize2; */

 return 1;

 error:
 return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* write the output cube */

static int writecoolmodel(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, double *par, decomp_inlist *index)
{
  int i=0;
  char *coolname = NULL;
  char **varystr = NULL;
  int keypres, nread, nreturned;

  char mes[81];
  int def;
  int nel;
  int err;

  /* These should be replaced with the default cube stuff */
  qfits_header *header;
  Cube *thecube = NULL;
  double beam;
  float *expfcs;
  float sincosofangle[2];

  long fluxpoints;
  int allnpoints;

  /* pcondisp = (NPARAMS + (rpm -> ndisks - 1)*NDPARAMS); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "COOLGAL", "Give cool name.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(coolname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(coolname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* The default is to do nothing */
  if (*coolname == '\0') {
    free(coolname);
    return 1;
  }

  /* Now we want the binning number */
  sprintf(mes, "Give cool binning");
  def = 2;
  nel = 1;
  err = 1;
  hdr -> coolbin = 1;
  while((err)) {
    userint_tir(startinfv -> arel, &(hdr -> coolbin), &nel, &def, "COOLBIN=", mes);
    if (hdr -> coolbin >= 1) {
      err = 0;
    }
    else {
      sprintf(mes, "COOLBIN should be >= 1");
      cancel_tir(startinfv -> arel, "COOLBIN=", 2);
      hdr -> coolbin = 1;
      def = 1;
    }
  }

  /* Now ask if the user wants a specific kind of beam, the default being the max beam */
  sprintf(mes, "Give 3d beam size (arcsec)");
  beam = hdr -> deltgridtouser[0]*((double) hdr -> bmaj);
  def = 2;
  nel = 1;
  err = 1;
  beam = 10;
  while((err)) {
    userdble_tir(startinfv -> arel, &beam, &nel, &def, "COOLBEAM=", mes);
    if (beam >= 0.0) {
      err = 0;
    }
    else {
      sprintf(mes, "COOLBEAM should be >= 0");
      cancel_tir(startinfv -> arel, "COOLBEAM=", 2);
      beam = hdr -> deltgridtouser[0]*((double) hdr -> bmaj);
      def = 1;
    }
  }

  /* Transfer the beam into deg */
  beam = hdr -> globgridtouser[0]*beam/hdr -> deltgridtouser[0];

  /* Make a header, if the beam is 0, we normalise everything such that the units get right */
  if (!(header = makecoolhdr(hdr, ((beam))?beam:sqrt(TWOPI)/(hdr -> globgridtouser[0]*0.42466090014401))))
    return 1;

  /* Transfer the beam back to grid units */
  beam = beam*hdr -> coolbin/(hdr -> globgridtouser[0]);

  /* Now arrange the cube */
  if (!(thecube = (Cube *) malloc(sizeof(Cube))))
    goto error;

  thecube -> refpix_x = 0;
  thecube -> refpix_y = 0;
  thecube -> refpix_v = 0;
  thecube -> size_x = hdr -> bsize1*hdr -> coolbin;
  thecube -> size_y = hdr -> bsize2*hdr -> coolbin;
  thecube -> size_v = (thecube -> size_x > thecube -> size_y)?thecube -> size_x:thecube -> size_y;
  thecube -> scale = 1.0;
  thecube -> padding = 0;

  /* As a precaution, these are not required, but must be set to NULL to avoid a free on some non-alloced stuff */
  thecube -> type_x = NULL;
  thecube -> type_y = NULL;
  thecube -> type_v = NULL;
  thecube -> epoch = NULL;
  thecube -> type = NULL;
  thecube -> unit = NULL;

  thecube -> asciiheader = NULL;
  thecube -> points = NULL;
  thecube -> wcs = NULL;

  /* This is required for gridding */
  hdr -> coolhalfc = ((float) thecube -> size_v)/2;
  hdr -> nprofcool = thecube -> size_x*thecube -> size_y;

  tir_get_grid(log, rpm, log -> outarray);

  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
    rpm -> par[i] = log -> outarray[i];

  /*     Convert the read parameter list to internal units */
  changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);

  /* provide some info */
  nel=1;
  sprintf(mes, "Cool number of bytes used: %lu", thecube -> size_x*thecube -> size_y*thecube -> size_v*sizeof(float));
  anyout_tir(&nel, mes);

  /* Now we allocate the cube, not caring for the padding, this will be done automatically */
  if (!(thecube -> points = (float *) fftwf_malloc(thecube -> size_x*thecube -> size_y*thecube -> size_v*sizeof(float)))) {
    ftsout_header_destroy(header);
    return 1;
  }

  hdr -> coolcube = thecube;

  /* We have to put the current best values to the cube */
  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i) {
    rpm -> par[i] = par[i];
  }

  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = 1;

  /* correct dependent parameters */
  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  /* Then we generate the cube and convolve it */
  galmodcool(hdr, rpm, 1, NULL, index, &fluxpoints, &allnpoints);

    /* Convolve it */
  sincosofangle[0] = 0;
  sincosofangle[1] = 1;

  if (!(expfcs = expofacsfft(0.42466090014401*beam, 0.42466090014401*beam, 0.42466090014401*beam, sincosofangle))) {
    ftsout_header_destroy(header);
    return 1;
  }

  /* Now, the normalisation is the fifth factor, we multiply it with this */
  expfcs[4] = expfcs[4]*sqrtf(TWOPI)*0.42466090014401*beam;

  /* This is the actual convolution */

  if ((beam)) {
    convolgaussfft(thecube, expfcs);
  }

  /* Output it */
  ftsout_writecube(coolname, thecube, header);

  /* Deallocate everything */
    ftsout_header_destroy(header);
    free(thecube -> points);
    thecube -> points = NULL;
    free(expfcs);

 /* Finally */
  if ((coolname))
    free(coolname);
  if ((varystr))
    freeparsed(varystr);
  return 1;

 error:
  /* Strangely, for this function, 0 returned means error. This is an old functino... */
  if ((thecube)) {
    if (hdr -> coolcube)
      cubarithm_cube_destroy(hdr -> coolcube);
    else
      cubarithm_cube_destroy(thecube);
  }
  if ((coolname))
    free(coolname);
  if ((varystr))
    freeparsed(varystr);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Destructor of a inlistel list */
static void destroyinlistel(inlistel *first)
{
  inlistel *next;

  while ((first)) {
    /* Convention is that elements is dynamically allocated */
    next = first -> next;
    free(first);
    first = next;
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Opens a file and puts an old-style ascii header to the top */

static void prepout(loginf *log, hdrinf *hdr, ringparms *rpm)
{
  int i, j;
  char key[21];

  /* Start with the usual check */
  if (*log -> textlog == '\0')
    return;

  /* We try to open write append without header if the file exists,
     without checking the content, first closing if this exists */
  if ((log -> tstream)) {
    fclose(log -> tstream);
    log -> tstream = NULL;
  }
  if (!(log -> tstream = fopen(log -> textlog, "r"))) {

    /* If the file doesn't exist we compose a header */
    if ((log -> tstream = fopen(log -> textlog, "w"))) {

    /* Turn off the buffering for tstream */
    setbuf(log -> tstream, NULL);

      fprintf(log -> tstream, " MODEL# ");

      /* We now compose a header entry for each keyword including radius */
      for (i = 1; i <= (NPARAMS+(rpm -> ndisks-1)*NDPARAMS); ++i) {
 for (j = 0; j < rpm -> nur; ++j) {
   /* Put the title */
   ftstab_putcoltitl(key, i);
   fprintf(log -> tstream, "%6s", key);

   /* Now with an underscore the radius */
   fprintf(log -> tstream, "_%04.1f ", dinterntoparam(rpm -> par[PRADI+j], RADI, hdr, rpm -> ndisks));
 }
      }
      for (i = 1; i <= NSPARAMS; ++i) {
	ftstab_putcoltitl(key, i+(NPARAMS+(rpm -> ndisks-1)*NDPARAMS));
	fprintf(log -> tstream, "%11s", key);
      }

      /* The chisquare, the reduced chisquare and acceptance */
      ftstab_putcoltitl(key, NPARAMS+(rpm -> ndisks-1)*NDPARAMS+NSPARAMS+(LASTSING_PRIMPOS+NUMB_MDPRIMPOS*rpm -> ndisks)+SECHDN_MULTI+CHISQ_TABNR);
      fprintf(log -> tstream, "%23s", key);
      ftstab_putcoltitl(key, NPARAMS+(rpm -> ndisks-1)*NDPARAMS+NSPARAMS+(LASTSING_PRIMPOS+NUMB_MDPRIMPOS*rpm -> ndisks)+SECHDN_MULTI+RCHISQ_TABNR);
      fprintf(log -> tstream, "%23s", key);
      ftstab_putcoltitl(key, NPARAMS+(rpm -> ndisks-1)*NDPARAMS+NSPARAMS+(LASTSING_PRIMPOS+NUMB_MDPRIMPOS*rpm -> ndisks)+SECHDN_MULTI+ACCEPT_TABNR);
      fprintf(log -> tstream, "%10s", key);

      fprintf(log -> tstream,"\n");
    }
  }
  else {
    log -> tstream = fopen(log -> textlog, "a");

    /* Turn off the buffering for tstream */
    setbuf(log -> tstream, NULL);
  }

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generic fitting using the gft */
static int genfit(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  double indpoints; /* Independent data points */
  double *dblarray = NULL;
  double change;
  double dpar;
  size_t npar;
  size_t asize_t = 1, hereiter;
  int maxmod, anintege; /* maximum occurrence of moderate */

  int i,j,k;
  varlel *nextvarlel;

  /* This block is for reporting at the end only */
  char mes[2160]; /* Any message: this is really not clever hardcoding. For many disks this will cause a crash */
  int dev = 1;
  int disk;
  size_t length;
  varlel *varele;

  /* Count the number of entries in the varylist */
  npar = 0;
  maxmod = 0;
  nextvarlel = fit -> varylist;
  while ((nextvarlel)) {
    ++npar;
    if (nextvarlel -> moderate > maxmod)
      maxmod = nextvarlel -> moderate;
    nextvarlel = nextvarlel -> next;
  }

  /* Now ensure that the indexed parameters are aligned */
  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = chkchangep(fit -> varylist, fit -> fitmode, i, rpm -> nur);

  /* When starting make one run of interpover, but first ensure a proper interpolation of the indexed parameters */
  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  interpover(rpm, rpm -> radsep, 0, NULL, fit -> index);

  /* The degrees of freedom are determined by the amount of variable
     parameters, we do it VERY roughly. If there is a parameter varied
     twice, this is not true anymore. Independent pixels are
     determined by the assumption that HPBW in v is two pixels */
  indpoints = (double) (hdr -> bsize1*hdr -> bsize2*hdr -> nsubs)/(CONVTHREEDBEAM*hdr -> bmaj*hdr -> bmin);
  gft_mst_put(fit -> gft_mstv, &indpoints, GFT_INPUT_INDPOINTS);

  /* Get the number of function calls per iteration */
  hereiter = fit -> callite;
  gft_mst_put(fit -> gft_mstv, &hereiter, GFT_INPUT_NCALLS_ST);

  /* Do the first initialisation */
  gft_mst_act(fit -> gft_mstv, GFT_ACT_INIT);

  /* Now check if there are enough loops, iterations, and parameters to fit */
  if (npar > 0 && fit -> loops > 0 && fit -> maxiter > 0) {

    /* allocate */
    if (!(dblarray = (double *) malloc(npar*sizeof(double))))
      goto error;

    /* The stopsize is 1 */
    *dblarray = fit -> size;
    gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_STOPSIZE);

    /* Get the number of total iterations left to be made */
    hereiter = fit -> maxiter;
    gft_mst_put(fit -> gft_mstv, &hereiter, GFT_INPUT_NITERS);

    /* PSWARM input */
    if (fit -> fitmode == PSWARM) {
      anintege = fit -> psse; gft_mst_put(fit -> gft_mstv, &anintege, GFT_INPUT_SEED   );
      anintege = fit -> psnp; gft_mst_put(fit -> gft_mstv, &anintege, GFT_INPUT_PSNPART);
      *dblarray = fit -> psco; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSCOGNI);
      *dblarray = fit -> psso; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSSOCIA);
      *dblarray = fit -> psmv; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSMAXVF);
      anintege = fit -> psnf; gft_mst_put(fit -> gft_mstv, &anintege, GFT_INPUT_PSNITFI);
      *dblarray = fit -> psii; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSINIIN);
      *dblarray = fit -> psfi; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSFININ);
      *dblarray = fit -> psid; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSINCDE);
      *dblarray = fit -> psdd; gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_PSDECDE);
    }
    /* As long as there is moderation, we do this */
    while (fit -> loopnr <= fit -> loops && fit -> loopnr <= maxmod) {

     /* The first guess is in rpm -> par */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = rpm -> par[nextvarlel -> elements[0]];
	nextvarlel = nextvarlel -> next;
	++i;
      }
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_SPAR);

      /* Choose the origin to be identical */
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_OPAR);

      /* Calculate the start deltas */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = fit -> loopnr <= nextvarlel -> moderate?((double) (fit -> loopnr - 1))*(nextvarlel -> delend - nextvarlel -> delstart)/((double) nextvarlel -> moderate)+nextvarlel -> delstart:nextvarlel -> delend;
	nextvarlel = nextvarlel -> next;
	++i;
      }
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_DPAR);

      /* Calculate the satisfaction deltas or grid normalisation */
      /* ERROR SOURCE: This is done many times, but positioning it in front of the loops will lead to a segfault. This is a noted but in gft */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = nextvarlel -> mindelta;
	nextvarlel = nextvarlel -> next;
	++i;
      }

      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_NDPAR);

      /* Put the number of loops to 1 */
      asize_t = 1;
      gft_mst_put(fit -> gft_mstv, &asize_t, GFT_INPUT_LOOPS);

      /* Now DO it */
      gft_mst_act(fit -> gft_mstv, GFT_ACT_START);

      /* At the end, in this loop, copy the results to the parameters */
      gft_mst_get(fit -> gft_mstv, dblarray, GFT_OUTPUT_SOLPAR);

      nextvarlel = fit -> varylist;
      j = 0;
      while ((nextvarlel)) {
	change = dblarray[j] - rpm -> par[nextvarlel -> elements[0]];

	/* Every adressant of elements will be changed by the same amount */
	for (i = 0; i < nextvarlel -> nelem; ++i)
	  rpm -> par[nextvarlel -> elements[i]] = rpm -> par[nextvarlel -> elements[i]]+change;
	++j;
	nextvarlel = nextvarlel -> next;
      }

      /* BUGFIX: change this according to the current solution */
      for (i = rpm -> nur*NSSDPARAMS; i < rpm ->nur *(NSSDPARAMS+NDPARAMS*rpm -> ndisks); ++i)
	rpm -> chapar[i] = chkchangep(fit -> varylist, fit -> fitmode, i, rpm -> nur);
      /*    rpm -> chapar[i] = 1; */

      if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
	goto error;

      ++fit -> loopnr;
    }

    /* The rest of the loops is run within the gft, possibly getting errors */

    if (fit -> loopnr <= fit -> loops) {

      /* The first guess is in rpm -> par */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = rpm -> par[nextvarlel -> elements[0]];
	nextvarlel = nextvarlel -> next;
	++i;
      }
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_SPAR);

      /* Choose the origin to be identical */
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_OPAR);

      /* Get the start deltas */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = nextvarlel -> delend;
	nextvarlel = nextvarlel -> next;
	++i;
      }
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_DPAR);

      /* Calculate the satisfaction deltas or grid normalisation */
      /* ERROR SOURCE: This is done many times, but positioning it in front of the loops will lead to a segfault. This is a noted but in gft */
      nextvarlel = fit -> varylist;
      i = 0;
      while (nextvarlel) {
	dblarray[i] = nextvarlel -> mindelta;
	nextvarlel = nextvarlel -> next;
	++i;
      }
      gft_mst_put(fit -> gft_mstv, dblarray, GFT_INPUT_NDPAR);

      /* Put the number of loops to the remaining number of loops */
      asize_t = fit -> loops - fit -> loopnr+1;
      gft_mst_put(fit -> gft_mstv, &asize_t, GFT_INPUT_LOOPS);

      /* Now DO it */
      gft_mst_act(fit -> gft_mstv, GFT_ACT_START);
    }
  }
  else {
    /* No iterations have been made, which means that we have to do something */

    i = gft_mst_act(fit -> gft_mstv, GFT_ACT_INIT);

    /* Some initialisation here? */
    gft_mst_get(fit -> gft_mstv, &fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_niters    , GFT_OUTPUT_NITERS);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_iters     , GFT_OUTPUT_ITERS);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_alliter   , GFT_OUTPUT_ALLITER);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_allcalls  , GFT_OUTPUT_ALLCALLS);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_calls_st  , GFT_OUTPUT_CALLS_ST);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_ncalls_st , GFT_OUTPUT_NCALLS_ST);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_npar_cur  , GFT_OUTPUT_NPAR_CUR);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_dsize     , GFT_OUTPUT_DSIZE);
    gft_mst_get(fit -> gft_mstv, fit -> mon_dpar      , GFT_OUTPUT_NDPAR);
    gft_mst_get(fit -> gft_mstv, &fit -> mon_stopsize  , GFT_OUTPUT_STOPSIZE);
    fit -> mon_maxiter = fit -> maxiter;
    fit -> mon_loops = fit -> loops;

    varele = fit -> varylist;
    i = 0;
    if (fit -> mon_npar_cur > -1) {
      while (i < fit -> mon_npar_cur) {
	varele = varele -> next;
	++i;
      }
      ftstab_putcoltitl(fit -> mon_key, (*varele -> elements)/rpm -> nur+1);
    }
    else {
      sprintf(fit -> mon_key,"GEN");
    }

    fit -> mon_dsize = ddinterntoparam(fit -> mon_dsize, (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks);
    for (k = 0; k < fit -> mon_npar; ++k) {
      fit -> mon_dpar[k] = ddinterntoparam(fit -> mon_dpar[k], (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks);
    }
    fit -> mon_ring = (*varele -> elements)%rpm -> nur+1;
    for (disk = 0; disk < rpm -> ndisks; ++disk){
      fit -> mon_repnpoints[disk] = fit -> npoints[disk];
      fit -> mon_totalflux[disk] = fit -> fluxpoints[disk]*rpm -> cflux[disk]*hdr -> deltgridtouser[2];
    }
  }

  /* Report */
  /* Find the chisquare of the latest iteration */
  gft_mst_get(fit -> gft_mstv, &fit -> mon_bestchisq , GFT_OUTPUT_BESTCHISQ);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_actchisq  , GFT_OUTPUT_ACTCHISQ);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_size      , GFT_OUTPUT_SIZE);

  if ((fit -> mon_allcalls)) {

    /* find the right dpar */
    if (fit -> mon_npar_cur > -1) {
      dpar = fit -> mon_dpar[fit -> mon_npar_cur];
    }
    else {
      dpar = fit -> mon_dpar[0];
    }

    sprintf(mes,
	    "L:%lu/%lu "    /* loops/number of loops */
	    "I:%02lu/%.1E "    /* iterations in loop/max iterations */
	    "M:%02lu/%.1E/%03lu "    /* models in iteration / max models / total models / total models */
	    "P:%-6s "             /* Parameter name */
            "R:%02i "          /* First ring number */
	    "A:%+.1E/%+.1E "  /* Alteration in parameter, start change */
	    "N:%.1E",          /* Number of pointsources */
	    (unsigned long) (fit -> mon_alloops+1), (unsigned long) fit -> mon_loops,   /* loops run in total/final number of loops */
	    (unsigned long) fit -> mon_alliter+1, (double) fit -> mon_niters,    /* iterations in loop/maximum iterations in loop */
	    (unsigned long) fit -> mon_calls_st+1, (double) fit -> mon_ncalls_st, (unsigned long) fit -> mon_allcalls,  /* Models in loop/total models */
	    fit -> mon_key,
	    fit -> mon_ring,
	    fit -> mon_dsize,
	    dpar,
	    (double) fit -> mon_repnpoints[0]);
    for (disk = 1; disk < rpm -> ndisks; ++disk) {
      length = strlen(mes);
      sprintf(mes+length,
	      "/%.1E",       /* Number of pointsources */
	      (double) fit -> mon_repnpoints[disk]);
    }
    length = strlen(mes);
    sprintf(mes+length,
	    " F:%+.1E",     /* Total flux */
	    fit -> mon_totalflux[0]);
    for (disk = 1; disk < rpm -> ndisks; ++disk) {
      length = strlen(mes);
      sprintf(mes+length,
	      "/%+.1E",
	      fit -> mon_totalflux[disk]);
    }
    length = strlen(mes);
    sprintf(mes+length,
	    " C:%.3E "          /* current chisquare */
/* 	    "B:%.3E "  */         /* current best (solution) chisquare */
	    "S:%+.1E",      /* Current size */
	    fit -> mon_actchisq,                      /* current chisquare */
/* 	    fit -> mon_bestchisq,      */                /* current minimum chisquare */
	    fit -> mon_size                           /* Current size */
	    );
  }
  else {
    sprintf(mes, "Start\n");
  }
  anyout_tir(&dev, mes);

  /*Output of a progress file Kamphuis addition */
  progressout(startinfv, mes);

/* Now keep everything in mind for the final (This is not necessarily necessary, but we do it anyway) */
  gft_mst_get(fit -> gft_mstv, &fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_niters    , GFT_OUTPUT_NITERS);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_iters     , GFT_OUTPUT_ITERS);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_alliter   , GFT_OUTPUT_ALLITER);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_allcalls  , GFT_OUTPUT_ALLCALLS);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_calls_st  , GFT_OUTPUT_CALLS_ST);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_ncalls_st , GFT_OUTPUT_NCALLS_ST);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_npar_cur  , GFT_OUTPUT_NPAR_CUR);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_dsize     , GFT_OUTPUT_DSIZE);
  gft_mst_get(fit -> gft_mstv, fit  -> mon_dpar      , GFT_OUTPUT_NDPAR);
  gft_mst_get(fit -> gft_mstv, &fit -> mon_stopsize  , GFT_OUTPUT_STOPSIZE);
  fit -> mon_maxiter = fit -> maxiter;
  fit -> mon_loops = fit -> loops;

  varele = fit -> varylist;
  i = 0;
  if (fit -> mon_npar_cur > -1) {
    while (i < fit -> mon_npar_cur) {
      varele = varele -> next;
      ++i;
    }
    ftstab_putcoltitl(fit -> mon_key, (*varele -> elements)/rpm -> nur+1);
  }
  else {
    sprintf(fit -> mon_key,"GEN");
  }

  fit -> mon_dsize = ddinterntoparam(fit -> mon_dsize, (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks);

  for (k = 0; k < fit -> mon_npar; ++k) {
    fit -> mon_dpar[k] = ddinterntoparam(fit -> mon_dpar[k], (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks);
  }
  fit -> mon_ring = (*varele -> elements)%rpm -> nur+1;
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    fit -> mon_repnpoints[disk] = fit -> npoints[disk];
    fit -> mon_totalflux[disk] = fit -> fluxpoints[disk]*rpm -> cflux[disk]*hdr -> deltgridtouser[2];
  }

  /* What has to be done is to get the output right, but this is done in putgenresults */
  if ((dblarray))
    free(dblarray);

  return 1;

 error:
  if ((dblarray))
     free(dblarray);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* function passed to gft */
static double gchsq_gen_start(double *vector, void *rest)
{
  double gchsq_genv;
  double chimult;
  int i;
  varlel *varele;
  int disk;

  /************************/
  /************************/
  adar *adarv;
  /************************/

/* We get all the info from the additional arguments */
  adarv = (adar *) rest;

  /* Change them */
    /* If they get out of range, we multiply the chisquare by OUTRANGEFAC */
  chimult = pow(OUTRANGEFAC,chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par));

  /* Now ensure that the indexed parameters are aligned */
  for (i = adarv -> rpm -> nur*NSSDPARAMS; i < adarv -> rpm ->nur *(NSSDPARAMS+NDPARAMS*adarv -> rpm -> ndisks); ++i)
    adarv -> rpm -> chapar[i] = 1;

  if (changedependent(adarv -> rpm, adarv -> rpm -> par, adarv -> fit -> index, adarv -> rpm -> chapar) < 0)
    goto error;

  /* When starting make one run of interpover */
  interpover(adarv -> rpm, adarv -> rpm -> radsep, 1, NULL, adarv -> fit -> index);

  /* Do make the model */
  galmod(adarv -> hdr, adarv -> rpm, GENFIT, adarv -> fit -> varylist, adarv -> fit -> index, adarv -> fit -> fluxpoints, adarv -> fit -> npoints);

  /* Get the chisquare, formerly using PCONDISP (NPARAMS + (ndisks - 1)*NDPARAMS) */
  gchsq_genv = getchisquare_c(adarv -> rpm -> par[((NPARAMS + (adarv -> rpm -> ndisks - 1)*NDPARAMS))*adarv -> rpm -> nur]);

  /* Regularise and get alloops first */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);

  gchsq_genv = reg_do(adarv -> fit -> reg_contv, (adarv -> fit -> mon_alloops == adarv -> fit -> loops)?adarv -> fit -> loops - 1:adarv -> fit -> mon_alloops, gchsq_genv);

  /* Correct the chisquare taking into account the outliers */
  adarv -> hdr -> chi2 = chimult*(gchsq_genv+((double) adarv -> rpm -> outpoints)*adarv -> rpm -> penalty);

/* Now keep everything in mind for the next iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_niters    , GFT_OUTPUT_NITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_iters     , GFT_OUTPUT_ITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alliter   , GFT_OUTPUT_ALLITER);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_allcalls  , GFT_OUTPUT_ALLCALLS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_calls_st  , GFT_OUTPUT_CALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_ncalls_st , GFT_OUTPUT_NCALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_npar_cur  , GFT_OUTPUT_NPAR_CUR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_bestchisq , GFT_OUTPUT_BESTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_actchisq  , GFT_OUTPUT_ACTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_dsize     , GFT_OUTPUT_DSIZE);
  gft_mst_get(adarv -> fit -> gft_mstv, adarv -> fit -> mon_dpar      , GFT_OUTPUT_DPAR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_stopsize  , GFT_OUTPUT_STOPSIZE);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_size      , GFT_OUTPUT_SIZE);
  adarv -> fit -> mon_maxiter = adarv -> fit -> maxiter;
  adarv -> fit -> mon_loops = adarv -> fit -> loops;

  varele = adarv -> fit -> varylist;
  i = 0;
  if (adarv -> fit -> mon_npar_cur > -1) {
    while (i < adarv -> fit -> mon_npar_cur) {
      varele = varele -> next;
      ++i;
    }
    ftstab_putcoltitl(adarv -> fit -> mon_key, (*varele -> elements)/adarv -> rpm -> nur+1);
  }
  else {
    sprintf(adarv -> fit -> mon_key,"GEN");
  }

  adarv -> fit -> mon_dsize = ddinterntoparam(adarv -> fit -> mon_dsize, (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
  for (i = 0; i < adarv -> fit -> mon_npar; ++i) {
    adarv -> fit -> mon_dpar[i] = ddinterntoparam(adarv -> fit -> mon_dpar[i], (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
  }

  adarv -> fit -> mon_ring = (*varele -> elements)%adarv -> rpm -> nur+1;
  for (disk = 0; disk < adarv -> rpm -> ndisks; ++disk){
    adarv -> fit -> mon_repnpoints[disk] = adarv -> fit -> npoints[disk];
    adarv -> fit -> mon_totalflux[disk] = adarv -> fit -> fluxpoints[disk]*adarv -> rpm -> cflux[disk]*adarv -> hdr -> deltgridtouser[2];
  }

 /* Change the fitting function */
 i = gft_mst_putf(adarv -> fit -> gft_mstv, &gchsq_gen, GFT_INPUT_GCHSQ_REP);

  return adarv -> hdr -> chi2;

 error:
  return -1.0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* function passed to gft */
static double gchsq_gen(double *vector, void *rest)
{
  char mes[160]; /* Any message */
  int dev = 1;
  double gchsq_genv;
  size_t length;
  /* double chimult; */
  double dpar;
  varlel *varele;
  int i,k;
  int disk;

  /************************/
  /************************/
  adar *adarv;
  /************************/

/* We get all the info from the additional arguments */
  adarv = (adar *) rest;

  /* We read from the logfile */

  if (ftstab_get_value(adarv -> fit -> recnr+1L, 1L, &gchsq_genv)) {

  /* Find the chisquare of the latest iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_bestchisq , GFT_OUTPUT_BESTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_actchisq  , GFT_OUTPUT_ACTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_size      , GFT_OUTPUT_SIZE);

  /* report what we have, if textlog, we assume that it has been written already */
  if (!(adarv -> fit -> recnr)) {
    sprintf(mes, "Start recalling\n");
    anyout_tir(&dev, mes);
    adarv -> fit -> mon_dsize = 0;
  }

  /* Now find dpar */
  if (adarv -> fit -> mon_npar_cur > -1) {
    dpar = adarv -> fit -> mon_dpar[adarv -> fit -> mon_npar_cur];
  }
  else {
    dpar = adarv -> fit -> mon_dpar[0];
  }
    sprintf(mes,
	    "L:%lu/%lu "    /* loops/number of loops */
	    "I:%02lu/%.1E "    /* iterations in loop/max iterations */
	    "M:%02lu/%.1E/%03lu "    /* models in iteration / max models / total models / total models */
	    "P:%-6s "             /* Parameter name */
            "R:%02i "          /* First ring number */
	    "A:%+.1E/%+.1E ",  /* Alteration in parameter, start change */
	    (unsigned long) (adarv -> fit -> mon_alloops+1), (unsigned long) adarv -> fit -> mon_loops,   /* loops run in total/final number of loops */
	    (unsigned long) adarv -> fit -> mon_alliter+1, (double) adarv -> fit -> mon_niters,    /* iterations in loop/maximum iterations in loop */
	    (unsigned long) adarv -> fit -> mon_calls_st+1, (double) adarv -> fit -> mon_ncalls_st, (unsigned long) adarv -> fit -> mon_allcalls,  /* Models in loop/total models */
	    adarv -> fit -> mon_key,
	    adarv -> fit -> mon_ring,
	    adarv -> fit -> mon_dsize,
	    dpar);
    length = strlen(mes);
    sprintf(mes+length,
	    " C:%.9E "          /* current chisquare */
/* 	    "B:%.3E "  */         /* current best (solution) chisquare */
	    "S:%+.1E",      /* Current size */
	    adarv -> fit -> mon_actchisq,                      /* current chisquare */
/* 	    adarv -> fit -> mon_bestchisq,      */                /* current minimum chisquare */
	    adarv -> fit -> mon_size                           /* Current size */
	    );

  anyout_tir(&dev, mes);

  /*Output of a progress file Kamphuis addition */
  progressout(adarv -> startinfv, mes);

   /* Change them */
  /* chimult = pow(OUTRANGEFAC,chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par)); */
  pow(OUTRANGEFAC,chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par));
/*   if (chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par)) */

/*     If they get out of range, we multiply the chisquare by OUTRANGEFAC  */
/*     chimult = OUTRANGEFAC; */
/*   else */
/*     chimult = 1.0; */

    /* Now ensure that the indexed parameters are aligned */
  for (i = adarv -> rpm -> nur*NSSDPARAMS; i < adarv -> rpm->nur *(NSSDPARAMS+NDPARAMS*adarv -> rpm->ndisks); ++i) {
    adarv -> rpm -> chapar[i] = chkchangep(adarv -> fit -> varylist, adarv -> fit -> fitmode, i, adarv -> rpm -> nur);
  }
  if (changedependent(adarv -> rpm, adarv -> rpm -> par, adarv -> fit -> index, adarv -> rpm -> chapar) < 0)
    goto error;

  /* Do make the model */
/*   galmod(adarv -> hdr, adarv -> rpm, GENFIT, adarv -> fit -> varylist, adarv -> fit -> index, fluxpoints, adarv -> fit -> npoints); */

  /* Get the chisquare */
/*   gchsq_genv = getchisquare_c(adarv -> rpm -> par[((NPARAMS + (adarv -> rpm -> ndisks - 1)*NDPARAMS))*adarv -> rpm -> nur]); */

  /* Correct the chisquare taking into account the outliers */
  adarv -> hdr -> chi2 = adarv -> hdr -> oldchi2 = gchsq_genv;

  /* Now change this for the next iteration */
/*   for (disk = 0; disk < rpm -> ndisks; ++disk) { */
/*     adarv -> fit -> fluxpoints[disk] = fluxpoints[disk]; */
/*   } */

  ++adarv -> fit -> recnr;

    /* Produce output */
    writeoutputread(adarv -> log, adarv -> hdr, adarv -> rpm, adarv -> fit, 0, adarv -> fit -> dof, adarv -> fit -> recnr, -1.0);

/* Now keep everything in mind for the next iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_niters    , GFT_OUTPUT_NITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_iters     , GFT_OUTPUT_ITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alliter   , GFT_OUTPUT_ALLITER);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_allcalls  , GFT_OUTPUT_ALLCALLS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_calls_st  , GFT_OUTPUT_CALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_ncalls_st , GFT_OUTPUT_NCALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_npar_cur  , GFT_OUTPUT_NPAR_CUR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_dsize     , GFT_OUTPUT_DSIZE);
  gft_mst_get(adarv -> fit -> gft_mstv, adarv -> fit -> mon_dpar      , GFT_OUTPUT_NDPAR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_stopsize  , GFT_OUTPUT_STOPSIZE);
  adarv -> fit -> mon_maxiter = adarv -> fit -> maxiter;
  adarv -> fit -> mon_loops = adarv -> fit -> loops;

  varele = adarv -> fit -> varylist;
  i = 0;
  if (adarv -> fit -> mon_npar_cur > -1) {
    while (i < adarv -> fit -> mon_npar_cur) {
      varele = varele -> next;
      ++i;
    }
    ftstab_putcoltitl(adarv -> fit -> mon_key, (*varele -> elements)/adarv -> rpm -> nur+1);
  }
  else {
    sprintf(adarv -> fit -> mon_key,"GEN");
  }

  adarv -> fit -> mon_dsize = ddinterntoparam(adarv -> fit -> mon_dsize, (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
  for (k = 0; k < adarv -> fit -> mon_npar; ++k) {
    adarv -> fit -> mon_dpar[k] = ddinterntoparam(adarv -> fit -> mon_dpar[k], (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
  }
  adarv -> fit -> mon_ring = (*varele -> elements)%adarv -> rpm -> nur+1;
  for (disk = 0; disk < adarv -> rpm -> ndisks; ++disk){
    adarv -> fit -> mon_repnpoints[disk] = adarv -> fit -> npoints[disk];
    adarv -> fit -> mon_totalflux[disk] = adarv -> fit -> fluxpoints[disk]*adarv -> rpm -> cflux[disk]*adarv -> hdr -> deltgridtouser[2];
  }

  }
  else {
    /* ERROR SOURCE: Some initialisation here ? */
    gchsq_genv = gchsq_gen2(vector, rest);

    /* Change the fitting function */
    gft_mst_putf(adarv -> fit -> gft_mstv, &gchsq_gen2, GFT_INPUT_GCHSQ_REP);

  }

  return gchsq_genv;

 error:
  return -1.0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* function passed to gft */
static double gchsq_gen2(double *vector, void *rest)
{
  char mes[260]; /* Any message */
  int dev = 1;
  double gchsq_genv = 0;
  double chimult;
  double dpar;
  int i,k;
  int disk;
  size_t length;
  varlel *varele;

  /************************/
  /************************/
  adar *adarv;
  /************************/

  /* We get all the info from the additional arguments */
  adarv = (adar *) rest;

  /* Find the chisquare of the latest iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_bestchisq , GFT_OUTPUT_BESTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_actchisq  , GFT_OUTPUT_ACTCHISQ);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_size      , GFT_OUTPUT_SIZE);

  /* report what we have, if textlog, we assume that it has been written already */
  if (!(adarv -> fit -> mon_allcalls)) {
    sprintf(mes, "Start\n");
    anyout_tir(&dev, mes);
    adarv -> fit -> mon_dsize = 0;
  }

  /* Now find dpar */
  if (adarv -> fit -> mon_npar_cur > -1) {
    dpar = adarv -> fit -> mon_dpar[adarv -> fit -> mon_npar_cur];
  }
  else {
    dpar = adarv -> fit -> mon_dpar[0];
  }

    sprintf(mes,
	    "L:%lu/%lu "    /* loops/number of loops */
	    "I:%02lu/%.1E "    /* iterations in loop/max iterations */
	    "M:%02lu/%.1E/%03lu "    /* models in iteration / max models / total models / total models */
	    "P:%-6s "             /* Parameter name */
            "R:%02i "          /* First ring number */
	    "A:%+.1E/%+.1E "  /* Alteration in parameter, start change */
	    "N:%.1E",          /* Number of pointsources */
	    (unsigned long) (adarv -> fit -> mon_alloops+1), (unsigned long) adarv -> fit -> mon_loops,   /* loops run in total/final number of loops */
	    (unsigned long) adarv -> fit -> mon_alliter+1, (double) adarv -> fit -> mon_niters,    /* iterations in loop/maximum iterations in loop */
	    (unsigned long) adarv -> fit -> mon_calls_st+1, (double) adarv -> fit -> mon_ncalls_st, (unsigned long) adarv -> fit -> mon_allcalls,  /* Models in loop/total models */
	    adarv -> fit -> mon_key,
	    adarv -> fit -> mon_ring,
	    adarv -> fit -> mon_dsize,
	    dpar,
	    (double) adarv -> fit -> mon_repnpoints[0]);
    for (disk = 1; disk < adarv -> rpm -> ndisks; ++disk) {
      length = strlen(mes);
      sprintf(mes+length,
	      "/%.1E",       /* Number of pointsources */
	      (double) adarv -> fit -> mon_repnpoints[disk]);
    }
    length = strlen(mes);
    sprintf(mes+length,
	    " F:%+.1E",     /* Total flux */
	    adarv -> fit -> mon_totalflux[0]);
    for (disk = 1; disk < adarv -> rpm -> ndisks; ++disk) {
      length = strlen(mes);
      sprintf(mes+length,
	      "/%+.1E",
	      adarv -> fit -> mon_totalflux[disk]);
    }
    length = strlen(mes);
    sprintf(mes+length,
	    " C:%.7E "          /* current chisquare */
/* 	    "B:%.3E "  */         /* current best (solution) chisquare */
	    "S:%+.1E",      /* Current size */
	    adarv -> fit -> mon_actchisq,                      /* current chisquare */
/* 	    adarv -> fit -> mon_bestchisq,      */                /* current minimum chisquare */
	    adarv -> fit -> mon_size                           /* Current size */
	    );

  anyout_tir(&dev, mes);

  /*Output of a progress file Kamphuis addition */
  progressout(adarv -> startinfv, mes);

   /* Change them */
  chimult = pow(OUTRANGEFAC,chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par));
/*   if (chprm_gen(vector, adarv -> fit -> varylist, adarv -> rpm -> par)) */

/*     If they get out of range, we multiply the chisquare by OUTRANGEFAC  */
/*     chimult = OUTRANGEFAC; */
/*   else */
/*     chimult = 1.0; */

  /* Now ensure that the indexed parameters are aligned */
  for (i = adarv -> rpm -> nur*NSSDPARAMS; i < adarv -> rpm->nur *(NSSDPARAMS+NDPARAMS*adarv -> rpm->ndisks); ++i)
    adarv -> rpm -> chapar[i] = chkchangep(adarv -> fit -> varylist, adarv -> fit -> fitmode, i, adarv -> rpm -> nur);

  if (changedependent(adarv -> rpm, adarv -> rpm -> par, adarv -> fit -> index, adarv -> rpm -> chapar) < 0)
    goto error;

  /* Do make the model */
  galmod(adarv -> hdr, adarv -> rpm, GENFIT, adarv -> fit -> varylist, adarv -> fit -> index, adarv -> rpm -> fluxpoints, adarv -> fit -> npoints);

  /* Get the chisquare, formerly using pcondisp */
  gchsq_genv = getchisquare_c(adarv -> rpm -> par[((NPARAMS + (adarv -> rpm -> ndisks - 1)*NDPARAMS))*adarv -> rpm -> nur]);

  /* Regularise */
/* First recall the loop number, keep everything in mind for the next iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
  gchsq_genv = reg_do(adarv -> fit -> reg_contv, (adarv -> fit -> mon_alloops == adarv -> fit -> loops)?adarv -> fit -> loops - 1:adarv -> fit -> mon_alloops, gchsq_genv);

  /* Correct the chisquare taking into account the outliers */
  adarv -> hdr -> chi2 = chimult*(gchsq_genv+((double) adarv -> rpm -> outpoints)*adarv -> rpm -> penalty);

  /* Now change this for the next iteration */
  for (disk = 0; disk < adarv -> rpm -> ndisks; ++disk) {
    adarv -> fit -> fluxpoints[disk] = adarv -> rpm -> fluxpoints[disk];
  }

  ++adarv -> fit -> recnr;

  /* Write an output cube */
  if ((*adarv -> hdr -> outset != '\0')) {
    if (!(adarv -> fit -> recnr%adarv -> hdr -> outcubup)) {

      /*   for (i = 0; i < adarv -> rpm -> nur*(NPARAMS+(adarv -> rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i) */
      /*     adarv -> rpm -> oldpar[i] = adarv -> rpm -> par[i]; */

      writemodel(adarv -> hdr, adarv -> rpm, adarv -> fit, adarv -> rpm -> par, adarv -> fit -> index);
    }
  }

    /* Produce output */
    adarv -> hdr -> oldchi2 = adarv -> hdr -> chi2;

    /* correct this fitting */
    writeoutput(adarv -> log, adarv -> hdr, adarv -> rpm, adarv -> fit, 0, adarv -> fit -> dof, adarv -> fit -> recnr, -1.0);

    /* Read out the same number, it might have changed by an epsilon */
    gchsq_genv = adarv -> hdr -> oldchi2;

    /* Correct this fitting */
    gchsq_genv = 1.0;
    ftstab_get_value(adarv -> fit -> recnr, 1L, &gchsq_genv);

/* Now keep everything in mind for the next iteration */
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alloops   , GFT_OUTPUT_ALLOOPS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_niters    , GFT_OUTPUT_NITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_iters     , GFT_OUTPUT_ITERS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_alliter   , GFT_OUTPUT_ALLITER);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_allcalls  , GFT_OUTPUT_ALLCALLS);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_calls_st  , GFT_OUTPUT_CALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_ncalls_st , GFT_OUTPUT_NCALLS_ST);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_npar_cur  , GFT_OUTPUT_NPAR_CUR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_dsize     , GFT_OUTPUT_DSIZE);
  gft_mst_get(adarv -> fit -> gft_mstv, adarv -> fit -> mon_dpar      , GFT_OUTPUT_NDPAR);
  gft_mst_get(adarv -> fit -> gft_mstv, &adarv -> fit -> mon_stopsize  , GFT_OUTPUT_STOPSIZE);
  adarv -> fit -> mon_maxiter = adarv -> fit -> maxiter;
  adarv -> fit -> mon_loops = adarv -> fit -> loops;

  varele = adarv -> fit -> varylist;
  i = 0;
  if (adarv -> fit -> mon_npar_cur > -1) {
    while (i < adarv -> fit -> mon_npar_cur) {
      varele = varele -> next;
      ++i;
    }
    ftstab_putcoltitl(adarv -> fit -> mon_key, (*varele -> elements)/adarv -> rpm -> nur+1);
  }
  else {
    sprintf(adarv -> fit -> mon_key,"GEN");
  }

  adarv -> fit -> mon_dsize = ddinterntoparam(adarv -> fit -> mon_dsize, (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
    for (k = 0; k < adarv -> fit -> mon_npar; ++k) {
      adarv -> fit -> mon_dpar[k] = ddinterntoparam(adarv -> fit -> mon_dpar[k], (*varele -> elements)/adarv -> rpm -> nur+1, adarv -> hdr, adarv -> rpm -> ndisks);
    }
  adarv -> fit -> mon_ring = (*varele -> elements)%adarv -> rpm -> nur+1;
  for (disk = 0; disk < adarv -> rpm -> ndisks; ++disk){
    adarv -> fit -> mon_repnpoints[disk] = adarv -> fit -> npoints[disk];
    adarv -> fit -> mon_totalflux[disk] = adarv -> fit -> fluxpoints[disk]*adarv -> rpm -> cflux[disk]*adarv -> hdr -> deltgridtouser[2];
  }

    return gchsq_genv;

 error:
    return -1.0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Interpolate over the par list to get the modpar */

static void interpinit(ringparms *rpm, double radsep, int disk)
{
  int i,j,jp,k;
  /* float width; */
  /* float dpardr[NPARAMS]; */
  /* float dr; */
  int n2, n1;

  /* In the modpar array interpolate over all rings */
  for (i = 1; i < rpm -> nur; ++i) {

    /* This is the actual width between two radii */
    /* Obsolete when using GSL */
    /* width = rpm -> par[PRADI*rpm -> nur+i] - rpm -> par[PRADI*rpm -> nur+i-1]; */

    /* These are the rings to be calculated */
    n2 = (int) (rpm -> par[PRADI*rpm -> nur+i]/radsep-0.5);
    n1 = ((int) (rpm -> par[PRADI*rpm -> nur+i-1]/radsep+0.5));

    /* in-between two rings, the slope is determined */
/* 	for (j = NPARAMS+(disk-1)*NDPARAMS; j < NPARAMS+disk*NDPARAMS; ++j) { */

    for (jp = NPARAMS-NDPARAMS; jp < NPARAMS; ++jp) {

      j = jp + disk*NDPARAMS;

      /* If the parameter is in the list */
      /* Obsolete when using GSL */
      /* dpardr[jp]= (rpm -> par[j*rpm -> nur+i]-rpm -> par[j*rpm -> nur+i-1])/width; */

      /* Not sure if this is required, but do it anyway */
      gsl_interp_accel_reset(rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);

      /* Very sure that this is a requirement; a test has shown that this should be ouside an omp pragma, not sure why */
      gsl_interp_init(rpm -> gsl_interparray[j-NSSDPARAMS],rpm -> par+PRADI*rpm -> nur, rpm -> par + rpm -> nur*j, rpm -> nur);
    }

    /* D*mn GSL! GSL interpolation is not compatible with OMP anyway */
/* #ifdef OPENMPTIR */
/* #pragma  omp parallel for schedule(dynamic) */
/* #endif */
    for (jp = NPARAMS-NDPARAMS; jp < NPARAMS; ++jp) {

      j = jp + disk*NDPARAMS;

      /* If the parameter is in the list */
      /* Obsolete when using GSL */
      /* dpardr[jp]= (rpm -> par[j*rpm -> nur+i]-rpm -> par[j*rpm -> nur+i-1])/width; */

      /* Not sure if this is required, but do it anyway */
      gsl_interp_accel_reset(rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);

      /* Very sure that this is a requirement; a test has shown */
      gsl_interp_init(rpm -> gsl_interparray[j-NSSDPARAMS],rpm -> par+PRADI*rpm -> nur, rpm -> par + rpm -> nur*j, rpm -> nur);

      for (k = n1; k <= n2; ++k) {
	/* for each parameter the intepolation is done */
	rpm -> modpar[PRADI*rpm -> nr+k] = ((float) k)*radsep+radsep/2.0;
	/* Obsolete when using GSL */
	/* dr = rpm -> modpar[PRADI*rpm -> nr+k]-rpm -> par[PRADI*rpm -> nur+i-1];  */
	/* rpm -> modpar[j*rpm -> nr+k] = rpm -> par[j*rpm -> nur+i-1]+dpardr[jp]*dr;  */
	/* if (k == n1) { */
	/*   fprintf(stderr,"Alpha j: %i n1: %i n2: %i %i %f %f\n",j,n1,n2,k,rpm -> modpar[PRADI*rpm -> nr+k],rpm -> par[PRADI*rpm -> nur+i-1]); */
	/* } */
	/* if (k == n2) { */
	/*   fprintf(stderr,"Omega %i %f %f\n",k,rpm -> modpar[PRADI*rpm -> nr+k],rpm -> par[PRADI*rpm -> nur+i]); */
	/* } */
	rpm -> modpar[j*rpm -> nr+k] = gsl_interp_eval(rpm -> gsl_interparray[j-NSSDPARAMS], rpm -> par+PRADI*rpm -> nur, rpm -> par + rpm -> nur*j, rpm -> modpar[PRADI*rpm -> nr+k], rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);
      }
    }

    /* Now change the pre-processed parameters and terminate the pointsource lists */
    for (k = n1; k <= n2; ++k)
      srprep(rpm, k, 0, disk);
  }
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Interpolate over the par list to get the modpar */

static void interpover(ringparms *rpm, double radsep, int fitmode, varlel *varele, decomp_inlist *index)
{
  int i,j,jp,k,disk;
  /* float width; */
  /* float dpardr[NPARAMS]; */
  /* float dr; */
  int n1, n2, s, e;

  /* Check if we initialise */
  if (!(varele)) {
    for (disk = 0; disk < rpm -> ndisks; ++disk) {
      interpinit(rpm, radsep, disk);
    }
    return;
  }

  /* Switch on all indicators right to a range that should be interpolated over, depending on interpolation method */
  for (disk = 0; disk < rpm -> ndisks; ++disk) {

    for (jp = 0; jp < NDPARAMS; ++jp) {

      for (i = 1; i < rpm -> nur; ++i) {
	if (rpm -> chapar[(NDPARAMS*disk+jp+NSSDPARAMS)*rpm -> nur+i])
	  break;
      }
      if (i < rpm -> nur) {
	if (rpm -> smothcar[jp+disk*NDPARAMS] == INTERP_AKIMA) {
	  s = -2;
	  e = 4;
	}
	else if (rpm -> smothcar[jp+disk*NDPARAMS] == INTERP_CSPLINE) {
	  s = 1;
	  e = rpm -> nur;
	}
	else {
	  s = 1;
	  e = 2;
	}
	for (i = 0; i < rpm -> nur; ++i) {
	  if (rpm -> chapar[(NDPARAMS*disk+jp+NSSDPARAMS)*rpm -> nur+i] == 1) {
	    for (k = s; k < e; ++k) {
	      if ((k+i) >= rpm -> nur)
		break;
	      if ((k+i) > -1) {
		rpm -> chapar[(NDPARAMS*disk+jp+NSSDPARAMS)*rpm -> nur+k+i] = 2;
	      }
	    }
	    /* i = i+k; */
	  }
	}
      }
    }
  }

  /* printf("paraf:"); */
  /* for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i) */
  /*   if (rpm -> chapar[i]) */
  /*     printf(" %i", i); */
  /* printf(" "); */

  for (disk = 0; disk < rpm -> ndisks; ++disk) {

    /* In the modpar array interpolate over all rings */
    for (i = 1; i < rpm -> nur; ++i) {

	/* These are the subrings to be calculated */
      n2 = (int) (rpm -> par[PRADI*rpm -> nur+i]/radsep-0.5);
      n1 = ((int) (rpm -> par[PRADI*rpm -> nur+i-1]/radsep+0.5));

      /* D*mn GSL! GSL interpolation is not compatible with OMP anyway */
      /* #ifdef OPENMPTIR */
      /* #pragma omp parallel for schedule(dynamic) */
      /* #endif */
      for (jp = 0; jp < NDPARAMS; ++jp) {

	j = NSSDPARAMS+jp+disk*NDPARAMS;

	/* If the parameter is in the list */
	if (rpm -> chapar[j*rpm -> nur+i]) {

	  /* Obsolete when using GSL */
	  /* dpardr[jp]= (rpm -> par[j*rpm -> nur+i]-rpm -> par[j*rpm -> nur+i-1])/width; */

	  /* GSL Re-initialise interpolation, don't know if required, but well ... */
	  gsl_interp_accel_reset(rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);

	  for (k = n1; k <= n2; ++k) {
	    /* Obsolete when using GSL */
	    /* dr = rpm -> modpar[PRADI*rpm -> nr+k]-rpm -> par[PRADI*rpm -> nur+i-1]; */

	    /* for each parameter the intepolation is done */
	    /* Obsolete when using GSL */
	    /* rpm -> modpar[j*rpm -> nr+k] = rpm -> par[j*rpm -> nur+i-1]+dpardr[jp]*dr; */
	    rpm -> modpar[j*rpm -> nr+k] = gsl_interp_eval (rpm -> gsl_interparray[j-NSSDPARAMS], rpm -> par, rpm -> par + rpm -> nur*j, rpm -> modpar[PRADI*rpm -> nr+k], rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);
	  }
	  /* Now change the pre-processed parameters and terminate the pointsource lists */
	  for (k = n1; k <= n2; ++k)
	    srprep(rpm, k, 0, disk);
	}
      }
    }
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static void srprep(ringparms *rpm, int srnr, long mode, int disk)
{
  (*(rpm -> inf_smiv[disk] -> srprsbrmax))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprb0))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprs1))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprs2))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprs3))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprs4))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprc1))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprc2))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprc3))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> srprc4))((void *) rpm, srnr, disk);
  (*(rpm -> inf_gauv[disk] -> srpr0))((void *) rpm, srnr, 0, disk);
  (*(rpm -> inf_gauv[disk] -> srpr1))((void *) rpm, srnr, 1, disk);
  (*(rpm -> inf_gauv[disk] -> srpr2))((void *) rpm, srnr, 2, disk);
  (*(rpm -> inf_gauv[disk] -> srpr3))((void *) rpm, srnr, 3, disk);

  /* Reset the number of point sources */
  rpm -> sd[disk][srnr].n =
    rpm -> sd[disk][srnr].nneg =
    rpm -> sd[disk][srnr].npos = 0;
  rpm -> sd[disk][srnr].nharmnorm =
    rpm -> sd[disk][srnr].ngaussian[0] =
    rpm -> sd[disk][srnr].ngaussian[1] =
    rpm -> sd[disk][srnr].ngaussian[2] =
    rpm -> sd[disk][srnr].ngaussian[3] = 0;

  /* Calculate the cloudnumber, rounded down; this will fill the harmnorm variables */
  (*(rpm -> inf_smiv[disk] -> getcloudnumber))((void *) rpm, srnr, disk);
  (*(rpm -> inf_gauv[disk] -> getcloudnumber0))((void *) rpm, srnr, 0, disk);
  (*(rpm -> inf_gauv[disk] -> getcloudnumber1))((void *) rpm, srnr, 1, disk);
  (*(rpm -> inf_gauv[disk] -> getcloudnumber2))((void *) rpm, srnr, 2, disk);
  (*(rpm -> inf_gauv[disk] -> getcloudnumber3))((void *) rpm, srnr, 3, disk);

  /* Change the number of point sources and the cloud flux */
  (*(rpm -> inf_sdisv[disk] -> chclfl))((void *) rpm, srnr, disk);

  rpm -> sd[disk][srnr].pllength = rpm -> sd[disk][srnr].n;

  /* We decide to change the cloudflux a bit instead of accepting an error in the ringflux */
  /*   rpm -> sd[disk][srnr].pf = ringflux/rpm -> sd[disk][srnr].n; */

  if (rpm -> sd[disk][srnr].n > 0) {

    /* We calculate cos's and sins and reset the random number generator */
    rpm -> sd[disk][srnr].sini=sinf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nr+srnr]);
    rpm -> sd[disk][srnr].cosi=cosf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nr+srnr]);
    rpm -> sd[disk][srnr].sinp=sinf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PPA)*rpm -> nr+srnr]);
    rpm -> sd[disk][srnr].cosp=cosf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PPA)*rpm -> nr+srnr]);

    /* prepare the subrings for harmonics info */
    /* velocity */
    (*(rpm -> inf_vm1v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm1v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm2v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm2v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm3v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm3v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm4v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_vm4v[disk] -> srprc))((void *) rpm, srnr, disk);

    (*(rpm -> inf_ra1v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra1v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra2v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra2v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra3v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra3v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra4v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ra4v[disk] -> srprc))((void *) rpm, srnr, disk);

    (*(rpm -> inf_ro1v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro1v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro2v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro2v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro3v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro3v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro4v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_ro4v[disk] -> srprc))((void *) rpm, srnr, disk);

    /* warps */
    (*(rpm -> inf_wm1v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm1v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm2v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm2v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm3v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm3v[disk] -> srprc))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm4v[disk] -> srprs))((void *) rpm, srnr, disk);
    (*(rpm -> inf_wm4v[disk] -> srprc))((void *) rpm, srnr, disk);

    /* Azimuth ranges */
    (*(rpm -> inf_aziv[disk] -> srpr0))((void *) rpm, srnr, 0, disk);
    (*(rpm -> inf_aziv[disk] -> srpr1))((void *) rpm, srnr, 1, disk);
  }

  /* free the pointsource list */
  if ((rpm -> sd[disk][srnr].pl)) {
    free(rpm -> sd[disk][srnr].pl);
    rpm -> sd[disk][srnr].pl = NULL;
  }
#ifdef PBCORR
  rpm -> dealloc_pbcfac(rpm, srnr, disk);
#endif

  return;
}
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static void gridpoint_norm(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#else
static void gridpoint_norm(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#endif
{
  int grid[3];

  /* of course we could make it even shorter, but we'll leave it at that. Next thingy is to grid the pointsource */
  grid[0] = roundnormal(modpar[(PRPARAMS+disk*NDPARAMS+PXPOS)*nr+srnr]-pp[1]);

  if (grid[0] >= 0 && grid[0] < hdr -> bsize1) {

    grid[1] = roundnormal(modpar[(PRPARAMS+disk*NDPARAMS+PYPOS)*nr+srnr]+pp[0]);
    if (grid[1] >= 0 && grid[1] < hdr -> bsize2) {
      /* */
      grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+hdr -> signv*pp[5]));
      /*       grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+pp[4])); */
      if (grid[2] >= 0 && grid[2] < hdr -> nsubs) {

	/* This is the position in the linear cube array */
	sd[disk][srnr].pl[*pnr] = hdr -> modelc -> points +(grid[0]+ hdr -> bcsize1*(grid[1])+hdr -> nprof*(grid[2]));

	/* And this is for the primary beam correction */

#ifdef PBCORR
	fill_pbcfac(hdr, sd, disk, srnr, pnr, grid);
#endif

	++(*pnr);
      }
      else {
	--sd[disk][srnr].n;
	*npoints -= 1;
	++sd[disk][srnr].outn;
      }
    }
    else {
      --sd[disk][srnr].n;
      *npoints -= 1;
      ++sd[disk][srnr].outn;
    }
  }
  else {
    --sd[disk][srnr].n;
    *npoints -= 1;
    ++sd[disk][srnr].outn;
  }
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static void gridpoint_mixed(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#else
static void gridpoint_mixed(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#endif
{
  int grid[3];

  /* of course we could make it even shorter, but we'll leave it at that. Next thingy is to grid the pointsource */
  grid[0] = roundnormal(modpar[(PRPARAMS+disk*NDPARAMS+PXPOS)*nr+srnr]-pp[1]);

  if (grid[0] >= 0 && grid[0] < hdr -> bsize1) {

    grid[1] = roundnormal(modpar[(PRPARAMS+disk*NDPARAMS+PYPOS)*nr+srnr]+pp[0]);
    if (grid[1] >= 0 && grid[1] < hdr -> bsize2) {
      /* For the sake of clarity, we kill the subsnuma operation in the source, in principle thus allowing only for the radio convention for velocity, but gaining an understanding of the code. What is seen here should not be done. It's really not what anyone should wish for. */
      grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+hdr -> signv*pp[5]));
      /*       grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+pp[4])); */
      if (grid[2] >= 0 && grid[2] < hdr -> nsubs) {

	/* This is the position in the linear cube array */
	if (signum) {
	  sd[disk][srnr].pl[sd[disk][srnr].npos] = hdr -> modelc -> points +(grid[0]+ hdr -> bcsize1*(grid[1])+hdr -> nprof*(grid[2]));
	  ++sd[disk][srnr].npos;
	}
	else {
	  ++sd[disk][srnr].nneg;
	  sd[disk][srnr].pl[sd[disk][srnr].pllength-sd[disk][srnr].nneg] = hdr -> modelc -> points+(grid[0]+ hdr -> bcsize1*(grid[1])+hdr -> nprof*(grid[2]));
	}

#ifdef PBCORR
	fill_pbcfac(hdr, sd, disk, srnr, pnr, grid);
#endif

	++(*pnr);
      }
      else {
	--sd[disk][srnr].n;
	*npoints -= 1;
	++sd[disk][srnr].outn;
/* 	if (signum) { */
/* 	  ++sd[disk][srnr].outnpos; */
/* 	} */
/* 	else { */
/* 	  ++sd[disk][srnr].outnneg; */
/* 	} */
      }
    }
    else {
      --sd[disk][srnr].n;
      *npoints -= 1;
      ++sd[disk][srnr].outn;
/*       if (signum) { */
/* 	++sd[disk][srnr].outnpos; */
/*       } */
/*       else { */
/* 	++sd[disk][srnr].outnneg; */
/*       } */
    }
  }
  else {
    --sd[disk][srnr].n;
    *npoints -= 1;
    ++sd[disk][srnr].outn;
/*     if (signum) { */
/*       ++sd[disk][srnr].outnpos; */
/*     } */
/*     else { */
/*       ++sd[disk][srnr].outnneg; */
/*     } */
  }
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static void gridpoint_normcool(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#else
static void gridpoint_normcool(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#endif
{
  int grid[3];

  /* of course we could make it even shorter, but we'll leave it at that. Next thingy is to grid the pointsource */
  grid[0] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PXPOS)*nr+srnr]-pp[1])*((float) hdr->coolbin));

  if (grid[0] >= 0 && grid[0] < hdr -> coolcube -> size_x) {

    grid[1] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PYPOS)*nr+srnr]+pp[0])*((float) hdr->coolbin));
    if (grid[1] >= 0 && grid[1] < hdr -> coolcube -> size_y) {
      /* */
      grid[2] = roundnormal(hdr -> coolhalfc+pp[2]*((float) hdr->coolbin));
      /*       grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+pp[4])); */
      if (grid[2] >= 0 && grid[2] < hdr -> coolcube -> size_v) {

	/* This is the position in the linear cube array */
	sd[disk][srnr].pl[*pnr] = hdr -> coolcube -> points +(grid[0]+ hdr -> coolcube -> size_x*(grid[1])+hdr -> nprofcool*(grid[2]));

	/* And this is for the primary beam correction */

#ifdef PBCORR
	fill_pbcfac(hdr, sd, disk, srnr, pnr, grid);
#endif

	++(*pnr);
      }
      else {
	--sd[disk][srnr].n;
	*npoints -= 1;
	++sd[disk][srnr].outn;
      }
    }
    else {
      --sd[disk][srnr].n;
      *npoints -= 1;
      ++sd[disk][srnr].outn;
    }
  }
  else {
    --sd[disk][srnr].n;
    *npoints -= 1;
    ++sd[disk][srnr].outn;
  }
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static void gridpoint_mixedcool(hdrinf *hdr, void (*fill_pbcfac)(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid), float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#else
static void gridpoint_mixedcool(hdrinf *hdr, float *modpar, int nr, struct srd **sd, int srnr, long *pnr, float *pp, int signum, long *npoints, int disk)
#endif
{
  int grid[3];

  /* of course we could make it even shorter, but we'll leave it at that. Next thingy is to grid the pointsource */
  grid[0] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PXPOS)*nr+srnr]-pp[1])*((float) hdr->coolbin));

  if (grid[0] >= 0 && grid[0] < hdr -> coolcube -> size_x) {

    grid[1] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PYPOS)*nr+srnr]+pp[0])*((float) hdr->coolbin));
    if (grid[1] >= 0 && grid[1] < hdr -> bsize2) {
      /* For the sake of clarity, we kill the subsnuma operation in the source, in principle thus allowing only for the radio convention for velocity, but gaining an understanding of the code. What is seen here should not be done. It's really not what anyone should wish for. */
      grid[2] = roundnormal(hdr -> coolhalfc+pp[2]*((float) hdr->coolbin));
      /*       grid[2] = roundnormal((modpar[(PRPARAMS+disk*NDPARAMS+PVSYS)*nr+srnr]+pp[4])); */
      if (grid[2] >= 0 && grid[2] < hdr -> coolcube -> size_v) {

	/* This is the position in the linear cube array */
	if (signum) {
	  sd[disk][srnr].pl[sd[disk][srnr].npos] = hdr -> coolcube -> points +(grid[0]+ hdr -> coolcube -> size_x*(grid[1])+hdr -> nprofcool*(grid[2]));
	  ++sd[disk][srnr].npos;
	}
	else {
	  ++sd[disk][srnr].nneg;
	  sd[disk][srnr].pl[sd[disk][srnr].pllength-sd[disk][srnr].nneg] = hdr -> coolcube -> points+(grid[0]+ hdr -> coolcube -> size_x*(grid[1])+hdr -> nprofcool*(grid[2]));
	}

#ifdef PBCORR
	fill_pbcfac(hdr, sd, disk, srnr, pnr, grid);
#endif

	++(*pnr);
      }
      else {
	--sd[disk][srnr].n;
	*npoints -= 1;
	++sd[disk][srnr].outn;
/* 	if (signum) { */
/* 	  ++sd[disk][srnr].outnpos; */
/* 	} */
/* 	else { */
/* 	  ++sd[disk][srnr].outnneg; */
/* 	} */
      }
    }
    else {
      --sd[disk][srnr].n;
      *npoints -= 1;
      ++sd[disk][srnr].outn;
/*       if (signum) { */
/* 	++sd[disk][srnr].outnpos; */
/*       } */
/*       else { */
/* 	++sd[disk][srnr].outnneg; */
/*       } */
    }
  }
  else {
    --sd[disk][srnr].n;
    *npoints -= 1;
    ++sd[disk][srnr].outn;
/*     if (signum) { */
/*       ++sd[disk][srnr].outnpos; */
/*     } */
/*     else { */
/*       ++sd[disk][srnr].outnneg; */
/*     } */
  }
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static int srput_mixed(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid), struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
#else
static int srput_mixed(struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
#endif
{
  long i;
  int negstop;

/*   ringflux = TWOPI*modpar[PRADI*nr+srnr]*radsep*modpar[PSBR*nr+srnr]/cflux; */

  /* Calculate the point source flux */

  /* These lines are a nice idea, however, if the total surface density is close to zero, this becomes probably more inaccurate than what we've left */
/*   if ((cloudsum = sd[disk][srnr].npos+sd[disk][srnr].outnpos-sd[disk][srnr].nneg-sd[disk][srnr].outnneg)  > 0) { */
/*     sd[disk][srnr].pf = TWOPI*modpar[PRADI*nr+srnr]*radsep*modpar[PSBR*nr+srnr]/fabs(cloudsum); */
/*   } */
/*   else */

/* Kamphuis bugfix */
/*   sd[disk][srnr].pf = cflux[0]*sd[disk][srnr].nsubclinv; -> */
  sd[disk][srnr].pf = cflux[disk]*sd[disk][srnr].nsubclinv;

/*   if (!(sd[disk][srnr].pf)) */
/*     sd[disk][srnr].pf = cflux[0]; */

#ifdef PBCORR
  for (i = 0; i < sd[disk][srnr].npos; ++i)
    corr_pbcfac(sd, disk, srnr, i);
#else
  for (i = 0; i < sd[disk][srnr].npos; ++i)
    *(sd[disk][srnr].pl[i]) += sd[disk][srnr].pf;
#endif

  sd[disk][srnr].pf = -sd[disk][srnr].pf;

  /* Here I don't trust the compiler a bit */
  negstop = sd[disk][srnr].pllength-sd[disk][srnr].nneg-1;

#ifdef PBCORR
  for (i = sd[disk][srnr].pllength-1; i > negstop; --i)
    corr_pbcfac(sd, disk, srnr, i);
#else
  for (i = sd[disk][srnr].pllength-1; i > negstop; --i)
    *(sd[disk][srnr].pl[i]) += sd[disk][srnr].pf;
#endif

  /* Don't need that anymore, but it would be good to have) */
/*   forget((void **) &sd[disk][srnr].pl); */

  /* Add to number of points contributing to flux */
  /*   fluxpoints[disk] = */
  sd[disk][srnr].fluxpoints = (sd[disk][srnr].npos-sd[disk][srnr].nneg)/sd[disk][srnr].nsubcl;

  /* Return number of pointsources */
  return sd[disk][srnr].allnpoints = (sd[disk][srnr].npos+sd[disk][srnr].nneg)/sd[disk][srnr].nsubcl;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Grids a point to a pointsource list */
#ifdef PBCORR
static int srput_norm(void (*corr_pbcfac)(struct srd **sd, int disk, int srnr, long grid), struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
#else
static int srput_norm(struct srd **sd, float *modpar, int nr, double *cflux, double radsep, int srnr, long *fluxpoints, int disk)
#endif
{
  long i;
  /****************/
  /****************/
/*       int obsint = 1;  */
/*       char obsmes[81];  */
  /****************/
  /******/
  /******/
/*       if (srnr == 0) { */
/* 	sprintf(obsmes, "ya got here: srput_norm disk: %i n: %i", disk, (int) sd[disk][srnr].n);   */
/*       anyout_tir(&obsint, obsmes); */
/*       } */
  /******/

  /* What was the pointsource flux, note that this is done now in parallel (danger?) */
#ifdef PBCORR
  for (i = 0; i < sd[disk][srnr].n; ++i)
    corr_pbcfac(sd, disk, srnr, i);
#else
  for (i = 0; i < sd[disk][srnr].n; ++i)
    *(sd[disk][srnr].pl[i]) += sd[disk][srnr].pf;
#endif

  /* Don't need that anymore, but it would be good to have) */
/*   forget((void **) &sd[disk][srnr].pl); */

/*   fluxpoints[disk]  */
    sd[disk][srnr].fluxpoints = sd[disk][srnr].n*(sd[disk][srnr].pf>0?1:-1)/sd[disk][srnr].nsubcl;

  /* Return number of pointsources */
  return sd[disk][srnr].allnpoints = sd[disk][srnr].n/sd[disk][srnr].nsubcl;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static long srconst(hdrinf *hdr, ringparms *rpm, int srnr, long mode, int disk)
{
  int i;

  /* The next four variables were declared static before, but now we use parallel code, such that it might be a bad idea */
  float az;
  float cosaz; /* The cos of the az (memory wasting) */
  float sinaz; /* The sin of the az (memory wasting) */
  float pp[6]; /* Cartesian coordinates in phase-space, x,y,z,vx,vy,vz */
                      /*                                       x: DEC, y: RA, z: LOS towards observer */
  char mes[180];
  int err = 4;
  int signum;
  long npoints, j;
  int dummyint;

  /* First check if we do anything but remembering */
  if (rpm -> sd[disk][srnr].pl) {
/*     remember((void **) &rpm -> sd[disk][srnr].pl); */
    return rpm -> sd[disk][srnr].outpoints = rpm -> sd[disk][srnr].outn/rpm -> sd[disk][srnr].nsubcl;
  }

  /* Now we try to allocate */
  if ((rpm -> sd[disk][srnr].n)){
    if (!(rpm -> sd[disk][srnr].pl = (float **) malloc(rpm -> sd[disk][srnr].n*sizeof(float *)))) {
      /* Catastrophy, simply stop */
      sprintf(mes, "Too many pointsources, increase PFLUX");
      error_tir(&err, mes);
    }
#ifdef PBCORR
    rpm -> alloc_pbcfac(rpm, srnr, disk);
#endif
  }

  /* If there's no pointsource we allocate nevertheless for the smallest thing possible */
  else {
    if (!(rpm -> sd[disk][srnr].pl = (float **) malloc(sizeof(float *)))) {

      /* Catastrophy, simply stop */
      sprintf(mes, "Too many pointsources, increase PFLUX");
      error_tir(&err, mes);
    }

#ifdef PBCORR
    rpm -> alloc_pbcfac(rpm, srnr, disk);
#endif

    /* Changed this, but not sure */
    rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].nneg = rpm -> sd[disk][srnr].npos = 0;
    return rpm -> sd[disk][srnr].outpoints = 0;
  }

  /* Initialise random generators */
  rpm -> sd[disk][srnr].iseed2[1] = srnr+disk;
  maths_rndmf_init(rpm -> sd[disk][srnr].iseed2, rpm -> sd[disk][srnr].permrandstr);

  /* reset the  zprof */
  zprof(6, rpm -> sd[disk][srnr].permrandstr, &(rpm -> sd[disk][srnr].y2));

  /* Do the same for variable functions */
  (*(rpm -> inf_sdisv[disk] -> rndmf_init))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> rndmf_init))((void *) rpm, srnr, disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init0))((void *) rpm, srnr, 0,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init1))((void *) rpm, srnr, 1,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init2))((void *) rpm, srnr, 2,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init3))((void *) rpm, srnr, 3,disk);

  /* Reset the counters */
  j = 0;
  rpm -> sd[disk][srnr].outn = 0;
/*   rpm -> sd[disk][srnr].outnpos = */
/*   rpm -> sd[disk][srnr].outnneg = 0; */

  npoints = rpm -> sd[disk][srnr].nharmnorm;

  signum = rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*rpm -> nr+srnr] > 0?1:0;

  while (j < npoints) {

    /* Calculate azimuth sine and cosine, conventional */
    (*(rpm -> inf_smiv[disk] -> getaz))((void *) rpm, &az, &sinaz, &cosaz, &signum, srnr, disk);

    /* Check if the azimuth is ok */
/*     rpm -> sd[disk][srnr].outofrange = 1; */
    (*(rpm -> inf_aziv[disk] -> setoutrange))(&(rpm -> sd[disk][srnr].outofrange));
    (*(rpm -> inf_aziv[disk] -> pr0))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 0);
    (*(rpm -> inf_aziv[disk] -> pr1))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 1);

    /* Put the point source where it belongs */
	/* Put the point source where it belongs */
	dummyint = (*(rpm -> inf_aziv[disk] -> srshape))(rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk);
/*     (*(rpm -> inf_aziv[disk] -> srshape))((void *) rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk); */
    /* srshape(rpm, pp, sinaz, cosaz, srnr); */

    /* Add ring-dependent dispersion, if activated */
    (*(rpm -> inf_sdisv[disk] -> pr))((void *) rpm, pp+5, &az, srnr, disk);

    /* Grid the point sources */
#ifdef PBCORR
    (*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> fill_pbcfac, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#else
    (*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#endif
    /* Correct for the number of point sources if necessary */
    rpm -> inf_aziv[disk] -> corrp((void *) rpm, srnr, &(rpm -> sd[disk][srnr].outofrange), signum);

    (*(rpm -> inf_sdisv[disk] -> repeater))((void *) rpm, pp, az, srnr, hdr, &j, signum, &npoints, disk);

    if (dummyint)
      rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].outn-rpm -> sd[disk][srnr].nsubcl;
  }

  /* This is a departure from the policy of doing the best to prevent
     the program from slowing down when including new parameters,
     albeit a small one */

  for (i = 0; i < 4; ++i) {

    if ((rpm -> sd[disk][srnr].ngaussian[i])) {

      npoints = npoints + rpm -> sd[disk][srnr].ngaussian[i];

      /* Determine point source flux */

      signum = rpm -> modpar[((PRPARAMS+disk*NDPARAMS+PGA1A)+3*i)*rpm -> nr+srnr] > 0?1:0;

      while (j < npoints) {

	/* Calculate azimuth sine and cosine, Gaussian */
	gau_getaz(rpm, (PRPARAMS+disk*NDPARAMS+PGA1P)+3*i, rpm -> sd[disk][srnr].grandstr[i], i, &az, &sinaz, &cosaz, srnr, disk);

	/* Check if the azimuth is ok */
/* 	rpm -> sd[disk][srnr].outofrange = 0; */
	(*(rpm -> inf_aziv[disk] -> setoutrange))(&(rpm -> sd[disk][srnr].outofrange));
	(*(rpm -> inf_aziv[disk] -> pr0))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 0);
 	(*(rpm -> inf_aziv[disk] -> pr1))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 1);

	/* Put the point source where it belongs */
	dummyint = (*(rpm -> inf_aziv[disk] -> srshape))(rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk);

	/* 	srshape(rpm, pp, sinaz, cosaz, srnr); */

	/* Add ring-dependent dispersion, if activated (why here and not in srshape?) */
	(*(rpm -> inf_sdisv[disk] -> pr))((void *) rpm, pp+5, &az, srnr, disk);

#ifdef PBCORR
	/* Grid the point sources */
	(*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> fill_pbcfac, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#else
	/* Grid the point sources */
	(*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#endif
	/* Correct for the number of point sources if necessary */
	(*(rpm -> inf_aziv[disk] -> corrp))((void *) rpm, srnr, &(rpm -> sd[disk][srnr].outofrange), signum);

	(*(rpm -> inf_sdisv[disk] -> repeater))((void *) rpm, pp, az, srnr, hdr, &j, signum, &npoints, disk);

	if (dummyint)
	  rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].outn-rpm -> sd[disk][srnr].nsubcl;

      }
    }
  }

  return rpm -> sd[disk][srnr].outpoints = rpm -> sd[disk][srnr].outn/rpm -> sd[disk][srnr].nsubcl;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static long srconstcool(hdrinf *hdr, ringparms *rpm, int srnr, long mode, int disk)
{
  int i;

  /* The next four variables were declared static before, but now we use parallel code, such that it might be a bad idea */
  float az;
  float cosaz; /* The cos of the az (memory wasting) */
  float sinaz; /* The sin of the az (memory wasting) */
  float pp[6]; /* Cartesian coordinates in phase-space, x,y,z,vx,vy,vz */
                      /*                                       x: DEC, y: RA, z: LOS towards observer */
  char mes[180];
  int err = 4;
  int signum;
  long npoints, j;
  int dummyint;

  /* First check if we do anything but remembering */
  /* if (rpm -> sd[disk][srnr].pl) { */
/*     remember((void **) &rpm -> sd[disk][srnr].pl); */
  /*   return rpm -> sd[disk][srnr].outpoints = rpm -> sd[disk][srnr].outn/rpm -> sd[disk][srnr].nsubcl; */
  /* } */

  /* Now we try to allocate */
  if ((rpm -> sd[disk][srnr].n)){
    if (!(rpm -> sd[disk][srnr].pl = (float **) malloc(rpm -> sd[disk][srnr].n*sizeof(float *)))) {
      /* Catastrophy, simply stop */
      sprintf(mes, "Too many pointsources, increase PFLUX");
      error_tir(&err, mes);
    }
#ifdef PBCORR
    rpm -> alloc_pbcfac(rpm, srnr, disk);
#endif
  }

  /* If there's no pointsource we allocate nevertheless for the smallest thing possible */
  else {
    if (!(rpm -> sd[disk][srnr].pl = (float **) malloc(sizeof(float *)))) {

      /* Catastrophy, simply stop */
      sprintf(mes, "Too many pointsources, increase PFLUX");
      error_tir(&err, mes);
    }

#ifdef PBCORR
    rpm -> alloc_pbcfac(rpm, srnr, disk);
#endif

    /* Changed this, but not sure */
    rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].nneg = rpm -> sd[disk][srnr].npos = 0;
    return rpm -> sd[disk][srnr].outpoints = 0;
  }

  /* Initialise random generators */
  rpm -> sd[disk][srnr].iseed2[1] = srnr+disk;
  maths_rndmf_init(rpm -> sd[disk][srnr].iseed2, rpm -> sd[disk][srnr].permrandstr);

  /* reset the  zprof */
  zprof(6, rpm -> sd[disk][srnr].permrandstr, &(rpm -> sd[disk][srnr].y2));

  /* Do the same for variable functions */
  (*(rpm -> inf_sdisv[disk] -> rndmf_init))((void *) rpm, srnr, disk);
  (*(rpm -> inf_smiv[disk] -> rndmf_init))((void *) rpm, srnr, disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init0))((void *) rpm, srnr, 0,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init1))((void *) rpm, srnr, 1,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init2))((void *) rpm, srnr, 2,disk);
  (*(rpm -> inf_gauv[disk] -> rndmf_init3))((void *) rpm, srnr, 3,disk);

  /* Reset the counters */
  j = 0;
  rpm -> sd[disk][srnr].outn = 0;
/*   rpm -> sd[disk][srnr].outnpos = */
/*   rpm -> sd[disk][srnr].outnneg = 0; */

  npoints = rpm -> sd[disk][srnr].nharmnorm;

  signum = rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*rpm -> nr+srnr] > 0?1:0;

  while (j < npoints) {

    /* Calculate azimuth sine and cosine, conventional */
    (*(rpm -> inf_smiv[disk] -> getaz))((void *) rpm, &az, &sinaz, &cosaz, &signum, srnr, disk);

    /* Check if the azimuth is ok */
/*     rpm -> sd[disk][srnr].outofrange = 1; */
    (*(rpm -> inf_aziv[disk] -> setoutrange))(&(rpm -> sd[disk][srnr].outofrange));
    (*(rpm -> inf_aziv[disk] -> pr0))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 0);
    (*(rpm -> inf_aziv[disk] -> pr1))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 1);

    /* Put the point source where it belongs */
	/* Put the point source where it belongs */
	dummyint = (*(rpm -> inf_aziv[disk] -> srshape))(rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk);
/*     (*(rpm -> inf_aziv[disk] -> srshape))((void *) rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk); */
    /* srshape(rpm, pp, sinaz, cosaz, srnr); */

    /* Add ring-dependent dispersion, if activated */
    /* (*(rpm -> inf_sdisv[disk] -> pr))((void *) rpm, pp+5, &az, srnr, disk); */

    /* Grid the point sources */
#ifdef PBCORR
    (*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> fill_pbcfac, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#else
    (*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#endif
    /* Correct for the number of point sources if necessary */
    rpm -> inf_aziv[disk] -> corrp((void *) rpm, srnr, &(rpm -> sd[disk][srnr].outofrange), signum);

    (*(rpm -> inf_sdisv[disk] -> repeater))((void *) rpm, pp, az, srnr, hdr, &j, signum, &npoints, disk);

    if (dummyint)
      rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].outn-rpm -> sd[disk][srnr].nsubcl;
  }

  /* This is a departure from the policy of doing the best to prevent
     the program from slowing down when including new parameters,
     albeit a small one */

  for (i = 0; i < 4; ++i) {

    if ((rpm -> sd[disk][srnr].ngaussian[i])) {

      npoints = npoints + rpm -> sd[disk][srnr].ngaussian[i];

      /* Determine point source flux */

      signum = rpm -> modpar[((PRPARAMS+disk*NDPARAMS+PGA1A)+3*i)*rpm -> nr+srnr] > 0?1:0;

      while (j < npoints) {

	/* Calculate azimuth sine and cosine, Gaussian */
	gau_getaz(rpm, (PRPARAMS+disk*NDPARAMS+PGA1P)+3*i, rpm -> sd[disk][srnr].grandstr[i], i, &az, &sinaz, &cosaz, srnr, disk);

	/* Check if the azimuth is ok */
/* 	rpm -> sd[disk][srnr].outofrange = 0; */
	(*(rpm -> inf_aziv[disk] -> setoutrange))(&(rpm -> sd[disk][srnr].outofrange));
	(*(rpm -> inf_aziv[disk] -> pr0))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 0);
 	(*(rpm -> inf_aziv[disk] -> pr1))(&az, rpm -> sd[disk][srnr].ranges, &(rpm -> sd[disk][srnr].outofrange), 1);

	/* Put the point source where it belongs */
	dummyint = (*(rpm -> inf_aziv[disk] -> srshape))(rpm, pp, sinaz, cosaz, srnr, rpm -> sd[disk][srnr].outofrange, disk);

	/* 	srshape(rpm, pp, sinaz, cosaz, srnr); */

	/* Add ring-dependent dispersion, if activated (why here and not in srshape?) */
/* 	(*(rpm -> inf_sdisv[disk] -> pr))((void *) rpm, pp+5, &az, srnr, disk); */

#ifdef PBCORR
	/* Grid the point sources */
	(*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> fill_pbcfac, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#else
	/* Grid the point sources */
	(*(rpm -> sd[disk][srnr].gridpoint))(hdr, rpm -> modpar, rpm -> nr, rpm -> sd, srnr, &j, pp, signum, &npoints, disk);
#endif
	/* Correct for the number of point sources if necessary */
	(*(rpm -> inf_aziv[disk] -> corrp))((void *) rpm, srnr, &(rpm -> sd[disk][srnr].outofrange), signum);

	(*(rpm -> inf_sdisv[disk] -> repeater))((void *) rpm, pp, az, srnr, hdr, &j, signum, &npoints, disk);

	if (dummyint)
	  rpm -> sd[disk][srnr].outn = rpm -> sd[disk][srnr].outn-rpm -> sd[disk][srnr].nsubcl;

      }
    }
  }

  return rpm -> sd[disk][srnr].outpoints = rpm -> sd[disk][srnr].outn/rpm -> sd[disk][srnr].nsubcl;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static void srshape(ringparms *rpm, float *pp, float sinaz, float cosaz, int srnr, int disk)
{
  float r;
  float pp2[6];

  /* The probability for the radius is weighted by r, and this is no approximation, hence a speed brake, should be removed at some point */
  r = sqrtf((rpm -> modpar[PRADI*rpm -> nr+srnr]-0.5*rpm -> radsep)*(rpm -> modpar[PRADI*rpm -> nr+srnr]-0.5*rpm -> radsep)+2*rpm -> radsep*rpm -> modpar[PRADI*rpm -> nr+srnr]*maths_rndmf(rpm -> sd[disk][srnr].permrandstr));

  /* Calculate the coordinates of the point source before rotation */
    pp[0] = cosaz*r;
    pp[1] = sinaz*r;
    pp[2] = zprof(rpm -> ltype[disk],  rpm -> sd[disk][srnr].permrandstr, &(rpm -> sd[disk][srnr].y2))*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PZ0)*rpm -> nr+srnr];

    pp[4] = cosaz*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nr+srnr];

/* Here comes the harmonic velocity terms */
    (*(rpm -> inf_ro1v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro2v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro3v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro4v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro1v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro2v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro3v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ro4v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);

    /* vertical gradient in rotation velocity */
    (*(rpm -> inf_dvrov[disk] -> pr)) ((void *) rpm, pp, srnr, sinaz, cosaz, disk);

    /* Radial velocity term */
    (*(rpm -> inf_vradv[disk] -> pr)) ((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);

    /* Here comes the harmonic velocity terms */
    (*(rpm -> inf_ra1v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra2v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra3v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra4v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra1v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra2v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra3v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ra4v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk);

    /* vertical gradient in radial velocity */
    (*(rpm -> inf_dvrav[disk] -> pr)) ((void *) rpm, pp, srnr, sinaz, cosaz, disk);

    pp[5] = 0.0;

    /* Vertical velocity term */
    (*(rpm -> inf_vverv[disk] -> pr)) ((void *) rpm, pp, srnr, disk);

    /* vertical gradient in vertical velocity */
    (*(rpm -> inf_dvvev[disk] -> pr)) ((void *) rpm, pp, srnr, disk);

    /* We do the warp harmonics here */
    (*(rpm -> inf_wm1v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm2v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm3v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm4v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm1v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm2v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm3v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm4v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm0v[disk] -> pr)) ((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);

    /* Now rotate about the x-axis by i */
    pp2[0] = pp[0];
    pp2[1] = pp[1]*rpm -> sd[disk][srnr].cosi-pp[2]*rpm -> sd[disk][srnr].sini;

    /* Now we shift */

    (*(rpm -> inf_lc0v[disk] -> pr))((void *) rpm, pp2+0, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ls0v[disk] -> pr))((void *) rpm, pp2+1, srnr, sinaz, cosaz, disk);

/*     pp2[2] = pp[1]*rpm -> sd[disk][srnr].sini+pp[2]*rpm -> sd[disk][srnr].cosi; */
/*     pp2[3] = pp[3]; */
/*     pp2[4] = pp[4]*rpm -> sd[disk][srnr].cosi-pp[5]*rpm -> sd[disk][srnr].sini; */
/*     pp2[5] = pp[4]*rpm -> sd[disk][srnr].sini+pp[5]*rpm -> sd[disk][srnr].cosi; */

    pp2[5] = pp[4]*rpm -> sd[disk][srnr].sini;

    /* But if we did a vertical velocity component */
    (*(rpm -> inf_vverv[disk] -> pr_rota)) ((void *) rpm, pp+5, pp2+5, srnr, disk);

/* Here comes the harmonic velocity terms */
    (*(rpm -> inf_vm1v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm2v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm3v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm4v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm1v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm2v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm3v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm4v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_vm0v[disk] -> pr))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk);

    /* Now rotate about the z-axis by pa */
/*     pp[0] = pp2[0]*rpm -> sd[disk][srnr].cosp-pp2[1]*rpm -> sd[disk][srnr].sinp; */
/*     pp[1] = pp2[0]*rpm -> sd[disk][srnr].sinp+pp2[1]*rpm -> sd[disk][srnr].cosp; */
/*     pp[2] = pp2[2]; */
/*     pp[3] = pp2[3]*rpm -> sd[disk][srnr].cosp-pp2[4]*rpm -> sd[disk][srnr].sinp; */
/*     pp[4] = pp2[3]*rpm -> sd[disk][srnr].sinp+pp2[4]*rpm -> sd[disk][srnr].cosp; */
/*     pp[5] = pp2[5]; */

    /* Here's the shortcut version */
    pp[0] = pp2[0]*rpm -> sd[disk][srnr].cosp-pp2[1]*rpm -> sd[disk][srnr].sinp;
    pp[1] = pp2[0]*rpm -> sd[disk][srnr].sinp+pp2[1]*rpm -> sd[disk][srnr].cosp;
    pp[5] = pp2[5];

return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static void srshapecool(ringparms *rpm, float *pp, float sinaz, float cosaz, int srnr, int disk)
{
  float r;
  float pp2[6];

  /* The probability for the radius is weighted by r, and this is no approximation, hence a speed brake, should be removed at some point */
  r = sqrtf((rpm -> modpar[PRADI*rpm -> nr+srnr]-0.5*rpm -> radsep)*(rpm -> modpar[PRADI*rpm -> nr+srnr]-0.5*rpm -> radsep)+2*rpm -> radsep*rpm -> modpar[PRADI*rpm -> nr+srnr]*maths_rndmf(rpm -> sd[disk][srnr].permrandstr));

  /* Calculate the coordinates of the point source before rotation */
    pp[0] = cosaz*r;
    pp[1] = sinaz*r;
    pp[2] = zprof(rpm -> ltype[disk],  rpm -> sd[disk][srnr].permrandstr, &(rpm -> sd[disk][srnr].y2))*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PZ0)*rpm -> nr+srnr];

    /* pp[4] = cosaz*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nr+srnr]; */

/* Here comes the harmonic velocity terms */
    /* (*(rpm -> inf_ro1v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro2v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro3v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro4v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro1v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro2v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro3v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ro4v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */

    /* vertical gradient in rotation velocity */
    /* (*(rpm -> inf_dvrov[disk] -> pr)) ((void *) rpm, pp, srnr, sinaz, cosaz, disk); */

    /* Radial velocity term */
    /* (*(rpm -> inf_vradv[disk] -> pr)) ((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */

    /* Here comes the harmonic velocity terms */
    /* (*(rpm -> inf_ra1v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra2v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra3v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra4v[disk] -> prs))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra1v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra2v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra3v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_ra4v[disk] -> prc))((void *) rpm, pp+4, srnr, sinaz, cosaz, disk); */

    /* vertical gradient in radial velocity */
    /* (*(rpm -> inf_dvrav[disk] -> pr)) ((void *) rpm, pp, srnr, sinaz, cosaz, disk); */

    /* pp[5] = 0.0; */

    /* Vertical velocity term */
    /* (*(rpm -> inf_vverv[disk] -> pr)) ((void *) rpm, pp, srnr, disk); */

    /* vertical gradient in vertical velocity */
    /* (*(rpm -> inf_dvvev[disk] -> pr)) ((void *) rpm, pp, srnr, disk); */

    /* We do the warp harmonics here */
    (*(rpm -> inf_wm1v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm2v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm3v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm4v[disk] -> prs))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm1v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm2v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm3v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm4v[disk] -> prc))((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_wm0v[disk] -> pr)) ((void *) rpm, pp+2, srnr, sinaz, cosaz, disk);

    /* Now rotate about the x-axis by i */
    pp2[0] = pp[0];
    pp2[1] = pp[1]*rpm -> sd[disk][srnr].cosi-pp[2]*rpm -> sd[disk][srnr].sini;
	 pp2[2] = pp[1]*rpm -> sd[disk][srnr].sini+pp[2]*rpm -> sd[disk][srnr].cosi;

    /* Now we shift */
    (*(rpm -> inf_lc0v[disk] -> pr))((void *) rpm, pp2+0, srnr, sinaz, cosaz, disk);
    (*(rpm -> inf_ls0v[disk] -> pr))((void *) rpm, pp2+1, srnr, sinaz, cosaz, disk);

/*     pp2[2] = pp[1]*rpm -> sd[disk][srnr].sini+pp[2]*rpm -> sd[disk][srnr].cosi; */
/*     pp2[3] = pp[3]; */
/*     pp2[4] = pp[4]*rpm -> sd[disk][srnr].cosi-pp[5]*rpm -> sd[disk][srnr].sini; */
/*     pp2[5] = pp[4]*rpm -> sd[disk][srnr].sini+pp[5]*rpm -> sd[disk][srnr].cosi; */

    /* pp2[5] = pp[4]*rpm -> sd[disk][srnr].sini; */

    /* But if we did a vertical velocity component */
    /* (*(rpm -> inf_vverv[disk] -> pr_rota)) ((void *) rpm, pp+5, pp2+5, srnr, disk); */

/* Here comes the harmonic velocity terms */
    /* (*(rpm -> inf_vm1v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm2v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm3v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm4v[disk] -> prs))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm1v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm2v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm3v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm4v[disk] -> prc))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */
    /* (*(rpm -> inf_vm0v[disk] -> pr))((void *) rpm, pp2+5, srnr, sinaz, cosaz, disk); */

    /* Now rotate about the z-axis by pa */
/*     pp[0] = pp2[0]*rpm -> sd[disk][srnr].cosp-pp2[1]*rpm -> sd[disk][srnr].sinp; */
/*     pp[1] = pp2[0]*rpm -> sd[disk][srnr].sinp+pp2[1]*rpm -> sd[disk][srnr].cosp; */
/*     pp[2] = pp2[2]; */
/*     pp[3] = pp2[3]*rpm -> sd[disk][srnr].cosp-pp2[4]*rpm -> sd[disk][srnr].sinp; */
/*     pp[4] = pp2[3]*rpm -> sd[disk][srnr].sinp+pp2[4]*rpm -> sd[disk][srnr].cosp; */
/*     pp[5] = pp2[5]; */

    /* Here's the shortcut version */
    pp[0] = pp2[0]*rpm -> sd[disk][srnr].cosp-pp2[1]*rpm -> sd[disk][srnr].sinp;
    pp[1] = pp2[0]*rpm -> sd[disk][srnr].sinp+pp2[1]*rpm -> sd[disk][srnr].cosp;
	 pp[2] = pp2[2];

    /* pp[5] = pp2[5]; */

return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Help function to interpover: Check if the modpar array in the range
   of a ring has to be changed */
static int chkchangep(varlel *varele, int fitmode, int parnr, int nur)
{
  int i, param;
  /* int k; */

  /* If fitmode is Golden Section, we check only the actual varele element */
  if ((fitmode == GOLDEN_SECTION)) {
    for (i = 0; i < varele -> nelem; ++i) {

      /* If the ring itself or the ting before has been changed, we return */
      if (parnr == varele -> elements[i])
	return 1;

      /* Don't know whether the second logical is a good idea */
      /* if ((parnr == param+1) && ((param+1)%nur)) */
      /* 	return 1; */

      /* for (j = 0; j < index -> nuel; ++j) { */
      /* 	if (index -> inpal[j] == varele -> elements[i] || index -> inpah[j] == varele -> elements[i]) { */
      /* 	  if (parnr == (param = index -> ipa[j])) { */
      /* 	    return 1; */
      /* 	  } */
      /* 	  if ((parnr == param+1) && ((param+1)%nur)) { */
      /* 	    return 1; */
      /* 	  } */
      /* 	} */
      /* }       */
    }
  }

  /* Fitmode is Metropolis, we check the whole list */
  else {
    /* k = 0; */
    while ((varele)) {
      /* fprintf(stderr,"This is the number: %i\n", k); */
	/* if (k == 2) { */
	/*   if (parnr == 131) */
	/*     printf("Should get there... %i   ", k); */
	/* } */
      if ((varele -> indicator)) {
	/* if (k == 2) { */
	/*    if (parnr == 131)  */
	/*    printf("got here!   ");  */
	/* } */
	for (i = 0; i < varele -> nelem; ++i) {
	  /* If the ring itself or the ting before has been changed, we return */
	  if (parnr == (param = varele -> elements[i])) {
	    /* if (parnr == 131) */
	    /*   printf("ding... "); */
	    return 1;
	  }
	  /* param = varele -> elements[i]; */
	  /* if ((parnr == param+1) && ((param+1)%nur)) { */
	  /*   if (parnr == 131) */
	  /*     printf("dong... "); */
	  /*   return 1; */
	  /* }	   */
	  /* for (j = 0; j < index -> nuel; ++j) { */
	  /*   if (index -> inpal[j] == varele -> elements[i] || index -> inpah[j] == varele -> elements[i]) { */
	  /*     if (parnr == (param = index -> ipa[j])) { */
	  /* 	return 1; */
	  /*     } */
	  /*     if ((parnr == param+1) && ((param+1)%nur)) { */
	  /* 	return 1; */
	  /*     } */
	  /*   } */
	  /* }       */
	}
      }
      varele = varele -> next;
      /* ++k; */
    }
  }

  /* The parameter is not in there */
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Takes the parameter list and changes the parameters on the index */
static int changedependent(ringparms *rpm, double *par, decomp_inlist *index, int *chapar)
{
  int i,j,k,counts;
  int nactive; /* number of active points (not indexed) */
  gsl_interp *gsl_interpv = NULL; /* interpolation function */
  gsl_interp_accel *gsl_interp_accelv = NULL; /* interpolation function accelerator */
  double dummy;

  /* fprintf(stderr,"got here\n"); */

  if (!(index -> nuel))
    return 0;

  /* index is strictly sorted */
  counts = 0;

  /* BUGFIX: this outer loop is required to catch a situation where a parameter is interpolated over but does not belong to a group which is fitted */
  while (counts < index -> nuel) {
  /* loop over all parameters except the radii */
  for (j = NSSDPARAMS; j < NSSDPARAMS+rpm -> ndisks*NDPARAMS; ++j) {
    nactive = 0;

    /* Check if any of the parameters in that parameter group has changed */
    for (i = 0; i < rpm -> nur; ++i) {
      if (chapar[j*rpm->nur+i]) {
	break;
      }
    }

    /* Only if there was a change, we need to interpolate in that group */
    if (i < rpm -> nur) {
	for (i = 0; i < rpm -> nur; ++i) {
	  rpm -> actindar[i] = j*rpm -> nur + i;
	  if (index -> ipa[counts] == rpm -> actindar[i]) {
	    rpm -> actarray[i] = 0;
	    ++counts;
	  }
	  else {
	    rpm -> actarray[i] = 1;
	    ++nactive;
	  }
     }
      /* fprintf(stderr,"got here2\n"); */

      /* Now evaluate a few situations */

      /* If there has been no dependent parameter, we do not need to do anything */
      if (nactive != rpm -> nur) {

	/* Only one active parameter for all */
	if (nactive == 1) {
	  for (i = 0; i < rpm -> nur; ++i) {
	    par[j*rpm -> nur + i] = par[index -> inpal[counts-1]];
	    chapar[j*rpm -> nur + i] = 1;
	  }
	}

	/* Otherwise interpolation */
	else {
	  i = 0;
	  while (!(rpm -> actarray[i]))
	    ++i;
	  if (i) {
	    rpm -> actarray[0] = 1;
	    par[j*rpm -> nur] = par[rpm -> actindar[i]];
	    chapar[j*rpm -> nur] = 1;
	  }

	  i = rpm -> nur-1;
	  while (!(rpm -> actarray[i]))
	    --i;
	  if (i != (rpm -> nur-1)) {
	    rpm -> actarray[rpm -> nur-1] = 1;
	    par[(j+1)*rpm -> nur-1] = par[rpm -> actindar[i]];
	    chapar[(j+1)*rpm -> nur-1] = 1;
	  }

	  /* Now fill the arrays to be passed to the interpolator */
	  k = 0;
	  for (i = 0; i < rpm -> nur; ++i) {
	    if (rpm -> actarray[i]) {
	      rpm -> radar[k] = par[PRADI*rpm -> nur+i];
	      rpm -> interar[k] = par[rpm -> actindar[i]];
	      ++k;
	    }
	  }

	  /* Interpolate: use the appropriate mode, same as defined in rpm -> smothcar (user input indy) unless number of available points is 2, which entails linear */

	  /* This we need in any case */
	  if (!(gsl_interp_accelv = gsl_interp_accel_alloc()))
	    goto error;

	  /* Linear */
	  if ((k < 3) || rpm -> smothindcar[j-NPARAMS+NDPARAMS] == INTERP_LINEAR  ) {
	    if (!(gsl_interpv = gsl_interp_alloc (gsl_interp_linear, k)))
	      goto error;
	  }

	  /* Spline */
	  else if (k < 5 || rpm -> smothindcar[j-NPARAMS+NDPARAMS] == INTERP_CSPLINE) {
	    if (!(gsl_interpv = gsl_interp_alloc (gsl_interp_cspline, k)))
	      goto error;
	  }

	  /* Akima */
	  else if (rpm -> smothindcar[j-NPARAMS+NDPARAMS] == INTERP_AKIMA) {
	    if (!(gsl_interpv = gsl_interp_alloc (gsl_interp_akima, k)))
	      goto error;
	  }

	  /* Something's wrong */
	  else
	    goto error;

	  gsl_interp_init (gsl_interpv, rpm -> radar, rpm -> interar, k);

	  /* Now interpolate where required */

	  for (i = 0; i < rpm -> nur; ++i) {
	    /* fprintf(stderr,"got here number: %i %i\n", i, rpm -> actarray[i]); */
	    if (!(rpm -> actarray[i])) {
	      dummy = par[rpm -> actindar[i]];
	      par[rpm -> actindar[i]] = gsl_interp_eval(gsl_interpv, rpm -> radar, rpm -> interar, par[PRADI*rpm -> nur+i], gsl_interp_accelv);
	      /* If there was a change, we note it down */
	      if (par[rpm -> actindar[i]] != dummy) {
		/* fprintf(stderr,"Found this to have changed: %i\n", i); */
		rpm -> chapar[rpm -> actindar[i]] = 1;
	      }
	    }
	  }
	}

	gsl_interp_free(gsl_interpv);
	gsl_interp_accel_free(gsl_interp_accelv);
      }
      if (counts == index -> nuel)
	break;
    }
  }
  ++counts;
  }
  /*
    #ifdef OPENMPTIR
    #pragma omp parallel for schedule(dynamic)
    #endif
    for (i = 0; i < index -> nuel; ++i) { */
  /* First check if the upper and the lower index are identical */
  /*    if (index -> inpal[i] == index -> inpah[i]) {
	if (index -> ipa[i] != index -> inpal[i]) {
	par[index -> ipa[i]] = par[index -> inpal[i]];
	}
	}
	else {
  */
  /* And interpolate the parameter */
  /*      par[index -> ipa[i]] = par[index -> inpal[i]]+(par[PRADI*rpm -> nur+index -> ripa[i]]-par[PRADI*rpm -> nur+index -> rinpal[i]])*(par[index -> inpah[i]]-par[index -> inpal[i]])/(par[PRADI*rpm -> nur+index -> rinpah[i]] - par[PRADI*rpm -> nur+index -> rinpal[i]]);
	  }
	  } */

  return index -> nuel;

 error:
  if (gsl_interpv)
    gsl_interp_free(gsl_interpv);
  if (gsl_interp_accelv)
    gsl_interp_accel_free(gsl_interp_accelv);
  return -1;
}
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Core to construct a pointsource cube from a parameter list */
static int galmod(hdrinf *hdr, ringparms *rpm, int fitmode, varlel *varele, decomp_inlist *index, long *fluxpoints, int *allnpoints)
{ int i;
  int disk, allnpoint = 0;

  interpover(rpm, rpm -> radsep, fitmode, varele, index);

  /* Initialise the model array */
  /*   for (i = 0; i < hdr -> bcsize1*hdr -> bsize2*hdr -> nsubs; ++i) */

#ifdef OPENMPTIR
#pragma omp parallel for schedule(dynamic)
#endif
  for (i = 0; i < hdr -> nprof*hdr -> nsubs; ++i)
	hdr -> modelc -> points[i] = 0;

  /* Initialise the chisquare */
  /*    hdr -> chi2 = 0; */

  rpm -> outpoints = 0;

  for (disk = 0; disk < rpm -> ndisks; ++disk) {

    allnpoints[disk] = 0;
    fluxpoints[disk] = 0;

    /* Do all the loops */
#ifdef OPENMPTIR
#pragma omp parallel for schedule(dynamic)
#endif
    for (i = 0; i < rpm -> nr; ++i) {
      /*       rpm -> outpoints +=  */
      srconst(hdr, rpm, i, 0, disk);
    }

    /* non-parallel bookkeeping */
    for (i = 0; i < rpm -> nr; ++i) {

      /* now create the clouds and grid them, seems to go well, although there is an additional component there */
      /*       allnpoints[disk] +=  */
#ifdef PBCORR
      (*(rpm -> sd[disk][i].srput))(rpm -> corr_pbcfac, rpm -> sd, rpm -> modpar, rpm -> nr, rpm -> cflux, rpm -> radsep, i, fluxpoints, disk);
#else
      (*(rpm -> sd[disk][i].srput))(rpm -> sd, rpm -> modpar, rpm -> nr, rpm -> cflux, rpm -> radsep, i, fluxpoints, disk);
#endif

      /* this should be correct */
      rpm -> outpoints += rpm -> sd[disk][i].outpoints;

      /* this might not be correct */
      allnpoints[disk] += rpm -> sd[disk][i].allnpoints;

      fluxpoints[disk] += rpm -> sd[disk][i].fluxpoints;
    }
  }

  /* We return the number of clouds */
  for (disk = 0; disk < rpm -> ndisks; ++disk)
    allnpoint += allnpoints[disk];

  return allnpoint;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Core to construct a pointsource cube from a parameter list */
static int galmodcool(hdrinf *hdr, ringparms *rpm, int fitmode, varlel *varele, decomp_inlist *index, long *fluxpoints, int *allnpoints)
{ int i;
  int disk, allnpoint = 0;
  int numpixs;

  interpover(rpm, rpm -> radsep, fitmode, varele, index);

  /* Initialise the model array */
  /*   for (i = 0; i < hdr -> bcsize1*hdr -> bsize2*hdr -> nsubs; ++i) */
  numpixs = hdr -> coolcube -> size_x*hdr -> coolcube -> size_y*hdr -> coolcube -> size_v;
#ifdef OPENMPTIR
#pragma omp parallel for schedule(dynamic)
#endif
  for (i = 0; i < numpixs; ++i)
	hdr -> coolcube -> points[i] = 0;

  /* Initialise the chisquare */
  /*    hdr -> chi2 = 0; */

  rpm -> outpoints = 0;

  for (disk = 0; disk < rpm -> ndisks; ++disk) {

    allnpoints[disk] = 0;
    fluxpoints[disk] = 0;

    /* Make sure that the correct function is linked for srconst */
    if (rpm -> inf_aziv[disk] -> srshape == srshape_azi_act) {
      rpm -> inf_aziv[disk] -> srshape = srshape_azi_actcool;
    }
    else {
      rpm -> inf_aziv[disk] -> srshape = srshape_azi_pascool;
    }
    /* Link the correct gridpoint function */
    if (rpm -> inf_sdisv[disk] -> repeater == sdis_repeater_act) {
      rpm -> inf_sdisv[disk] -> repeater = sdis_repeater_actcool;
    }
    else {
      rpm -> inf_sdisv[disk] -> repeater = sdis_repeater_pascool;
    }

    for (i = 0; i < rpm -> nr; ++i) {
      if (rpm -> sd[disk][i].gridpoint == gridpoint_norm) {
	rpm -> sd[disk][i].gridpoint = gridpoint_normcool;
      }
      else {
	rpm -> sd[disk][i].gridpoint = gridpoint_mixedcool;
      }
    }

    /* Do all the loops */
#ifdef OPENMPTIR
#pragma omp parallel for schedule(dynamic)
#endif
    for (i = 0; i < rpm -> nr; ++i) {
      /*       rpm -> outpoints +=  */
      srconstcool(hdr, rpm, i, 0, disk);
    }

    /* non-parallel bookkeeping */
    for (i = 0; i < rpm -> nr; ++i) {

      /* now create the clouds and grid them, seems to go well, although there is an additional component there */
      /*       allnpoints[disk] +=  */
#ifdef PBCORR
      (*(rpm -> sd[disk][i].srput))(rpm -> corr_pbcfac, rpm -> sd, rpm -> modpar, rpm -> nr, rpm -> cflux, rpm -> radsep, i, fluxpoints, disk);
#else
      (*(rpm -> sd[disk][i].srput))(rpm -> sd, rpm -> modpar, rpm -> nr, rpm -> cflux, rpm -> radsep, i, fluxpoints, disk);
#endif

      /* this should be correct */
      rpm -> outpoints += rpm -> sd[disk][i].outpoints;

      /* this might not be correct */
      allnpoints[disk] += rpm -> sd[disk][i].allnpoints;

      fluxpoints[disk] += rpm -> sd[disk][i].fluxpoints;
    }

    /* Make sure that the correct function is linked for srconst at the end*/
    if (rpm -> inf_aziv[disk] -> srshape == srshape_azi_actcool) {
      rpm -> inf_aziv[disk] -> srshape = srshape_azi_act;
    }
    else {
      rpm -> inf_aziv[disk] -> srshape = srshape_azi_pas;
    }

    if (rpm -> inf_sdisv[disk] -> repeater == sdis_repeater_actcool) {
      rpm -> inf_sdisv[disk] -> repeater = sdis_repeater_act;
    }
    else {
      rpm -> inf_sdisv[disk] -> repeater = sdis_repeater_pas;
    }
        /* Link the correct gridpoint function back */
    for (i = 0; i < rpm -> nr; ++i) {
      if (rpm -> sd[disk][i].gridpoint == gridpoint_normcool) {
	rpm -> sd[disk][i].gridpoint = gridpoint_norm;
      }
      else {
	rpm -> sd[disk][i].gridpoint = gridpoint_mixed;
      }
    }
  }

  /* We return the number of clouds */
  for (disk = 0; disk < rpm -> ndisks; ++disk)
    allnpoint += allnpoints[disk];

  return allnpoint;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Changes the parameters in par according to parms */
static int chprm_gen(double *parms, varlel *varylist, double *newpar)
{
  int i,j = 0;
  int outofrange = 0;
  double oldzero = 0.0;

  /* As long as there is any element of varylist we continue */
  while ((varylist)) {

    varylist -> indicator = 0;

    oldzero = newpar[varylist -> elements[0]];

    if (!(parms[j] == oldzero)) {

      varylist -> indicator = 1;
      /* Every adressant of elements will be changed by the same amount */
      for (i = 0; i < varylist -> nelem; ++i) {
	newpar[varylist -> elements[i]] = newpar[varylist -> elements[i]]-oldzero+parms[j];

	/* And it will be checked whether on of them is out of range */
	if (maths_checkinbetw(varylist -> parmax, varylist -> parmin, newpar[varylist -> elements[i]])) {
	  ++outofrange;
	}
      }
    }
    ++j;
    varylist = varylist -> next;
  }

  return outofrange;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes the information contained in rpm -> par to the output */
static void writeoutput(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq)
{
  int i;
/*   char mes[80]; */
/*   int dev = 0; */
  if (fit -> fitmode > GOLDEN_SECTION)
    writeoutarray(log, hdr, rpm, rpm -> par, accept, hdr -> oldchi2, modcount, dof, rchisq);
  else
    writeoutarray(log, hdr, rpm, rpm -> oldpar, accept, hdr -> oldchi2, modcount, dof, -1.0);

  if ((log -> tstream)) {
    fprintf(log -> tstream, "%7i ",  (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR]);
    for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur + NSPARAMS; ++i) {
      fprintf(log -> tstream, "%12.9e ", log -> outarray[i]);
    }
    fprintf(log -> tstream, "%.16e ", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+CHISQ_TABNR]);
    fprintf(log -> tstream, "%.16e ", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+RCHISQ_TABNR]);
    fprintf(log -> tstream, "%9i\n", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+ACCEPT_TABNR]);
  }

  if (!(log -> logpres)) {
    ftstab_appendrow_(log -> outarray+(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+CHISQ_TABNR);
  }
  tir_put_register(log, rpm, log -> outarray);

  /* Comment on it */
/*   dev = 0; */
/*   if (fit -> fitmode == METROPOLIS) */
/*     sprintf(mes, "Model %i, chisquare %E, relative probability: %E", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR], hdr -> chi2, proba); */
/*   else if (fit -> fitmode == GOLDEN_SECTION) */
/*     sprintf(mes, "Loop %i, %i iterations since start, chisquare %E", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR],  (int) proba, hdr -> oldchi2); */
/*   anyout_tir(&dev, mes); */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes the information contained in rpm -> par to the output */
static void writeoutputread(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit, char accept, double dof, int modcount, double rchisq)
{
  int i;
/*   char mes[80]; */
/*   int dev = 0; */
  if (fit -> fitmode > GOLDEN_SECTION)
    writeoutarray(log, hdr, rpm, rpm -> par, accept, hdr -> oldchi2, modcount, dof, rchisq);
  else
    writeoutarray(log, hdr, rpm, rpm -> oldpar, accept, hdr -> oldchi2, modcount, dof, -1.0);

  if ((log -> tstream)) {
    fprintf(log -> tstream, "%7i ",  (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR]);
    for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur + NSPARAMS; ++i) {
      fprintf(log -> tstream, "%12.9e ", log -> outarray[i]);
    }
    fprintf(log -> tstream, "%.16e ", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+CHISQ_TABNR]);
    fprintf(log -> tstream, "%.16e ", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+RCHISQ_TABNR]);
    fprintf(log -> tstream, "%9i\n", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+ACCEPT_TABNR]);
  }

  tir_put_register(log, rpm, log -> outarray);

  /* Comment on it */
/*   dev = 0; */
/*   if (fit -> fitmode == METROPOLIS) */
/*     sprintf(mes, "Model %i, chisquare %E, relative probability: %E", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR], hdr -> chi2, proba); */
/*   else if (fit -> fitmode == GOLDEN_SECTION) */
/*     sprintf(mes, "Loop %i, %i iterations since start, chisquare %E", (int) log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+LOOPNR_TABNR],  (int) proba, hdr -> oldchi2); */
/*   anyout_tir(&dev, mes); */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes the information contained in rpm -> par to the output array of rpm */
void writeoutarray(loginf *log, hdrinf *hdr, ringparms *rpm, double *par, char accept, double chisquare, int modcount, double dof, double chisquare_red)
{
  int i;
  double globin[3];
  double globout[3];
  int disk;
  int condisp, pcondisp;

  /************/
  /************/
  /* int obsint = 0; */
  /* char obsmes[80]; */
  /************/

  /* Fill the output array */
  for (i = 0; i < rpm -> nur; ++i) {
    log -> outarray[PRADI*rpm -> nur+i] = dinterntoparam(par[PRADI*rpm -> nur+i], RADI, hdr, rpm -> ndisks);
    for (disk = 0; disk < rpm -> ndisks; ++disk) {
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VROT, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVRAD)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVRAD)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VRAD, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVVER)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVVER)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VVER, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PDVRO)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVRO)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVRO, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PDVRA)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVRA)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVRA, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PDVVE)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVVE)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVVE, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PZDRO)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDRO)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDRO, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PZDRA)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDRA)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDRA, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PZDVE)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDVE)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDVE, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PZ0  )*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZ0  )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ Z0  , hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSBR )*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSBR )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SBR , hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSM4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA1D)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1D, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA2D)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2D, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA3D)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3D, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PGA4D)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4D, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PAZ1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PAZ1W)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ1W)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ1W, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PAZ2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PAZ2W)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ2W)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ2W, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ INCL, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PPA  )*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PPA  )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ PA  , hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PSDIS)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSDIS)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SDIS, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PCLNR)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PCLNR)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ CLNR, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM0A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM0A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM0A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVM4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRA4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PRO4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM0A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM0A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM0A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM1A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM1A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM1P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM1P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM2A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM2A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM2P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM2P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM3A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM3A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM3P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM3P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM4A)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM4A, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PWM4P)*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM4P, hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PLS0 )*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PLS0 )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ LS0 , hdr, rpm -> ndisks);
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PLC0 )*rpm -> nur+i] = dinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PLC0 )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ LC0 , hdr, rpm -> ndisks);

      /* Now, we have to convert the triplets into internal units */
      globin[0] = par[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i];
      globin[1] = par[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i];
      globin[2] = par[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i];

      interntoglob(globin, globout, hdr);

      log -> outarray[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i] = globout[0];
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i] = globout[1];
      log -> outarray[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i] = globout[2];
    }
  }
  pcondisp = (NPARAMS + (rpm -> ndisks - 1)*NDPARAMS);
  condisp = pcondisp +1;

  log -> outarray[pcondisp*rpm -> nur] = dinterntoparam(par[pcondisp*rpm -> nur], condisp, hdr, rpm -> ndisks);

  /* Chisquare */
  log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+CHISQ_TABNR] = chisquare;
  if (chisquare_red >= 0.0)
    log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+RCHISQ_TABNR] = chisquare_red;
  else
    log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+RCHISQ_TABNR] = chisquare/dof;

  /* Acceptance */
  log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+ACCEPT_TABNR] = (double) accept;

  /* model number */
  log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+LOOPNR_TABNR] = (double) modcount;

  return;
}
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes the information contained in rpm -> par to the output array of rpm */
static void writeoutarrayerr(hdrinf *hdr, ringparms *rpm, double *par, double *errors, char accept, double chisquare, int modcount, double dof)
{
  int i;
  int disk;
  /************/
  /************/
  /* int obsint = 0; */
  /* char obsmes[80]; */
  /************/
  int condisp, pcondisp;

  for (i = 0; i < rpm -> nur; ++i) {
    errors[PRADI*rpm -> nur+i] = ddinterntoparam(par[PRADI*rpm -> nur+i], RADI, hdr, rpm -> ndisks);
    for (disk = 0; disk < rpm -> ndisks; ++disk) {
      errors[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VROT, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVRAD)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVRAD)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VRAD, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVVER)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVVER)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VVER, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PDVRO)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVRO)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVRO, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PDVRA)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVRA)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVRA, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PDVVE)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PDVVE)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ DVVE, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PZDRO)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDRO)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDRO, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PZDRA)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDRA)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDRA, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PZDVE)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZDVE)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ ZDVE, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PZ0  )*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PZ0  )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ Z0  , hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSBR )*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSBR )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SBR , hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PSM4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PSM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ SM4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA1D)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA1D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA1D, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA2D)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA2D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA2D, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA3D)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA3D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA3D, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PGA4D)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PGA4D)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ GA4D, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PAZ1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PAZ1W)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ1W)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ1W, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PAZ2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PAZ2W)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PAZ2W)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ AZ2W, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ INCL, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PPA  )*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PPA  )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ PA  , hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ XPOS, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ YPOS, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VSYS, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM0A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM0A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM0A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PVM4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PVM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ VM4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRA4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRA4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RA4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PRO4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PRO4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ RO4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM0A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM0A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM0A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM1A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM1A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM1A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM1P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM1P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM1P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM2A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM2A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM2A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM2P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM2P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM2P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM3A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM3A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM3A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM3P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM3P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM3P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM4A)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM4A)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM4A, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PWM4P)*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PWM4P)*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ WM4P, hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PLS0 )*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PLS0 )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ LS0 , hdr, rpm -> ndisks);
      errors[(PRPARAMS+disk*NDPARAMS+PLC0 )*rpm -> nur+i] = ddinterntoparam(par[(PRPARAMS+disk*NDPARAMS+PLC0 )*rpm -> nur+i], PRPARAMS+disk*NDPARAMS+ LC0 , hdr, rpm -> ndisks);
    }
  }

  pcondisp = (NPARAMS + (rpm -> ndisks - 1)*NDPARAMS);
  condisp = pcondisp +1;
  errors[(pcondisp)*rpm -> nur] = ddinterntoparam(par[(pcondisp)*rpm -> nur], condisp, hdr, rpm -> ndisks);

  /* Chisquare */
  errors[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+CHISQ_TABNR] = chisquare;

  errors[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+RCHISQ_TABNR] = chisquare/dof;

  /* Acceptance */
  errors[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+ACCEPT_TABNR] = (double) accept;

  /* model number */
  errors[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+LOOPNR_TABNR] = (double) modcount;

  return;
}
/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Delivers a random variable according to a profile identifyer */
static float zprof(int option, maths_rstrf *permrandstr, float *y2)
{

  /* Note: y1 is basically uninitialised for case 1 UNLESS it is initialised by calling zprof(6,randstr) before. This is (hopefully done throughout the program) */

  float  x1, x2, w;
  static float y1 = 0.0;

/*   static float y2; */

  switch (option) {
  case 1:
    if (*y2 < -1000.0) {

      /* According to http://www.taygeta.com/random/gaussian.html a gaussian distribution with sigma = 1 and mean 0, unfortunately two independent numbers are generated */
      do {
	x1 = 2.0*maths_rndmf(permrandstr)-1.0;
	x2 = 2.0*maths_rndmf(permrandstr)-1.0;
	w = x1*x1+x2*x2;
    } while (w >= 1.0);

      w = sqrtf((-2.0*logf(w))/w);
      y1 = x1*w;
      *y2 = x2*w;
    }
     else {
       y1 = *y2;
       *y2 = -1024.0;
     }
    break;

    /* Sech2 */
  case 2:
    /* sech2: 0.5*sech^2(x) or  1/(2*Z0)*sech^2(z/Z0) (normalised to 1) */
    while (!((x1 = 2.0*maths_rndmf(permrandstr)-1.0)-1.0))
      ;
    /* Note that this is the same as 0.5 log(p/(1-p)) if p varies from 0 to 1, so this is correct */
    y1 = atanhf(x1);
    break;

    /* exponential exp(-|x|)/2 or with Z0 exp(-|x/Z0|)/(2*Z0) (normalised to 1) */
  case 3:
    while (!((x1 = 2.0*maths_rndmf(permrandstr)-1.0)))
      ;
    if (x1 > 0.0)
      y1 = -logf(x1);
    else if (x1 < 0.0)
      y1 = logf(-x1);
    break;

  case 4:
    /* Lorentzian layer: (1/pi)/(x^2+1) or with Z0: Z0/(pi*(x^2+Z0^2)) (normalised to 1) */
    while (!((x1 = 2.0*maths_rndmf(permrandstr)-1.0)-1.0))
      ;

    /* this is correct */
    y1 = tanf(PIHALF*x1);
    break;

  case 6:
    *y2 = -1024.0;
    y1 = 0.0;
    break;

  default:
    /* Uniform layer 1/2 for -1<x<1 0 otherwise or with Z0: 1/(2*Z0) for -Z0<z<Z0 0 otherwise */
    y1 = 2.0*maths_rndmf(permrandstr)-1.0;
    break;
  }

  return y1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initializes the standard header context table */
static int hdl_init(int ndisks)
{
  int disk;
  char placer[9];

  if (ftstab_hdladditem("RADI", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VROT", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VRAD", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VVER", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DVRO", "VELO/ANGLE", "km/s/arcsec"       , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DVRA", "VELO/ANGLE", "km/s/arcsec"       , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DVVE", "VELO/ANGLE", "km/s/arcsec"       , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ZDRO", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ZDRA", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ZDVE", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("Z0"  , "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SBR" , "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0, 1000.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM1A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM2A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM3A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM4A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SM4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA1A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA1D", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA2A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA2D", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA3A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA3D", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA4A", "FLUX"      , "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("GA4D", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("AZ1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("AZ1W", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("AZ2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("AZ2W", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("INCL", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PA"  , "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("XPOS", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("YPOS", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VSYS", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SDIS", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("CLNR", "NATURAL"   , " "                 , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM0A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM1A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM2A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM3A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM4A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("VM4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM0A", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM1A", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM2A", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM3A", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM4A", "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WM4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("LS0" , "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("LC0" , "ANGLE"     , "arcsec"            , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO1A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO2A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO3A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO4A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RO4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA1A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA1P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA2A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA2P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA3A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA3P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA4A", "VELO"      , "km/s"              , 0.0,    1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RA4P", "ANGLE"     , "deg"               , 0.0,    1.0) < 0)    { return 0;}

  for (disk = 1; disk < ndisks; ++disk) {

    sprintf(placer, "VROT_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VRAD_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VVER_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "DVRO_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO/ANGLE", "km/s/arcsec",        0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "DVRA_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO/ANGLE", "km/s/arcsec",        0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "DVVE_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO/ANGLE", "km/s/arcsec",        0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "ZDRO_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",       "arcsec",            0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "ZDRA_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",       "arcsec",            0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "ZDVE_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",       "arcsec",            0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "Z0_%i"  , disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SBR_%i" , disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0, 1000.0) < 0)         { return 0;}
    sprintf(placer, "SM1A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM2A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM3A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM4A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SM4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA1A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA1D_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA2A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA2D_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA3A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA3D_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA4A_%i", disk+1);       if (ftstab_hdladditem(placer, "FLUX",       "Jy*m/(s*arcsec**2)", 0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "GA4D_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "AZ1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "AZ1W_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "AZ2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "AZ2W_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "INCL_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "PA_%i"  , disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "XPOS_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "YPOS_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VSYS_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "SDIS_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "CLNR_%i", disk+1);       if (ftstab_hdladditem(placer, "NATURAL",    " ",                  0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM0A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM1A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM2A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM3A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM4A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "VM4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM0A_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM1A_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM2A_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM3A_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM4A_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "WM4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "LS0_%i" , disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "LC0_%i" , disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "arcsec",             0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO1A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO2A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO3A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO4A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RO4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA1A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA1P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA2A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA2P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA3A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA3P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA4A_%i", disk+1);       if (ftstab_hdladditem(placer, "VELO",       "km/s",               0.0,    1.0) < 0)         { return 0;}
    sprintf(placer, "RA4P_%i", disk+1);       if (ftstab_hdladditem(placer, "ANGLE",      "deg",                0.0,    1.0) < 0)         { return 0;}
  }

  if (ftstab_hdladditem("CONDISP" , "VELO"   , "km/s"        , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("BMAJ"    , "ANGLE"  , "arcsec"      , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("BMIN"    , "ANGLE"  , "arcsec"      , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("BPA"     , "ANGLE"  , "deg"         , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RMS"     , "FLUX"   , "Jy*km/s*beam", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("NUR"     , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RADSEP"  , "ANGLE"  , "arcsec"      , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("WEIGHT"  , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("MODE"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ISEED"  , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("LOOPS"   , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("NCORES"  , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ISEED_2" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ANSTART" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ANEND"   , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ANSTEPS" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("INIMODE" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("FITMODE" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("OUTCUBUP", "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DISTANCE", "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PENALTY" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RFREQ"   , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ITOU"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("MAXITER" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("CALLITE" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SIZE"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSSE"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSNP"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSCO"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSSO"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSMV"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSNF"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSII"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSFI"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSID"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PSDD"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("NUR"     , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("INTY"    , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("INDINTY" , "NATURAL", " "           , 0.0, 1.0) < 0)    { return 0;}
  for (disk = 1; disk < ndisks; ++disk) {
    /* NOTE: this used to be sprintf(placer, "LTYPE_%i" , disk+1); */
    sprintf(placer, "LTYPE_%i" , disk+1);
    if (ftstab_hdladditem(placer, "NATURAL", " ", 0.0, 1.0) < 0)
      { return 0;}
  }
  if (ftstab_hdladditem("CFLUX", "FLUX", "Jy*km/s", 0.0, 1.0) < 0)    { return 0;}
  for (disk = 1; disk < ndisks; ++disk) {
    /* NOTE: this used to be sprintf(placer, "CFLUX_%i" , disk+1); */
    sprintf(placer, "CFLUX_%i" , disk+1);
    if (ftstab_hdladditem(placer, "FLUX", "Jy*km/s", 0.0, 1.0) < 0)
      { return 0;}
  }

  /* Second hdu */
  if (ftstab_hdladditem("PARMAX"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("PARMIN"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("MODERATE", "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DELSTART", "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("DELEND"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ITESTART", "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ITEEND"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("SATDELT" , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("MINDELTA", "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ELEMENTS", "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}

  /* Third hdu */
  if (ftstab_hdladditem("CHISQ"   , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("RCHISQ"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("LOOPNR"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  if (ftstab_hdladditem("ACCEPT"  , "NATURAL", " ", 0.0, 1.0) < 0)    { return 0;}
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Opens if necessary creat the third hdu */
static int open_hdu_3(loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  if (fit -> fitmode == GOLDEN_SECTION) {
    /* Now we get the number of loops */
      fit -> loopnr = 0;
  }
  else if (fit -> fitmode > GOLDEN_SECTION) {
      fit -> recnr = 0;
      fit -> loopnr = 1;
  }
  else
    goto error;

  return 0;

 error:
  return 1;
}

/* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Calculates and puts the results of the fitting procedure */
static int putgenresults(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  double *errors = NULL, *array = NULL;
  int i;
  size_t size_tv, length;
  double doublev, chimult = 1.0;
  char solpres = 1;
  int disk;
  char mes[200];
  int dev = 1;
  double solchisq;

    /* Get the best-fit chisquare and check if we had a solution*/
  if (gft_mst_get(fit -> gft_mstv, &solchisq, GFT_OUTPUT_SOLCHSQ)) {
    if (!gft_mst_get(fit -> gft_mstv, &fit -> mon_bestchisq, GFT_OUTPUT_BESTCHISQ))
      solpres = 2;
    else
      solpres = 0;
  }

  gft_mst_get(fit -> gft_mstv, &fit -> mon_size, GFT_OUTPUT_SIZE);

  /* Allocate the error array */
  if (!(errors = (double *) malloc(((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR)*sizeof(double))))
    goto error;

  /* Get the number of elements in varlist */
  if (solpres) {
    gft_mst_get(fit -> gft_mstv, &size_tv, GFT_OUTPUT_NPAR);

    /* Allocate a double array of this length */
    if ((size_tv)) {
      if (!(array = (double *) malloc (size_tv*sizeof(double))))
		  goto error;
    }

    if ((solpres == 1)) {
      for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR; ++i)
		  errors[i] = 0.0;

      /* Get the best-fit parameters therein */
      if (gft_mst_get(fit -> gft_mstv, array, GFT_OUTPUT_SOLPAR)) {
		  free(array);
		  free(errors);
		  return 1;
      }
    }
    else if (solpres == 2) {
      if (gft_mst_get(fit -> gft_mstv, array, GFT_OUTPUT_BESTPAR)) {
	free(array);
	free(errors);
	return 1;
      }
    }
  }

  /* Now calculate the parameters from that and copy to oldpar */
  if (solpres){
    chimult = pow(OUTRANGEFAC,chprm_gen(array, fit -> varylist, rpm -> par));
/*     if (chprm_gen(array, fit -> varylist, rpm -> par)) */

/*       If they get out of range, we multiply the chisquare by OUTRANGEFAC  */
/*       chimult = OUTRANGEFAC; */
/*     else */
/*       chimult = 1.0; */
  }

  /* Now ensure that the indexed parameters are aligned */
  for (i = rpm -> nur*NSSDPARAMS; i < rpm -> nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i) {
    rpm -> chapar[i] = chkchangep(fit -> varylist, fit -> fitmode, i, rpm -> nur);
  }

  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  /* When ending make one run of interpover */
  interpover(rpm, rpm -> radsep, 1, NULL, fit -> index);

  /* Do make the model */
  galmod(hdr, rpm, GENFIT, fit -> varylist, fit -> index, fit -> fluxpoints, fit -> npoints);

  /* Get the chisquare */

  /* use here the usual replacement of PCONDISP */
  doublev = chimult*(reg_do(fit -> reg_contv, (fit -> mon_alloops == fit -> loops)?fit -> loops - 1:fit -> mon_alloops, getchisquare_c(rpm -> par[((NPARAMS + (rpm -> ndisks - 1)*NDPARAMS))*rpm -> nur]))+((double) rpm -> outpoints)*rpm -> penalty);

  /* report */
  sprintf(mes,
	  "Finished "      /* Fitting */
	  "N:%d",          /* Number of pointsources */
	  fit -> npoints[0]);
  for (disk = 1; disk < rpm -> ndisks; ++disk) {
    length = strlen(mes);
    sprintf(mes+length,
	    "/%d",       /* Number of pointsources */
	    fit -> npoints[disk]);
  }
  length = strlen(mes);
  sprintf(mes+length,
	  " F:%.2E",     /* Total flux */
	  fit -> fluxpoints[0]*rpm -> cflux[0]*hdr -> deltgridtouser[2]);
  for (disk = 1; disk < rpm -> ndisks; ++disk) {
    length = strlen(mes);
    sprintf(mes+length,
	    "/%.2E",
	    fit -> fluxpoints[disk]*rpm -> cflux[disk]*hdr -> deltgridtouser[2]);
  }
  length = strlen(mes);
  sprintf(mes+length,
	  " C:%E "          /* current chisquare */
	  " S:%E ",          /* size */
			 doublev,      /* current minimum chisquare */
	  fit -> mon_size    /* size */
	  );
  anyout_tir(&dev, mes);

  /* New Kamphuis */
  if (startinfv -> restartid) {
    length = strlen(mes);
    sprintf(mes+length,
	    " R:%i ",          /* current restart-id */
	    startinfv -> restartid    /* size */
	    );
  }
  progressout(startinfv, mes);

  /* error source ? */

  for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS; ++i) {
    rpm -> oldpar[i] = rpm -> par[i];
  }

  /* This does not work for some reason, has to be addressed in gft. Nasty hack? */
  /*
 if (gft_mst_get(fit -> gft_mstv, &doublev2, GFT_OUTPUT_SOLCHSQRED)) {
   gft_mst_get(fit -> gft_mstv, &doublev2, GFT_OUTPUT_ACTCHISQRED);
   gft_mst_get(fit -> gft_mstv, &doublev, GFT_OUTPUT_ACTCHISQ);
 }
  */

  /* instead we use what we get from the last model */

  /* make the output array */
 writeoutarray(log, hdr, rpm, rpm -> par, 1, doublev, fit -> recnr, fit -> dof, -1.0);

  /* Errors are 0 if there are none, we use the par array to indicate that */
  for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur + NSPARAMS; ++i)
    rpm -> par[i] = 0.0;

  /* get the errors */
  if (!gft_mst_get(fit -> gft_mstv, array, GFT_OUTPUT_SOLERR))
    chprm_gen(array, fit -> varylist, rpm -> par);

  /* Go through the parameters */
  writeoutarrayerr(hdr, rpm, rpm -> par, errors, 1, 0.0, 0, fit -> dof);

  /* Put it to the grid */
  for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR; ++i) {
/*     ftstab_fillhd(i, ftstab_get_coltit(i+1), ftstab_get_coltyp(i+1), errors[i], log -> outarray[i]); */
    tir_fillhd(log, i, errors[i], log -> outarray[i]);
  }
  /* Apply the changes */
/*   if (!ftstab_clearhd(0)) */
/*     goto error; */

  for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS; ++i) {
    rpm -> par[i] = rpm -> oldpar[i];
  }

  if ((errors))
    free(errors);

  if ((array))
    free(array);

  return 1;

 error:
  if ((errors))
    free(errors);
  if ((array))
    free(array);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* A golden section iteration */
static int golden_section(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int i,j;
  int accept = 1;
  long bigloops;
  varlel *varele;
  varlel *varele2;
  double delta;
  double delta_start;
  int maxiter;
  int curiter;
  int satisfied;
  int globiter = 0;
  int globiter_old;
  int def = 1;
  char mes[300];
  char key[20];
  double *prevresult;
  int nmax = 0;
  double chimult;
  /*  double mdelt; */
  int disk;
  size_t length;

     for (i=0; i<100000000; ++i)
       ;

  /* Get the number of elements in the varlist */
  varele = fit -> varylist;

  i = 0;
  while (varele) {
    ++i;
    nmax = (nmax > varele -> nelem) ? nmax: varele -> nelem;
    varele = varele -> next;
  }

  /* The degrees of freedom are determined by the amount of variable
     parameters, we do it VERY roughly. If there is a parameter varied
     twice, this is not true anymore */
  /* dof = (hdr -> bsize1-1)*hdr -> bsize2* hdr -> nsubs-i; */

  /* We allocate the prevresult array */
  if (!(prevresult = (double *) malloc(nmax*sizeof(double))))
    return 0;

  /* Now get the number of big loops */
/*   if (ftstab_get_rownr_()) */
/*     bigloops = (fit -> loopnr)/i+1+!((fit -> loopnr)%i); */
/*   else { */
  bigloops = 0;
/*   } */
  bigloops = (fit -> loopnr != 0)?(fit -> loopnr-1)/i+1:0;

  /* Now put the pointer to the next element in the varlel */
  if ((fit -> loopnr))
    i = (fit -> loopnr-1)%i;
  else
    i = 0;

  varele = fit -> varylist;
  for (j = 0; j < i; ++j)
    varele = varele -> next;

  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = 1;

  /* The new parameter list will be created */
  if (!(fit -> loopnr)) {
    if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
      goto error;
    for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
      rpm -> oldpar[i] = rpm -> par[i];
  }
  else {
    if (changedependent(rpm, rpm -> oldpar, fit -> index, rpm -> chapar) < 0)
      goto error;
    for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
      rpm -> par[i] = rpm -> oldpar[i];
  }

  /* When starting make one run of interpover */
  interpover(rpm, rpm -> radsep, 1, NULL, fit -> index);

/* Get the old chisqare or initialise */
  if ((fit -> loopnr)) {
    hdr -> oldchi2 = log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+CHISQ_TABNR-1];
    satisfied = log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+ACCEPT_TABNR-1];
  }
  else {

     /* addendum: change penalising strategy also for this task */
     varele2 = fit -> varylist;
     chimult = 1.0;
     while(varele2) {
       for (i = 0; i < varele2 -> nelem; ++i) {
	 if (maths_checkinbetw(varele2 -> parmax, varele2 -> parmin, rpm -> par[varele2 -> elements[i]])) {

	   /* If they get out of range, we multiply the chisquare by OUTRANGEFAC */
	   chimult = chimult*OUTRANGEFAC;
	   break;
	 }
       }
       varele2 = varele2 -> next;
     }

    /* Do it */
    galmod(hdr, rpm, 1, varele, fit -> index, rpm -> fluxpoints, fit -> npoints);

    /* Get the chisquare */
    hdr -> chi2 = getchisquare_c(rpm -> par[((NPARAMS + (rpm -> ndisks - 1)*NDPARAMS))*rpm -> nur]);

    /* Regularise */
    hdr -> chi2 = reg_do(fit -> reg_contv, fit -> loopnr, hdr -> chi2);

    /* For bookkeeping */
    fit -> mon_alloops = fit -> loopnr;

    /* Correct the chisquare taking into account the outliers, don't know if that is necessary here... */
    hdr -> chi2 = chimult*(hdr -> chi2+((double) rpm -> outpoints)*rpm -> penalty);

    /* Copy it */
    hdr -> oldchi2 = hdr -> chi2;

    /* Write the output */
    satisfied = 1;

    /* Starting */
    sprintf(mes, "START");

    anyout_tir(&def, mes);
    writeoutput(log, hdr, rpm, fit, satisfied, fit -> dof, bigloops, globiter);
    ++fit -> loopnr;
    ++bigloops;
  }

  /* This will run until the bigloops is reached */
  while (bigloops <= fit -> loops) {

    /* We go through the varylist */
    while(varele) {

      /* Record where we started */
      for (i = 0; i < varele -> nelem; ++i)
	prevresult[i] = rpm -> oldpar[varele -> elements[i]];

      /* Reset the old chisquare */
      /* chi2_old = hdr -> oldchi2 ; */

      globiter_old = globiter;

      /* Calculate the delta */
      if (bigloops - varele -> moderate <= 0)
	delta = (bigloops-1)*(varele -> delend-varele -> delstart)/varele -> moderate+varele -> delstart;
      else
	delta = varele -> delend;

      delta_start = delta;

      /* Calculate the number of steps */
      if (bigloops - varele -> moderate <= 0)
	maxiter = ((bigloops-1)*(varele -> iteend-varele -> itestart))/varele -> moderate+varele -> itestart;
      else
	maxiter = varele -> iteend;

      /* The first iteration */
      curiter = 0;
      accept = 1;

      /* We go on searching until we find a lower chisquare and then a higher chisquare */
      while (1) {

	/* If the maximum number of iterations is reached break out, deeply disappointed */
	if (curiter == maxiter) {
	  accept = 0;
	  satisfied = 0;
	  break;
	}

	/* Change the params */
	for (i = 0; i < varele -> nelem; ++i)
	  rpm -> par[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] + delta;

	/* addendum: change penalising strategy also for this task */
     /* addendum: change penalising strategy also for this task */
     varele2 = fit -> varylist;
     chimult = 1.0;
     while(varele2) {
       for (i = 0; i < varele2 -> nelem; ++i) {
	 if (maths_checkinbetw(varele2 -> parmax, varele2 -> parmin, rpm -> par[varele2 -> elements[i]])) {

	   /* If they get out of range, we multiply the chisquare by OUTRANGEFAC */
	   chimult = chimult*OUTRANGEFAC;
	   break;
	 }
       }
       varele2 = varele2 -> next;
     }

     /* Reset the touched array */
     for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
       rpm -> chapar[i] = chkchangep(varele, fit -> fitmode, i, rpm -> nur);

     /* check and change the index */
     if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
       goto error;

     /* Do it */
     for (i = 0; i < rpm -> ndisks; ++i)
       rpm -> fluxpoints[i] = 0;
     galmod(hdr, rpm, 1, varele, fit -> index, rpm -> fluxpoints, fit -> npoints);

	++globiter;

	/* Get the chisquare */
	hdr -> chi2 = getchisquare_c(rpm -> par[((NPARAMS + (rpm -> ndisks - 1)*NDPARAMS))*rpm -> nur]);

	/* Regularise */
	hdr -> chi2 = reg_do(fit -> reg_contv, bigloops-1, hdr -> chi2);
	fit -> mon_alloops = bigloops-1;

	/* Correct the chisquare taking into account the outliers, don't know if that is necessary here... */
	hdr -> chi2 = chimult*(hdr -> chi2+((double) rpm -> outpoints)*rpm -> penalty);

	/* 	ftstab_putcoltitl(key, ftstab_get_coltit(*varele -> elements+1)); */
	ftstab_putcoltitl(key, (*varele -> elements)/rpm -> nur+1);

	/* Report Search minimum, big loops, keyword loops, total models, keyword, first ringnumber, keyword models/maxmodels, number of pointsources, total flux, current minimum chisquare, trial chisquare, difference, current stepwidth, start stepwidth. In principle, this should be a status report, but gipsy... crashes when you interrupt the task if you change the length MSGLEN of the status line in taskcom.h */
	sprintf(mes,
		"SM "         /* Searching minimum */
		"BL:%li "       /* Big loops */
		"KL:%li "       /* Keyword loops */
		"TM:%i "     /* Total models */
		"KW:%s "       /* Keyword */
		"FR:%i "       /* First ringnumber */
		"KM:%i"        /* Keyword models */
		"/%i "         /* Keyword maxmodels */
		"NP:%d",       /* Number of pointsources */
		bigloops,                /* Big loops */
		fit -> loopnr,                       /* Keyword loops */
		globiter,                /* Total models */
		key,                 /* Keyword */
		(*varele -> elements/rpm -> nur < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS))?*varele -> elements%rpm -> nur+1:1,                  /* First ringnumber */
		globiter-globiter_old,                      /* Keyword models */
		maxiter,                /* Keyword maxmodels */
		fit -> npoints[0]);               /* Number of pointsources */
	for (disk = 1; disk < rpm -> ndisks; ++disk) {
	  length = strlen(mes);
	  sprintf(mes+length,
		  "/%d",       /* Number of pointsources */
		  fit -> npoints[disk]);
	}
	length = strlen(mes);
	sprintf(mes+length,
		" TF:%.2E",     /* Total flux */
		rpm -> fluxpoints[0]*rpm -> cflux[0]);
	for (disk = 1; disk < rpm -> ndisks; ++disk) {
	  length = strlen(mes);
	  sprintf(mes+length,
		  "/%.2E",
		  rpm -> fluxpoints[disk]*rpm -> cflux[disk]);
	}

	length = strlen(mes);
	sprintf(mes+length,
		" CC:%E "       /* current minimum chisquare */
		"DC:%+.1E "       /* Difference */
		"SW:%+.2E"       /* Current stepwidth */
		"/%.2E "         /* Start stepwidth */
		"AC:%i",      /* Acceptance flag */
		hdr -> oldchi2,               /* current minimum chisquare */
		hdr -> oldchi2-hdr -> chi2,                                                     /* Difference */
		ddinterntoparam(delta, (*varele -> elements)/rpm -> nur +1, hdr, rpm -> ndisks),         /* Current stepwidth */
		ddinterntoparam(delta_start, (*varele -> elements)/rpm -> nur +1, hdr, rpm -> ndisks),   /* Start stepwidth */
		satisfied               /* Acceptance flag */
		);
	anyout_tir(&def, mes);

	/* Now compare */
	if (hdr -> chi2 >= hdr -> oldchi2) {

	  /* If the number of iterations is larger than 1, we stop it here */
	  if (curiter > 0) {
	    delta = BFAC*delta;
	    ++curiter;
	    break;
	  }
	  /* If not we search in the other direction */
	  else {
	    delta = -delta;
	  }
	}
	else {

	  /* Now overwrite the oldparams */
	  for (i = 0; i < varele -> nelem; ++i)
	    rpm -> oldpar[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] + delta;

	  /* check and change the index */

	  if (changedependent(rpm, rpm -> oldpar, fit -> index, rpm -> chapar) < 0)
	    goto error;

	  /* Now enlarge the delta and accept the chisquare */
	  hdr -> oldchi2 = hdr -> chi2;
	  if (curiter < MAGNIFICNR)
	    delta = AFAC*delta;
	}

	++curiter;
      }

      /* search = 1; */

      if ((accept)) {
	/* We go on searching to find the minimum in the knowledge that we are nearly there */
	while (1) {

	  /* If the maximum number of iterations is reached break out, deeply disappointed */
	  if (curiter == maxiter) {
	    satisfied = 0;
	    break;
	  }

	  /* Change the delta */
	  delta = BFAC * delta;

	  /* Check if we break out because of too small deltas*/
	  if (fabs(delta) < varele -> mindelta)
	    break;

	  for (i = 0; i < varele -> nelem; ++i)
	    rpm -> par[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] + delta;

     /* addendum: change penalising strategy also for this task */
     varele2 = fit -> varylist;
     chimult = 1.0;
     while(varele2) {
       for (i = 0; i < varele2 -> nelem; ++i) {
	 if (maths_checkinbetw(varele2 -> parmax, varele2 -> parmin, rpm -> par[varele2 -> elements[i]])) {

	   /* If they get out of range, we multiply the chisquare by OUTRANGEFAC */
	   chimult = chimult*OUTRANGEFAC;
	   break;
	 }
       }
       varele2 = varele2 -> next;
     }
	  /* check out the indexed parameters */
     for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
       rpm -> chapar[i] = chkchangep(varele, fit -> fitmode, i, rpm -> nur);

     if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
       goto error;

     /* We don't have to check whether we broke out of range */

     /* Do it */
     galmod(hdr, rpm, 1, varele, fit -> index, rpm -> fluxpoints, fit -> npoints);
     ++globiter;

     /* Get the chisquare */
	  hdr -> chi2 = getchisquare_c(rpm -> par[((NPARAMS + (rpm -> ndisks - 1)*NDPARAMS))*rpm -> nur]);

	  /* Regularise */
	  hdr -> chi2 = reg_do(fit -> reg_contv, bigloops-1, hdr -> chi2);
	  fit -> mon_alloops = bigloops-1;

	  /* Correct the chisquare taking into account the outliers, don't know if that is necessary here... */
	  hdr -> chi2 = chimult*(hdr -> chi2+((double) rpm -> outpoints)*rpm -> penalty);

	  /* Report Found minimum, big loops,  total models, keyword loops, keyword, first ringnumber, keyword models/maxmodels, number of pointsources, total flux, current minimum chisquare, trial chisquare, difference, current stepwidth, start stepwidth */

	  /* Report Search minimum, big loops, keyword loops, total models, keyword, first ringnumber, keyword models/maxmodels, number of pointsources, total flux, current minimum chisquare, trial chisquare, difference, current stepwidth, start stepwidth */
	  sprintf(mes,
		  "FM "         /* Searching minimum */
		  "BL:%li "       /* Big loops */
		  "KL:%li "       /* Keyword loops */
		  "TM:%i "     /* Total models */
		  "KW:%s "       /* Keyword */
		  "FR:%i "       /* First ringnumber */
		  "KM:%i"        /* Keyword models */
		  "/%i "         /* Keyword maxmodels */
		  "NP:%d",       /* Number of pointsources */
		  bigloops,                /* Big loops */
		  fit -> loopnr,                       /* Keyword loops */
		  globiter,                /* Total models */
		  key,                 /* Keyword */
		  (*varele -> elements/rpm -> nur < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS))?*varele -> elements%rpm -> nur+1:1,                  /* First ringnumber */
		  globiter-globiter_old,                      /* Keyword models */
		  maxiter,                /* Keyword maxmodels */
		  fit -> npoints[0]);               /* Number of pointsources */
	  for (disk = 1; disk < rpm -> ndisks; ++disk) {
	    length = strlen(mes);
	    sprintf(mes+length,
		    "/%d",       /* Number of pointsources */
		    fit -> npoints[disk]);
	  }
	  length = strlen(mes);
	  sprintf(mes+length,
		  " TF:%.2E",     /* Total flux */
		  rpm -> fluxpoints[0]*rpm -> cflux[0]);
	  for (disk = 1; disk < rpm -> ndisks; ++disk) {
	    length = strlen(mes);
	    sprintf(mes+length,
		    "/%.2E",
		    rpm -> fluxpoints[disk]*rpm -> cflux[disk]);
	  }

	  length = strlen(mes);
	  sprintf(mes+length,
		  " CC:%E "       /* current minimum chisquare */
		  "DC:%+.1E "       /* Difference */
		  "SW:%+.2E"       /* Current stepwidth */
		  "/%.2E "         /* Start stepwidth */
		  "AC:%i",      /* Acceptance flag */
		  hdr -> oldchi2,               /* current minimum chisquare */
		  hdr -> oldchi2-hdr -> chi2,                                                     /* Difference */
		  ddinterntoparam(delta, (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks),         /* Current stepwidth */
		  ddinterntoparam(delta_start, (*varele -> elements)/rpm -> nur+1, hdr, rpm -> ndisks),   /* Start stepwidth */
		  satisfied               /* Acceptance flag */
		  );
	  anyout_tir(&def, mes);

	  /* Now compare */
	  if (hdr -> chi2 >= hdr -> oldchi2) {
	    delta = -delta;
	  }
	  else {
	    /* Now overwrite the oldparams */

	    for (i = 0; i < varele -> nelem; ++i)
	      rpm -> oldpar[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] + delta;

	    for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
	      rpm -> chapar[i] = chkchangep(varele, fit -> fitmode, i, rpm -> nur);

		 /* check out the indexed parameters */
	    if (changedependent(rpm, rpm -> oldpar, fit -> index, rpm -> chapar) < 0)
	      goto error;

	    hdr -> oldchi2 = hdr -> chi2;
	  }
	  ++curiter;
	}
      }

      /*Output of a progress file Kamphuis addition */
      progressout(startinfv, mes);

      /* We have to check whether we have changed too much to be satisfied */
      if ((satisfied)) {

	/* We only have to check one variable */
	if (fabs(rpm -> oldpar[varele -> elements[0]]-prevresult[0]) > varele -> satdelt) {
	  satisfied = 0;
	}
      }

      /* Check the range of the params, this is old */
      /* Deleted everything START */
      /*       for (i = 0; i < varele -> nelem; ++i) { */
      /* 	if (maths_checkinbetw(varele -> parmax, varele -> parmin, rpm -> oldpar[varele -> elements[i]])) { */

      /* Comment on that */
      /* 	  sprintf(mes, "Parameter out of range, interpolating"); */
      /* 	  anyout_tir(&def, mes); */

      /***************/
      /* This is new */
      /***************/

      /* Find out what has happened */
      /* mdelt = 0 */
      /* 	  mdelt = fabs(prevresult[i] - rpm -> oldpar[varele -> elements[i]])/2.0; */

      /* 	  if (varele -> parmax > varele -> parmin) { */
      /* 	    if (rpm -> oldpar[varele -> elements[i]] < varele -> parmin) { */
      /* 	      while (i < varele -> nelem) { */
      /* 		mdelt = (((prevresult[i]-varele -> parmin)/2.0) < mdelt)?((prevresult[i]-varele -> parmin)/2.0):mdelt; */
      /* 		mdelt = (fabs(prevresult[i]-varele -> parmin) < mdelt)?(fabs(prevresult[i]-varele -> parmin)/2.0):mdelt; */
      /* 		++i; */
      /* 	      } */
      /* 	      mdelt = -mdelt; */
      /* 	    } */
      /* 	    else { */
      /* 	      while (i < varele -> nelem) { */
      /* 				mdelt = (((varele -> parmax-prevresult[i])/2.0) < mdelt)?(((varele -> parmax-prevresult[i])/2.0)/2.0):mdelt; */
      /* 		mdelt = (fabs(prevresult[i]-varele -> parmax) < mdelt)?(fabs(prevresult[i]-varele -> parmax)/2.0):mdelt; */
      /* 		++i; */
      /* 	      } */
      /* 	    } */
      /* 	  } */
      /* 	  else { */
      /* 	    if (rpm -> oldpar[varele -> elements[i]] < varele -> parmax) { */
      /* 	      while (i < varele -> nelem) { */
      /* 		 		mdelt = (((prevresult[i]-varele -> parmax)/2.0) < mdelt)?((prevresult[i]-varele -> parmax)/2.0):mdelt; */
      /* 		mdelt = (fabs(prevresult[i]-varele -> parmax) < mdelt)?(fabs(prevresult[i]-varele -> parmax)/2.0):mdelt; */
      /* 		++i; */
      /* 	      } */
      /* 	      mdelt = -mdelt; */
      /* 	    } */
      /* 	    else { */
      /* 	      while (i < varele -> nelem) { */
      /* 		 		mdelt = (((varele -> parmin-prevresult[i])/2.0) < mdelt)?(((varele -> parmin-prevresult[i])/2.0)/2.0):mdelt; */
      /* 		mdelt = (fabs(prevresult[i]-varele -> parmin) < mdelt)?(fabs(prevresult[i]-varele -> parmin)/2.0):mdelt; */
      /* 		++i; */
      /* 	      } */
      /* 	    } */
      /* 	  } */

      /* change all the values: new */
      /* 	  for (i = 0; i < varele -> nelem; ++i) */
      /* 	    rpm -> par[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] = prevresult[i]+mdelt; */

      /* check out the indexed parameters */
      /* 	  changedependent(rpm, rpm -> par, fit -> index); */
      /* 	  changedependent(rpm, rpm -> oldpar, fit -> index); */

      /* write back all the values: old */
      /*    for (i = 0; i < varele -> nelem; ++i) */
      /*      rpm -> par[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]] = prevresult[i]; */

      /* This is crucial at that point */
      /* 	  interpover(rpm, rpm -> radsep, 1, varele, fit -> index); */

      /* Do it */
      /*  	  galmod(hdr, rpm, 1, varele, fit -> index, fluxpoints, fit -> npoints); */

      /* Get the chisquare */
      /*  	  hdr -> chi2 = getchisquare_c(rpm -> par[(PCONDISP)*rpm -> nur]); */

      /* Regularise */
      /* 	  hdr -> chi2 = reg_do(fit -> reg_contv, bigloops-1, hdr -> chi2); */
      /* 	  fit -> mon_alloops = bigloops-1; */

      /* Correct the chisquare taking into account the outliers, don't know if that is necessary here... */
      /* 	  hdr -> chi2 = hdr -> chi2+((double) rpm -> outpoints)*rpm -> penalty; */

      /* 	  hdr -> oldchi2 = hdr -> chi2; */

      /* 	  satisfied = 0; */
      /* 	  break; */
      /* 	} */
      /*       } */

      /* BUGFIXED? The following lines were not present in the previous version */
      /* Write oldpar into par */
      for (i = 0; i < varele -> nelem; ++i)
	rpm -> par[varele -> elements[i]] = rpm -> oldpar[varele -> elements[i]];

      /* check out the indexed parameters */
      for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
	rpm -> chapar[i] = 1;

      if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
	goto error;

      /* BUGFIX: This seems to be very important in order not to loose pointsources; if not done, a pointsource list might be terminated the wrong way */
      interpover(rpm, rpm -> radsep, 1, varele, fit -> index);

      writeoutput(log, hdr, rpm, fit, satisfied, fit -> dof, fit -> loopnr, globiter);

      varele = varele -> next;

      /* Now we document on the results */
      ++fit -> loopnr;

      if ((*hdr -> outset != '\0')) {
	if (!(fit -> loopnr%hdr -> outcubup)) {
	  writemodel(hdr, rpm, fit, rpm -> oldpar, fit -> index);
	}
      }
    }

    /* If we are still satisfied, we break, because we have results, which is documented also in outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS-1+ACCEPT_TABNR] */
    if ((satisfied)) {
      break;
    }

    /* We start at the start of the varylist again */
    varele = fit -> varylist;

    ++bigloops;
    satisfied = 1;
  }

  free(prevresult);
  return 1;

 error:
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Calculates and puts the results of the fitting procedure */
static int putgoldresults(loginf *log, ringparms *rpm, fitparms *fit)
{
  int i;

  /* The best value is at the end */
/*   ftstab_get_row(fit -> loopnr, log -> outarray); */
/* This is probably stupid, but, well... */
  tir_get_register(log, rpm, log -> outarray);

  /* Put it to the grid */
  for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+OUTTABNR; ++i)
/*     ftstab_fillhd(i, ftstab_get_coltit(i+1), ftstab_get_coltyp(i+1), COLRADI_DEFAULT, log -> outarray[i]); */
    tir_fillhd(log, i, COLRADI_DEFAULT, log -> outarray[i]);

  /* Apply the changes */
/*   if (!ftstab_clearhd(0)) */
/*     goto error; */

  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes an ascii table with the results */
static int writeasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int def = 2;
  int nel = 1;
  int rring;
  int err = 1;
  char mes[81];

  FILE *stream;
  int i, j;
  char key[21];
  char key2[26];
  double value;
  double delta;
  double vsys;
  double nu;
  double nv[3];
  double nvtot[3];
  double nrefr[3];

  double cosp;
  double sinp;
  double sini;
  double cosi;
  double pp[3];
  double posin[3];
  double posout[3];

  /**********/
  /**********/
  /* int obsint; */
  /* char obsmes[81]; */
  /*********/

  /* First check if there was an input */
  if (*log -> table == '\0')
    return 1;

  /* Also check if there was a logfile and stop if there wasn't */
/*   if (*log -> logname == '\0') */
/*     return 0; */

  rring = rpm -> nur >= 5?5:rpm -> nur;

  /* Get the reference ring */
  sprintf(mes, "Give reference ring for warp angle calculation");
  while ((err)) {
    userint_tir(startinfv -> arel, &rring, &nel, &def, "REFRING=", mes);
    if (rring <= 0 || rring > rpm -> nur) {
      sprintf(mes, "REFRING: impossible number");
      cancel_tir(startinfv -> arel, "REFRING=", 2);
      def = 4;
    }
    else
      err = 0;
  }

  /* Try to open the output file */
  if (!(stream = fopen(log -> table, "r"))) {

    /* If the file doesn't exist we compose a header */
    if (!(stream = fopen(log -> table, "w"))) {
      return 0;
    }
  }
  else {
    if (!(stream = fopen(log -> table, "a")))
      return 0;
    fprintf(stream, "\n");
  }

  /* Now we put some general information, commented */
  fprintf(stream, "# tirific version 1\n");
  fprintf(stream, "# logfile: %s\n", log -> logname);

  if (fit -> fitmode >= GOLDEN_SECTION) {
    fprintf(stream, "# fitmode was golden section or higher\n");
    fprintf(stream, "# last acceptance was (1 accepted, 0 not accepted): %f\n", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+ACCEPT_TABNR-1]);
  }
  else {
    fprintf(stream, "# fitmode was metropolis\n");
  }
  /* The chisquare makes only sense in case of zero errors */
/*   fprintf(stream, "# Chisquare: %f\n# Reduced Chisquare: %f\n",  */
/* ftstab_get_colgrd((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+CHISQ_TABNR),  */
/* ftstab_get_colgrd((NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+RCHISQ_TABNR)); */
  fprintf(stream, "# Chisquare: %f\n# Reduced Chisquare: %f\n", tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+CHISQ_TABNR), tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+RCHISQ_TABNR));

  /* We comment the header */
  fprintf(stream, "# ");

  /* We now compose a header entry for each keyword including radius */
  for (i = 1; i <= (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i) {
    /* Put the title */
    ftstab_putcoltitl(key, i);
    fprintf(stream, "%19s ", key);
    sprintf(key2, "DELTA%s", key);
    fprintf(stream, "%19s ", key2);
  }

  /* Now we include some specials */

    sprintf(key, "RADI/kpc");
    fprintf(stream, "%19s ", key);
    sprintf(key2, "DELTA%s", key);
    fprintf(stream, "%19s ", key2);

    sprintf(key, "SBR/cm^(-2)");
    fprintf(stream, "%19s ", key);
    sprintf(key2, "DELTA%s", key);
    fprintf(stream, "%19s ", key2);

    sprintf(key, "SBR/(msol/(pc^2))");
    fprintf(stream, "%19s ", key);
    sprintf(key2, "DELTA%s", key);
    fprintf(stream, "%19s ", key2);

    sprintf(key, "WA_old (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "WA_new (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_ASC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_ASC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_DSC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_DSC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_APP_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_APP_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_REC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_REC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    fprintf(stream, "\n");
    fprintf(stream, "  ");

    /* We read all values into the outarray */
    tir_get_grid(log, rpm, log -> outarray);

    for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
      rpm -> par[j] = log -> outarray[j];

    /* We convert to internal units and interpolate over */
    changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);

    for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
      rpm -> chapar[i] = chkchangep(fit -> varylist, fit -> fitmode, i, rpm -> nur);

    if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
      goto error;

    interpover(rpm, rpm -> radsep, 0, NULL, fit -> index);

    for (i = 0; i < 3; ++i) {
      nvtot[i] = 0;
    }

    /* Now we calculate the direction of the total angular momentum of the observed component */
    for (j = 0; j < rpm -> nr; ++j) {
      /* We don't do a relativistic correction */
      value = pow(rpm -> modpar[PRADI*rpm -> nr+j],2)*rpm -> modpar[PVROT*rpm -> nr+j]*rpm -> modpar[PSBR*rpm -> nr+j];
      nvtot[0] = nvtot[0]+(double) value*sin(rpm -> modpar[PINCL*rpm -> nr+j])*sin(rpm -> modpar[PPA*rpm -> nr+j]);
      nvtot[1] = nvtot[1]-(double) value*sin(rpm -> modpar[PINCL*rpm -> nr+j])*cos(rpm -> modpar[PPA*rpm -> nr+j]);
      nvtot[2] = nvtot[2]+(double) value*cos(rpm -> modpar[PINCL*rpm -> nr+j]);
    }

    value = sqrt(pow(nvtot[0],2)+pow(nvtot[1],2)+pow(nvtot[2],2));
    nvtot[0] = nvtot[0]/value;
    nvtot[1] = nvtot[1]/value;
    nvtot[2] = nvtot[2]/value;

    /* Now get the normal vector of the reference ring */
    nrefr[0] = sinf(rpm -> par[PINCL*rpm -> nur+rring-1])*sinf(rpm -> par[PPA*rpm -> nur+rring-1]);
    nrefr[1] = -sinf(rpm -> par[PINCL*rpm -> nur+rring-1])*cosf(rpm -> par[PPA*rpm -> nur+rring-1]);
    nrefr[2] = cosf(rpm -> par[PINCL*rpm -> nur+rring-1]);

    /* Now we read in the values, we should have a third extension opened */
    for (j = 1; j <= rpm -> nur; ++j) {
      for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS); ++i) {
 /* Put the title */
	value = tir_get_colgrd(log, rpm, i*rpm -> nur+j);
	delta = tir_get_colrad(log, rpm, i*rpm -> nur+j);
 fprintf(stream, "%+.12E %+.12E ", value, delta);
      }

      /* The single parameters */
      for (i = 0; i < NSPARAMS; ++i) {
	value = tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+i+1);
	delta = tir_get_colrad(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+i+1);
 fprintf(stream, "%+.12E %+.12E ", value, delta);
      }

      /* Now the specials */

      /* Calculate the radius in kpc */
      value = tir_get_colgrd(log, rpm, PRADI*rpm -> nur+j);
      delta = tir_get_colrad(log, rpm, PRADI*rpm -> nur+j);

      /* Let's be slow, as this is only output */
      value = value*1000*log -> distance*TWOPI/(360*60*60);
      delta = delta*1000*log -> distance*TWOPI/(360*60*60);
      fprintf(stream, "%+.12E %+.12E ", value, delta);

      /* Calculate the approximate frequency */
      vsys = tir_get_colgrd(log, rpm, PVSYS*rpm -> nur+j);
      nu = (SPEEDOFLIGHT-vsys)*hdr -> rfreq/SPEEDOFLIGHT;

      value = tir_get_colgrd(log, rpm, PSBR*rpm -> nur+j);
      delta = tir_get_colrad(log, rpm, PSBR*rpm -> nur+j);

      /* The intensity in the restframe scales like */
      value = hdr -> itou*value*pow(hdr -> rfreq/nu,4);
      delta = hdr -> itou*delta*pow(hdr -> rfreq/nu,4);
      fprintf(stream, "%+.12E %+.12E ", value, delta);

      /* Now we convert to Msol/pc^2 */
      value = UTOSOLAR*value;
      delta = UTOSOLAR*delta;
      fprintf(stream, "%+.12E %+.12E ", value, delta);
      fprintf(stream, "   ");

      /* Get the normal vector of the current ring */
      nv[0] = sin(rpm -> par[PINCL*rpm -> nur+j-1])*sin(rpm -> par[PPA*rpm -> nur+j-1]);
      nv[1] = -sin(rpm -> par[PINCL*rpm -> nur+j-1])*cos(rpm -> par[PPA*rpm -> nur+j-1]);
      nv[2] = cos(rpm -> par[PINCL*rpm -> nur+j-1]);

      /* Here is the scalar product with the reference ring */
      value = nv[0]*nrefr[0]+nv[1]*nrefr[1]+nv[2]*nrefr[2];

      /* This is the arcus */
      value = value>1?0.0:RADTODEG*acos(value);
      fprintf(stream, "%+.12E ", value);

      /* Here is the scalar product with the reference frame */
      value = nv[0]*nvtot[0]+nv[1]*nvtot[1]+nv[2]*nvtot[2];

      /* This is the arcus */
      value = value>1?0.0:RADTODEG*acos(value);
      fprintf(stream, "%+.12E ", value);

      /* LON and maximum velocity coordinates */
      cosi = cos(rpm -> par[PINCL*rpm -> nur+j-1]);
      sini = sin(rpm -> par[PINCL*rpm -> nur+j-1]);
      cosp = cos(rpm -> par[PPA*rpm -> nur+j-1]);
      sinp = sin(rpm -> par[PPA*rpm -> nur+j-1]);

      /* Ascending LON */

      /* Position */
      posin[0] = 0;
      posin[1] = rpm -> par[PRADI*rpm -> nur+j-1];
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Add central coordinates */
      posout[0] = posout[0]+rpm -> par[PXPOS*rpm -> nur+j-1];
      posout[1] = posout[1]+rpm -> par[PYPOS*rpm -> nur+j-1];
      posout[2] = rpm -> par[PVSYS*rpm -> nur+j-1];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Descending LON */

      /* Position */
      posin[0] = 0;
      posin[1] = -rpm -> par[PRADI*rpm -> nur+j-1];
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Add central coordinates */
      posout[0] = posout[0]+rpm -> par[PXPOS*rpm -> nur+j-1];
      posout[1] = posout[1]+rpm -> par[PYPOS*rpm -> nur+j-1];
      posout[2] = rpm -> par[PVSYS*rpm -> nur+j-1];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Approaching Maximum Velocity */

      /* Position */
      posin[0] = -rpm -> par[PRADI*rpm -> nur+j-1];
      posin[1] = 0;
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Add central coordinates */
      posout[0] = posout[0]+rpm -> par[PXPOS*rpm -> nur+j-1];
      posout[1] = posout[1]+rpm -> par[PYPOS*rpm -> nur+j-1];
      posout[2] = rpm -> par[PVSYS*rpm -> nur+j-1];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Receding Maximum Velocity */

      /* Position */
      posin[0] = rpm -> par[PRADI*rpm -> nur+j-1];
      posin[1] = 0;
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Add central coordinates */
      posout[0] = posout[0]+rpm -> par[PXPOS*rpm -> nur+j-1];
      posout[1] = posout[1]+rpm -> par[PYPOS*rpm -> nur+j-1];
      posout[2] = rpm -> par[PVSYS*rpm -> nur+j-1];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      fprintf(stream, "\n  ");
    }

  fclose(stream);
  return 1;

 error:
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Writes an ascii table with the results */
static int writebigasctable(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int def = 2;
  int nel = 1;
  int rring = 5;
  int err = 1;
  char mes[81];

  FILE *stream;
  int i, j;
  /* char key[201]; */
  char *key = NULL;
  double value;
  double vsys;
  double nu;
  double nv[3];
  double nvtot[3];
  double nrefr[3];

  double cosp;
  double sinp;
  double sini;
  double cosi;
  double pp[3];
  double posin[3];
  double posout[3];

  char **varystr = NULL;
  int keypres, nread, nreturned;

  if ((key)) {
    free(key);
    key = NULL;
  }

  if (varystr) {
    freeparsed(varystr);
    varystr = NULL;
  }

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "BIGTABLE", "Give big table name.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(key = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(key = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* If there is no input we stop here */
  if (*key == '\0') {
    free(key);
    return 1;
  }

  /* Check if there was a logfile and stop if there wasn't */
  /*   if (*log -> logname == '\0') */
  /*     return 0; */

  /* Get the reference ring */
  sprintf(mes, "Give reference ring for warp angle calculation");
  while ((err)) {
    userint_tir(startinfv -> arel, &rring, &nel, &def, "REFRING=", mes);
    if (rring <= 0 || rring > rpm -> nur) {
      sprintf(mes, "REFRING: impossible number");
      cancel_tir(startinfv -> arel, "REFRING=", 2);
      def = 4;
    }
    else
      err = 0;
  }

  /* Try to open the output file */
  if (!(stream = fopen(key, "r"))) {

    /* If the file doesn't exist we compose a header */
    if (!(stream = fopen(key, "w"))) {
      return 0;
    }
  }
  else {
    if (!(stream = fopen(key, "a")))
      return 0;
    fprintf(stream, "\n");
  }

  /* Now we put some general information, commented */
  fprintf(stream, "# tirific version 1\n");
  fprintf(stream, "# logfile: %s\n", log -> logname);

  if (fit -> fitmode >= GOLDEN_SECTION) {
    fprintf(stream, "# fitmode was golden section\n");
    fprintf(stream, "# last acceptance was (1 accepted, 0 not accepted): %f\n", log -> outarray[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+ACCEPT_TABNR-1]);
  }
  else {
    fprintf(stream, "# fitmode was metropolis\n");
  }
  /* The chisquare makes only sense in case of zero errors */
  if (tir_get_colrad(log, rpm, (PRADI)*rpm -> nur+1) == 0.0) {
    fprintf(stream, "# Chisquare: %f\n# Reduced Chisquare: %f\n", tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+CHISQ_TABNR), tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+NSPARAMS+RCHISQ_TABNR));
  }

  /* We comment the header */
  fprintf(stream, "# ");

  /* We now compose a header entry for each keyword including radius */
  for (i = 1; i <= (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i) {
    /* Put the title */
    ftstab_putcoltitl(key, i);
    fprintf(stream, "%19s ", key);
  }

  /* Now we include some specials */

    sprintf(key, "RADI/kpc");
    fprintf(stream, "%19s ", key);

    sprintf(key, "SBR/cm^(-2)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "SBR/(msol/(pc^2))");
    fprintf(stream, "%19s ", key);

    sprintf(key, "WA_old (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "WA_new (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_ASC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_ASC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_DSC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LON_DSC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_APP_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_APP_DEC (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_REC_RA (deg)");
    fprintf(stream, "%19s ", key);

    sprintf(key, "LMV_REC_DEC (deg)");
    fprintf(stream, "%19s ", key);

    fprintf(stream, "\n");
    fprintf(stream, "  ");

    /* We read all values into the par array */
    tir_get_grid(log, rpm, log -> outarray);

    for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
      rpm -> par[j] = log -> outarray[j];

    /* We con't convert to internal units and interpolate over */
/*     changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks); */

    for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
      rpm -> chapar[i] = 1;

    if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
      goto error;

    interpover(rpm, dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks), 0, NULL, fit -> index);

    for (i = 0; i < 3; ++i) {
      nvtot[i] = 0;
    }

    /* Now we calculate the direction of the total angular momentum of the observed component */
    for (j = 0; j < rpm -> nr; ++j) {

      /* We don't do a relativistic correction for this */
      value = pow(rpm -> modpar[PRADI*rpm -> nr+j],2)*rpm -> modpar[PVROT*rpm -> nr+j]*rpm -> modpar[PSBR*rpm -> nr+j];
      nvtot[0] = nvtot[0]+(double) value*sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
      nvtot[1] = nvtot[1]-(double) value*sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
      nvtot[2] = nvtot[2]+(double) value*cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);
    }

    value = sqrt(pow(nvtot[0],2)+pow(nvtot[1],2)+pow(nvtot[2],2));
    nvtot[0] = nvtot[0]/value;
    nvtot[1] = nvtot[1]/value;
    nvtot[2] = nvtot[2]/value;

    /* Now get the normal vector of the reference ring */
    nrefr[0] = sinf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1])*sinf(DEGTORAD*rpm -> par[PPA*rpm -> nur+rring-1]);
    nrefr[1] = -sinf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1])*cosf(DEGTORAD*rpm -> par[PPA*rpm -> nur+rring-1]);
    nrefr[2] = cosf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1]);

    /* Now we read in the values */
    for (j = 0; j < rpm -> nr; ++j) {
      for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS); ++i) {
 value = rpm -> modpar[i*rpm -> nr+j];
 fprintf(stream, "%+.12E ", value);
      }
      /* The single parameters */
      for (i = 0; i < NSPARAMS; ++i) {
	value = tir_get_colgrd(log, rpm, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+i+1);
 fprintf(stream, "%+.12E ", value);
      }
      /* Now the specials */

      /* Calculate the radius in kpc */
      value = rpm -> modpar[PRADI*rpm -> nr+j];

      /* Let's be slow, as this is only output */
      value = value*1000*log -> distance*TWOPI/(360*60*60);
      fprintf(stream, "%+.12E ", value);

      /* Calculate the approximate frequency */
      vsys = rpm -> modpar[PVSYS*rpm -> nr+j];
      nu = (SPEEDOFLIGHT-vsys)*hdr -> rfreq/SPEEDOFLIGHT;

      value = rpm -> modpar[PSBR*rpm -> nr+j];

      /* The intensity in the restframe scales like */
      value = hdr -> itou*value*pow(hdr -> rfreq/nu,4);
      fprintf(stream, "%+.12E ", value);

      /* Now we convert to Msol/pc^2 */
      value = UTOSOLAR*value;
      fprintf(stream, "%+.12E ", value);

      /* Get the normal vector of the current ring */
      nv[0] = sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
      nv[1] = -sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
      nv[2] = cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);

      /* Here is the scalar product with the reference ring */
      value = nv[0]*nrefr[0]+nv[1]*nrefr[1]+nv[2]*nrefr[2];

      /* This is the arcus */
      value = value>1?0.0:RADTODEG*acos(value);
      fprintf(stream, "%+.12E ", value);

      /* Here is the scalar product with the reference frame */
      value = nv[0]*nvtot[0]+nv[1]*nvtot[1]+nv[2]*nvtot[2];

      /* This is the arcus */
      value = value>1?0.0:RADTODEG*acos(value);
      fprintf(stream, "%+.12E ", value);

      /* LON and maximum velocity coordinates */
      cosi = cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);
      sini = sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);
      cosp = cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
      sinp = sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);

      /* Ascending LON */

      /* Position */
      posin[0] = 0;
      posin[1] = dparamtointern(rpm -> modpar[PRADI*rpm -> nr+j], RADI, hdr, rpm -> ndisks);
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Get central coordinates */
      posin[0] = rpm -> modpar[PXPOS*rpm -> nr+j];
      posin[1] = rpm -> modpar[PYPOS*rpm -> nr+j];
      posin[2] = rpm -> modpar[PVSYS*rpm -> nr+j];
      globtointern(posin, pp, hdr);

      /* Add central coordinates */
      posout[0] = posout[0]+pp[0];
      posout[1] = posout[1]+pp[1];
      posout[2] = pp[2];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Descending LON */

      /* Position */
      posin[0] = 0;
      posin[1] = -dparamtointern(rpm -> modpar[PRADI*rpm -> nr+j], RADI, hdr, rpm -> ndisks);
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Get central coordinates */
      posin[0] = rpm -> modpar[PXPOS*rpm -> nr+j];
      posin[1] = rpm -> modpar[PYPOS*rpm -> nr+j];
      posin[2] = rpm -> modpar[PVSYS*rpm -> nr+j];
      globtointern(posin, pp, hdr);

      /* Add central coordinates */
      posout[0] = posout[0]+pp[0];
      posout[1] = posout[1]+pp[1];
      posout[2] = pp[2];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Approaching Maximum Velocity */
      posin[0] = -dparamtointern(rpm -> modpar[PRADI*rpm -> nr+j], RADI, hdr, rpm -> ndisks);;
      posin[1] = 0;
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Get central coordinates */
      posin[0] = rpm -> modpar[PXPOS*rpm -> nr+j];
      posin[1] = rpm -> modpar[PYPOS*rpm -> nr+j];
      posin[2] = rpm -> modpar[PVSYS*rpm -> nr+j];
      globtointern(posin, pp, hdr);

      /* Add central coordinates */
      posout[0] = posout[0]+pp[0];
      posout[1] = posout[1]+pp[1];
      posout[2] = pp[2];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      /* Receding Maximum Velocity */
      posin[0] = dparamtointern(rpm -> modpar[PRADI*rpm -> nr+j], RADI, hdr, rpm -> ndisks);;
      posin[1] = 0;
      posin[2] = 0;

      /* Velocity will not be regarded*/

      /* Rotate about x-axis */
      maths_rotax(cosi, sini, posin, pp);

      /* Rotate about z-axis */
      maths_rotaz(cosp, sinp, pp, posout);

      /* Get central coordinates */
      posin[0] = rpm -> modpar[PXPOS*rpm -> nr+j];
      posin[1] = rpm -> modpar[PYPOS*rpm -> nr+j];
      posin[2] = rpm -> modpar[PVSYS*rpm -> nr+j];
      globtointern(posin, pp, hdr);

      /* Add central coordinates */
      posout[0] = posout[0]+pp[0];
      posout[1] = posout[1]+pp[1];
      posout[2] = pp[2];

      /* Change into user coordinates */
      interntoglob(posout, pp, hdr);

      /* Print */
      fprintf(stream, "%+.12E ", pp[0]);
      fprintf(stream, "%+.12E ", pp[1]);

      fprintf(stream, "\n  ");
    }
  fclose(stream);

  /* Finally */
  if ((key))
    free(key);
  if ((varystr))
    freeparsed(varystr);
  return 1;

 error:
  /* Strangely, for this function, 0 returned means error. This is an old functino... */
  if ((key))
    free(key);
  if ((varystr))
    freeparsed(varystr);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Make a qfits header suitable for coolgal output */
static qfits_header *makecoolhdr(hdrinf *hdr, double beamsizeindeg)
{
  /* char key[9]; */
  char value[21];
  /* int j; */
  /* int level = 0; */
  /* int err = 0; */
  int sizez;
  qfits_header *header = NULL;

  /* The bitpix is -32 */
  if (!(header = ftsout_putcard(header, "BITPIX","-32")))
    goto error;

  /* The number of axes is set to three */
  if (!ftsout_putcard(header, "NAXIS","3"))
    goto error;

  /* Now get the axis numbers */
  sprintf(value, "%i", hdr -> bsize1*hdr->coolbin);
  if (!ftsout_putcard(header, "NAXIS1",value))
    goto error;
  sprintf(value, "%i", hdr -> bsize2*hdr->coolbin);
  if (!ftsout_putcard(header, "NAXIS2",value))
    goto error;

  /* The third axis is simply the maximum spatial size */
  sprintf(value, "%i", sizez = ((hdr -> bsize2 > hdr -> bsize1)?hdr -> bsize2:hdr -> bsize1)*hdr->coolbin);
  if (!ftsout_putcard(header, "NAXIS3",value))
    goto error;

  /* May contain an extension */
  if (!ftsout_putcard(header, "EXTEND","T"))
    goto error;

  /* These are clear */
  if (!ftsout_putcard(header, "BSCALE","1"))
    goto error;
  if (!ftsout_putcard(header, "BZERO","0"))
    goto error;

  /* The bunit is Jy*km/s/beam, while this is the 3d beam */
  if (!ftsout_putcard(header, "BUNIT","'JY*(KM/S)/BEAM'"))
    goto error;

  /* The cdelt is taken from the hdr struct, this should be ok with the unit being DEGREE*/
  sprintf(value, "%.12E", hdr -> userglobcdelt[0]/((double) hdr -> coolbin));
  if (!ftsout_putcard(header, "CDELT1", value))
    goto error;

  /* The crpix is copied from the header of the inset */
  sprintf(value, "%.12E", hdr -> setcrpix[0]*((double) hdr -> coolbin));
  if (!ftsout_putcard(header, "CRPIX1", value))
    goto error;

  /* The crval in user units -> degree */
  sprintf(value, "%.12E", hdr -> userglobcrval[0]);
  if (!ftsout_putcard(header, "CRVAL1", value))
    goto error;

  /* This is nasty, because we have to re-read the info */
  /* sprintf(key, "CTYPE%i", hdr -> inaxperm[0]); */
  /* for (j = 0; j < 20; ++j) */
  /*   value[j] = ' '; */
  /* value[20] = '\0'; */
  /* gdsd_rchar_tir(hdr -> inset, key, &(level), value, &err); */

  /* Type */
  if (!ftsout_putcard(header, "CTYPE1", hdr -> oric -> type_x))
    goto error;
  /* if (!ftsout_putcard(header, "CUNIT1", "'DEGREE            '")) */
  /*   goto error; */

  /* The cdelt is taken from the hdr struct, this should be ok with the unit being DEGREE*/
  sprintf(value, "%.12E", hdr -> userglobcdelt[1]/((double) hdr -> coolbin));
  if (!ftsout_putcard(header, "CDELT2", value))
    goto error;

  /* The crpix is copied from the header of the inset */
  sprintf(value, "%.12E", hdr -> setcrpix[1]*((double) hdr -> coolbin));
  if (!ftsout_putcard(header, "CRPIX2", value))
    goto error;

  /* The crval in user units -> degree */
  sprintf(value, "%.12E", hdr -> userglobcrval[1]);
  if (!ftsout_putcard(header, "CRVAL2", value))
    goto error;

  /* This is nasty, because we have to re-read the info */
  /* sprintf(key, "CTYPE%i", hdr -> inaxperm[1]); */
  /* for (j = 0; j < 20; ++j) */
  /*   value[j] = ' '; */
  /* value[20] = '\0'; */
  /* gdsd_rchar_tir(hdr -> inset, key, &(level), value, &err); */
  if (!ftsout_putcard(header, "CTYPE2", hdr -> oric -> type_y))
    goto error;
  /* if (!ftsout_putcard(header, "CUNIT2", "'DEGREE            '")) */
  /*   goto error; */

  if (!ftsout_putcard(header, "EPOCH", hdr -> oric -> epoch))
    goto error;

  /* The third axis is the artificial one */

  /* The cdelt is copied from the inset */
  sprintf(value, "%.12E", fabs(hdr -> userglobcdelt[0])/((double) hdr -> coolbin));
  if (!ftsout_putcard(header, "CDELT3", value))
    goto error;

  /* crpix is in the middle */
  sprintf(value, "%.12E", ((double) sizez)/2.0);
  if (!ftsout_putcard(header, "CRPIX3", value))
    goto error;

  /* This is exactly 0 */
  if (!ftsout_putcard(header, "CRVAL3", "0.0"))
    goto error;

  /* The type is somthing without projection, this should do */
  if (!ftsout_putcard(header, "CTYPE3", "'ANGLE             '"))
    goto error;

  /* This is DEGREE again */
  /* if (!ftsout_putcard(header, "CUNIT3", "'DEGREE            '")) */
  /*   goto error; */

  /* Fourth axis is velocity, one pixel with the width of the whole cube to give plotting programs an orientation */
/*   if (!ftsout_putcard(header, "CDELT4", "1.0")) */
/*     goto error; */
/*   if (!ftsout_putcard(header, "CRPIX4", "1.0")) */
/*     goto error; */
/*   if (!ftsout_putcard(header, "CRVAL4", "0.0")) */
/*     goto error; */
/*   if (!ftsout_putcard(header, "CTYPE4", "' '")) */
/*     goto error; */
/*   if (!ftsout_putcard(header, "CUNIT4", "'Y'")) */
/*     goto error; */

/* Now we just put the beam properties, symmetric beam */
  sprintf(value, "%.12E", beamsizeindeg);
  if (!ftsout_putcard(header, "BMAJ", value))
    goto error;
  sprintf(value, "%.12E", beamsizeindeg);
  if (!ftsout_putcard(header, "BMIN", value))
    goto error;
  if (!ftsout_putcard(header, "BPA", "0"))
    goto error;

  return header;

 error:
  if ((header))
    ftsout_header_destroy(header);
  header = NULL;
  return header;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces a 3d fits image of the model */
static int coolgal(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int i;
  char *coolname = NULL;
  char mes[81];
  int def;
  int nel;
  int err;
  qfits_header *header;
  Cube thecube;
  double beam;
  float *expfcs;
  float sincosofangle[2];

  char **varystr = NULL;
  int keypres, nread, nreturned;

  /* First check if the user wants a coolgal output */
  /* sprintf(mes, "Give cool name."); */
  /* for (i = 0; i < 200; ++i) */
  /*   coolname[i] = ' '; */
  /* coolname[200] = '\0'; */
  /* def = 2; */
  /* nel = 1; */

  /* userchar_tir(coolname, &nel, &def, "COOLGAL=", mes); */
  /* termsinglestr(coolname); */

  /* cancel_tir(startinfv -> arel, "COOLGAL"); */

  if ((coolname)) {
    free(coolname);
    coolname = NULL;
  }

  if (varystr) {
    freeparsed(varystr);
    varystr = NULL;
  }

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "COOLGALPAST", "Give cool name.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(coolname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(coolname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* The default is to do nothing */
  if (*coolname == '\0') {
    free(coolname);
    return 1;
  }
  /* Now ask if the user wants a specific kind of beam, the default being the max beam */
  sprintf(mes, "Give 3d beam size (arcsec)");
  beam = hdr -> deltgridtouser[0]*((double) hdr -> bmaj);
  def = 2;
  nel = 1;
  err = 1;
  beam = 10;
  while((err)) {
    userdble_tir(startinfv -> arel, &beam, &nel, &def, "COOLBEAM=", mes);
    if (beam >= 0.0) {
      err = 0;
    }
    else {
      sprintf(mes, "COOLBEAM should be >= 0");
      cancel_tir(startinfv -> arel, "COOLBEAM=", 2);
      beam = hdr -> deltgridtouser[0]*((double) hdr -> bmaj);
      def = 1;
    }
  }

  /* Transfer the beam into deg */
  beam = hdr -> globgridtouser[0]*beam/hdr -> deltgridtouser[0];

  /* Make a header, if the beam is 0, we normalise everything such that the units get right */
  if (!(header = makecoolhdr(hdr, ((beam))?beam:sqrt(TWOPI)/(hdr -> globgridtouser[0]*0.42466090014401))))
    return 1;

  /* Transfer the beam back to grid units */
  beam = beam/hdr -> globgridtouser[0];

  /* Now arrange the cube */
  thecube.refpix_x = 0;
  thecube.refpix_y = 0;
  thecube.refpix_v = 0;
  thecube.size_x = hdr -> bsize1;
  thecube.size_y = hdr -> bsize2;
  thecube.size_v = (thecube.size_x > thecube.size_y)?thecube.size_x:thecube.size_y;
  thecube.scale = 1.0;
  thecube.padding = 0;

  /* After that, we can deallocate to get some memory, but first I try
     not to do so and see how that works. */

/* We read in the values, this should be possible and make sense */
    tir_get_grid(log, rpm, log -> outarray);

  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i)
    rpm -> par[i] = log -> outarray[i];

  /*     Convert the read parameter list to internal units */
  changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);

  /* provide some info */
  nel=1;
  sprintf(mes, "cool number of bytes used: %lu", thecube.size_x*thecube.size_y*thecube.size_v*sizeof(float));
  anyout_tir(&nel, mes);

  /* Now we allocate the cube, not caring for the padding, this will be done automatically */
  if (!(thecube.points = (float *) malloc(thecube.size_x*thecube.size_y*thecube.size_v*sizeof(float)))) {
    ftsout_header_destroy(header);
    return 1;
  }

  /* Make the cube */
  makecoolpoints(&thecube, hdr, rpm, fit);

  /* Convolve it */
  sincosofangle[0] = 0;
  sincosofangle[1] = 1;

  if (!(expfcs = expofacsfft(0.42466090014401*beam, 0.42466090014401*beam, 0.42466090014401*beam, sincosofangle))) {
    ftsout_header_destroy(header);
    free(thecube.points);
    return 1;
  }

  /* Now, the normalisation is the fifth factor, we multiply it with this */
  expfcs[4] = expfcs[4]*sqrtf(TWOPI)*0.42466090014401*beam;

  /* This is the actual convolution */

  if ((beam)) {
    convolgaussfft(&thecube, expfcs);
  }

  /* Output it */
  ftsout_writecube(coolname, &thecube, header);

  /* Deallocate everything */
    ftsout_header_destroy(header);
    free(thecube.points);
    free(expfcs);

 /* Finally */
  if ((coolname))
    free(coolname);
  if ((varystr))
    freeparsed(varystr);
  return 1;

 error:
  /* Strangely, for this function, 0 returned means error. This is an old functino... */
  if ((coolname))
    free(coolname);
  if ((varystr))
    freeparsed(varystr);
  return 0;

}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Makes a 3d pointsource model and packs in on cube */
static int makecoolpoints(Cube *cube, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int i,j,k;
  float ringflux; /* Total flux of a subring */
  int nc; /* Cloudnumber of a subring */
  float cfluxcorr; /* The correct flux of a pointsource */
  float sininc;
  float cosinc;
  float sinpa;
  float cospa;
  float r; /* A radius */
  float az; /* Azimuth of pointsource */
  float cosaz; /* The cosine of the az (memory wasting) */
  float sinaz; /* The sine of the az (memory wasting) */
  int grid[3]; /* Grid positions */
  int totflux = 0;
  float z0; /* The central plane for the z */
  float pp[6]; /* Cartesian coordinates in phase-space, x,y,z,vx,vy,vz */
                      /*                                       x: DEC, y: LOS, z: RA */
  float pp2[6]; /* Cartesian coordinates in phase-space, x,y,z,vx,vy,vz */

  int disk;

  z0 = ((float) cube -> size_v)/2;

  interpover(rpm, rpm -> radsep, 0, NULL, fit -> index);

  /* Initialise the model array */
  cuberase(cube);

  for (disk = 0; disk < rpm -> ndisks; ++disk) {

    /* Do all the loops */
    for (i = 0; i < rpm -> nr; ++i) {

      /* Calculate the ringflux */
      ringflux = TWOPI*rpm -> modpar[PRADI*rpm -> nr+i]*rpm -> radsep*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*rpm -> nr+i];
      /* Calculate the cloudnumber, rounded down, Kamphuis bugfix */
      nc = (int) (ringflux/rpm -> cflux[disk]);

      /* We decide to change the cloudflux a bit instead of accepting an error in the ringflux */
      cfluxcorr = ringflux/nc;
      if (nc > 0) {

	/* We calculate cos's and sins and reset the random number generator */
	sininc=sinf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nr+i]);
	cosinc=cosf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nr+i]);;
	sinpa=sinf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PPA)*rpm -> nr+i]);
	cospa=cosf(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PPA)*rpm -> nr+i]);
	rpm -> sd[disk][i].iseed2[1] = i;
	maths_rndmf_init(rpm -> sd[disk][i].iseed2, rpm -> sd[disk][i].permrandstr);

	/* reset the  zprof */
	zprof(6, rpm -> sd[disk][i].permrandstr, &(rpm -> sd[disk][i].y2));

	/* now create the clouds and grid them */
	for (j = 0; j < nc; ++j) {

	  /* The probability for the #radius is weighted by r, and this is no approximation */
	  r = sqrtf((rpm -> modpar[PRADI*rpm -> nr+i]-0.5*rpm -> radsep)*(rpm -> modpar[PRADI*rpm -> nr+i]-0.5*rpm -> radsep)+2*rpm -> radsep*rpm -> modpar[PRADI*rpm -> nr+i]*maths_rndmf(rpm -> sd[disk][i].permrandstr));

	  /* Azimuth is easy */
	  az = TWOPI*maths_rndmf(rpm -> sd[disk][i].permrandstr);
	  cosaz = cosf(az);
	  sinaz = sinf(az);

	  /* Now, these are the cartesian coordinates, if you look face-on at the ring in the system of the ring, x eastwards, y to the north, z along los from you to the source */
	  /*       x = cosaz*r; */
	  /*       y = sinaz*r; */
	  /*       z = zprof(ltype)*modpar[PZ0*rpm -> nr+i]; */
	  /*       vx = -sinaz*modpar[PVROT*rpm -> nr+i]; */
	  /*       vy = cosaz*modpar[PVROT*rpm -> nr+i]; */
	  /*       vz = 0; */

	  /* Now, the whole system will be rotated about the x-axis with the amount of the inclination */
	  /*       xp  = x; */
	  /*       yp  = cosinc*y-sininc*z; */
	  /*       zp  = sininc*y+cosinc*z; */
	  /*       vxp = vx; */
	  /*       vyp = cosinc*vy-sininc*vz; */
	  /*       vzp = sininc*vy+cosinc*vz; */

	  /*  Now we rotate about the z-axis with pa, because in this module the pa is defined as the angle with the minor axis */
	  /*       x = xp*cos(-pa)-yp*sin(-pa)    or x = xp*cospa-yp*sinpa;      */
	  /*       y = xp*sin(-pa)+yp*cos(-pa)    or y = xp*sinpa+yp*cospa;     */
	  /*       z = zp;                        or z = zp;                     */
	  /*       vx = vxp*cos(-pa)-vyp*sin(-pa) or vx = vxp*cospa-vyp*sinpa;   */
	  /*       vy = vxp*sin(-pa)+vyp*cos(-pa) or vy = vxp*sinpa+vyp*cospa;  */
	  /*       vz = vzp;                      or vz = vzp;                   */

	  /*  z = zprof(rpm -> ltype[0], rpm -> permrandstr)*rpm -> modpar[PZ0*rpm -> nr+i]; */
	  /*  x = (cosaz*r)*cospa-(cosinc*(sinaz*r)-sininc*z)*sinpa;  */
	  /*  y = (cosaz*r)*sinpa+(cosinc*(sinaz*r)-sininc*z)*cospa; */
	  /* Instead of vz this is the z component in the middle of the cube */
	  /*  z = sininc*sinaz*r+cosinc*z; */
	  /*  vz = (sininc*cosaz*rpm -> modpar[PVROT*rpm -> nr+i]); */
	  /* Calculate the coordinates of the point source before rotation */
	  pp[0] = cosaz*r;
	  pp[1] = sinaz*r;
	  pp[2] = zprof(rpm -> ltype[disk],  rpm -> sd[disk][i].permrandstr, &(rpm -> sd[disk][i].y2))*rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PZ0)*rpm -> nr+i];

	  (*(rpm -> inf_wm1v[disk] -> prs))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm2v[disk] -> prs))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm3v[disk] -> prs))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm4v[disk] -> prs))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm1v[disk] -> prc))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm2v[disk] -> prc))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm3v[disk] -> prc))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm4v[disk] -> prc))((void *) rpm, pp+2, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_wm0v[disk] -> pr)) ((void *) rpm, pp+2, i, sinaz, cosaz, disk);

	  /* Now rotate about the x-axis by i */
	  pp2[0] = pp[0];
	  pp2[1] = pp[1]*cosinc-pp[2]*sininc;
	  pp2[2] = pp[1]*sininc+pp[2]*cosinc;

	  /* Now we shift */

	  (*(rpm -> inf_lc0v[disk] -> pr))((void *) rpm, pp2+0, i, sinaz, cosaz, disk);
	  (*(rpm -> inf_ls0v[disk] -> pr))((void *) rpm, pp2+1, i, sinaz, cosaz, disk);

	  /* Now rotate about the z-axis by pa */
	  pp[0] = pp2[0]*cospa-pp2[1]*sinpa;
	  pp[1] = pp2[0]*sinpa+pp2[1]*cospa;
	  pp[2] = pp2[2];

	  /* Here's the shortcut version */
	  /*     pp[0] = pp2[0]*cospa-pp2[1]*sinpa; */
	  /*     pp[1] = pp2[0]*sinpa+pp2[1]*cospa; */
	  /*     pp[2] = pp[1]*sininc+pp[2]*cosinc; */

	  /* of course we could make it even shorter, but we'll leave it at that. Next thingy is to grid the pointsource */
	  grid[0] = roundnormal(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nr+i]-pp[1]);

	  if (grid[0] >= 0 && grid[0] < cube -> size_x) {

	    grid[1] = roundnormal(rpm -> modpar[(PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nr+i]+pp[0]);
	    if (grid[1] >= 0 && grid[1] < cube -> size_y) {
	      /* For the sake of clearity, we kill the subsnuma operation in the source, in principle thus allowing only for the radio convention for velocity, but gaining an understanding of the code. What is seen here should not be done. It's really not what anyone should wish for. */
	      grid[2] = roundnormal((z0-pp[2]));
	      if (grid[2] >= 0 && grid[2] < cube -> size_v) {
		++totflux;
		/* This is the position in the linear cube array */
		k = grid[0]+ cube -> size_x*(grid[1]+cube -> size_y*grid[2]);

		cube -> points[k] = cube -> points[k]+cfluxcorr;
	      }
	    }
	  }
	}
      }
    }
  }

  /* We return the number of clouds */
  return totflux;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces a progress file at every ring loop and write the last line. Kamphuis addition */
static int progressout(startinf *startinfv, char *message)
{
  /* int i; */
  /* int def = 2; */
  /* int nel = 1; */
  FILE *stream;
  char *progname = NULL;
  /* int obsint = 0;
     char obsmes[180];*/
  /* char mes[100]; */
  char *currentname;

  char **varystr = NULL;
  int keypres, nread, nreturned;

  /* for (i = 0; i < 200; ++i) { */
  /*   progname[i] = ' '; */
  /* } */
  /* progname[200] = '\0'; */

  /* Ask the user what to do */
  /* sprintf(mes, "Give a progress file name for no point actually when you can read this"); */
  /* userchar_tir(progname, &nel, &def, "PROGRESSLOG=", mes); */
  /* termsinglestr(progname); */
  /* cancel_tir(startinfv -> arel, "PROGRESSLOG"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "PROGRESSLOG", "Give a progress file name for no point actually when you can read this.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(progname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(progname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* i = 0; */
  currentname = progname;

  if (*currentname != '\0') {

      /* Try to open the output, we overwrite */
    if (!(stream = fopen(currentname, "w")))
      goto error;

      /* Now put the first line, copy from input */
    fprintf(stream,"%s",message);
    fprintf(stream, "\n");
    /* and close again otherwise the file stays unreadable */
        fflush(stream);
    fclose(stream);
     fflush(NULL);
    }

  if ((progname))
    free(progname);
  if ((varystr))
    freeparsed(varystr);
  return 0;

  error:

  if ((progname))
    free(progname);
  if ((varystr))
    freeparsed(varystr);
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Appends a message to the progress file at the end of the fitting procedure. Kamphuis addition */
static int progressfinished(startinf *startinfv)
{
  /* int i; */
  /* int def = 2; */
  /* int nel = 1; */
  FILE *stream;
  char *progname = NULL;
  /* int obsint = 0;
     char obsmes[180];*/
  /* char mes[100]; */
  char *currentname;

  char **varystr = NULL;
  int keypres, nread, nreturned;

  /* for (i = 0; i < 200; ++i) { */
  /*   progname[i] = ' '; */
  /* } */
  /* progname[200] = '\0'; */

  /* Ask the user what to do */
  /* sprintf(mes, "Give a progress file name for no point actually when you can read this"); */
  /* userchar_tir(progname, &nel, &def, "PROGRESSLOG=", mes); */
  /* termsinglestr(progname); */

  /* i = 0; */
  /* cancel_tir(startinfv -> arel, "PROGRESSLOG"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "PROGRESSLOG", "Give a progress file name for no point actually when you can read this.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(progname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(progname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  currentname = progname;

  if (*currentname != '\0') {

      /* Try to open the output, we append */
    if (!(stream = fopen(currentname, "a")))
      goto error;

      /* Now put the first line, copy from input */
    fprintf(stream,"<STATUS> Tirific Finished");
    fprintf(stream, "\n");
    /* and close again otherwise the file stays unreadable */
    fclose(stream);
    }

  if ((progname))
    free(progname);
  if ((varystr))
    freeparsed(varystr);
  return 1;

  error:

  if ((progname))
    free(progname);
  if ((varystr))
    freeparsed(varystr);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces one or two tirific logfiles containing the results */
static int tirout(startinf *startinfv, loginf *log, ringparms *rpm, fitparms *fit, int nrplts)
{
  int i, j, k, l, m, n;
  int def = 2;
  int nel = 1;
  int acc;
  int len;
  char *defname = NULL;
  char *deintername = NULL;
  char key[9];
  char *currentname;
  char mes[81];
  FILE *stream;
  /* char input[VARYHSTRELES]; */ /* Has the length of the maximum input */
  char format[8];
  char format2[8];
  /* double *smarray = NULL; */
  double *reparray = NULL;
  double smsum, smweightsum, weight, lm1;
  char inqstr[13];

  int nrings;
  int ringnr;
  double *radii = NULL;
  int givrad;
  double dpdr;
  int disk;
  char placer[10];

  char **varystr = NULL;
  int keypres, nread, nreturned;

  time_t restimest = 0;

  /* Initialise the input arrays */
  /* for (i = 0; i < 200; ++i) { */
  /*   defname[i] = ' '; */
  /*   deintername[i] = ' '; */
  /* } */
  /* defname[200] = '\0'; */
  /* deintername[200] = '\0'; */

  /* Ask the user what to do */
  /* sprintf(mes, "Give a .def file name for best results output"); */
  /* userchar_tir(defname, &nel, &def, "TIRDEF=", mes); */
  /* termsinglestr(defname); */

  /* sprintf(mes, "Give a file name for smoothed results output"); */
  /* userchar_tir(deintername, &nel, &def, "TIRSMO=", mes); */
  /* termsinglestr(deintername); */

  /* cancel_tir(startinfv -> arel, "TIRDEF"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "TIRDEF", "Give a progress file name for no point actually when you can read this.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(defname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(defname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* cancel_tir(startinfv -> arel, "TIRSMO"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "TIRSMO", "Give a progress file name for no point actually when you can read this.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(deintername = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(deintername = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  sprintf(mes, "Give accuracy of def file output [2]");
  i = 1;
  acc = 5;
  def = 2;
  while ((i)) {
    userint_tir(startinfv -> arel, &acc, &nel, &def, "TIRACC=", mes);
    if (acc < 1 || acc > 99) {
      sprintf(mes, "TIRACC: Must be larger than 0");
      def = 4;
      cancel_tir(startinfv -> arel, "TIRACC=", 2);
    }
    else
      --i;
  }

  def = 2;
  if (*deintername != '\0') {
    /* Smoothing kernel is a Hanning function h(k) = (Sum_l =
       -(len-1)/2, ..., (len-1)/2
       f(k+l)*(1+cos(2pi*l/(len-1))))/(Sum_l = -(len-1)/2, ...,
       (len-1)/2 (1+cos(2pi*l/(len-1)))), while the at the edges the
       function plus weights are evaluated only where defined */

    sprintf(mes, "Give length of smoothing kernel [5]");
    i = 1;
    len = 5;
    while ((i)) {
      userint_tir(startinfv -> arel, &len, &nel, &def, "TIRLEN=", mes);
      if (len < 2 || len > 99) {
	sprintf(mes, "TIRLEN: Must be larger than 1");
	def = 4;
	cancel_tir(startinfv -> arel, "TIRLEN=", 2);
      }
      else if ((float) (len/2) == ((float) len) / 2.) {
	sprintf(mes, "TIRLEN: Must be odd %f %f", ((float) (len/2)), (((float) len) / 2.) );
	def = 4;
	cancel_tir(startinfv -> arel, "TIRLEN=", 2);
      }
      else
	--i;
    }

    /* Allocate the array for smoothing */
    /* if (!(smarray = (double *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(double)))) */
    /* 	  goto error; */
  }

  /* Query the number of rings */
  sprintf(mes, "Give number of rings [%i]", rpm -> nur);
  i = 1;
  def = 2;
  nel = 1;
  nrings = rpm -> nur;
  while ((i)) {
    userint_tir(startinfv -> arel, &nrings, &nel, &def, "TIRNR=", mes);
    if (nrings < 2) {
      sprintf(mes, "TIRNR: Must be larger than 1");
      def = 4;
      cancel_tir(startinfv -> arel, "TIRNR=", 2);
    }
    else
      --i;
  }

  /* Now allocate the radius array */
  if (!(radii = (double *) malloc(nrings*sizeof(double))))
    goto error;

  /* We read all values into the outarray */
  tir_get_grid(log, rpm, log -> outarray);

  /* BUGFIX: We copy that to the par array */
  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i){
    rpm -> par[i] = log -> outarray[i];
  }

  /* Now ask the user to give the radii */
  sprintf(mes, "Give radii");
  i = 1;
  def = 2;
  nel = nrings;

  while ((i)) {

    /* Fill it with the old values */
    for (ringnr = 0; (ringnr < nrings) && (ringnr < rpm -> nur); ++ringnr) {
      radii[ringnr] = rpm -> par[PRADI*rpm -> nur+ringnr];
    }

    /* Fill the rest, extrapolating with the last stepwidth, this should work */
    while (ringnr < nrings) {
      radii[ringnr] = 2*radii[ringnr-1]-radii[ringnr-2];
      ++ringnr;
    }

    /* Check if we can interpolate */
    givrad = userdble_tir(startinfv -> arel, radii, &nel, &def, "TIRRAD=", mes);
    if ((givrad < 2) && (givrad != 0)) {
      sprintf(mes, "TIRRAD: give more than 1 element");
      def = 4;
      cancel_tir(startinfv -> arel, "TIRRAD=", 2);
    }
    else {

      /* Check the first radius */
      if (radii[0] != 0.0) {
	sprintf(mes, "TIRRAD: First radius has to be 0.0");
	def = 4;
	cancel_tir(startinfv -> arel, "TIRRAD=", 2);
      }
      else {

	/* Extrapolate */
	if ((givrad))
	  while (givrad < nrings) {
	    radii[givrad] = 2*radii[givrad-1]-radii[givrad-2];
	    ++givrad;
	  }

	/* Check if the radii are in ascending order */
	for (ringnr = 1; ringnr < nrings; ++ringnr) {
	  if (radii[ringnr] <= radii[ringnr-1]) {
	    i = 2;
	    break;
	  }
	}
	if (i == 2) {
	  sprintf(mes, "TIRRAD: Radii must be in ascending order %i %f %f %f", ringnr, radii[ringnr], radii[ringnr-1], radii[ringnr-2]);
	  def = 4;
	  i = 1;
	  cancel_tir(startinfv -> arel, "TIRRAD=", 2);
	}
	else
	  i = 0;
      }
    }
  }

  /* Now we should have a proper array with radii */

  /* Construct the format strings, a bit tricky */
  *format = '%';
  sprintf(format+1, "+.%iE", acc);
  if (acc > 9)
    sprintf(format+6, " ");
  else
    sprintf(format+5, " ");
  *format2 = '%';
  sprintf(format2+1, "+.%iE", acc+3);
  if (acc > 6)
    sprintf(format2+6, " ");
  else
    sprintf(format2+5, " ");

  i = 0;
  currentname = defname;

  /* From here on we freeze the input def */
  if (startinfv -> arel[2]) {
    if (!strcmp(startinfv -> arel[2] -> orifilename,currentname)) {
      fprintf(stderr, "Warning: Input deffile will be overwritten by output deffile\n");
      simparse_scn_arel_timestamp_late(startinfv -> arel[2]);
    }
    else if (!strcmp(startinfv -> arel[2] -> orifilename,deintername)) {
      fprintf(stderr, "Warning: Input deffile will be overwritten by output smoothed deffile\n");
      simparse_scn_arel_timestamp_late(startinfv -> arel[2]);
    }
    restimest = startinfv -> arel[2] -> timestamp;
  }

  while (i < 2) {

    if (*currentname != '\0') {

      /* Try to open the output, we overwrite */
      if (!(stream = fopen(currentname, "w")))
	goto error;

      /* Now put the first line, copy from input */
      tirout_a(startinfv -> arel, stream, "LOGNAME=");
      /* Action should be taken over from prompt */
      tirout_a(startinfv -> arel, stream, "ACTION=");
      tirout_a(startinfv -> arel, stream, "PROMPT=");
      tirout_a(startinfv -> arel, stream, "NCORES=");
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "INSET=");
      /* tirout_a(startinfv -> arel, stream, "BOX="); */
      tirout_a(startinfv -> arel, stream, "OUTSET=");
      tirout_a(startinfv -> arel, stream, "OUTCUBUP=");
      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "OKAY="); */
      tirout_a(startinfv -> arel, stream, "PROGRESSLOG=");
      tirout_a(startinfv -> arel, stream, "TEXTLOG=");
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "BMIN=");
      tirout_a(startinfv -> arel, stream, "BMAJ=");
      tirout_a(startinfv -> arel, stream, "BPA=");
      tirout_a(startinfv -> arel, stream, "RMS=");
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "NDISKS=");
      fprintf(stream, "NUR= %i", nrings);
      fprintf(stream, "\n");

      /* Now it depends on the file we are outputting */
      if (currentname == defname) {
	reparray = rpm -> par;
      }
      else {
	lm1 =len-1;

	/* Here, we have to filter */
	for (j = 0; j < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS); ++j) {

	  /* Important: do not Hanning smooth the radii */
	  if (j != PRADI) {
	  {

	    for (k = 0; k < rpm -> nur; ++k) {

	      smsum = 0.0;
	      smweightsum = 0.0;
	      for (l = -len/2+1; l < len/2+1-1; ++l) {
		/* if we exceed the ringnumbers, we take in the values at
		   the border */
		/* if ((k+l) < 0) { */
		/*   valcur = rpm -> par[j*rpm -> nur]; */
		/* } */
		/* else if ((k+l) > rpm -> nur - 1) { */
		/*   valcur = rpm -> par[(j+1)*rpm -> nur-1]; */
		/* } */
		/* else { */
		m = k+l;
		if (m >= 0 && m < rpm -> nur) {
		  weight = 0.5*(1+cos(TWOPI*l/lm1));
		  smsum = smsum + weight * rpm -> par[j*rpm -> nur+m];
		  smweightsum = smweightsum + weight;
		}
	      }

	      /* Use outarray as a buffer */
	      log -> outarray[j*rpm -> nur+k] = smsum/smweightsum;

		/* Sort the array */
	      /* maths_bubble(smarray, len); */

	      /* if (!(j == PRADI) && ((n = ((j-NSSDPARAMS)%NDPARAMS + NSSDPARAMS)) == PXPOS || n == PYPOS)) */
	      /* 	fprintf(stream, format2, smarray[(len-1)/2]); */
	      /* else */
	      /* 	fprintf(stream, format, smarray[(len-1)/2]); */

	    }
	  }

	}
	}
	reparray = log -> outarray;
      }

      /* put out the radii */
      ftstab_putcoltitl(key, RADI);
      fprintf(stream, "%8s= ", key);
      for (m = 0; m < nrings; ++m) {
	fprintf(stream, format, radii[m]);
      }
      fprintf(stream, "\n");

      for (j = NSSDPARAMS; j < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS); ++j) {

	/************/
	/************/
	k = 0;
	while (k < rpm -> nur) {
	  if ((reparray[j*rpm -> nur+k]))
	    break;
	    ++k;
	}
	if (k < rpm -> nur) {

	  /************/

	  /* Put the title */
	  ftstab_putcoltitl(key, j+1);
	  fprintf(stream, "%8s= ", key);

	    for (m = 0; m < nrings; ++m) {

	      /* Not sure if this is required, but do it anyway */
	      gsl_interp_accel_reset(rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);

	      /* Very sure that this is a requirement; a test has shown */
	      /* gsl_interp_init(rpm -> gsl_interparray[j-NSSDPARAMS],rpm -> par+PRADI*rpm -> nur, rpm -> par + rpm -> nur*j, rpm -> nur); */
	      gsl_interp_init(rpm -> gsl_interparray[j-NSSDPARAMS],reparray+PRADI*rpm -> nur, reparray + rpm -> nur*j, rpm -> nur);

	      /* Search the first radius that is greater than the current, don't care about efficiency */
	      /* for (k = 1; k < rpm -> nur; ++k) { */
	      /* 	if (radii[m] < reparray[PRADI*rpm -> nur+k]) */
	      /* 	  break; */
	      /* } */

	      /* Now we can interpolate or extrapolate */
	      /* Check for radius here */
	      if ( radii[m] < reparray[PRADI*rpm -> nur+rpm -> nur-1]) {
		/* dpdr = (reparray[j*rpm -> nur+k]-reparray[j*rpm -> nur+k-1])/(reparray[PRADI*rpm -> nur+k]-reparray[PRADI*rpm -> nur+k-1]); */
		/* dpdr = reparray[j*rpm -> nur+k-1]+dpdr*(radii[m]-reparray[PRADI*rpm -> nur+k-1]); */
		dpdr = gsl_interp_eval(rpm -> gsl_interparray[j-NSSDPARAMS], rpm -> par+PRADI*rpm -> nur, rpm -> par + rpm -> nur*j, radii[m], rpm -> gsl_interp_accelarray[j-NSSDPARAMS]);
	      }
	      else {
		dpdr = reparray[(j+1)*rpm -> nur-1];
	      }

	      if (!(j == PRADI) && ((n = ((j-NSSDPARAMS)%NDPARAMS + NSSDPARAMS)) == PXPOS || n == PYPOS)) {
		fprintf(stream, format2, dpdr);
	      }
	      else {
	      	fprintf(stream, format, dpdr);
	      }
	    }
	    fprintf(stream, "\n");
	}
      }

      for (j = 0; j < NSPARAMS; ++j) {
	  ftstab_putcoltitl(key, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+j+1);
	  fprintf(stream, "%8s= ", key);
	  fprintf(stream, format, rpm -> par[(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur+j]);
	}

      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "LTYPE=");
      for (disk = 1; disk < rpm -> ndisks; ++disk) {
	sprintf(placer, "LTYPE_%i=" , disk+1);
	tirout_a(startinfv -> arel, stream, placer);
      }

      /* Now put the rest of the input to the file */
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "CFLUX=");
      for (disk = 1; disk < rpm -> ndisks; ++disk) {
	sprintf(placer, "CFLUX_%i=" , disk+1);
	tirout_a(startinfv -> arel, stream, placer);
      }
      tirout_a(startinfv -> arel, stream, "PENALTY=");
      tirout_a(startinfv -> arel, stream, "WEIGHT=");
      tirout_a(startinfv -> arel, stream, "RADSEP=");
      /*       tirout_a(startinfv -> arel, stream, "MEMMODE="); */
      tirout_a(startinfv -> arel, stream, "INIMODE=");
      tirout_a(startinfv -> arel, stream, "ISEED=");
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "FITMODE=");
      tirout_a(startinfv -> arel, stream, "LOOPS=");
      tirout_a(startinfv -> arel, stream, "MAXITER=");
      tirout_a(startinfv -> arel, stream, "CALLITE=");
      tirout_a(startinfv -> arel, stream, "SIZE=");
      tirout_a(startinfv -> arel, stream, "INTY=");
      tirout_a(startinfv -> arel, stream, "INDINTY=");

      /* We want to hide the whole pswarm issue from the user, so we only spit it out if there have been changes to the defaults */
      if (fit -> psse != PSW_PSSE_DEF) tirout_a(startinfv -> arel, stream, "PSSE=");
      if (fit -> psnp != PSW_PSNP_DEF) tirout_a(startinfv -> arel, stream, "PSNP=");
      if (fit -> psco != PSW_PSCO_DEF) tirout_a(startinfv -> arel, stream, "PSCO=");
      if (fit -> psso != PSW_PSSO_DEF) tirout_a(startinfv -> arel, stream, "PSSO=");
      if (fit -> psmv != PSW_PSMV_DEF) tirout_a(startinfv -> arel, stream, "PSMV=");
      if (fit -> psnf != PSW_PSNF_DEF) tirout_a(startinfv -> arel, stream, "PSNF=");
      if (fit -> psii != PSW_PSII_DEF) tirout_a(startinfv -> arel, stream, "PSII=");
      if (fit -> psfi != PSW_PSFI_DEF) tirout_a(startinfv -> arel, stream, "PSFI=");
      if (fit -> psid != PSW_PSID_DEF) tirout_a(startinfv -> arel, stream, "PSID=");
      if (fit -> psdd != PSW_PSDD_DEF) tirout_a(startinfv -> arel, stream, "PSDD=");

      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "ANSTART="); */
      /*       tirout_a(startinfv -> arel, stream, "ANEND="); */
      /*       tirout_a(startinfv -> arel, stream, "ANSTEPS="); */
      /*       tirout_a(startinfv -> arel, stream, "ISEED="); */
      /*       fprintf(stream, "\n"); */
      fprintf(stream, "VARY= %s\n", fit -> varyhstr);
      tirout_a(startinfv -> arel, stream, "VARINDX=");
      /*       tirout_a(startinfv -> arel, stream, "VARYMULT="); */
      /*       tirout_a(startinfv -> arel, stream, "VARYSING= "); */
      tirout_a(startinfv -> arel, stream, "PARMAX=");
      tirout_a(startinfv -> arel, stream, "PARMIN=");
      tirout_a(startinfv -> arel, stream, "MODERATE=");
      tirout_a(startinfv -> arel, stream, "DELSTART=");
      tirout_a(startinfv -> arel, stream, "DELEND=");
      tirout_a(startinfv -> arel, stream, "ITESTART=");
      tirout_a(startinfv -> arel, stream, "ITEEND=");
      tirout_a(startinfv -> arel, stream, "SATDELT=");
      tirout_a(startinfv -> arel, stream, "MINDELTA=");
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "REGPARA=");
      if ((fit -> reg_contv[0])) {
	tirout_a(startinfv -> arel, stream, "REGDENO=");
	tirout_a(startinfv -> arel, stream, "REGNUME=");
	tirout_a(startinfv -> arel, stream, "REGTHRE=");
	tirout_a(startinfv -> arel, stream, "REGWIDT=");
	tirout_a(startinfv -> arel, stream, "REGAMPL=");
	tirout_a(startinfv -> arel, stream, "REGASTE=");
	tirout_a(startinfv -> arel, stream, "REGAMPD=");
      }
      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "TABLE="); */
      /*       tirout_a(startinfv -> arel, stream, "DISTANCE="); */
      /*       tirout_a(startinfv -> arel, stream, "REFRING="); */
      /*       tirout_a(startinfv -> arel, stream, "BIGTABLE="); */
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "TIRDEF=");
      tirout_a(startinfv -> arel, stream, "TIRSMO=");
      /*       tirout_a(startinfv -> arel, stream, "TIRACC="); */
      /*       tirout_a(startinfv -> arel, stream, "TIRLEN="); */
      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "HISNAME="); */
      /*       tirout_a(startinfv -> arel, stream, "HISTARTROW="); */
      /*       tirout_a(startinfv -> arel, stream, "HISTENDROW="); */
      /*       tirout_a(startinfv -> arel, stream, "HISKEY1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISRING1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISMIN1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISMAX1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISBINS1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISDELTA1="); */
      /*       tirout_a(startinfv -> arel, stream, "HISKEY2="); */
      /*       tirout_a(startinfv -> arel, stream, "HISRING2="); */
      /*       tirout_a(startinfv -> arel, stream, "HISMIN2="); */
      /*       tirout_a(startinfv -> arel, stream, "HISMAX2="); */
      /*       tirout_a(startinfv -> arel, stream, "HISBINS2="); */
      /*       tirout_a(startinfv -> arel, stream, "HISDELTA2="); */
      /*       fprintf(stream, "\n"); */
      tirout_a(startinfv -> arel, stream, "COOLGAL=");
      tirout_a(startinfv -> arel, stream, "COOLBEAM=");
      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "RECT="); */
      /*       tirout_a(startinfv -> arel, stream, "BIGRECT="); */
      /*       fprintf(stream, "\n"); */
      tirout_a(startinfv -> arel, stream, "TILT=");
      tirout_a(startinfv -> arel, stream, "BIGTILT=");
      fprintf(stream, "\n");
      /*       tirout_a(startinfv -> arel, stream, "INCLINO=");    */
      /*       tirout_a(startinfv -> arel, stream, "IN_REFINE="); */
      fprintf(stream, "\n");
      tirout_a(startinfv -> arel, stream, "GR_DEVICE=");
      tirout_a(startinfv -> arel, stream, "GR_PARMS=");
      tirout_a(startinfv -> arel, stream, "GR_XMIN=");
      tirout_a(startinfv -> arel, stream, "GR_XMAX=");
      tirout_a(startinfv -> arel, stream, "GR_MR=");
      tirout_a(startinfv -> arel, stream, "GR_ML=");
      tirout_a(startinfv -> arel, stream, "GR_TXHT=");
      tirout_a(startinfv -> arel, stream, "GR_SBHT=");
      tirout_a(startinfv -> arel, stream, "GR_LGND=");
      tirout_a(startinfv -> arel, stream, "GR_SBRP=");

      for (j = 1; j <= nrplts; ++j) {
	fprintf(stream, "\n");
	sprintf(inqstr, "GR_COL_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	sprintf(inqstr, "GR_LINES_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	sprintf(inqstr, "GR_INTERP_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	sprintf(inqstr, "GR_ERRB_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	sprintf(inqstr, "GR_YMIN_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	sprintf(inqstr, "GR_YMAX_%i=", j);
	tirout_a(startinfv -> arel, stream, inqstr);
	/*  sprintf(inqstr, "GR_NPAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_XPAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_YPAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_ERAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_EBAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_COAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_LIAD_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
	/*  sprintf(inqstr, "GR_INTERPAD_%i_%i=", j); */
	/*  tirout_a(startinfv -> arel, stream, inqstr); */
      }
      fclose(stream);
    }
    currentname = deintername;
    ++i;
  }

  if (startinfv -> arel[2]) {
    startinfv -> arel[2] -> timestamp = restimest;
  }

  /* Reset outarray to the original state */
  for (i = 0; i < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++i){
    log -> outarray[i] = rpm -> par[i];
  }

  free(radii);
  if ((defname))
    free(defname);
  if ((deintername))
    free(deintername);
  if ((varystr))
    freeparsed(varystr);
  return 1;

 error:
  if ((radii))
    free(radii);
  if ((defname))
    free(defname);
  if ((deintername))
    free(deintername);
  if ((varystr))
    freeparsed(varystr);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Copies a part of the gipsy input to a stream */
static int tirout_a(simparse_scn_arel **arel, FILE *stream, char *keyword)
{
  /* int def = 2; */
  /* int length; */
  /* char mes[2]; */
  /* int i; */
  char *varyhstr = NULL;
  int keypres, nread, nreturned;

  if (simparse_scn_arel_readval_stringwhitesp(arel, keyword, "", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &varyhstr)) {
    if ((varyhstr))
      free(varyhstr);
    return 1;
  }
  fprintf(stream, "%s%s\n", keyword, varyhstr);
  free(varyhstr);
  return 0;

  /* sprintf(mes, "A"); */

  /* Initialise */
  /* { */
  /*   for (i = 0; i < VARYHSTRELES-2; ++i) { */
  /*     input[i] = ' '; */
  /*   } */
  /*   input[i] = '\0'; */

    /* Get the value */
    /* length = usertext_tir(input, &def, keyword,mes); */
    /* input[length] = '\0'; */

    /* Copy it into the file */
  /*   fprintf(stream, "%s %s\n", keyword); */
  /* } */

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Get a double parameter */
static int get_parameter_double(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, char *mess, char *parname, int ident, int force)
{
  int def;      /* Any default mode */
  int nel;      /* Number of elements */
  int i; /* Simple control variables */
  int nident;

  /**************/
  /**************/
/*        int obsint = 0; */
/*        char obsmes[80];  */
  /**************/

       /* Make this transformation to identify higher-order VSYS XPOS and YPOS */
  nident = (ident-NSSDPARAMS)%NDPARAMS + NSSDPARAMS;

  /* Read values that are needed only in this module */

  /* First from the log if present */
  /* Default is 0 */
  for (i = 0; i < rpm -> nur; ++i)
    *(rpm -> par + rpm -> nur*ident+i) = 0.0;
  def = force;

  nel = 0;

  /* This is the third parameter sequence */
  if (!(startinfv -> firstrun))
    cancel_tir(startinfv -> arel, parname, 0);

  nel = userdble_tir(startinfv -> arel, rpm -> par+ident*rpm -> nur, &rpm -> nur, &def, parname, mess);

  if (!nel)
    nel = rpm -> nur;

  /* Check for errors and extrapolate */

  for (i = 0; i < rpm -> nur; ++i) {
    if (i > nel-1) {
      rpm -> par[ident*rpm -> nur+i] = rpm -> par[ident*rpm -> nur+nel-1];
    }
    else {
      if ((ident == PRADI) || !(nident == PXPOS || nident == PVSYS || nident == PYPOS)) {
		  rpm -> par[ident*rpm ->nur+i] =  dparamtointern(rpm -> par[ident*rpm ->nur+i], ident+1, hdr, rpm -> ndisks);
      }
    }
  }

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces the tiltogram output of tirific */
static int tiltout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  int i,j;

  /* int def = 2; */
  /* int nel = 1; */
  /* char mes[81]; */
  char *filename = NULL;
  qfits_header *header = NULL;
  float *array = NULL;
  double nrefr[3];
  double nr[3];
  char value[21];

  char **varystr = NULL;
  int keypres, nread, nreturned;

  /* Initialise the input array */
  /* for (i = 0; i < 200; ++i) { */
  /*   filename[i] = ' '; */
  /* } */
  /* filename[200] = '\0'; */

  /* sprintf(mes, "Give a filename for a tiltogram output"); */
  /* userchar_tir(filename, &nel, &def, "TILT=", mes); */
  /* termsinglestr(filename); */

  /* cancel_tir(startinfv -> arel, "TILT"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "TILT", "Give a filename for a tiltogram output.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(filename = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(filename = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  if (*filename != '\0') {

    if (rpm -> nur < 2)
      return 1;

    /* Read in the values */
    tir_get_grid(log, rpm, log -> outarray);

    /* Make a header */
    /* The bitpix is -32 */
    if (!(header = ftsout_putcard(header, "BITPIX","-32")))
      goto error;

    /* The number of axes is set to three */
    if (!ftsout_putcard(header, "NAXIS","2"))
      goto error;

    /* Now get the axis numbers */
    sprintf(value, "%i", rpm -> nur);
    if (!ftsout_putcard(header, "NAXIS1",value))
      goto error;
    sprintf(value, "%i", rpm -> nur);
    if (!ftsout_putcard(header, "NAXIS2",value))
      goto error;

    /* May contain an extension */
    if (!ftsout_putcard(header, "EXTEND","T"))
      goto error;

    /* These are clear */
    if (!ftsout_putcard(header, "BSCALE","1"))
      goto error;
    if (!ftsout_putcard(header, "BZERO","0"))
      goto error;

    /* The bunit is Jy*km/s/beam, while this is the 3d beam */
    if (!ftsout_putcard(header, "BUNIT","'deg               '"))
      goto error;

    /* The cdelt is the difference between the first two rings */
    sprintf(value, "%.12E", log -> outarray[PRADI*rpm -> nur+1]-log -> outarray[PRADI*rpm -> nur]);
    if (!ftsout_putcard(header, "CDELT1", value))
      goto error;

    /* The crpix is 1 */
    sprintf(value, "%.12E", 1.0);
    if (!ftsout_putcard(header, "CRPIX1", value))
      goto error;

    /* The crval in user units -> arcsec is 0 */
    sprintf(value, "%.12E", 0.0);
    if (!ftsout_putcard(header, "CRVAL1", value))
      goto error;

    /* ctype is angle ... */
    if (!ftsout_putcard(header, "CTYPE1", "'ANGLE   '"))
      goto error;
    if (!ftsout_putcard(header, "CUNIT1", "'arcsec            '"))
      goto error;

    /* The cdelt is the difference between the first two rings */
    sprintf(value, "%.12E", log -> outarray[PRADI*rpm -> nur+1]-log -> outarray[PRADI*rpm -> nur]);
    if (!ftsout_putcard(header, "CDELT2", value))
      goto error;

    /* The crpix is 1 */
    sprintf(value, "%.12E", 1.0);
    if (!ftsout_putcard(header, "CRPIX2", value))
      goto error;

    /* The crval in user units -> arcsec is 0 */
    sprintf(value, "%.12E", 0.0);
    if (!ftsout_putcard(header, "CRVAL2", value))
      goto error;

    /* ctype is angle ... */
    if (!ftsout_putcard(header, "CTYPE2", "'ANGLE   '"))
      goto error;
    if (!ftsout_putcard(header, "CUNIT2", "'arcsec            '"))
      goto error;

    /* After that allocate the memory */
    if (!(array = (float *) malloc(rpm -> nur*rpm -> nur*sizeof(float))))
      goto error;

    /* Convert to internal units (radian) */
    for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur + NSPARAMS; ++i) {
      rpm -> par[i] = log -> outarray[i];
    }
    changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);

    /* Now fill the array */
    for (i = 0; i < rpm -> nur; ++i) {
      /* Now get the normal vector of the reference ring */
      nrefr[0] = sin(rpm -> par[PINCL*rpm -> nur+i])*sinf(rpm -> par[PPA*rpm -> nur+i]);
      nrefr[1] = -sin(rpm -> par[PINCL*rpm -> nur+i])*cosf(rpm -> par[PPA*rpm -> nur+i]);
      nrefr[2] = cos(rpm -> par[PINCL*rpm -> nur+i]);

      /* Now we read in the values */
      for (j = 0; j < rpm -> nur; ++j) {
 nr[0] = sin(rpm -> par[PINCL*rpm -> nur+j])*sinf(rpm -> par[PPA*rpm -> nur+j]);
 nr[1] = -sin(rpm -> par[PINCL*rpm -> nur+j])*cosf(rpm -> par[PPA*rpm -> nur+j]);
 nr[2] = cos(rpm -> par[PINCL*rpm -> nur+j]);

 /* This is the arcus */
 array[i+rpm -> nur*j] = (nr[0]*nrefr[0]+nr[1]*nrefr[1]+nr[2]*nrefr[2]) > 1?0.0:RADTODEG*acos(nr[0]*nrefr[0]+nr[1]*nrefr[1]+nr[2]*nrefr[2]);
      }
    }

    /* Put it to the disk */
    ftsout_writeimage(filename, array, header, rpm -> nur, rpm -> nur);

    /* Clear things */
    ftsout_header_destroy(header);
    free(array);
  }
  /* Initialise the input array */
  /* for (i = 0; i < 19; ++i) { */
  /*   filename[i] = ' '; */
  /* } */
  /* filename[i] = '\0'; */

  /* sprintf(mes, "Give a filename for a big tiltogram output"); */
  /* userchar_tir(filename, &nel, &def, "BIGTILT=", mes); */
  /* termsinglestr(filename); */

  if ((filename)){
    free(filename);
    filename = NULL;
  }

  /* cancel_tir(startinfv -> arel, "BIGTILT"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "BIGTILT", "Give a filename for a big tiltogram output", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(filename = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(filename = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  if (*filename != '\0') {

    if (rpm -> nr < 2)
      return 1;

    /* Make a header */
    /* The bitpix is -32 */
    header = NULL;

    if (!(header = ftsout_putcard(header, "BITPIX","-32")))
      goto error;

    /* The number of axes is set to three */
    if (!ftsout_putcard(header, "NAXIS","2"))
      goto error;

    /* Now get the axis numbers */
    sprintf(value, "%i", rpm -> nr);
    if (!ftsout_putcard(header, "NAXIS1",value))
      goto error;
    sprintf(value, "%i", rpm -> nr);
    if (!ftsout_putcard(header, "NAXIS2",value))
      goto error;

    /* May contain an extension */
    if (!ftsout_putcard(header, "EXTEND","T"))
      goto error;

    /* These are clear */
    if (!ftsout_putcard(header, "BSCALE","1"))
      goto error;
    if (!ftsout_putcard(header, "BZERO","0"))
      goto error;

    /* The bunit is Jy*km/s/beam, while this is the 3d beam */
    if (!ftsout_putcard(header, "BUNIT","'deg     '"))
      goto error;

    /* The cdelt is the width of one ring */
    sprintf(value, "%.12E", dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks));
    if (!ftsout_putcard(header, "CDELT1", value))
      goto error;

    /* The crpix is 1 */
    sprintf(value, "%.12E", 1.0);
    if (!ftsout_putcard(header, "CRPIX1", value))
      goto error;

    /* The crval in user units -> arcsec is 1/2 radsep */
    sprintf(value, "%.12E", dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks)/2);
    if (!ftsout_putcard(header, "CRVAL1", value))
      goto error;

    /* ctype is angle ... */
    if (!ftsout_putcard(header, "CTYPE1", "'ANGLE             '"))
      goto error;
    if (!ftsout_putcard(header, "CUNIT1", "'arcsec            '"))
      goto error;

    /* The cdelt is the width of one ring */
    sprintf(value, "%.12E", dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks));
    if (!ftsout_putcard(header, "CDELT2", value))
      goto error;

    /* The crpix is 1 */
    sprintf(value, "%.12E", 1.0);
    if (!ftsout_putcard(header, "CRPIX2", value))
      goto error;

    /* The crval in user units -> arcsec is 1/2 radsep */
    sprintf(value, "%.12E", dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks)/2);
    if (!ftsout_putcard(header, "CRVAL2", value))
      goto error;

    /* ctype is angle ... */
    if (!ftsout_putcard(header, "CTYPE2", "'ANGLE             '"))
      goto error;
    if (!ftsout_putcard(header, "CUNIT2", "'arcsec            '"))
      goto error;

    /* After that allocate the memory */
    if (!(array = (float *) malloc(rpm -> nr*rpm -> nr*sizeof(float))))
      goto error;

    /* Read in the values */
    tir_get_grid(log, rpm, log -> outarray);

    /* Convert to internal units (radian) */
    for (i = 0; i < (NPARAMS+(rpm -> ndisks-1)*NDPARAMS)*rpm -> nur + NSPARAMS; ++i) {
      rpm -> par[i] = log -> outarray[i];
    }
    changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);
    for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
      rpm -> chapar[i] = 1;
    if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
      goto error;
    interpover(rpm, rpm -> radsep, 0, NULL, fit -> index);

    /* Now fill the array */
    for (i = 0; i < rpm -> nr; ++i) {
      /* Now get the normal vector of the reference ring */
      nrefr[0] = sin(rpm -> modpar[PINCL*rpm -> nr+i])*sinf(rpm -> modpar[PPA*rpm -> nr+i]);
      nrefr[1] = -sin(rpm -> modpar[PINCL*rpm -> nr+i])*cosf(rpm -> modpar[PPA*rpm -> nr+i]);
      nrefr[2] = cos(rpm -> modpar[PINCL*rpm -> nr+i]);

      /* Now we read in the values */
      for (j = 0; j < rpm -> nr; ++j) {
 nr[0] = sin(rpm -> modpar[PINCL*rpm -> nr+j])*sinf(rpm -> modpar[PPA*rpm -> nr+j]);
 nr[1] = -sin(rpm -> modpar[PINCL*rpm -> nr+j])*cosf(rpm -> modpar[PPA*rpm -> nr+j]);
 nr[2] = cos(rpm -> modpar[PINCL*rpm -> nr+j]);

 /* This is the arcus */
 array[i+rpm -> nr*j] = (nr[0]*nrefr[0]+nr[1]*nrefr[1]+nr[2]*nrefr[2]) > 1?0.0:RADTODEG*acos(nr[0]*nrefr[0]+nr[1]*nrefr[1]+nr[2]*nrefr[2]);
      }
    }

    /* Put it to the disk */
    ftsout_writeimage(filename, array, header, rpm -> nr, rpm -> nr);

    /* Clear things */
    ftsout_header_destroy(header);
    free(array);
  }
  free(filename);

  return 1;

 error:
  if ((header))
    ftsout_header_destroy(header);
  if ((array))
    free(array);
  if ((filename))
    free(filename);
  if ((varystr))
    freeparsed(varystr);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces the tip-lon output of tirific  */

static int briggsout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  char mes[81];
  int i, j, ok, nel, def, dev;

  char *br_device = NULL;
  double br_pa;
  float pa_float;
  double br_incl;
  double pa;
  double inc;
  int br_annr;
  float rmax;
  float *br_angl = NULL;

  int br_swdth;
  int br_cwdth;
  int br_lwdth;
  int br_col = 1;
  int br_refl;
  int numplpts;

  float *xarray = NULL;
  float *xlarray = NULL;
  float *yarray = NULL;
  float *dummyarray = NULL;
  float *ylarray = NULL;

  double nrefr[3];
  double rota[3];

  int nread, nreturned, keypres;
  char **varystr = NULL;

  /**************/
   /**************/
/*     int obsint = 0;   */
/*     char obsmes[80];   */
  /**************/
  /**************/
  /**************/
/* sprintf(obsmes, "graph: x: %.2f y: %.2f", x,y); */
/* anyout_tir(&obsint, obsmes); */
  /**************/

  /* Keywords:
     BR_DEVICE= pgplot device
     BR_PA= position angle of reference ring
     BR_INCL= inclination of reference ring
     BR_ANNR= circles to plot
     BR_ANGL= circle radii in deg
     BR_SWDTH= dot width
     BR_CWDTH= circle width
     BR_LWDTH= line width
     BR_REFL= Plot reference line?
     BR_COL= Colour of dots and lines
  */

  /* Ask the user for the output device */
  /* for (j = 0; j < 200; ++j) { */
  /*   br_device[j] = ' '; */
  /* } */
  /* br_device[200] = '\0'; */

  /* sprintf(mes, "Give graphics (pgplot) device:"); */
  /* def = 2; */
  /* nel = 1; */
  /* userchar_tir(br_device, &nel, &def, "BR_DEVICE=", mes); */
  /* termsinglestr(br_device); */

  /* cancel_tir(startinfv -> arel, "BR_DEVICE"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "BR_DEVICE", "Give a progress file name for no point actually when you can read this.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(br_device = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(br_device = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* If there was no input we return */
  if (*br_device == '\0') {
    free(br_device);
    return 0;
  }

  /* Check if there was a logfile and stop if there wasn't */
/*   if (*log -> logname == '\0') */
/*     return 0; */

  /* Ask for the reference position angle, default 0 */
  sprintf(mes, "Give Briggs reference position angle");
  br_pa = 0;
  def = 2;
  nel = 1;
  userdble_tir(startinfv -> arel, &br_pa, &nel, &def, "BR_PA=", mes);

  /* Ask for the reference inclination, default 0 */
  sprintf(mes, "Give Briggs reference position angle");
  br_incl = 0;
  def = 2;
  nel = 1;
  userdble_tir(startinfv -> arel, &br_incl, &nel, &def, "BR_INCL=", mes);

  /* Then get the stuff in radian */
  inc = DEGTORAD*br_incl;
  pa = DEGTORAD*br_pa;

  /* Ask for the angles to plot rings for */
  ok = 0;
  def = 2;

  while (ok == 0) {
    sprintf(mes, "Give number of Briggs angles");
    br_annr = 0;
    nel = 1;
    userint_tir(startinfv -> arel, &br_annr, &nel, &def, "BR_ANNR=", mes);

    if (br_annr < 0) {
      dev = 0;
      sprintf(mes, "Must be a positive number");
      anyout_tir(&dev,mes);
      cancel_tir(startinfv -> arel, "BR_ANNR=", 2);
      def = 0;
    }
    else
      ok = 1;
  }

  /* Symbol width */
  ok = 0;
  def = 2;
  while (ok == 0) {
    sprintf(mes, "Give width of dots (1-201) [5]");
    br_swdth = 10;
    nel = 1;
    userint_tir(startinfv -> arel, &br_swdth, &nel, &def, "BR_SWDTH=", mes);

    if ((br_swdth < 1) || (br_swdth > 201)) {
      dev = 0;
      sprintf(mes, "Must be in-between 1 and 201");
      anyout_tir(&dev,mes);
      cancel_tir(startinfv -> arel, "BR_SWDTH=", 2);
      def = 1;
    }
    else
      ok = 1;
  }

  /* circle width */
  ok = 0;
  def = 2;
  while (ok == 0) {
    sprintf(mes, "Give width of circles (1-201) [1]");
    br_cwdth = 2;
    nel = 1;
    userint_tir(startinfv -> arel, &br_cwdth, &nel, &def, "BR_CWDTH=", mes);

    if ((br_cwdth < 1) || (br_cwdth > 201)) {
      dev = 0;
      sprintf(mes, "Must be in-between 1 and 201");
      anyout_tir(&dev,mes);
      cancel_tir(startinfv -> arel, "BR_CWDTH=", 2);
      def = 1;
    }
    else
      ok = 1;
  }

  /* line width */
  ok = 0;
  def = 2;
  while (ok == 0) {
    sprintf(mes, "Give width of lines (1-201) [1]");
    br_lwdth = 2;
    nel = 1;
    userint_tir(startinfv -> arel, &br_lwdth, &nel, &def, "BR_LWDTH=", mes);

    if ((br_lwdth < 1) || (br_lwdth > 201)) {
      dev = 0;
      sprintf(mes, "Must be in-between 1 and 201");
      anyout_tir(&dev,mes);
      cancel_tir(startinfv -> arel, "BR_LWDTH=", 2);
      def = 1;
    }
    else
      ok = 1;
  }

  /* Ask whether to plot the reference line */
    sprintf(mes, "Plot reference line? [1]");
    def = 2;
    br_refl = 1;
    nel = 1;
    userint_tir(startinfv -> arel, &br_refl, &nel, &def, "BR_REFL=", mes);

  /* Ask for colour */
    sprintf(mes, "Colour of dots and lines");
    br_col = 1;
    def = 2;
    nel = 1;
    userint_tir(startinfv -> arel, &br_col, &nel, &def, "BR_COL=", mes);

  /* Allocate memory */
    if (!(xarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

    if (!(yarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

    if (!(dummyarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

    if (!(xlarray = (float *) malloc((rpm -> nr*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

    if (!(ylarray = (float *) malloc((rpm -> nr*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  /* We read all values into the outarray */
    tir_get_grid(log, rpm, log -> outarray);

  /* And then into the par array */
  for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
    rpm -> par[j] = log -> outarray[j];

  /* Interpolate over */
  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = 1;

  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  interpover(rpm, dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks), 0, NULL, fit -> index);

  /* Now fill the arrays */
  for (j = 0; j < rpm -> nur; ++j) {

    /* Normal vector of current ring */
    nrefr[0] = sin(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j])*sin(DEGTORAD*rpm -> par[PPA*rpm -> nur+j]);
    nrefr[1] = -sin(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j])*cos(DEGTORAD*rpm -> par[PPA*rpm -> nur+j]);
    nrefr[2] = cos(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j]);

    /* Rotate the ring clockwise about the LOS */
    rota[0] = cos(pa)*nrefr[0]+sin(pa)*nrefr[1];
    rota[1] = -sin(pa)*nrefr[0]+cos(pa)*nrefr[1];
    rota[2] = nrefr[2];

    /* Then rotate the ring about the x axis, clockwise */
    rota[1] = cos(inc)*rota[1]+sin(inc)*rota[2];

    /* Finally get back to the original position with a clockwise rotation about the LOS */
    xarray[j] = rota[0];
    yarray[j] = rota[1];

  /**************/
/*  sprintf(obsmes, "graph: x: %.2f y: %.2f",  xarray[j],yarray[j]); */
/*  anyout_tir(&obsint, obsmes); */
  /**************/

/*      xarray[j] = cos(pa)*rota[0]-sin(pa)*rota[1];  */
/*      yarray[j] = sin(pa)*rota[0]+cos(pa)*rota[1];  */
  }

  /* Do the same with the large array */
  for (j = 0; j < rpm -> nr; ++j) {

    /* Normal vector of current ring */
    nrefr[0] = sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
    nrefr[1] = -sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
    nrefr[2] = cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);

    /* Rotate the ring clockwise about the LOS */
    rota[0] = cos(pa)*nrefr[0]+sin(pa)*nrefr[1];
    rota[1] = -sin(pa)*nrefr[0]+cos(pa)*nrefr[1];
    rota[2] = nrefr[2];

    /* Then rotate the ring about the x axis, clockwise */
    rota[1] = cos(inc)*rota[1]+sin(inc)*rota[2];

    /* Finally get back to the original position with a clockwise rotation about the LOS */
     xlarray[j] = cos(pa)*rota[0]-sin(pa)*rota[1];
     ylarray[j] = sin(pa)*rota[0]+cos(pa)*rota[1];
     xlarray[j] = rota[0];
     ylarray[j] = rota[1];

}

  /* In order to provide the user with some suggestion */
  rmax = 0;
  for (j = 0; j < rpm -> nur; ++j) {
    if (rmax < sqrt(xarray[j]*xarray[j]+yarray[j]*yarray[j]))
      rmax = sqrt(xarray[j]*xarray[j]+yarray[j]*yarray[j]);
  }
  for (j = 0; j < rpm -> nr; ++j) {
    if (rmax < sqrt(xlarray[j]*xlarray[j]+ylarray[j]*ylarray[j]))
      rmax = sqrt(xlarray[j]*xlarray[j]+ylarray[j]*ylarray[j]);
  }
  if (rmax > 1.0)
    rmax = 1.0;
  rmax = asin(rmax)/DEGTORAD;

  if ((br_annr)) {
    if (!(br_angl = (float *) malloc(br_annr*sizeof(float))))
      goto error;

    /* Now get the numbers */
    sprintf(mes, "Give %i Briggs angles, calculated max: %.1f",br_annr,rmax);
    def = 5;
    nel = br_annr;
    userreal_tir(startinfv -> arel, br_angl, &nel, &def, "BR_ANGL=", mes);
  }

  /* Calculate the proper radii for the rings */
  for (j = 0; j < br_annr; ++j)
    br_angl[j] = sin(DEGTORAD*br_angl[j]);

  /* Now pass it to the graphics */
  pgp_opendev(br_device);

  pa_float = br_pa;

  /* remove indexed data points */
  numplpts = gr_deleteindexed(rpm -> nur, (NPARAMS+(rpm -> ndisks-1)*NDPARAMS+1), xarray, yarray, dummyarray, fit -> index, rpm -> ndisks);
/*   numplpts = rpm -> nur; */

  /* then plot */
  if (!numplpts)
    numplpts = 1;
  pgp_polar(numplpts, xarray, yarray, rpm -> nr, xlarray, ylarray, br_annr, br_angl, (br_refl)?(&pa_float):NULL, br_lwdth, br_cwdth, br_swdth, br_col);

  /* Once we got here, we ask the user if to continue */
  sprintf(mes, "Continue (Press return)?");
  def = 1;
  nel = 1;
  userint_tir(startinfv -> arel, &br_swdth, &nel, &def, "BR_CONT=", mes);

  /* Then we stop it */
  pgp_end();

    free(xarray);
    free(xlarray);
    free(yarray);
    free(dummyarray);
    free(ylarray);
    if ((br_angl))
      free(br_angl);

  if ((br_device))
    free(br_device);
  return 0;

 error:
  if ((br_angl))
    free(br_angl);
  if ((xarray))
    free(xarray);
  if ((xlarray))
    free(xlarray);
  if ((yarray))
    free(yarray);
  if ((dummyarray))
    free(dummyarray);
  if ((ylarray))
    free(ylarray);
  if ((br_device))
    free(br_device);
  if ((varystr))
    freeparsed(varystr);

  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces the graphics output of tirific  */

static int graphout(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  pgp_gdsc *gdsc = NULL;
  float *xarray = NULL;
  float *xarray2 = NULL;
  float *yarray = NULL;
  float *yerrarray = NULL;
  float *xlarray = NULL;
  float *ylarray = NULL;
  float xmin;
  float xmax;
  float ymin;
  float ymax;
  int bars;
  float barwidth;
  int posrefr;
  double xrefp;
  double yrefp;

  char **varystr = NULL;
  char *varyhstr = NULL;
  char *strbef = NULL;

  int i, j, k, dev, def, nel, inword, nrplts, dummy;
  char mes[200];
  char *pgdevice = NULL;

  char inqstr[24];
  int colour;
  int lines;
  int interp;
  int errbars;
  int symb;
  int fill;
  float sizer;

  char leftdeschi[8];
  char rightdeschi[8];
  char leftdesclo[30];
  char rightdesclo[30];
  char bottomdeschi[8];
  char bottomdesclo[30];
  char topdesclo[30];
  char topdeschi[30];

  float lrzero;
  float lrscale;
  float btzero;
  float btscale;
  int xlog;
  int ylog;
  int numplpts, ident;

  char legend[80];

  int pltlegend;

  int nradd = 0;
  int *npadd = NULL;
  float **xval = NULL;
  float **yval = NULL;
  float **errb = NULL;
  int *erad = NULL;
  int *adcol = NULL;
  int *adfill = NULL;
  int *adsymb = NULL;
  int *adlines = NULL;
  int *adinterp = NULL;
  float *adsizer = NULL;

  int verln, horln;
  float *vertarray = NULL, *horarray = NULL;
  int *vertcarray = NULL, *horcarray = NULL;
  float vhlxs[2],vhlys[2];

  int keypres, nread, nreturned;

  /* Ask the user for the output device */
  /* for (i = 0; i < 200; ++i) { */
  /*   pgdevice[i] = ' '; */
  /* } */
  /* pgdevice[200] = '\0'; */

  /* sprintf(mes, "Give graphics (pgplot) device:"); */
  /* def = 2; */
  /* nel = 1; */
  /* userchar_tir(pgdevice, &nel, &def, "GR_DEVICE=", mes); */
  /* termsinglestr(pgdevice); */

  /* cancel_tir(startinfv -> arel, "GR_DEVICE"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "GR_DEVICE", "Give graphics (pgplot) device.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr)) {
    goto error;
  }

  if ((varystr[0])) {
    if (!(pgdevice = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(pgdevice = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  /* If there was no input we return */
  if (*pgdevice == '\0') {
    free(pgdevice);
    return 0;
  }
  /* Check if there was a logfile and stop if there wasn't */
  /*   if (*log -> logname == '\0') */
  /*     return 0; */

  /* Allocate the complicated varystr */
  if (!(varystr = (char **) malloc(MAXGRAPHS*sizeof(char *))))
    goto error;
  /* if (!(varyhstr = getfcharray(VARYHSTRELES, NULL))) */
  /*   goto error; */

  /* Then ask for the things to plot */
  /* sprintf(mes, "Give parameters to plot"); */
  /* def = 0; */
  /* nel = usertext_tir(varyhstr, &def, "GR_PARMS=",mes); */

  /* Terminate the string */
  /* varyhstr[nel] = '\0'; */

  if ((varyhstr))
    free(varyhstr);
  if (simparse_scn_arel_readval_string(startinfv -> arel, "GR_PARMS", "Give parameters to plot.", 0, "", 0, -1, 0, 0, &keypres, &nread, &nreturned, &varyhstr)) {
    goto error;
  }

  /* Change the case if it is lower case */
  i = 0;
  while (varyhstr[i]) {
    if (varyhstr[i] >= 'a' && varyhstr[i] <= 'z')
      varyhstr[i] = varyhstr[i]+'A'-'a';
    ++i;
  }

  /* Now hack it into peaces, fill varystr, ignoring wrong parameters */
  inword = 0;
  i = 0;
  nrplts = 0;

  while (varyhstr[i] != '\0') {

    if ((inword)) {
      if (varyhstr[i] == ' ' || varyhstr[i] == '\t') {
	varyhstr[i] = '\0';

	if ((ident = get_graphident(strbef, NULL, NULL, NULL, NULL, rpm -> ndisks)) > 0) {
	  varystr[nrplts] = strbef;
	  ++nrplts;
	}
	inword = 0;
      }
      else if (varyhstr[i+1] == '\0') {

	if ((ident = get_graphident(strbef, NULL, NULL, NULL, NULL, rpm -> ndisks)) > 0) {
	  varystr[nrplts] = strbef;
	  ++nrplts;
	}
      }
    }
    else if (varyhstr[i] != ' ' && varyhstr[i] != '\t') {
      if (nrplts < MAXGRAPHS)
	strbef = varyhstr+i;
      inword = 1;
    }
    ++i;
  }

  dev = 1;
  if (nrplts < 2) {
    sprintf(mes, "Something wrong with GR_PARMS=, no output");
    anyout_tir(&dev, mes);
  }

  /* Allocate memory for the output */
  if (!(xarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  if (!(xarray2 = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  if (!(yarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  if (!(yerrarray = (float *) malloc((rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  if (!(xlarray = (float *) malloc((rpm -> nr*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  if (!(ylarray = (float *) malloc((rpm -> nr*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS)*sizeof(float))))
    goto error;

  /* We read all values into the outarray */
  tir_get_grid(log, rpm, log -> outarray);

  /* Then into the par array */
  for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
    rpm -> par[j] = log -> outarray[j];

  /* Get the reference positions */

  /* First ask for the reference ring */
  sprintf(mes, "Position reference ring [1]");
  def = 2;
  nel = 1;
  posrefr = 1;
  userint_tir(startinfv -> arel, &posrefr, &nel, &def, "GR_PRFR=", mes);
  if ((posrefr < 1) || (posrefr >  rpm -> nur))
    posrefr = 1;
  else
    --posrefr;

  /* Then this will be a default for the reference position */
  sprintf(mes, "Reference Right Ascension [%.3f]",rpm -> par[PXPOS*rpm -> nur+posrefr]);
  def = 2;
  nel = 1;
  xrefp = rpm -> par[PXPOS*rpm -> nur+posrefr];
  userdble_tir(startinfv -> arel, &xrefp, &nel, &def, "GR_PRFX=", mes);

  /* Export this to log */
  log -> xref = xrefp;

  sprintf(mes, "Reference Declination [%.3f]",rpm -> par[PYPOS*rpm -> nur+posrefr]);
  def = 2;
  nel = 1;
  yrefp = rpm -> par[PYPOS*rpm -> nur+posrefr];
  userdble_tir(startinfv -> arel, &yrefp, &nel, &def, "GR_PRFY=", mes);

  /* Export this to log */
  log -> yref = yrefp;

  /* Interpolate over */
  for (i = rpm -> nur*NSSDPARAMS; i < rpm->nur *(NSSDPARAMS+NDPARAMS*rpm->ndisks); ++i)
    rpm -> chapar[i] = 1;

  if (changedependent(rpm, rpm -> par, fit -> index, rpm -> chapar) < 0)
    goto error;

  interpover(rpm, barwidth = dinterntoparam(rpm -> radsep, RADI, hdr, rpm -> ndisks), 0, NULL, fit -> index);

  /* Now prepare the arrays for x */

  fillgrapharray(startinfv, hdr, rpm, ident = get_graphident(varystr[0], NULL, NULL, NULL, NULL, rpm -> ndisks), xarray, xlarray, rpm -> ndisks);

  /* Get the scale and the identity card */
  gr_fillscaling(log, hdr, get_graphident(varystr[0], bottomdeschi, bottomdesclo, topdesclo, legend, rpm -> ndisks), &btscale, &btzero, rpm -> ndisks);

  /* Inquire whether to plot subrings */
  sprintf(mes, "Plot values for subrings 1/0? [1]");
  def = 2;
  nel = 1;
  bars = 1;
  userint_tir(startinfv -> arel, &bars, &nel, &def, "GR_SBRP=", mes);

  /* Get min */
  xmin = xarray[0];
  for (i = 1; i < rpm -> nur; ++i)
    xmin = (xmin > xarray[i])?xarray[i]:xmin;
  if ((bars))
    for (i = 0; i < rpm -> nr; ++i)
      xmin = (xmin > xlarray[i])?xlarray[i]:xmin;

  /* Get max */
  xmax = xarray[0];
  for (i = 1; i < rpm -> nur; ++i)
    xmax = (xmax < xarray[i])?xarray[i]:xmax;
  if ((bars))
    for (i = 0; i < rpm -> nr; ++i)
      xmax = (xmax < xlarray[i])?xlarray[i]:xmax;

  /* Inquire min and max */
  sprintf(mes, "Give minimum of x-axis [%f]", xmin);
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &xmin, &nel, &def, "GR_XMIN=", mes);
  sprintf(mes, "Give maximum of x-axis [%f]", xmax);
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &xmax, &nel, &def, "GR_XMAX=", mes);

  /* Inquire x-axis style */
  sprintf(mes, "Logarithmic scaling of x-axis? (1/0)");
  xlog = 0;
  def = 2;
  nel = 1;
  userint_tir(startinfv -> arel, &xlog, &nel, &def, "GR_XLOG=", mes);

  if ((xlog))
    xlog = 1;

  /* In case of SBR, the right hand is SD */
  if (ident == SBR)
    gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+DENS_GRAPHNR), topdeschi, rpm -> ndisks);
  else if (ident == XPOS) {
    gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+RASH_GRAPHNR), topdeschi, rpm -> ndisks);
    xlog = 2;
  }
  else if (ident == YPOS) {
    gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+DESH_GRAPHNR), topdeschi, rpm -> ndisks);
    xlog = 3;
  }
  else {
    gr_fillaxis(ident, topdeschi, rpm -> ndisks);
  }

  /* Ask whether to plot a legend */
  sprintf(mes, "Plot legend (1/0)?");
  def = 2;
  nel = 1;
  pltlegend = 1;
  userint_tir(startinfv -> arel, &pltlegend, &nel, &def, "GR_LGND=", mes);

  /* Now initialise the graphics */
  pgp_opendev(pgdevice);

  /* Generate the standard frame information */
  gdsc = pgp_gdsc_default(nrplts-1, 2, (pltlegend)?((nrplts+1)/2):0, 1.0);

  /* Make the adjustment of left and right frame possible */
  sprintf(mes, "Give right hand margin");
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &gdsc -> rightmargin, &nel, &def, "GR_MR=", mes);
  sprintf(mes, "Give left hand margin");
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &gdsc -> leftmargin, &nel, &def, "GR_ML=", mes);

  /* Ask for the height of text and symbols */
  sprintf(mes, "Give height of Text");
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &gdsc -> numberheight, &nel, &def, "GR_TXHT=", mes);

  sprintf(mes, "Give height of symbols");
  def = 2;
  nel = 1;
  userreal_tir(startinfv -> arel, &gdsc -> symbolheight, &nel, &def, "GR_SBHT=", mes);

  /* Legendheight and axdescheight are 1 by default, we leave it at that */

  /* Put the x axis descriptor */
  if ((pltlegend))
    pgp_legend(gdsc, 1, 1, legend);

  /* Plot everything */
  for (i = 1; i < nrplts; ++i) {
    def = 2;
    nel = 1;

    /* Inquire colour */
    colour = i;
    sprintf(inqstr, "GR_COL_%i=", i);
    sprintf(mes, "Give Colour of plot %i", i);
    userint_tir(startinfv -> arel, &colour, &nel, &def, inqstr, mes);

    /* Inquire symbol */
    symb = -1;
    sprintf(inqstr, "GR_SYMB_%i=", i);
    sprintf(mes, "Give symbol for plot %i", i);
    userint_tir(startinfv -> arel, &symb, &nel, &def, inqstr, mes);

    /* Inquire fill */
    fill = 0;
    /*     sprintf(inqstr, "GR_EMTY_%i=", i); */
    /*     sprintf(mes, "Fill symbol for plot %i? (0)", i); */
    /*     userint_tir(startinfv -> arel, &fill, &nel, &def, inqstr, mes); */

    /* Inquire sizer */
    sizer = 1.0;
    sprintf(inqstr, "GR_SIZE_%i=", i);
    sprintf(mes, "Relative size of symbol for plot %i? (0)", i);
    userreal_tir(startinfv -> arel, &sizer, &nel, &def, inqstr, mes);

    /* Inquire lines */
    lines = 0;
    sprintf(inqstr, "GR_LINES_%i=", i);
    sprintf(mes, "Plot lines 1/0? [0]");
    userint_tir(startinfv -> arel, &lines, &nel, &def, inqstr, mes);

    /* Inquire lines interpolation type */
    switch (rpm -> smothcar[ident-1+NPARAMS-NDPARAMS]) {
    case PGP_I_CSPLINE:
      interp = 1;
      break;
    case PGP_I_AKIMA:
      interp = 2;
      break;
    default:
      interp = 0;
      break;
    }
    sprintf(inqstr, "GR_INTERP_%i=", i);
    sprintf(mes, "Interpolation 0: linear, 1: cubic spline, 2: Akima [0]");
    userint_tir(startinfv -> arel, &interp, &nel, &def, inqstr, mes);
    switch (interp) {
    case 1:
      interp = PGP_I_CSPLINE;
      break;
    case 2:
      interp = PGP_I_AKIMA;
      break;
    default:
      interp = PGP_I_LINEAR;
      break;
    }

    /* Inqurie number of small interpolating lines, once for all */
    gdsc -> interp_numlines = GR_INTERP_NUMLINES_DEFAULT;
    sprintf(inqstr, "GR_INTERP_NUMLINES=");
    sprintf(mes, "Number of small straight lines when interpolating [%i]", gdsc -> interp_numlines);
    userint_tir(startinfv -> arel, &(gdsc -> interp_numlines), &nel, &def, inqstr, mes);

    /* Inquire errorbars */
    errbars = 0;
    sprintf(inqstr, "GR_ERRB_%i=", i);
    sprintf(mes, "Plot errorbars 1/0? [0]");
    userint_tir(startinfv -> arel, &errbars, &nel, &def, inqstr, mes);

    /* Inquire logarithmic scaling */
    ylog = 0;
    sprintf(inqstr, "GR_YLOG_%i=", i);
    sprintf(mes, "y-axis logarithmic scaling 1/0? [0]");
    userint_tir(startinfv -> arel, &ylog, &nel, &def, inqstr, mes);

    if ((ylog))
      ylog = 1;

    /* Get number of vertical lines */
    verln = 0;
    nel = 1;
    sprintf(inqstr, "GR_VERL_%i=", i);
    sprintf(mes, "How many vertical lines for plot %i?", i);
    userint_tir(startinfv -> arel, &verln, &nel, &def, inqstr, mes);
    verln = verln > 0 ? verln : -verln;

    if ((verln)) {

      /* allocate */
      if (!(vertarray = (float *) malloc(verln*sizeof(float))))
	goto error;

      if (!(vertcarray = (int *) malloc(verln*sizeof(int))))
	goto error;

      for (j = 0; j < verln; ++j)
	vertarray[j] = 0.0;

      for (j = 0; j < verln; ++j)
	vertcarray[j] = 1;

      sprintf(mes, "Give values for vertical lines");
      def = 2;
      nel = verln;
      sprintf(inqstr, "GR_VLVA_%i=", i);
      userreal_tir(startinfv -> arel, vertarray, &nel, &def, inqstr, mes);

      sprintf(mes, "Give colours for vertical lines");
      def = 2;
      nel = verln;
      sprintf(inqstr, "GR_VLCA_%i=", i);
      userint_tir(startinfv -> arel, vertcarray, &nel, &def, inqstr, mes);

      for (j = 0; j < verln; ++j)
	vertcarray[j] = vertcarray[j] > 0 ?  vertcarray[j] : - vertcarray[j];
    }

    /* Get number of horizontal lines */
    horln = 0;
    nel = 1;
    sprintf(inqstr, "GR_HORL_%i=", i);
    sprintf(mes, "How many horizontal lines for plot %i?", i);
    userint_tir(startinfv -> arel, &horln, &nel, &def, inqstr, mes);
    horln = horln > 0 ? horln : -horln;

    if ((horln)) {

      /* allocate */
      if (!(horarray = (float *) malloc(horln*sizeof(float))))
	goto error;

      if (!(horcarray = (int *) malloc(horln*sizeof(int))))
	goto error;

      for (j = 0; j < horln; ++j)
	horarray[j] = 0.0;

      for (j = 0; j < horln; ++j)
	horcarray[j] = 1;

      sprintf(mes, "Give values for horizontal lines of plot %i",i);
      sprintf(inqstr, "GR_HLVA_%i=", i);
      def = 2;
      nel = horln;
      userreal_tir(startinfv -> arel, horarray, &nel, &def, inqstr, mes);

      sprintf(mes, "Give colours for horizontal lines of plot %i", i);
      def = 2;
      nel = horln;
      sprintf(inqstr, "GR_HLCA_%i=", i);
      userint_tir(startinfv -> arel, horcarray, &nel, &def, inqstr, mes);

      for (j = 0; j < verln; ++j)
	horcarray[j] = horcarray[j] > 0 ?  horcarray[j] : - horcarray[j];
    }

    /* Fill yerrarray */
    if ((errbars)) {

      /* We read all values into the outarray */
      tir_get_radius(log, rpm, log -> outarray);

      for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
	rpm -> par[j] = log -> outarray[j];

      fillgrapharray(startinfv, hdr, rpm, ident, yerrarray, ylarray, rpm -> ndisks);

      /* Give the user the possibility to put own errorbars */
      def = 2;
      nel = rpm -> nur;
      sprintf(mes, "Give own errorbars");
      sprintf(inqstr, "GR_ERRV_%i=", i);
      userreal_tir(startinfv -> arel, yerrarray, &nel, &def, inqstr, mes);
    }
    else {
      for (j = 0; j < rpm -> nur; ++j)
	yerrarray[j] = 0;
    }

    /* Fill yarray */

    /* We read all values into the outarray */
    tir_get_grid(log, rpm, log -> outarray);

    for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
      rpm -> par[j] = log -> outarray[j];

    /* Central coordinates get the head cut off */
    /*     for (j = 0; j < rpm -> nur; ++j) { */
    /*       rpm -> par[PXPOS*rpm -> nur+j] = rpm -> par[PXPOS*rpm -> nur+j]-((int) rpm -> par[(PXPOS+1)*rpm -> nur-1]); */
    /*       rpm -> par[PYPOS*rpm -> nur+j] = rpm -> par[PYPOS*rpm -> nur+j]-((int) rpm -> par[(PYPOS+1)*rpm -> nur-1]); */
    /*     } */

    fillgrapharray(startinfv, hdr, rpm, ident = get_graphident(varystr[i], NULL, NULL, NULL, NULL, rpm -> ndisks), yarray, ylarray, rpm -> ndisks);

    /* Inquire number of additional arrays */
    sprintf(mes, "Give number of additional rows for plot %i: [0]", i);
    sprintf(inqstr, "GR_NRAD_%i=", i);
    def = 2;
    nel = 1;
    nradd = 0;
    userint_tir(startinfv -> arel, &nradd, &nel, &def, inqstr, mes);

    /* Reserve memory */
    if (nradd > 0) {
      if (!(npadd = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(erad = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adcol = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adsymb = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adfill = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adlines = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adinterp = (int *) malloc(nradd*sizeof(int))))
	goto error;
      if (!(adsizer = (float *) malloc(nradd*sizeof(float))))
	goto error;
      if (!(xval = (float **) malloc(nradd*sizeof(float *))))
	goto error;
      for (k = 0; k < nradd; ++k) {
	xval[k] = NULL;
      }
      if (!(yval = (float **) malloc(nradd*sizeof(float *))))
	goto error;
      for (k = 0; k < nradd; ++k) {
	yval[k] = NULL;
      }
      if (!(errb = (float **) malloc(nradd*sizeof(float *))))
	goto error;
      for (k = 0; k < nradd; ++k) {
	errb[k] = NULL;
      }
    }

    /* Now get the info about all the additional points */
    for (k = 0; k < nradd; ++k) {

      /* Inquire number of additional points */
      sprintf(mes, "Give number of additional points for plot %i (%i): [0]", i, k+1);
      sprintf(inqstr, "GR_NPAD_%i_%i=", i, k+1);

      npadd[k] = -1;
      while(npadd[k] < 0) {
	def = 4;
	nel = 1;
	npadd[k] = 0;
	userint_tir(startinfv -> arel, npadd+k, &nel, &def, inqstr, mes);
	if (npadd[k] < 0) {
	  sprintf(mes, "Must be at least 0");
	  anyout_tir(&nel, mes);
	  cancel_tir(startinfv -> arel, inqstr, 2);
	}
      }

      if ((npadd[k])) {

	/* Reserve memory */
	if (!(xval[k] = (float *) malloc(npadd[k]*sizeof(float))))
	  goto error;
	if (!(yval[k] = (float *) malloc(npadd[k]*sizeof(float))))
	  goto error;
	if (!(errb[k] = (float *) malloc(npadd[k]*sizeof(float))))
	  goto error;

	/* Inquire points */
	sprintf(mes, "Give additional points, x axis for plot %i (%i):", i, k+1);
	sprintf(inqstr, "GR_XPAD_%i_%i=", i, k+1);
	def = 4;
	nel = npadd[k];
	userreal_tir(startinfv -> arel, xval[k], &nel, &def, inqstr, mes);

	sprintf(mes, "Give additional points, y axis for plot %i (%i):", i, k+1);
	sprintf(inqstr, "GR_YPAD_%i_%i=", i, k+1);
	userreal_tir(startinfv -> arel, yval[k], &nel, &def, inqstr, mes);

	/* Inquire errorbars */
	sprintf(mes, "Errorbars to additional points of plot %i (%i) (1/0)?", i, k+1);
	sprintf(inqstr, "GR_ERAD_%i_%i=", i, k+1);
	def = 2;
	nel = 1;
	erad[k] = 0;
	userint_tir(startinfv -> arel, &erad[k], &nel, &def, inqstr, mes);

	if ((erad[k])) {

	  /* Get the errorbars */
	  sprintf(mes, "Give errorbars for additional points of plot %i (%i):", i, k+1);
	  sprintf(inqstr, "GR_EBAD_%i_%i=", i, k+1);
	  def = 4;
	  nel = npadd[k];
	  userreal_tir(startinfv -> arel, errb[k], &nel, &def, inqstr, mes);
	}
	else {
	  for (j = 0; j < npadd[k]; ++j)
	    (errb[k])[j] = 0;
	}

	/* Inquire colour */
	sprintf(mes, "Give colour of additional points of plot %i (%i):", i, k+1);
	sprintf(inqstr, "GR_COAD_%i_%i", i, k+1);
	def = 2;
	nel = 1;
	adcol[k] = i;
	userint_tir(startinfv -> arel, adcol+k, &nel, &def, inqstr, mes);

	/* Inquire symbol */
	sprintf(mes, "Give symbol of additional points of plot %i (-1):", i);
	sprintf(inqstr, "GR_SYAD_%i_%i", i, k+1);
	def = 2;
	nel = 1;
	adsymb[k] = -1;
	userint_tir(startinfv -> arel, adsymb+k, &nel, &def, inqstr, mes);

	/* Inquire emptyness */
	sprintf(mes, "Symbols of additional points of plot %i empty: (1)", i);
	sprintf(inqstr, "GR_EMAD_%i_%i", i, k+1);
	def = 2;
	nel = 1;
	adfill[k] = 0;
	/*  userint_tir(startinfv -> arel, adfill+k, &nel, &def, inqstr, mes); */

	/* Inquire sizer */
	sprintf(mes, "Size of additional points relative to standard size");
	sprintf(inqstr, "GR_SIAD_%i_%i", i, k+1);
	def = 2;
	nel = 1;
	adsizer[k] = 1.0;
	userreal_tir(startinfv -> arel, adsizer+k, &nel, &def, inqstr, mes);

	/* Inquire lines */
	sprintf(mes, "Draw lines between additional points of plot %i (%i) (1/0)?", i, k+1);
	sprintf(inqstr, "GR_LIAD_%i_%i", i, k+1);
	def = 2;
	nel = 1;
	adlines[k] = 0;
	userint_tir(startinfv -> arel, adlines+k, &nel, &def, inqstr, mes);

	switch (interp) {
	case PGP_I_CSPLINE:
	  adinterp[k] = 1;
	  break;
	case PGP_I_AKIMA:
	  adinterp[k] = 2;
	  break;
	default:
	  adinterp[k] = 0;
	  break;
	}
	/***/
	/***/
	/***/
	/*	fprintf(stderr,"Got here"); */
	/***/
	sprintf(inqstr, "GR_INTERPAD_%i_%i=", i, k+1);
	sprintf(mes, "Interpolation between additional points plot %i (%i), 0: linear, 1: cubic spline, 2: Akima [0]", i, k+1);
	userint_tir(startinfv -> arel, adinterp+k, &nel, &def, inqstr, mes);
	switch (adinterp[k]) {
	case 1:
	  adinterp[k] = PGP_I_CSPLINE;
	  break;
	case 2:
	  adinterp[k] = PGP_I_AKIMA;
	  break;
	default:
	  adinterp[k] = PGP_I_LINEAR;
	  break;
	}
      }
    }

    /* Inquire min and max */
    ymin = yarray[0]-fabs(yerrarray[0]);
    for (j = 1; j < rpm -> nur; ++j)
      ymin = (ymin > (yarray[j]-fabs(yerrarray[j])))?(yarray[j]-fabs(yerrarray[j])):ymin;
    if ((bars))
      for (j = 0; j < rpm -> nr; ++j)
	ymin = (ymin > ylarray[j])?ylarray[j]:ymin;
    for (k = 0; k < nradd; ++k) {
      for (j = 0; j < npadd[k]; ++j)
	ymin = (ymin > ((yval[k])[j]-fabs((errb[k])[j])))?((yval[k])[j]-fabs((errb[k])[j])):ymin;
    }

    ymax = yarray[0]+fabs(yerrarray[0]);
    for (j = 1; j < rpm -> nur; ++j)
      ymax = (ymax < (yarray[j]+fabs(yerrarray[j])))?(yarray[j]+fabs(yerrarray[j])):ymax;
    if ((bars))
      for (j = 0; j < rpm -> nr; ++j)
	ymax = (ymax < ylarray[j])?ylarray[j]:ymax;
    for (k = 0; k < nradd; ++k) {
      for (j = 0; j < npadd[k]; ++j)
	ymax = (ymax < ((yval[k])[j]+fabs((errb[k])[j])))?((yval[k])[j]+fabs((errb[k])[j])):ymax;
    }
    /* Ask */
    sprintf(inqstr, "GR_YMIN_%i=", i);
    sprintf(mes, "Give minimum of y-axis %i: [%f]", i, ymin);
    def = 2;
    nel = 1;
    userreal_tir(startinfv -> arel, &ymin, &nel, &def, inqstr, mes);
    sprintf(inqstr, "GR_YMAX_%i=", i);
    sprintf(mes, "Give maximum of y-axis %i: [%f]", i, ymax);
    def = 2;
    nel = 1;
    userreal_tir(startinfv -> arel, &ymax, &nel, &def, inqstr, mes);

    /* Fill the y axis descriptors and scalings */
    /* Get the scale and the identity card */
    gr_fillscaling(log, hdr, get_graphident(varystr[i], leftdeschi, leftdesclo, rightdesclo, legend, rpm -> ndisks), &lrscale, &lrzero, rpm -> ndisks);

    /* In case of SBR, the right hand is SD */
    if (ident == SBR)
      gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+DENS_GRAPHNR), rightdeschi, rpm -> ndisks);
    else if (ident == XPOS) {
      gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+RASH_GRAPHNR), rightdeschi, rpm -> ndisks);
      ylog = 2;
    }
    else if (ident == YPOS) {
      gr_fillaxis((NPARAMS+(rpm -> ndisks-1)*NDPARAMS+DESH_GRAPHNR), rightdeschi, rpm -> ndisks);
      ylog = 3;
    }
    else
      gr_fillaxis(ident, rightdeschi, rpm -> ndisks);

    /* Plot the box */
    pgp_openbox(gdsc, i, xmin, xmax, ymin, ymax, leftdeschi, leftdesclo, rightdeschi, rightdesclo, bottomdeschi, bottomdesclo, topdeschi, topdesclo, lrzero, lrscale, btzero, btscale, xlog, ylog);

    /* Plot additional points */
    if (nradd > 0) {
      for (k = 0; k < nradd; ++k) {
	if ((npadd[k])) {

	  pgp_marker(gdsc, npadd[k], xval[k], yval[k], adcol[k], adfill[k], adsymb[k], adsizer[k]);

	  /* Plot errorbars */
	  if ((erad[k]))
	    pgp_errby(gdsc, npadd[k], xval[k], yval[k], errb[k], adcol[k]);

	  /* Plot lines */
	  if ((adlines[k])) {
	    gdsc -> interptype_lines = adinterp[k];
	    pgp_lines(gdsc, npadd[k], xval[k], yval[k], adcol[k]);
	  }

	  /* Free memory */
	  free(xval[k]);
	  xval[k] = NULL;
	  free(yval[k]);
	  yval[k] = NULL;
	  free(errb[k]);
	  errb[k] = NULL;
	}
      }

      /* free stuff */
      free(npadd);
      free(erad);
      free(adcol);
      free(adlines);
      free(xval);
      free(yval);
      free(errb);
    }

    /* Plot bars */
    if ((bars))
      pgp_bars(gdsc, rpm -> nr, xlarray, ylarray, barwidth, colour);

    /* Plot lines */
    if ((lines)) {
      gdsc -> interptype_lines = interp;
      pgp_lines(gdsc, rpm -> nur, xarray, yarray, colour);
    }

    /* Copy the x array and remove points */
    for (j = 0; j < rpm -> nur; ++j)
      xarray2[j] = xarray[j];
    numplpts = gr_deleteindexed(rpm -> nur, ident, xarray2, yarray, yerrarray, fit -> index, rpm -> ndisks);

    if (numplpts) {

      /* Plot errorbars */
      if ((errbars))
	pgp_errby(gdsc, numplpts, xarray2, yarray, yerrarray, colour);

      /* Plot the points */
      pgp_marker(gdsc, numplpts, xarray2, yarray, colour, fill, symb, sizer);
    }

    /* plot horizontal lines */
    if ((horln)) {
      for (j = 0; j < horln; ++j) {
	vhlys[0] = vhlys[1] = horarray[j];

	if (xmin == xmax) {
	  vhlxs[0] = 1000000.0*xarray[0]+0.1;
	  vhlxs[1] = -1000000.0*xarray[0]-0.1;
	}
	else {
	  vhlxs[0] = (xmin+xmax)/2.0-1000000.0*(xmax-xmin);
	  vhlxs[1] = (xmin+xmax)/2.0+1000000.0*(xmax-xmin);
	}
	dummy = gdsc -> interptype_lines;
	gdsc -> interptype_lines = PGP_I_LINEAR;
	pgp_lines(gdsc, 2, vhlxs, vhlys, horcarray[j]);
	gdsc -> interptype_lines = dummy;
      }
      free(horarray);
      free(horcarray);
    }

    /* plot vertical lines */
    if ((verln)) {
      for (j = 0; j < verln; ++j) {
	vhlxs[0] = vhlxs[1] = vertarray[j];
	if (ymin == ymax) {
	  vhlys[0] = 1000000.0*yarray[0]+0.1;
	  vhlys[1] = -1000000.0*yarray[0]-0.1;
	}
	else {
	  vhlys[0] = (ymin+ymax)/2.0-1000000.0*(ymax-ymin);
	  vhlys[1] = (ymin+ymax)/2.0+1000000.0*(ymax-ymin);
	}
	/* Switch off interpolation scheme before plotting and reinstate */
	dummy = gdsc -> interptype_lines;
	gdsc -> interptype_lines = PGP_I_LINEAR;
	pgp_lines(gdsc, 2, vhlxs, vhlys, vertcarray[j]);
	gdsc -> interptype_lines = dummy;
      }
      free(vertarray);
      free(vertcarray);
    }

    /* Put the legend line */
    if ((pltlegend))
      pgp_legend(gdsc, i%2+1, i/2+1, legend);
  }

  /* Free memory */
  free(varystr);
  free(varyhstr);
  free(xarray);
  free(xarray2);
  free(yarray);
  free(yerrarray);
  free(xlarray);
  free(ylarray);
  free(pgdevice);

  /* Once we got here, we ask the user if to continue */
  sprintf(mes, "Continue (Press return)?");
  def = 1;
  nel = 1;
  userint_tir(startinfv -> arel, &pltlegend, &nel, &def, "GR_CONT=", mes);

  /* Then we stop it */
  pgp_end();

  return nrplts-1;

 error:
  if ((varystr))
    free(varystr);
  if ((varyhstr))
    free(varyhstr);
  if ((xarray))
    free(xarray);
  if ((xarray2))
    free(xarray2);
  if ((yarray))
    free(yarray);
  if ((yerrarray))
    free(yerrarray);
  if ((xlarray))
    free(xlarray);
  if ((ylarray))
    free(ylarray);

  if ((npadd))
    free(npadd);
  if ((erad))
    free(erad);
  if ((adcol))
    free(adcol);
  if ((adsymb))
    free(adsymb);
  if ((adfill))
    free(adfill);
  if ((adlines))
    free(adlines);
  if ((adsizer))
    free(adsizer);
  if ((vertarray))
    free(vertarray);
  if ((horarray))
    free(horarray);
  if ((vertcarray))
    free(vertcarray);
  if ((horcarray))
    free(horcarray);

  if ((xval)) {
    for (i = 0; i < nradd; ++i) {
      if ((xval[i]))
	free(xval[i]);
    }
    free(xval);
  }

  if ((yval)) {
    for (i = 0; i < nradd; ++i) {
      if ((yval[i]))
	free(yval[i]);
    }
    free(yval);
  }

  if ((errb)) {
    for (i = 0; i < nradd; ++i) {
      if ((errb[i]))
	free(errb[i]);
    }
    free(errb);
  }

  if ((pgdevice))
    free(pgdevice);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns the identifyer of a graphics output */
static int get_graphident(char *string, char *axis, char *unit, char *altunit, char *legend, int ndisks)
{
  int ident;

  /* First check if there is a string */
  if (!string)
    return -1;

  /* Now check if it can be identified with a variable parameter itself */
  if(((ident = ftstab_gtitln_(string)) <= 0))
    ident = get_graphnr(string, ndisks);
  else if (ident > (NPARAMS+(ndisks-1)*NDPARAMS))
    return -1;

  if (ident == 0)
    return -1;

  /* Now fill the strings */
  gr_fillaxis(ident, axis, ndisks);
  gr_fillunit(ident, unit, ndisks);
  gr_fillaltunit(ident, altunit, ndisks);
  gr_filllegend(ident, legend, ndisks);

  /* Finis */
  return ident;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Identifies a graphics output number */
static int get_graphnr(char *string, int ndisks)
{
  if (!strcmp(string, "WA"))
    return NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR;
  if (!strcmp(string, "DENS"))
    return NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR;
  if (!strcmp(string, "WOLD"))
    return NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR;
  if (!strcmp(string, "TIP"))
    return NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR;
  if (!strcmp(string, "LON"))
    return NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR;
  return -1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns an axis descriptor string suitable for the use in the pgp module */
static void gr_fillaxis(int ident, char *string, int ndisks)
{
  int disk;

  if ((string)) {
    if (ident ==RADI) {
      sprintf(string, "R");
      return;
    }
    if (ident ==VROT) {
      sprintf(string, "VROT");
      return;
    }
    if (ident ==VRAD) {
      sprintf(string, "VRAD");
      return;
    }
    if (ident ==VVER) {
      sprintf(string, "VVER");
      return;
    }
    if (ident ==DVRO) {
      sprintf(string, "DVRO");
      return;
    }
    if (ident ==DVRA) {
      sprintf(string, "DVRA");
      return;
    }
    if (ident ==DVVE) {
      sprintf(string, "DVVE");
      return;
    }
    if (ident ==ZDRO) {
      sprintf(string, "ZDRO");
      return;
    }
    if (ident ==ZDRA) {
      sprintf(string, "ZDRA");
      return;
    }
    if (ident ==ZDVE) {
      sprintf(string, "ZDVE");
      return;
    }
    if (ident ==Z0) {
      sprintf(string, "SCHT");
      return;
    }
    if (ident ==SDIS) {
      sprintf(string, "DISP");
      return;
    }
    if (ident ==CLNR) {
      sprintf(string, "CLNR");
      return;
    }
    if (ident ==VM0A ) {
      sprintf(string, "VM0A");
      return;
    }
    if (ident ==VM1A) {
      sprintf(string, "VM1A");
      return;
    }
    if (ident ==VM1P) {
      sprintf(string, "VM1P");
      return;
    }
    if (ident ==VM2A) {
      sprintf(string, "VM2A");
      return;
    }
    if (ident ==VM2P) {
      sprintf(string, "VM2P");
      return;
    }
    if (ident ==VM3A) {
      sprintf(string, "VM3A");
      return;
    }
    if (ident ==VM3P) {
      sprintf(string, "VM3P");
      return;
    }
    if (ident ==VM4A) {
      sprintf(string, "VM4A");
      return;
    }
    if (ident ==VM4P) {
      sprintf(string, "VM4P");
      return;
    }

    if (ident ==RA1A) {
      sprintf(string, "RA1A");
      return;
    }
    if (ident ==RA1P) {
      sprintf(string, "RA1P");
      return;
    }
    if (ident ==RA2A) {
      sprintf(string, "RA2A");
      return;
    }
    if (ident ==RA2P) {
      sprintf(string, "RA2P");
      return;
    }
    if (ident ==RA3A) {
      sprintf(string, "RA3A");
      return;
    }
    if (ident ==RA3P) {
      sprintf(string, "RA3P");
      return;
    }
    if (ident ==RA4A) {
      sprintf(string, "RA4A");
      return;
    }
    if (ident ==RA4P) {
      sprintf(string, "RA4P");
      return;
    }
    if (ident ==RO1A) {
      sprintf(string, "RO1A");
      return;
    }
    if (ident ==RO1P) {
      sprintf(string, "RO1P");
      return;
    }
    if (ident ==RO2A) {
      sprintf(string, "RO2A");
      return;
    }
    if (ident ==RO2P) {
      sprintf(string, "RO2P");
      return;
    }
    if (ident ==RO3A) {
      sprintf(string, "RO3A");
      return;
    }
    if (ident ==RO3P) {
      sprintf(string, "RO3P");
      return;
    }
    if (ident ==RO4A) {
      sprintf(string, "RO4A");
      return;
    }
    if (ident ==RO4P) {
      sprintf(string, "RO4P");
      return;
    }
    if (ident ==WM0A  ) {
      sprintf(string, "WM0A");
      return;
    }
    if (ident ==WM1A ) {
      sprintf(string, "WM1A");
      return;
    }
    if (ident ==WM1P ) {
      sprintf(string, "WM1P");
      return;
    }
    if (ident ==WM2A ) {
      sprintf(string, "WM2A");
      return;
    }
    if (ident ==WM2P ) {
      sprintf(string, "WM2P");
      return;
    }
    if (ident ==WM3A ) {
      sprintf(string, "WM3A");
      return;
    }
    if (ident ==WM3P ) {
      sprintf(string, "WM3P");
      return;
    }
    if (ident ==WM4A ) {
      sprintf(string, "WM4A");
      return;
    }
    if (ident ==WM4P ) {
      sprintf(string, "WM4P");
      return;
    }
    if (ident ==LS0 ) {
      sprintf(string, "LS0");
      return;
    }
    if (ident ==LC0 ) {
      sprintf(string, "LC0");
      return;
    }
    if (ident ==SBR) {
      sprintf(string, "SBR");
      return;
    }
    if (ident ==SM1A) {
      sprintf(string, "SM1A");
      return;
    }
    if (ident ==SM1P) {
      sprintf(string, "SM1P");
      return;
    }
    if (ident ==SM2A) {
      sprintf(string, "SM2A");
      return;
    }
    if (ident ==SM2P) {
      sprintf(string, "SM2P");
      return;
    }
    if (ident ==SM3A) {
      sprintf(string, "SM3A");
      return;
    }
    if (ident ==SM3P) {
      sprintf(string, "SM3P");
      return;
    }
    if (ident ==SM4A) {
      sprintf(string, "SM4A");
      return;
    }
    if (ident ==SM4P) {
      sprintf(string, "SM4P");
      return;
    }
    if (ident ==GA1A) {
      sprintf(string, "GA1A");
      return;
    }
    if (ident ==GA1P) {
      sprintf(string, "GA1P");
      return;
    }
    if (ident ==GA1D) {
      sprintf(string, "GA1D");
      return;
    }
    if (ident ==GA2A) {
      sprintf(string, "GA2A");
      return;
    }
    if (ident ==GA2P) {
      sprintf(string, "GA2P");
      return;
    }
    if (ident ==GA2D) {
      sprintf(string, "GA2D");
      return;
    }
    if (ident ==GA3A) {
      sprintf(string, "GA3A");
      return;
    }
    if (ident ==GA3P) {
      sprintf(string, "GA3P");
      return;
    }
    if (ident ==GA3D) {
      sprintf(string, "GA3D");
      return;
    }
    if (ident ==GA4A) {
      sprintf(string, "GA4A");
      return;
    }
    if (ident ==GA4P) {
      sprintf(string, "GA4P");
      return;
    }
    if (ident ==GA4D) {
      sprintf(string, "GA4D");
      return;
    }
    if (ident ==AZ1P) {
      sprintf(string, "AZ1P");
      return;
    }
    if (ident ==AZ1W) {
      sprintf(string, "AZ1W");
      return;
    }
    if (ident ==AZ2P) {
      sprintf(string, "AZ2P");
      return;
    }
    if (ident ==AZ2W) {
      sprintf(string, "AZ2W");
      return;
    }
    if (ident ==INCL) {
      sprintf(string, "INCL");
      return;
    }
    if (ident ==PA) {
      sprintf(string, "PA");
      return;
    }
    if (ident ==XPOS) {
      sprintf(string, "RA");
      return;
    }
    if (ident ==YPOS) {
      sprintf(string, "DEC");
      return;
    }
    if (ident ==VSYS) {
      sprintf(string, "VSYS");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR)) {
      sprintf(string, "WA");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)) {
      sprintf(string, "SD");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {
      sprintf(string, "WAOL");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR)) {
      sprintf(string, "TIP");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {
      sprintf(string, "LON");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DESH_GRAPHNR)) {
      sprintf(string, "DESH");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+RASH_GRAPHNR)) {
      sprintf(string, "RASH");
      return;
    }

    for (disk = 1; disk < ndisks; ++disk) {
      if (ident == VROT+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VROT_%i", disk+1);         return;   }
      if (ident == VRAD+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VRAD_%i", disk+1);         return;   }
      if (ident == VVER+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VVER_%i", disk+1);         return;   }
      if (ident == DVRO+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVRO_%i", disk+1);         return;   }
      if (ident == DVRA+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVRA_%i", disk+1);         return;   }
      if (ident == DVVE+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVVE_%i", disk+1);         return;   }
      if (ident == ZDRO+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDRO_%i", disk+1);         return;   }
      if (ident == ZDRA+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDRA_%i", disk+1);         return;   }
      if (ident == ZDVE+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDVE_%i", disk+1);         return;   }
      if (ident == Z0  +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SCHT_%i", disk+1);         return;   }
      if (ident == SDIS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DISP_%i", disk+1);         return;   }
      if (ident == CLNR+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "CLNR_%i", disk+1);         return;   }
      if (ident == VM0A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM0A_%i", disk+1);         return;   }
      if (ident == VM1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM1A_%i", disk+1);         return;   }
      if (ident == VM1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM1P_%i", disk+1);         return;   }
      if (ident == VM2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM2A_%i", disk+1);         return;   }
      if (ident == VM2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM2P_%i", disk+1);         return;   }
      if (ident == VM3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM3A_%i", disk+1);         return;   }
      if (ident == VM3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM3P_%i", disk+1);         return;   }
      if (ident == VM4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM4A_%i", disk+1);         return;   }
      if (ident == VM4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM4P_%i", disk+1);         return;   }
      if (ident == RA1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA1A_%i", disk+1);         return;   }
      if (ident == RA1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA1P_%i", disk+1);         return;   }
      if (ident == RA2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA2A_%i", disk+1);         return;   }
      if (ident == RA2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA2P_%i", disk+1);         return;   }
      if (ident == RA3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA3A_%i", disk+1);         return;   }
      if (ident == RA3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA3P_%i", disk+1);         return;   }
      if (ident == RA4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA4A_%i", disk+1);         return;   }
      if (ident == RA4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA4P_%i", disk+1);         return;   }
      if (ident == RO1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO1A_%i", disk+1);         return;   }
      if (ident == RO1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO1P_%i", disk+1);         return;   }
      if (ident == RO2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO2A_%i", disk+1);         return;   }
      if (ident == RO2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO2P_%i", disk+1);         return;   }
      if (ident == RO3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO3A_%i", disk+1);         return;   }
      if (ident == RO3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO3P_%i", disk+1);         return;   }
      if (ident == RO4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO4A_%i", disk+1);         return;   }
      if (ident == RO4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO4P_%i", disk+1);         return;   }
      if (ident == WM0A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM0A_%i", disk+1);         return;   }
      if (ident == WM1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM1A_%i", disk+1);         return;   }
      if (ident == WM1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM1P_%i", disk+1);         return;   }
      if (ident == WM2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM2A_%i", disk+1);         return;   }
      if (ident == WM2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM2P_%i", disk+1);         return;   }
      if (ident == WM3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM3A_%i", disk+1);         return;   }
      if (ident == WM3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM3P_%i", disk+1);         return;   }
      if (ident == WM4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM4A_%i", disk+1);         return;   }
      if (ident == WM4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "WM4P_%i", disk+1);         return;   }
      if (ident == LS0 +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "LS0_%i",  disk+1);         return;   }
      if (ident == LC0 +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "LC0_%i",  disk+1);         return;   }
      if (ident == SBR +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SBR_%i",  disk+1);         return;   }
      if (ident == SM1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM1P_%i", disk+1);         return;   }
      if (ident == SM2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM2A_%i", disk+1);         return;   }
      if (ident == SM2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM2P_%i", disk+1);         return;   }
      if (ident == SM3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM3A_%i", disk+1);         return;   }
      if (ident == SM3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM3P_%i", disk+1);         return;   }
      if (ident == SM4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM4A_%i", disk+1);         return;   }
      if (ident == SM4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM4P_%i", disk+1);         return;   }
      if (ident == GA1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1A_%i", disk+1);         return;   }
      if (ident == GA1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1P_%i", disk+1);         return;   }
      if (ident == GA1D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1D_%i", disk+1);         return;   }
      if (ident == GA2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2A_%i", disk+1);         return;   }
      if (ident == GA2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2P_%i", disk+1);         return;   }
      if (ident == GA2D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2D_%i", disk+1);         return;   }
      if (ident == GA3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3A_%i", disk+1);         return;   }
      if (ident == GA3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3P_%i", disk+1);         return;   }
      if (ident == GA3D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3D_%i", disk+1);         return;   }
      if (ident == GA4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4A_%i", disk+1);         return;   }
      if (ident == GA4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4P_%i", disk+1);         return;   }
      if (ident == GA4D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4D_%i", disk+1);         return;   }
      if (ident == AZ1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ1P_%i", disk+1);         return;   }
      if (ident == AZ1W+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ1W_%i", disk+1);         return;   }
      if (ident == AZ2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ2P_%i", disk+1);         return;   }
      if (ident == AZ2W+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ2W_%i", disk+1);         return;   }
      if (ident == INCL+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "INCL_%i", disk+1);         return;   }
      if (ident == PA  +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "PA_%i",   disk+1);         return;   }
      if (ident == XPOS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "XPOS_%i", disk+1);         return;   }
      if (ident == YPOS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "YPOS_%i", disk+1);         return;   }
      if (ident == VSYS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VSYS_%i", disk+1);         return;   }
    }
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns an unit string suitable for the use in the pgp module */
void gr_fillunit(int ident, char *string, int ndisks)
{
  if ((string)) {

    if (ident == RADI) {
      sprintf(string, "arcsec");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)) {
      sprintf(string, "cm\\u-2");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }

    ident = (ident-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;
    switch (ident) {
    case VROT:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VRAD:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VVER:
      sprintf(string, "km\\.s\\u-1");
      return;
    case DVRO:
      sprintf(string, "km\\.s\\u-1\\d\\.arcsec\\u-1");
      return;
    case DVRA:
      sprintf(string, "km\\.s\\u-1\\d\\.arcsec\\u-1");
      return;
    case DVVE:
      sprintf(string, "km\\.s\\u-1\\d\\.arcsec\\u-1");
      return;
    case ZDRO:
      sprintf(string, "arcsec");
      return;
    case ZDRA:
      sprintf(string, "arcsec");
      return;
    case ZDVE:
      sprintf(string, "arcsec");
      return;
    case Z0:
      sprintf(string, "arcsec");
      return;
    case SDIS:
      sprintf(string, "km\\.s\\u-1");
      return;
    case CLNR:
      sprintf(string, " ");
      return;
    case VM0A :
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM1P:
      sprintf(string, "degree");
      return;
    case VM2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM2P:
      sprintf(string, "degree");
      return;
    case VM3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM3P:
      sprintf(string, "degree");
      return;
    case VM4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM4P:
      sprintf(string, "degree");
      return;
    case RA1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA1P:
      sprintf(string, "degree");
      return;
    case RA2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA2P:
      sprintf(string, "degree");
      return;
    case RA3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA3P:
      sprintf(string, "degree");
      return;
    case RA4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA4P:
      sprintf(string, "degree");
      return;
    case RO1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO1P:
      sprintf(string, "degree");
      return;
    case RO2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO2P:
      sprintf(string, "degree");
      return;
    case RO3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO3P:
      sprintf(string, "degree");
      return;
    case RO4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO4P:
      sprintf(string, "degree");
      return;
    case WM0A  :
      sprintf(string, "arcsec");
      return;
    case WM1A :
      sprintf(string, "arcsec");
      return;
    case WM1P :
      sprintf(string, "degree");
      return;
    case WM2A :
      sprintf(string, "arcsec");
      return;
    case WM2P :
      sprintf(string, "degree");
      return;
    case WM3A :
      sprintf(string, "arcsec");
      return;
    case WM3P :
      sprintf(string, "degree");
      return;
    case WM4A :
      sprintf(string, "arcsec");
      return;
    case WM4P :
      sprintf(string, "degree");
      return;
    case LS0 :
      sprintf(string, "arcsec");
      return;
    case LC0 :
      sprintf(string, "arcsec");
      return;
    case SBR:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case SM1A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case SM1P:
      sprintf(string, "degree");
      return;
    case SM2A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case SM2P:
      sprintf(string, "degree");
      return;
    case SM3A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case SM3P:
      sprintf(string, "degree");
      return;
    case SM4A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case SM4P:
      sprintf(string, "degree");
      return;
    case GA1A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case GA1P:
      sprintf(string, "degree");
      return;
    case GA1D:
      sprintf(string, "arcsec");
      return;
    case GA2A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case GA2P:
      sprintf(string, "degree");
      return;
    case GA2D:
      sprintf(string, "arcsec");
      return;
    case GA3A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case GA3P:
      sprintf(string, "degree");
      return;
    case GA3D:
      sprintf(string, "arcsec");
      return;
    case GA4A:
      sprintf(string, "Jy\\.km\\.s\\u-1\\d\\.arcsec\\u-2");
      return;
    case GA4P:
      sprintf(string, "degree");
      return;
    case GA4D:
      sprintf(string, "arcsec");
      return;
    case AZ1P:
      sprintf(string, "degree");
      return;
    case AZ1W:
      sprintf(string, "degree");
      return;
    case AZ2P:
      sprintf(string, "degree");
      return;
    case AZ2W:
      sprintf(string, "degree");
      return;
    case INCL:
      sprintf(string, "degree");
      return;
    case PA:
      sprintf(string, "degree");
      return;
    case XPOS:
      sprintf(string, "hh mm ss.s");
      return;
    case YPOS:
      sprintf(string, "dd mm ss.s");
      return;
    case VSYS:
      sprintf(string, "km\\.s\\u-1");
      return;
    }
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns an alternative unit string suitable for the use in the pgp module */
static void gr_fillaltunit(int ident, char *string, int ndisks)
{
  if ((string)) {
    if (ident == RADI) {
      sprintf(string, "kpc");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)) {
      sprintf(string, "M\\d\\(2281)\\u\\.pc\\u-2");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {
      sprintf(string, "degree");
      return;
    }

    ident = (ident-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;
    switch (ident) {
    case VROT:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VRAD:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VVER:
      sprintf(string, "km\\.s\\u-1");
      return;
    case DVRO:
      sprintf(string, "km\\.s\\u-1\\d\\.pc\\u-1");
      return;
    case DVRA:
      sprintf(string, "km\\.s\\u-1\\d\\.pc\\u-1");
      return;
    case DVVE:
      sprintf(string, "km\\.s\\u-1\\d\\.pc\\u-1");
      return;
    case ZDRA:
      sprintf(string, "pc");
      return;
    case ZDRO:
      sprintf(string, "pc");
      return;
    case ZDVE:
      sprintf(string, "pc");
      return;
    case Z0:
      sprintf(string, "pc");
      return;
    case SDIS:
      sprintf(string, "km\\.s\\u-1");
      return;
    case CLNR:
      sprintf(string, " ");
      return;
    case VM0A :
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM1P:
      sprintf(string, "degree");
      return;
    case VM2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM2P:
      sprintf(string, "degree");
      return;
    case VM3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM3P:
      sprintf(string, "degree");
      return;
    case VM4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case VM4P:
      sprintf(string, "degree");
      return;
    case RA1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA1P:
      sprintf(string, "degree");
      return;
    case RA2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA2P:
      sprintf(string, "degree");
      return;
    case RA3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA3P:
      sprintf(string, "degree");
      return;
    case RA4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RA4P:
      sprintf(string, "degree");
      return;
    case RO1A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO1P:
      sprintf(string, "degree");
      return;
    case RO2A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO2P:
      sprintf(string, "degree");
      return;
    case RO3A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO3P:
      sprintf(string, "degree");
      return;
    case RO4A:
      sprintf(string, "km\\.s\\u-1");
      return;
    case RO4P:
      sprintf(string, "degree");
      return;
    case WM0A  :
      sprintf(string, "pc");
      return;
    case WM1A :
      sprintf(string, "pc");
      return;
    case WM1P :
      sprintf(string, "degree");
      return;
    case WM2A :
      sprintf(string, "pc");
      return;
    case WM2P :
      sprintf(string, "degree");
      return;
    case WM3A :
      sprintf(string, "pc");
      return;
    case WM3P :
      sprintf(string, "degree");
      return;
    case WM4A :
      sprintf(string, "pc");
      return;
    case WM4P :
      sprintf(string, "degree");
      return;
    case LS0 :
      sprintf(string, "pc");
      return;
    case LC0 :
      sprintf(string, "pc");
      return;
    case SBR:
      sprintf(string, "cm\\u-2");
      return;
    case SM1A:
      sprintf(string, "cm\\u-2");
      return;
    case SM1P:
      sprintf(string, "degree");
      return;
    case SM2A:
      sprintf(string, "cm\\u-2");
      return;
    case SM2P:
      sprintf(string, "degree");
      return;
    case SM3A:
      sprintf(string, "cm\\u-2");
      return;
    case SM3P:
      sprintf(string, "degree");
      return;
    case SM4A:
      sprintf(string, "cm\\u-2");
      return;
    case SM4P:
      sprintf(string, "degree");
      return;
    case GA1A:
      sprintf(string, "cm\\u-2");
      return;
    case GA1P:
      sprintf(string, "degree");
      return;
    case GA1D:
      sprintf(string, "pc");
      return;
    case GA2A:
      sprintf(string, "cm\\u-2");
      return;
    case GA2P:
      sprintf(string, "degree");
      return;
    case GA2D:
      sprintf(string, "pc");
      return;
    case GA3A:
      sprintf(string, "cm\\u-2");
      return;
    case GA3P:
      sprintf(string, "degree");
      return;
    case GA3D:
      sprintf(string, "pc");
      return;
    case GA4A:
      sprintf(string, "cm\\u-2");
      return;
    case GA4P:
      sprintf(string, "degree");
      return;
    case GA4D:
      sprintf(string, "pc");
      return;
    case AZ1P:
      sprintf(string, "degree");
      return;
    case AZ1W:
      sprintf(string, "degree");
      return;
    case AZ2P:
      sprintf(string, "degree");
      return;
    case AZ2W:
      sprintf(string, "degree");
      return;
    case INCL:
      sprintf(string, "rad");
      return;
    case PA:
      sprintf(string, "rad");
      return;
    case XPOS:
      sprintf(string, "kpc");
      return;
    case YPOS:
      sprintf(string, "kpc");
      return;
    case VSYS:
      sprintf(string, "km\\.s\\u-1");
      return;
    }
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/*  */

static int gr_deleteindexed(int nur, int ident, float *xarray, float *yarray, float *yerrarray, decomp_inlist *index, int ndisks)
{
  int i = 0, j , k, l, m, ident2;

  ident2 = ident;

  if (ident > 0) {
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR) || ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR) || ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR) || ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {
      ident = PA;
      ident2 = INCL;
    }
    else if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)){
      ident = ident2 = SBR;
    }
  }

  l = nur;

  for (i = 0; i < nur; ++i) {
    for (m = 0; m < index -> nuel; ++m) {
      if ((ident-1)*nur+i == index -> ipa[m]) {
	for (j = 0; j < index -> nuel; ++j) {
	  if ((ident2-1)*nur+i == index -> ipa[j]) {
	    for (k = i-nur+l+1; k < nur; ++k) {
	      xarray[k-1] = xarray[k];
	      yarray[k-1] = yarray[k];
	      yerrarray[k-1] = yerrarray[k];
	    }
	    --l;
	    m = index -> nuel;
	    break;
	  }
	}
      }
    }
  }

  return l;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Fills two arrays for graphics use */
static int fillgrapharray(startinf *startinfv, hdrinf *hdr, ringparms *rpm, int ident, float *array, float *larray, int ndisks)
{
  int i, j;

  int def = 2;
  int nel = 1;
  int rring = 5;
  int err = 1;
  int gr_tlr = 0;
  char mes[81];

  double br_incl;
  double br_pa;
  double gr_tll;
  double nv[3];
  double nrefr[3];
  double value;
  double vsys, nu;
  double rescval;
  double x,y;

  /* Check if it can be done */
  if (ident > 0) {
    if (ident <= (NPARAMS+(ndisks-1)*NDPARAMS)) {

      /* Simply put the values into the arrays */
      for (i = 0; i < rpm -> nur; ++i)
	array[i] = rpm -> par[(ident-1)*rpm -> nur+i];
      for (i = 0; i < rpm -> nr; ++i)
	larray[i] = rpm -> modpar[(ident-1)*rpm -> nr+i];
    }
    else if (ident == (NPARAMS+(rpm -> ndisks-1)*NDPARAMS+WA_GRAPHNR) || ident == (NPARAMS+(rpm -> ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {
      if (ident == (NPARAMS+(rpm -> ndisks-1)*NDPARAMS+WA_GRAPHNR)) {

	/* Calculate the normal vector of the reference */
	for (i = 0; i < 3; ++i) {
	  nrefr[i] = 0;
	}

	/* Now we calculate the direction of the total angular momentum of the observed component */
	for (j = 0; j < rpm -> nr; ++j) {

	  /* We don't do a relativistic correction for this */
	  value = pow(rpm -> modpar[PRADI*rpm -> nr+j],2)*rpm -> modpar[PVROT*rpm -> nr+j]*rpm -> modpar[PSBR*rpm -> nr+j];
	  nrefr[0] = nrefr[0]+(double) value*sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
	  nrefr[1] = nrefr[1]-(double) value*sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
	  nrefr[2] = nrefr[2]+(double) value*cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);
	}

	value = sqrt(pow(nrefr[0],2)+pow(nrefr[1],2)+pow(nrefr[2],2));
	nrefr[0] = nrefr[0]/value;
	nrefr[1] = nrefr[1]/value;
	nrefr[2] = nrefr[2]/value;
      }

      else {

	/* Get the reference ring */
	sprintf(mes, "Give reference ring for warp angle calculation");
	while ((err)) {
	  userint_tir(startinfv -> arel, &rring, &nel, &def, "REFRING=", mes);
	  if (rring <= 0 || rring > rpm -> nur) {
	    sprintf(mes, "REFRING: impossible number");
	    cancel_tir(startinfv -> arel, "REFRING=", 2);
	    def = 4;
	  }
	  else
	    err = 0;
	}

	/* Now get the normal vector of the reference ring */
	nrefr[0] = sinf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1])*sinf(DEGTORAD*rpm -> par[PPA*rpm -> nur+rring-1]);
	nrefr[1] = -sinf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1])*cosf(DEGTORAD*rpm -> par[PPA*rpm -> nur+rring-1]);
	nrefr[2] = cosf(DEGTORAD*rpm -> par[PINCL*rpm -> nur+rring-1]);
      }

      /* Now calculate the inclination of the rings with the refring */
      for (j = 0; j < rpm -> nur; ++j) {
	nv[0] = sin(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j])*sin(DEGTORAD*rpm -> par[PPA*rpm -> nur+j]);
	nv[1] = -sin(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j])*cos(DEGTORAD*rpm -> par[PPA*rpm -> nur+j]);
	nv[2] = cos(DEGTORAD*rpm -> par[PINCL*rpm -> nur+j]);

	/* Here is the scalar product with the reference ring */
	value = nv[0]*nrefr[0]+nv[1]*nrefr[1]+nv[2]*nrefr[2];

	/* This is the arcus */
	array[j] = value>1?0.0:RADTODEG*acos(value);
      }

      /* Now calculate the inclination of the subrings with the refring */
      for (j = 0; j < rpm -> nr; ++j) {
	nv[0] = sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*sin(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
	nv[1] = -sin(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j])*cos(DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j]);
	nv[2] = cos(DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j]);

	/* Here is the scalar product with the reference ring */
	value = nv[0]*nrefr[0]+nv[1]*nrefr[1]+nv[2]*nrefr[2];

	/* This is the arcus */
	larray[j] = value>1?0.0:RADTODEG*acos(value);
      }
    }
    else if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)){

      /* We do it properly */
      for (j = 0; j < rpm -> nur; ++j) {
	vsys = rpm -> par[PVSYS*rpm -> nur+j];
	nu = (SPEEDOFLIGHT-vsys)*HIRESFREQ/SPEEDOFLIGHT;
	value = rpm -> par[PSBR*rpm -> nur+j];

	/* The intensity in the restframe scales like */
	array[j] = hdr -> itou*value*pow(HIRESFREQ/nu,4);
      }
      for (j = 0; j < rpm -> nr; ++j) {
	vsys = rpm -> modpar[PVSYS*rpm -> nr+j];
	nu = (SPEEDOFLIGHT-vsys)*HIRESFREQ/SPEEDOFLIGHT;
	value = rpm -> modpar [PSBR*rpm -> nr+j];

	/* The intensity in the restframe scales like */
	larray[j] = hdr -> itou*value*pow(HIRESFREQ/nu,4);
      }
    }
    else if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR) || ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {

      /* Ask for the reference position angle, default 0 */
      sprintf(mes, "Give Briggs reference position angle");
      br_pa = 0;
      def = 2;
      nel = 1;
      userdble_tir(startinfv -> arel, &br_pa, &nel, &def, "BR_PA=", mes);

      /* Ask for the reference inclination, default 0 */
      sprintf(mes, "Give Briggs reference inclination");
      br_incl = 0;
      def = 2;
      nel = 1;
      userdble_tir(startinfv -> arel, &br_incl, &nel, &def, "BR_INCL=", mes);

      /* Ask for the angle range, 0: 10-360, 1:-180-180 */
      sprintf(mes, "Give range for tiplon diagram 0: 10-360, 1:-180-180");
      gr_tlr = 0;
      def = 2;
      nel = 1;
      userint_tir(startinfv -> arel, &gr_tlr, &nel, &def, "GR_TLR=", mes);

      /* Then get the stuff in radian */
      br_incl = DEGTORAD*br_incl;
      br_pa = DEGTORAD*br_pa;

      if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR)) {
	for (j = 0; j < rpm -> nur; ++j) {

	  /* We get the radian position angle and the radian inclination */
	  nrefr[0] = DEGTORAD*rpm -> par[PINCL*rpm -> nur+j];
	  nrefr[1] = DEGTORAD*rpm -> par[PPA*rpm -> nur+j];

	  /* Then we do this: */
	  value = sin(br_incl)*sin(nrefr[0])*cos(nrefr[1]-br_pa)+cos(br_incl)*cos(nrefr[0]);
	  array[j] = value>1?0.0:RADTODEG*acos(value);
	  /**************/
	  /**************/
	  /*     sprintf(obsmes, "tip: %.2f",array[j]);  */
	  /*     anyout_tir(&obsint, obsmes);  */
	  /**************/

	}
	for (j = 0; j < rpm -> nr; ++j) {

	  /* We get the radian position angle and the radian inclination */
	  nrefr[0] = DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j];
	  nrefr[1] = DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j];

	  /* Then we do this: */
	  value = sin(br_incl)*sin(nrefr[0])*cos(nrefr[1]-br_pa)+cos(br_incl)*cos(nrefr[0]);
	  larray[j] = value>1?0.0:RADTODEG*acos(value);
	}
      }
      else {

	/* First scan for the first point where pa and incl are different */
	rescval = 0.0;
	for (j = 0; j < rpm -> nr; ++j) {
	  nrefr[0] = DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j];
	  nrefr[1] = DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j];

	  if (maths_checkeq(nrefr[0], br_incl, 1.0E-6) || maths_checkeq(nrefr[1], br_pa, FLOAT_ACCURACY)) {

	    x = sin(nrefr[0])*sin(nrefr[1]-br_pa);
	    y = -cos(br_incl)*sin(nrefr[0])*cos(nrefr[1]-br_pa)+sin(br_incl)*cos(nrefr[0]);

	    if (y == 0)
	      y = 1E-15;

	    rescval = (x/y);

	    if ((x<=0) && (y > 0))
	      rescval = -atan(rescval);
	    if ((x>=0) && (y > 0))
	      rescval = TWOPI-atan(rescval);

	    if ((x>=0) && (y < 0))
	      rescval = TWOPI/2-atan(rescval);
	    if ((x<=0) && (y < 0))
	      rescval = TWOPI/2-atan(rescval);
	    break;
	  }
	}

	/* Ask for the reference LON */
	sprintf(mes, "Give value for indefinite LON");
	gr_tll = RADTODEG*rescval;
	def = 2;
	nel = 1;
	userdble_tir(startinfv -> arel, &gr_tll, &nel, &def, "GR_TLL=", mes);
	rescval = DEGTORAD*gr_tll;
	/* sprintf(obsmes, "graph: %.2f", gr_tll); */
	/* anyout_tir(&obsint, obsmes); */

	for (j = 0; j < rpm -> nr; ++j) {

	  /* We get the radian position angle and the radian inclination */
	  nrefr[0] = DEGTORAD*rpm -> modpar[PINCL*rpm -> nr+j];
	  nrefr[1] = DEGTORAD*rpm -> modpar[PPA*rpm -> nr+j];

	  /* Then we do this: */
	  if (maths_checkeq(nrefr[0], br_incl, 1.0E-6) || maths_checkeq(nrefr[1], br_pa, FLOAT_ACCURACY)) {

	    x = sin(nrefr[0])*sin(nrefr[1]-br_pa);
	    y = -cos(br_incl)*sin(nrefr[0])*cos(nrefr[1]-br_pa)+sin(br_incl)*cos(nrefr[0]);

	    if (y == 0.0)
	      y = 1E-15;

	    value = (x/y);

	    if ((x<=0) && (y > 0))
	      value = -atan(value);
	    if ((x>=0) && (y > 0))
	      value = TWOPI-atan(value);
	    if ((x>=0) && (y < 0))
	      value = TWOPI/2-atan(value);
	    if ((x<=0) && (y < 0))
	      value = TWOPI/2-atan(value);
	    else if ((x<=0) && (y == 0))
	      value = TWOPI/4;
	    else if ((x>=0) && (y == 0))
	      value = 3*TWOPI/4;
	  }
	  else
	    value = rescval;

	  larray[j] = RADTODEG*value;
	  if ((gr_tlr)) {
	    if ((larray[j] > 180))
	      larray[j] = larray[j]-360.0;
	  }

	}
	for (j = 0; j < rpm -> nur; ++j) {

	  /* We get the radian position angle and the radian inclination */
	  nrefr[0] = DEGTORAD*rpm -> par[PINCL*rpm -> nur+j];
	  nrefr[1] = DEGTORAD*rpm -> par[PPA*rpm -> nur+j];

	  /* Then we do this: */
	  if (maths_checkeq(nrefr[0], br_incl, 1.0E-6) || maths_checkeq(nrefr[1], br_pa, FLOAT_ACCURACY)) {

	    x = sin(nrefr[0])*sin(nrefr[1]-br_pa);
	    y = -cos(br_incl)*sin(nrefr[0])*cos(nrefr[1]-br_pa)+sin(br_incl)*cos(nrefr[0]);

	    value = (x/y);

	    /**************/
	    /**************/
	    /* sprintf(obsmes, "graph: x: %.2f y: %.2f", x,y); */
	    /* anyout_tir(&obsint, obsmes); */
	    /**************/

	    if ((x<=0) && (y > 0))
	      value = -atan(value);
	    else if ((x>=0) && (y > 0))
	      value = TWOPI-atan(value);
	    else if ((x>=0) && (y < 0))
	      value = TWOPI/2-atan(value);
	    else if ((x<=0) && (y < 0))
	      value = TWOPI/2-atan(value);
	    else if ((x<=0) && (y == 0))
	      value = TWOPI/4;
	    else if ((x>=0) && (y == 0))
	      value = 3*TWOPI/4;
	  }
	  else
	    value = rescval;

	  array[j] = RADTODEG*value;

	  if ((gr_tlr)) {
	    if ((array[j] > 180))
	      array[j] = array[j]-360.0;
	  }
	  /**************/
	  /**************/
	  /*    sprintf(obsmes, "lon: %.2f",array[j]); */
	  /*    anyout_tir(&obsint, obsmes); */
	  /**************/

	}
      }
    }
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns a legend string suitable for the use in the pgp module */
static void gr_filllegend(int ident, char *string, int ndisks)
{

  int disk;

  if ((string)) {
    if (ident == RADI) {        sprintf(string, "R: Radius");      return;}
    if (ident == VROT) {        sprintf(string, "VROT: Rotation velocity"                   );     return;}
    if (ident == VRAD) {        sprintf(string, "VRAD: Radial velocity"                     );     return;}
    if (ident == VVER) {        sprintf(string, "VROT: Vertical velocity"                   );     return;}
    if (ident == DVRO) {        sprintf(string, "DVRO: Gradient of rotation velocity"       );     return;}
    if (ident == DVRA) {        sprintf(string, "DVRA: Gradient of radial velocity"         );     return;}
    if (ident == DVVE) {        sprintf(string, "VROT: Gradient of vertical velocity"       );     return;}
    if (ident == ZDRO) {        sprintf(string, "ZDRO: Onset rotation change"               );     return;}
    if (ident == ZDRA) {        sprintf(string, "ZDRA: Onset radial v change"               );     return;}
    if (ident == ZDVE) {        sprintf(string, "ZDVE: Onset vertical v change"             );     return;}
    if (ident == Z0) {          sprintf(string, "SCHT: Scaleheight"                         );     return;}
    if (ident == SDIS) {        sprintf(string, "DISP: Dispersion"                          );     return;}
    if (ident == CLNR) {        sprintf(string, "CLNR: Sub-Cloud number"                    );     return;}
    if (ident == VM0A) {        sprintf(string, "VM0A: Velocity harmonics, 0th order"       );     return;}
    if (ident == VM1A) {        sprintf(string, "VM1A: Velocity harmonics, 1st order, amp"  );     return;}
    if (ident == VM1P) {        sprintf(string, "VM1P: Velocity harmonics, 1st order, phase");     return;}
    if (ident == VM2A) {        sprintf(string, "VM2A: Velocity harmonics, 2nd order, amp"  );     return;}
    if (ident == VM2P) {        sprintf(string, "VM2P: Velocity harmonics, 2nd order, phase");     return;}
    if (ident == VM3A) {        sprintf(string, "VM3A: Velocity harmonics, 3rd order, amp"  );     return;}
    if (ident == VM3P) {        sprintf(string, "VM3P: Velocity harmonics, 3rd order, phase");     return;}
    if (ident == VM4A) {        sprintf(string, "VM4A: Velocity harmonics, 4th order, amp"  );     return;}
    if (ident == VM4P) {        sprintf(string, "VM4P: Velocity harmonics, 4th order, phase");     return;}

    if (ident == RA1A) {        sprintf(string, "RA1A: Velocity harmonics (radial), 1st order, amp"  );     return;}
    if (ident == RA1P) {        sprintf(string, "RA1P: Velocity harmonics (radial), 1st order, phase");     return;}
    if (ident == RA2A) {        sprintf(string, "RA2A: Velocity harmonics (radial), 2nd order, amp"  );     return;}
    if (ident == RA2P) {        sprintf(string, "RA2P: Velocity harmonics (radial), 2nd order, phase");     return;}
    if (ident == RA3A) {        sprintf(string, "RA3A: Velocity harmonics (radial), 3rd order, amp"  );     return;}
    if (ident == RA3P) {        sprintf(string, "RA3P: Velocity harmonics (radial), 3rd order, phase");     return;}
    if (ident == RA4A) {        sprintf(string, "RA4A: Velocity harmonics (radial), 4th order, amp"  );     return;}
    if (ident == RA4P) {        sprintf(string, "RA4P: Velocity harmonics (radial), 4th order, phase");     return;}
    if (ident == RO1A) {        sprintf(string, "RO1A: Velocity harmonics (tangential), 1st order, amp"  );     return;}
    if (ident == RO1P) {        sprintf(string, "RO1P: Velocity harmonics (tangential), 1st order, phase");     return;}
    if (ident == RO2A) {        sprintf(string, "RO2A: Velocity harmonics (tangential), 2nd order, amp"  );     return;}
    if (ident == RO2P) {        sprintf(string, "RO2P: Velocity harmonics (tangential), 2nd order, phase");     return;}
    if (ident == RO3A) {        sprintf(string, "RO3A: Velocity harmonics (tangential), 3rd order, amp"  );     return;}
    if (ident == RO3P) {        sprintf(string, "RO3P: Velocity harmonics (tangential), 3rd order, phase");     return;}
    if (ident == RO4A) {        sprintf(string, "RO4A: Velocity harmonics (tangential), 4th order, amp"  );     return;}
    if (ident == RO4P) {        sprintf(string, "RO4P: Velocity harmonics (tangential), 4th order, phase");     return;}
    if (ident == SBR) {         sprintf(string, "SBR: Surface brightness"                   );     return;}
    if (ident == SM1A) {        sprintf(string, "SM1A: Sbr harmonics, 1st order, amp"       );     return;}
    if (ident == SM1P) {        sprintf(string, "SM1P: Sbr harmonics, 1st order, phase"     );     return;}
    if (ident == SM2A) {        sprintf(string, "SM2A: Sbr harmonics, 2nd order, amp"       );     return;}
    if (ident == SM2P) {        sprintf(string, "SM2P: Sbr harmonics, 2nd order, phase"     );     return;}
    if (ident == SM3A) {        sprintf(string, "SM3A: Sbr harmonics, 3rd order, amp"       );     return;}
    if (ident == SM3P) {        sprintf(string, "SM3P: Sbr harmonics, 3rd order, phase"     );     return;}
    if (ident == SM4A) {        sprintf(string, "SM4A: Sbr harmonics, 4th order, amp"       );     return;}
    if (ident == SM4P) {        sprintf(string, "SM4P: Sbr harmonics, 4th order, phase"     );     return;}
    if (ident == GA1A) {        sprintf(string, "GA1A: Sbr Gaussian 1, amplitude"           );     return;}
    if (ident == GA1P) {        sprintf(string, "GA1P: Sbr Gaussian 1, , phase"             );     return;}
    if (ident == GA1D) {        sprintf(string, "GA1D: Sbr Gaussian 1, dispersion"          );     return;}
    if (ident == GA2A) {        sprintf(string, "GA2A: Sbr Gaussian 2, amplitude"           );     return;}
    if (ident == GA2P) {        sprintf(string, "GA2P: Sbr Gaussian 2, , phase"             );     return;}
    if (ident == GA2D) {        sprintf(string, "GA2D: Sbr Gaussian 2, dispersion"          );     return;}
    if (ident == GA3A) {        sprintf(string, "GA3A: Sbr Gaussian 3, amplitude"           );     return;}
    if (ident == GA3P) {        sprintf(string, "GA3P: Sbr Gaussian 3, , phase"             );     return;}
    if (ident == GA3D) {        sprintf(string, "GA3D: Sbr Gaussian 3, dispersion"          );     return;}
    if (ident == GA4A) {        sprintf(string, "GA4A: Sbr Gaussian 4, amplitude"           );     return;}
    if (ident == GA4P) {        sprintf(string, "GA4P: Sbr Gaussian 4, , phase"             );     return;}
    if (ident == GA4D) {        sprintf(string, "GA4D: Sbr Gaussian 4, dispersion"          );     return;}
    if (ident == AZ1P) {        sprintf(string, "AZ1P: Model range 1, position"             );     return;}
    if (ident == AZ1W) {        sprintf(string, "AZ1W: Model range 1, width"                );     return;}
    if (ident == AZ2P) {        sprintf(string, "AZ2P: Model range 2, position"             );     return;}
    if (ident == AZ2W) {        sprintf(string, "AZ2W: Model range 2, width"                );     return;}
    if (ident == INCL) {        sprintf(string, "INCL: Inclination"                         );     return;}
    if (ident == PA) {          sprintf(string, "PA: Position angle"                        );     return;}
    if (ident == XPOS) {        sprintf(string, "RA: Right ascension of centre"             );     return;}
    if (ident == YPOS) {        sprintf(string, "DEC: Declination of centre"                );     return;}
    if (ident == VSYS)  {        sprintf(string, "VSYS: Systemic velocity"                   );     return;}
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR)) {  sprintf(string, "WA: Warp angle"                            );     return;}
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)) {sprintf(string, "SD: Surface density"                       );     return;}
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {sprintf(string, "WAOL: Warp angle, old definition"          );     return;}
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR))  {sprintf(string, "TIP: Tip angle"                            );     return;}
    if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR))  {sprintf(string, "LON: LON angle"                            );     return;}

    for (disk = 1; disk < ndisks; ++disk) {
      if (ident == VROT+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VROT_%i Rotation velocity disk %i", disk+1, disk+1                  );     return;}
      if (ident == VRAD+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VRAD_%i Radial velocity disk %i", disk+1, disk+1                    );     return;}
      if (ident == VVER+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VROT_%i Vertical velocity disk %i", disk+1, disk+1                  );     return;}
      if (ident == DVRO+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVRO_%i Gradient of rotation velocity disk %i", disk+1, disk+1      );     return;}
      if (ident == DVRA+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVRA_%i Gradient of radial velocity disk %i", disk+1, disk+1        );     return;}
      if (ident == DVVE+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DVVE_%i Gradient of vertical velocity disk %i", disk+1, disk+1      );     return;}
      if (ident == ZDRO+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDRO_%i Onset rotation change disk %i", disk+1, disk+1      );     return;}
      if (ident == ZDRA+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDRA_%i Onset radial v change %i", disk+1, disk+1        );     return;}
      if (ident == ZDVE+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "ZDVE_%i Onset vertical v change disk %i", disk+1, disk+1      );     return;}
      if (ident == Z0  +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SCHT_%i Scaleheight disk %i", disk+1, disk+1                        );     return;}
      if (ident == SDIS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "DISP_%i Dispersion disk %i", disk+1, disk+1                         );     return;}
      if (ident == CLNR+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "CLNR_%i Sub-Cloud number disk %i", disk+1, disk+1                   );     return;}
      if (ident == VM0A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM0A_%i Velocity harmonics, 0th order disk %i", disk+1, disk+1      );     return;}
      if (ident == VM1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM1A_%i Velocity harmonics, 1st order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == VM1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM1P_%i Velocity harmonics, 1st order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == VM2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM2A_%i Velocity harmonics, 2nd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == VM2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM2P_%i Velocity harmonics, 2nd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == VM3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM3A_%i Velocity harmonics, 3rd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == VM3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM3P_%i Velocity harmonics, 3rd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == VM4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM4A_%i Velocity harmonics, 4th order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == VM4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VM4P_%i Velocity harmonics, 4th order, phase disk %i", disk+1, disk+1);     return;}

      if (ident == RA1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA1A_%i Velocity harmonics (radial), 1st order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RA1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA1P_%i Velocity harmonics (radial), 1st order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RA2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA2A_%i Velocity harmonics (radial), 2nd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RA2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA2P_%i Velocity harmonics (radial), 2nd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RA3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA3A_%i Velocity harmonics (radial), 3rd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RA3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA3P_%i Velocity harmonics (radial), 3rd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RA4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA4A_%i Velocity harmonics (radial), 4th order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RA4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RA4P_%i Velocity harmonics (radial), 4th order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RO1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO1A_%i Velocity harmonics (tangential), 1st order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RO1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO1P_%i Velocity harmonics (tangential), 1st order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RO2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO2A_%i Velocity harmonics (tangential), 2nd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RO2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO2P_%i Velocity harmonics (tangential), 2nd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RO3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO3A_%i Velocity harmonics (tangential), 3rd order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RO3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO3P_%i Velocity harmonics (tangential), 3rd order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == RO4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO4A_%i Velocity harmonics (tangential), 4th order, amp disk %i", disk+1, disk+1 );     return;}
      if (ident == RO4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "RO4P_%i Velocity harmonics (tangential), 4th order, phase disk %i", disk+1, disk+1);     return;}
      if (ident == SBR +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SBR_%i Surface brightness disk %i", disk+1, disk+1                  );     return;}
      if (ident == SM1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM1A_%i Sbr harmonics, 1st order, amp disk %i", disk+1, disk+1      );     return;}
      if (ident == SM1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM1P_%i Sbr harmonics, 1st order, phase disk %i", disk+1, disk+1    );     return;}
      if (ident == SM2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM2A_%i Sbr harmonics, 2nd order, amp disk %i", disk+1, disk+1      );     return;}
      if (ident == SM2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM2P_%i Sbr harmonics, 2nd order, phase disk %i", disk+1, disk+1    );     return;}
      if (ident == SM3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM3A_%i Sbr harmonics, 3rd order, amp disk %i", disk+1, disk+1      );     return;}
      if (ident == SM3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM3P_%i Sbr harmonics, 3rd order, phase disk %i", disk+1, disk+1    );     return;}
      if (ident == SM4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM4A_%i Sbr harmonics, 4th order, amp disk %i", disk+1, disk+1      );     return;}
      if (ident == SM4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "SM4P_%i Sbr harmonics, 4th order, phase disk %i", disk+1, disk+1    );     return;}
      if (ident == GA1A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1A_%i Sbr Gaussian 1, amplitude disk %i", disk+1, disk+1          );     return;}
      if (ident == GA1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1P_%i Sbr Gaussian 1, , phase disk %i", disk+1, disk+1            );     return;}
      if (ident == GA1D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA1D_%i Sbr Gaussian 1, dispersion disk %i", disk+1, disk+1         );     return;}
      if (ident == GA2A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2A_%i Sbr Gaussian 2, amplitude disk %i", disk+1, disk+1          );     return;}
      if (ident == GA2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2P_%i Sbr Gaussian 2, , phase disk %i", disk+1, disk+1            );     return;}
      if (ident == GA2D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA2D_%i Sbr Gaussian 2, dispersion disk %i", disk+1, disk+1         );     return;}
      if (ident == GA3A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3A_%i Sbr Gaussian 3, amplitude disk %i", disk+1, disk+1          );     return;}
      if (ident == GA3P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3P_%i Sbr Gaussian 3, , phase disk %i", disk+1, disk+1            );     return;}
      if (ident == GA3D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA3D_%i Sbr Gaussian 3, dispersion disk %i", disk+1, disk+1         );     return;}
      if (ident == GA4A+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4A_%i Sbr Gaussian 4, amplitude disk %i", disk+1, disk+1          );     return;}
      if (ident == GA4P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4P_%i Sbr Gaussian 4, , phase disk %i", disk+1, disk+1            );     return;}
      if (ident == GA4D+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "GA4D_%i Sbr Gaussian 4, dispersion disk %i", disk+1, disk+1         );     return;}
      if (ident == AZ1P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ1P_%i Model range 1, position disk %i", disk+1, disk+1            );     return;}
      if (ident == AZ1W+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ1W_%i Model range 1, width disk %i", disk+1, disk+1               );     return;}
      if (ident == AZ2P+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ2P_%i Model range 2, position disk %i", disk+1, disk+1            );     return;}
      if (ident == AZ2W+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "AZ2W_%i Model range 2, width disk %i", disk+1, disk+1               );     return;}
      if (ident == INCL+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "INCL_%i Inclination disk %i", disk+1, disk+1                        );     return;}
      if (ident == PA  +PRPARAMS+disk*NDPARAMS) {         sprintf(string, "PA_%i Position angle disk %i", disk+1, disk+1                       );     return;}
      if (ident == XPOS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "XPOS_%i Right ascension of centre disk %i", disk+1, disk+1            );     return;}
      if (ident == YPOS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "YPOS_%i Declination of centre disk %i", disk+1, disk+1               );     return;}
      if (ident == VSYS+PRPARAMS+disk*NDPARAMS) {         sprintf(string, "VSYS_%i Systemic velocity disk %i", disk+1, disk+1                  );     return;}
    }
    string[0] = '\0'; return;

  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Returns the scale for one unit to the alternative unit */
static void gr_fillscaling(loginf *log, hdrinf *hdr, int ident, float *scale, float *zero, int ndisks)
{

  if (ident == RADI) {
    *scale = 1000.0*log -> distance*TWOPI/(360*60*60);
    *zero = 0.0;
    return;
  }
  if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WA_GRAPHNR)) {
    *scale = 1.0;
    *zero = 0.0;
    return;
  }
  if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+DENS_GRAPHNR)) {
    *scale = UTOSOLAR;
    *zero = 0.0;
    return;
  }
  if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+WOLD_GRAPHNR)) {
    *scale = 1.0;
    *zero = 0.0;
    return;
  }
  if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+TIP_GRAPHNR)) {
    *scale = 1.0;
    *zero = 0.0;
    return;
  }
  if (ident == (NPARAMS+(ndisks-1)*NDPARAMS+LON_GRAPHNR)) {
    *scale = 1.0;
    *zero = 0.0;
    return;
  }
  *scale = 1.0;
  *zero = 0.0;

/*   ident = ident%NDPARAMS?ident%NDPARAMS:NDPARAMS; */
  ident = (ident-NSSDPARAMS-1)%NDPARAMS + NSSDPARAMS + 1;
  switch (ident) {
  case VROT:
    *scale = 1.0;
    *zero = 0.0;
    return;
  case VRAD:
    *scale = 1.0;
    *zero = 0.0;
    return;
  case VVER:
    *scale = 1.0;
    *zero = 0.0;
    return;
  case DVRO:
    *scale = 1.0/(log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0);
    *zero = 0.0;
    return;
  case DVRA:
    *scale = 1.0/(log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0);
    *zero = 0.0;
    return;
  case DVVE:
    *scale = 1.0/(log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0);
    *zero = 0.0;
    return;
  case ZDRO:
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case ZDRA:
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case ZDVE:
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case Z0:
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case SDIS:
    *scale = 1.0;
    *zero = 0.0;
    return;
  case CLNR:
    *scale = 1.0;
    *zero = 0.0;
    return;
  case VM0A:    *scale = 1.0;    *zero = 0.0;    return;
  case VM1A:    *scale = 1.0;    *zero = 0.0;    return;
  case VM1P:    *scale = 1.0;    *zero = 0.0;    return;
  case VM2A:    *scale = 1.0;    *zero = 0.0;    return;
  case VM2P:    *scale = 1.0;    *zero = 0.0;    return;
  case VM3A:    *scale = 1.0;    *zero = 0.0;    return;
  case VM3P:    *scale = 1.0;    *zero = 0.0;    return;
  case VM4A:    *scale = 1.0;    *zero = 0.0;    return;
  case VM4P:    *scale = 1.0;    *zero = 0.0;    return;
  case RA1A:    *scale = 1.0;    *zero = 0.0;    return;
  case RA1P:    *scale = 1.0;    *zero = 0.0;    return;
  case RA2A:    *scale = 1.0;    *zero = 0.0;    return;
  case RA2P:    *scale = 1.0;    *zero = 0.0;    return;
  case RA3A:    *scale = 1.0;    *zero = 0.0;    return;
  case RA3P:    *scale = 1.0;    *zero = 0.0;    return;
  case RA4A:    *scale = 1.0;    *zero = 0.0;    return;
  case RA4P:    *scale = 1.0;    *zero = 0.0;    return;
  case RO1A:    *scale = 1.0;    *zero = 0.0;    return;
  case RO1P:    *scale = 1.0;    *zero = 0.0;    return;
  case RO2A:    *scale = 1.0;    *zero = 0.0;    return;
  case RO2P:    *scale = 1.0;    *zero = 0.0;    return;
  case RO3A:    *scale = 1.0;    *zero = 0.0;    return;
  case RO3P:    *scale = 1.0;    *zero = 0.0;    return;
  case RO4A:    *scale = 1.0;    *zero = 0.0;    return;
  case RO4P:    *scale = 1.0;    *zero = 0.0;    return;
  case WM0A  :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case WM1A :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case WM1P :
    *scale = 1.0;
    *zero = 0.0;
    return;
  case WM2A :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case WM2P :
    *scale = 1.0;
    *zero = 0.0;
    return;
  case WM3A :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case WM3P :
    *scale = 1.0;
    *zero = 0.0;
    return;
  case WM4A :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case WM4P :
    *scale = 1.0;
    *zero = 0.0;
    return;

  case LS0 :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case LC0 :
    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;
    *zero = 0.0;
    return;
  case SBR:
    *scale = hdr -> itou;
    *zero = 0.0;
    return;
  case SM1A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case SM1P:    *scale = 1.0;    *zero = 0.0;    return;
  case SM2A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case SM2P:    *scale = 1.0;    *zero = 0.0;    return;
  case SM3A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case SM3P:    *scale = 1.0;    *zero = 0.0;    return;
  case SM4A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case SM4P:    *scale = 1.0;    *zero = 0.0;    return;

  case GA1A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case GA1P:    *scale = 1.0;    *zero = 0.0;    return;
  case GA1D:    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;    *zero = 0.0;    return;
  case GA2A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case GA2P:    *scale = 1.0;    *zero = 0.0;    return;
  case GA2D:    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;    *zero = 0.0;    return;
  case GA3A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case GA3P:    *scale = 1.0;    *zero = 0.0;    return;
  case GA3D:    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;    *zero = 0.0;    return;
  case GA4A:    *scale = hdr -> itou;    *zero = 0.0;    return;
  case GA4P:    *scale = 1.0;    *zero = 0.0;    return;
  case GA4D:    *scale = log -> distance*TWOPI/(360.0*60.0*60.0)*1000000.0;    *zero = 0.0;    return;
  case AZ1P:    *scale = 1.0;    *zero = 0.0;    return;
  case AZ1W:    *scale = 1.0;    *zero = 0.0;    return;
  case AZ2P:    *scale = 1.0;    *zero = 0.0;    return;
  case AZ2W:    *scale = 1.0;    *zero = 0.0;    return;

  case INCL:
    *scale = DEGTORAD;
    *zero = 0.0;
    return;
  case PA:
    *scale = DEGTORAD;
    *zero = DEGTORAD*180.0;
    return;
  case XPOS:
    *scale = 1000.0*log -> distance*TWOPI*cos(fabs(log -> yref)*TWOPI/360.0)/360.0;
    *zero =  1000.0*(-log -> xref)*log -> distance*TWOPI*cos(fabs(log -> yref)*TWOPI/360.0)/360.0;
    return;
  case YPOS:
    *scale = 1000.0*log -> distance*TWOPI/360.0;
    *zero = 1000.0*(-log -> yref)*log -> distance*TWOPI/360.0;
    return;
  case VSYS:
    *scale = 1.0;
    *zero = 0.0;
    return;
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Produces a renzogram with the rings */
static int renzo(startinf *startinfv, loginf *log, hdrinf *hdr, ringparms *rpm)
{
  int i,j,k;
  char *renzoname = NULL;
  char mes[81];
  int def;
  int nel;
  qfits_header *header = NULL;
  Cube thecube;
  int refine;

  double majhax;
  double minhax;
  double point[3];
  int keypres, nread, nreturned;
  char **varystr = NULL;

  /* First check if the user wants a renzogram output */
  /* sprintf(mes, "Give inclinogram name:"); */
  /* for (i = 0; i < 200; ++i) */
  /*   renzoname[i] = ' '; */
  /* renzoname[200] = '\0'; */
  /* def = 2; */
  /* nel = 1; */

  /* userchar_tir(renzoname, &nel, &def, "INCLINO=", mes); */
  /* termsinglestr(renzoname); */

  /* The default is to do nothing */
   /* cancel_tir(startinfv -> arel, "INCLINO"); */

  if (simparse_scn_arel_readval_stringlist(startinfv -> arel, "INCLINO", "Give graphics (pgplot) device.", 0, NULL, 0, -1, 0, 0, &keypres, &nread, &nreturned, &varystr))
    goto error;

  if ((varystr[0])) {
    if (!(renzoname = simparse_copystring(varystr[0]))) {
      goto error;
    }
  }
  else {
    if (!(renzoname = simparse_copystring(""))) {
      goto error;
    }
  }

  freeparsed(varystr);
  varystr = NULL;

  if (*renzoname == '\0') {
    free(renzoname);
    return 1;
  }

  /* Ask for refinement */
  sprintf(mes, "Give inclinogram refinement:");
  def = 2;
  nel = 1;

  while (refine <= 0) {
    refine = 1;
    userint_tir(startinfv -> arel, &refine, &nel, &def, "IN_REFINE=", mes);
    if (refine <= 0) {
      cancel_tir(startinfv -> arel, "IN_REFINE=", 2);
      sprintf(mes, "IN_REFINE= must be greater than 0");
      def = 1;
    }
  }

  if (!(header = makerenzohdr(hdr, rpm -> nur, refine)))
    return 1;

  /* Now arrange the cube */
  thecube.refpix_x = 0;
  thecube.refpix_y = 0;
  thecube.refpix_v = 0;
  thecube.size_x = hdr -> bsize1*refine;
  thecube.size_y = hdr -> bsize2*refine;
  thecube.size_v = rpm -> nur;
  thecube.scale = 1.0;
  thecube.padding = 0;
  thecube.points = NULL;

  /* Allocate the cube */
  if (!(thecube.points = (float *) malloc(thecube.size_x*thecube.size_y*thecube.size_v*sizeof(float))))
    goto error;

  /* Now get the best-fit values and turn them into internal units */

  /* We read all values into the par array */
  tir_get_grid(log, rpm, log -> outarray);

  for (j = 0; j < rpm -> nur*(NPARAMS+(rpm -> ndisks-1)*NDPARAMS)+NSPARAMS; ++j)
    rpm -> par[j] = log -> outarray[j];

  /* We convert to internal units and interpolate over */
  changetointern(rpm -> par, rpm -> nur, hdr, rpm -> ndisks);

  /* Now se go through the planes, and hence the rings */
  for (i = 0; i < thecube.size_v; ++i) {

    /* First calculate the major and the minor half axis */
    majhax = rpm -> par[PRADI*rpm -> nur+i]*refine;
    minhax = fabs(cos(rpm -> par[PINCL*rpm -> nur+i]))*majhax;

    /* Each point in the plane will be put to the origin, then be rotated back */
    for (j = 0; j < thecube.size_x; ++j) {
      for (k = 0; k < thecube.size_y; ++k) {
 point[0] = cos(rpm -> par[PPA*rpm -> nur+i])*(((double) j) - ((rpm -> par[PXPOS*rpm -> nur+i]+0.5)*refine-0.5))+sin(rpm -> par[PPA*rpm -> nur+i])*(((double) k) - ((rpm -> par[PYPOS*rpm -> nur+i]+0.5)*refine-0.5));
 point[1] = -sin(rpm -> par[PPA*rpm -> nur+i])*(((double) j) - ((rpm -> par[PXPOS*rpm -> nur+i]+0.5)*refine-0.5))+cos(rpm -> par[PPA*rpm -> nur+i])*(((double) k) - ((rpm -> par[PYPOS*rpm -> nur+i]+0.5)*refine-0.5));

 if ((minhax > 0.5)) {
 /* Now check if the position is inside an ellipse, if yes, the point is 1, if not 0 */
 if (((minhax*point[0])*(minhax*point[0])+(majhax*point[1])*(majhax*point[1])) > (minhax*minhax*majhax*majhax))
   thecube.points[j+thecube.size_x*(k+thecube.size_y*i)] = 0;
 else
   thecube.points[j+thecube.size_x*(k+thecube.size_y*i)] = 1;
 }
 else {

 /* We want to prevent that nothing is drawn, so we plot a line if minhax is 0 */
   if (!maths_checkinbetw(1,-1,point[1]) && (point[0]*point[0] <= majhax*majhax))
     thecube.points[j+thecube.size_x*(k+thecube.size_y*i)] = 1;
   else
     thecube.points[j+thecube.size_x*(k+thecube.size_y*i)] = 0;
 }
      }

    }

    /* If the major axis is 0, we draw a point */
    if (majhax < 1)
      thecube.points[roundnormal((rpm -> par[PXPOS*rpm -> nur+i]+0.5)*refine-0.5)+thecube.size_x*(roundnormal((rpm -> par[PYPOS*rpm -> nur+i]+0.5)*refine-0.5)+thecube.size_y*i)] = 1;
  }

  /* Output it */
  ftsout_writecube(renzoname, &thecube, header);

  /* Deallocate everything */
    ftsout_header_destroy(header);
    free(thecube.points);

    /* Return, deeply satisfied */
    if ((renzoname))
      free(renzoname);
    if (varystr)
      freeparsed(varystr);

    return 0;

 error:
  if ((header))
    ftsout_header_destroy(header);
  if ((thecube.points))
    free((thecube.points));
  if ((renzoname))
    free(renzoname);
  if (varystr)
    freeparsed(varystr);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Make a qfits header suitable for coolgal output */
static qfits_header *makerenzohdr(hdrinf *hdr, int planes, int refine)
{
  /*  char key[9] */
  char value[21];
  /* int j; */
  /* int level = 0; */
  /* int err = 0; */
  qfits_header *header = NULL;

  /* The bitpix is -32 */
  if (!(header = ftsout_putcard(header, "BITPIX","-32")))
    goto error;

  /* The number of axes is set to three */
  if (!ftsout_putcard(header, "NAXIS","3"))
    goto error;

  /* Now get the axis numbers */
  sprintf(value, "%i", hdr -> bsize1*refine);
  if (!ftsout_putcard(header, "NAXIS1",value))
    goto error;
  sprintf(value, "%i", hdr -> bsize2*refine);
  if (!ftsout_putcard(header, "NAXIS2",value))
    goto error;

  /* The third axis is simply the number of planes */
  sprintf(value, "%i", planes );
  if (!ftsout_putcard(header, "NAXIS3",value))
    goto error;

  /* May contain an extension */
  if (!ftsout_putcard(header, "EXTEND","T"))
    goto error;

  /* These are clear */
  if (!ftsout_putcard(header, "BSCALE","1"))
    goto error;
  if (!ftsout_putcard(header, "BZERO","0"))
    goto error;

  /* The bunit is nothing */
  if (!ftsout_putcard(header, "BUNIT","' '"))
    goto error;

  /* The cdelt is taken from the hdr struct, this should be ok with the unit being DEGREE*/
  sprintf(value, "%.12E", hdr -> userglobcdelt[0]/refine);
  if (!ftsout_putcard(header, "CDELT1", value))
    goto error;

  /* The crpix is copied from the header of the inset */
  sprintf(value, "%.12E", (hdr -> setcrpix[0]-0.5)*refine+0.5);
  if (!ftsout_putcard(header, "CRPIX1", value))
    goto error;

  /* The crval in user units -> degree */
  sprintf(value, "%.12E", hdr -> userglobcrval[0]);
  if (!ftsout_putcard(header, "CRVAL1", value))
    goto error;

  /* This is nasty, because we have to re-read the info */
  /* sprintf(key, "CTYPE%i", hdr -> inaxperm[0]); */
  /* for (j = 0; j < 20; ++j) */
  /*   value[j] = ' '; */
  /* value[20] = '\0'; */
  /* gdsd_rchar_tir(hdr -> inset, key, &(level), value, &err); */

  if (!ftsout_putcard(header, "CTYPE1", hdr -> oric -> type_x))
    goto error;
  if (!ftsout_putcard(header, "CUNIT1", "'DEGREE            '"))
    goto error;

  /* The cdelt is taken from the hdr struct, this should be ok with the unit being DEGREE*/
  sprintf(value, "%.12E", hdr -> userglobcdelt[1]/refine);
  if (!ftsout_putcard(header, "CDELT2", value))
    goto error;

  /* The crpix is copied from the header of the inset */
  sprintf(value, "%.12E", (hdr -> setcrpix[1]-0.5)*refine+0.5);
  if (!ftsout_putcard(header, "CRPIX2", value))
    goto error;

  /* The crval in user units -> degree */
  sprintf(value, "%.12E", hdr -> userglobcrval[1]);
  if (!ftsout_putcard(header, "CRVAL2", value))
    goto error;

  /* This is nasty, because we have to re-read the info */
  /* sprintf(key, "CTYPE%i", hdr -> inaxperm[1]); */
  /* for (j = 0; j < 20; ++j) */
  /*   value[j] = ' '; */
  /* value[20] = '\0'; */
  /* gdsd_rchar_tir(hdr -> inset, key, &(level), value, &err); */

  if (!ftsout_putcard(header, "CTYPE2", hdr -> oric -> type_y))
    goto error;
  if (!ftsout_putcard(header, "CUNIT2", "'DEGREE            '"))
    goto error;

  /* The third axis is the artificial one */

  /* The cdelt is 1 */
  sprintf(value, "%.12E", 1.0);
  if (!ftsout_putcard(header, "CDELT3", value))
    goto error;

/* crpix is at the start */
  sprintf(value, "%.12E", 1.0);
  if (!ftsout_putcard(header, "CRPIX3", value))
    goto error;

  /* This is exactly 0 */
  if (!ftsout_putcard(header, "CRVAL3", "1.0"))
    goto error;

  /* The type is somthing without projection, this should do */
  if (!ftsout_putcard(header, "CTYPE3", "' '"))
    goto error;

  /* This is nothing again */
  if (!ftsout_putcard(header, "CUNIT3", "' '"))
    goto error;

  return header;

 error:
  if ((header))
    ftsout_header_destroy(header);
  header = NULL;
  return header;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* deallocates an inf_sdis struct */
static int destroy_inf_sdis(inf_sdis *int_sdisv)
{
  if (!(int_sdisv))
    return 0;

/*   if ((int_sdisv -> randstr)) */
/*     free(int_sdisv -> randstr); */
  free(int_sdisv);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* allocates an inf_sdis struct */
static inf_sdis *create_inf_sdis(void)
{
  inf_sdis *create_inf_sdis = NULL;
  if (!(create_inf_sdis = (inf_sdis *) malloc(sizeof(inf_sdis))))
    return create_inf_sdis;

/*   create_inf_sdis -> randstr = NULL; */

  return create_inf_sdis;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* allocates an inf_smi struct */
static inf_smi *create_inf_smi(void)
{
  inf_smi *create_inf_smi = NULL;
  if (!(create_inf_smi = (inf_smi *) malloc(sizeof(inf_smi))))
    return create_inf_smi;

/*   create_inf_smi -> randstr = NULL; */

  return create_inf_smi;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* deallocates an inf_sdis struct */
static int destroy_inf_smi(inf_smi *inf_smiv)
{
  if (!(inf_smiv))
    return 0;

/*     if ((inf_smiv -> randstr)) */
/*       free(inf_smiv -> randstr); */

  free(inf_smiv);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm1 struct */
static int chkb_smi(ringparms *rpm, fitparms *fit)
{
  int actiflag, disk, srnr;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_smiv[disk]))
    if (!(rpm -> inf_smiv[disk] = create_inf_smi()))
      return 1;

    actiflag = 0;

    /* check out subring calculation and calculation of surface density */
    /* Zeroth order */

    /* First order */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM1A))) {
      rpm -> inf_smiv[disk] -> prs1 = rpm -> inf_smiv[disk] -> prc1 = &pr_smi_pas;
      rpm -> inf_smiv[disk] -> srprs1 = rpm -> inf_smiv[disk] -> srprc1 = &srpr_smi_pas;
    }
    else {
      actiflag = 1;
      rpm -> inf_smiv[disk] -> prs1 = &pr_sm1s_act;
      rpm -> inf_smiv[disk] -> prc1 = &pr_sm1c_act;
      rpm -> inf_smiv[disk] -> srprs1 = &srpr_sm1s_act;
      rpm -> inf_smiv[disk] -> srprc1 = &srpr_sm1c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM1P))) {
	rpm -> inf_smiv[disk] -> prs1 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs1 = &srpr_smi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM1P, PIHALF))) {
	rpm -> inf_smiv[disk] -> prc1 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprc1 = &srpr_smi_pas;
      }
    }

    /* second order */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM2A))) {
      rpm -> inf_smiv[disk] -> prs2 = rpm -> inf_smiv[disk] -> prc2 = &pr_smi_pas;
      rpm -> inf_smiv[disk] -> srprs2 = rpm -> inf_smiv[disk] -> srprc2 = &srpr_smi_pas;
    }
    else {
      actiflag = 1;
      rpm -> inf_smiv[disk] -> prs2 = &pr_sm2s_act;
      rpm -> inf_smiv[disk] -> prc2 = &pr_sm2c_act;
      rpm -> inf_smiv[disk] -> srprs2 = &srpr_sm2s_act;
      rpm -> inf_smiv[disk] -> srprc2 = &srpr_sm2c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM2P))) {
	rpm -> inf_smiv[disk] -> prs2 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs2 = &srpr_smi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM2P, PIHALF))) {
	rpm -> inf_smiv[disk] -> prs2 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs2 = &srpr_smi_pas;
      }
    }

    /* third order */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM3A))) {
      rpm -> inf_smiv[disk] -> prs3 = rpm -> inf_smiv[disk] -> prc3 = &pr_smi_pas;
      rpm -> inf_smiv[disk] -> srprs3 = rpm -> inf_smiv[disk] -> srprc3 = &srpr_smi_pas;
    }
    else {
      actiflag = 1;
      rpm -> inf_smiv[disk] -> prs3 = &pr_sm3s_act;
      rpm -> inf_smiv[disk] -> prc3 = &pr_sm3c_act;
      rpm -> inf_smiv[disk] -> srprs3 = &srpr_sm3s_act;
      rpm -> inf_smiv[disk] -> srprc3 = &srpr_sm3c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM3P))) {
	rpm -> inf_smiv[disk] -> prs3 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs3 = &srpr_smi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM3P, PIHALF))) {
	rpm -> inf_smiv[disk] -> prc3 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprc3 = &srpr_smi_pas;
      }
    }

    /* fourth order */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM4A))) {
      rpm -> inf_smiv[disk] -> prs4 = rpm -> inf_smiv[disk] -> prc4 = &pr_smi_pas;
      rpm -> inf_smiv[disk] -> srprs4 = rpm -> inf_smiv[disk] -> srprc4 = &srpr_smi_pas;
    }
    else {
      actiflag = 1;
      rpm -> inf_smiv[disk] -> prs4 = &pr_sm4s_act;
      rpm -> inf_smiv[disk] -> prc4 = &pr_sm4c_act;
      rpm -> inf_smiv[disk] -> srprs4 = &srpr_sm4s_act;
      rpm -> inf_smiv[disk] -> srprc4 = &srpr_sm4c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM4P))) {
	rpm -> inf_smiv[disk] -> prs4 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs4 = &srpr_smi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PSM4P, PIHALF))) {
	rpm -> inf_smiv[disk] -> prs4 = &pr_smi_pas;
	rpm -> inf_smiv[disk] -> srprs4 = &srpr_smi_pas;
      }
    }

    /* we allocate the rng, since we will need it */
    if ((actiflag)) {

      for (srnr = 0; srnr < rpm -> nr; ++srnr)
      if (!(rpm -> sd[disk][srnr].randstr))
	if (!(rpm -> sd[disk][srnr].randstr = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	  goto error;

      rpm -> inf_smiv[disk] -> prb0 = &pr_sm0b_act;
      rpm -> inf_smiv[disk] -> srprb0 = &srpr_sm0b_act;
      rpm -> inf_smiv[disk] -> srprsbrmax = &smi_sbrmax_act;
      rpm -> inf_smiv[disk] -> getaz = &smi_getaz_harm;
      rpm -> inf_smiv[disk] -> getcloudnumber = &smi_getcloudnumber_harm;
      rpm -> inf_smiv[disk] -> rndmf_init = &rndmf_init_smi_act;
    }
    else {
      rpm -> inf_smiv[disk] -> prb0 = &pr_sm0b_pas;
      rpm -> inf_smiv[disk] -> srprsbrmax = &smi_sbrmax_pas;
      rpm -> inf_smiv[disk] -> srprb0 = &srpr_smi_pas;
      rpm -> inf_smiv[disk] -> getaz = &smi_getaz_cons;
      rpm -> inf_smiv[disk] -> getcloudnumber = &smi_getcloudnumber_norm;
      rpm -> inf_smiv[disk] -> rndmf_init = &rndmf_init_smi_pas;
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_smi(rpm -> inf_smiv[disk]);
    rpm -> inf_smiv[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function */
static void srpr_smi_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm0b_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].spb0 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr]*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm1s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].sps1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1A)*prm -> nr+srnr]*sinf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm1c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].spc1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1A)*prm -> nr+srnr]*cosf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm2s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].sps2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2A)*prm -> nr+srnr]*sinf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm2c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].spc2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2A)*prm -> nr+srnr]*cosf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm3s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].sps3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3A)*prm -> nr+srnr]*sinf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm3c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].spc3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3A)*prm -> nr+srnr]*cosf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm4s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].sps4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4A)*prm -> nr+srnr]*sinf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void srpr_sm4c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].spc4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4A)*prm -> nr+srnr]*cosf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4P)*prm -> nr+srnr])*prm -> sd[disk][srnr].sbrmax;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void smi_getcloudnumber_harm(void *rpm, int srnr, int disk)
{
  ringparms *prm;
  float nor;
  float ringflux;

  prm = (ringparms *) rpm;

  /* Normalise to point source number instead of surface brightness */

  if (fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr])-(fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4A)*prm -> nr+srnr])) >= 0.0) {

    ringflux = TWOPI*prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr];

    /* This is the integral if there is no negative flux (because the integral of a harmonic function with order > 0 is 0), Kamphuis bugfix */
    /* prm -> sd[disk][srnr].nharmnorm = (long) (ringflux/prm -> cflux[0]); -> */
    prm -> sd[disk][srnr].nharmnorm = (long) (ringflux/prm -> cflux[disk]);

    /* correct the point source flux */
    if ((prm -> sd[disk][srnr].nharmnorm))
      prm -> sd[disk][srnr].pf = fabs(ringflux)/prm -> sd[disk][srnr].nharmnorm;
    else
      /* Kamphuis bugfix */
/*       prm -> sd[disk][srnr].pf = prm -> cflux[0]; */
      prm -> sd[disk][srnr].pf = prm -> cflux[disk];

    /* We allow for a negative pointsource flux, even if it makes no sense */
    if (prm -> sd[disk][srnr].nharmnorm < 0) {
      prm -> sd[disk][srnr].nharmnorm = -prm -> sd[disk][srnr].nharmnorm;
    }

    /* We determine the gridder to be the "normal" one */
    prm -> sd[disk][srnr].gridpoint = &gridpoint_norm;
    prm -> sd[disk][srnr].srput = &srput_norm;
  }
  else {

    /* Normalise to point source number instead of surface brightness */
    /* Kamphuis bugfix */
/*     nor = prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep/prm -> cflux[0]; -> */
    nor = prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep/prm -> cflux[disk];

    /* Negative flux occurs, which is why we have to calculate the full integral (numerically) */
    prm -> sd[disk][srnr].nharmnorm =
      (long) maths_intabsfou4(
			      nor*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr],
			      nor*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1A)*prm -> nr+srnr],
			      prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1P)*prm -> nr+srnr],
			      nor*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2A)*prm -> nr+srnr],
			      prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2P)*prm -> nr+srnr],
			      nor*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3A)*prm -> nr+srnr],
			      prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3P)*prm -> nr+srnr],
			      nor*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4A)*prm -> nr+srnr],
			      prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4P)*prm -> nr+srnr]
    );

    /* We determine the gridder to be the "mixed" one */
    prm -> sd[disk][srnr].gridpoint = &gridpoint_mixed;
    prm -> sd[disk][srnr].srput = &srput_mixed;

    /* We reset the number of positive and negative point sources */
  }

  /* Change the number of point sources */
  prm -> sd[disk][srnr].n += prm -> sd[disk][srnr].nharmnorm;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void smi_getcloudnumber_norm(void *rpm, int srnr, int disk)
{
  ringparms *prm;
  float ringflux;
  prm = (ringparms *) rpm;

  ringflux = TWOPI*prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr];

  /* This is the integral if there is no negative flux (because the integral of a harmonic function with order > 0 is 0) */
  /* Kamphuis bugfix */
/*   prm -> sd[disk][srnr].nharmnorm = (long) (ringflux/prm -> cflux[0]); -> */
  prm -> sd[disk][srnr].nharmnorm = (long) (ringflux/prm -> cflux[disk]);

  /* correct the point source flux */
  if ((prm -> sd[disk][srnr].nharmnorm))
    prm -> sd[disk][srnr].pf = fabs(ringflux)/prm -> sd[disk][srnr].nharmnorm;
  else
    /* Kamphuis bugfix */
/*     prm -> sd[disk][srnr].pf = prm -> cflux[0]; -> */
    prm -> sd[disk][srnr].pf = prm -> cflux[disk];

  /* We allow for a negative pointsource flux, even if it makes no sense */
  if (prm -> sd[disk][srnr].nharmnorm < 0) {
    prm -> sd[disk][srnr].nharmnorm = -prm -> sd[disk][srnr].nharmnorm;
  }

  prm -> sd[disk][srnr].n += prm -> sd[disk][srnr].nharmnorm;

  prm -> sd[disk][srnr].gridpoint = &gridpoint_norm;
  prm -> sd[disk][srnr].srput = &srput_norm;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_smis/c_act */
static void pr_smi_pas(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm0b_pas(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  *sbr = 0.0;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm0b_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = prm -> sd[disk][srnr].spb0;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm1s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+sinaz*prm -> sd[disk][srnr].sps1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm2s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(2.0*sinaz*cosaz)* prm -> sd[disk][srnr].sps2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm3s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(3.0*sinaz-4.0*sinaz*sinaz*sinaz)*prm  -> sd[disk][srnr].sps3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm4s_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(8.0*sinaz*cosaz*cosaz*cosaz-4.0*sinaz*cosaz)* prm -> sd[disk][srnr].sps4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm1c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+cosaz* prm -> sd[disk][srnr].spc1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm2c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(1.0-2.0*sinaz*sinaz)*prm -> sd[disk][srnr].spc2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm3c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(4.0*cosaz*cosaz*cosaz-3.0*cosaz)*prm -> sd[disk][srnr].spc3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void pr_sm4c_act(void *rpm, float *sbr, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *sbr = *sbr+(8.0*cosaz*cosaz*cosaz*cosaz-8.0*cosaz*cosaz+1.0)*prm -> sd[disk][srnr].spc4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void smi_getaz_cons(void *rpm, float *az, float *sinaz, float *cosaz, int *signum, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  *az = TWOPI*maths_rndmf(prm -> sd[disk][srnr].permrandstr);
  *cosaz = cosf(*az);
  *sinaz = sinf(*az);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void smi_getaz_harm(void *rpm, float *az, float *sinaz, float *cosaz, int *signum, int srnr, int disk)
{
  ringparms *prm;
  float sbr;

  prm = (ringparms *) rpm;

  while (1) {
    *az = TWOPI*maths_rndmf(prm -> sd[disk][srnr].permrandstr);
    *cosaz = cosf(*az);
    *sinaz = sinf(*az);

    /* Caution!!! This function replaces sbr with the constant value */
    (*(prm -> inf_smiv[disk] -> prb0))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);

    /* Caution!!! The following functions add to sbr */
    (*(prm -> inf_smiv[disk] -> prs1))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prs2))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prs3))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prs4))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prc1))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prc2))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prc3))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);
    (*(prm -> inf_smiv[disk] -> prc4))(rpm, &sbr, srnr, *sinaz, *cosaz, disk);

    if (maths_rndmf(prm -> sd[disk][srnr].randstr) <= fabs(sbr))
      break;
    else {
      /* This is to keep the pointsource lists similar */
      maths_rndmf(prm -> sd[disk][srnr].permrandstr);
/*       zprof(prm -> ltype[0],  prm -> sd[disk][srnr].permrandstr)*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZ0)*prm -> nr+srnr]; */
      zprof(prm -> ltype[disk],  prm -> sd[disk][srnr].permrandstr, &(prm -> sd[disk][srnr].y2));
      (*(prm -> inf_sdisv[disk] -> pr_empty))(rpm, srnr, disk);
    }
  }

  if (sbr >= 0)
    *signum = 1;
  else
    *signum = 0;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates the sum of absolute amplitudes of surface brightness modes and puts that number in the sbrmax variable of the subring structure */
static void smi_sbrmax_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;
  double sbrmax;
  prm = (ringparms *) rpm;

  sbrmax = (fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSBR)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM1A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM2A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM3A)*prm -> nr+srnr])+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSM4A)*prm -> nr+srnr]));
  if (sbrmax != 0.0)
    prm -> sd[disk][srnr].sbrmax = 1.0/sbrmax;
  else
    sbrmax = 2.0;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial surface brightness component and adds it to the input */
static void smi_sbrmax_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm1 struct */
static int chkb_gau(ringparms *rpm, fitparms *fit)
{
  int actiflag, disk, srnr;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_gauv[disk]))
      if (!(rpm -> inf_gauv[disk] = create_inf_gau()))
	return 1;

    actiflag = 0;

    /* check out subring calculation and calculation of surface density */

    /* First order */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PGA1A))) {
      rpm -> inf_gauv[disk] -> srpr0 = &srpr_gau_pas;
      rpm -> inf_gauv[disk] -> rndmf_init0 = &rndmf_init_gau_pas;
      rpm -> inf_gauv[disk] -> getcloudnumber0 = gau_getcloudnumber_pas;
    }
    else {
      rpm -> inf_gauv[disk] -> srpr0 = &srpr_gau_act;
      rpm -> inf_gauv[disk] -> rndmf_init0 = &rndmf_init_gau_act;
      rpm -> inf_gauv[disk] -> getcloudnumber0 = gau_getcloudnumber_act;
      for (srnr = 0; srnr < rpm -> nr; ++srnr) {
      if (!(rpm -> sd[disk][srnr].grandstr[0]))
	if (!(rpm -> sd[disk][srnr].grandstr[0] = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	  goto error;
      }
      actiflag = 1;
    }

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PGA2A))) {
      rpm -> inf_gauv[disk] -> srpr1 = &srpr_gau_pas;
      rpm -> inf_gauv[disk] -> rndmf_init1 = &rndmf_init_gau_pas;
      rpm -> inf_gauv[disk] -> getcloudnumber1 = gau_getcloudnumber_pas;
    }
    else {
      rpm -> inf_gauv[disk] -> srpr1 = &srpr_gau_act;
      rpm -> inf_gauv[disk] -> rndmf_init1 = &rndmf_init_gau_act;
      rpm -> inf_gauv[disk] -> getcloudnumber1 = gau_getcloudnumber_act;
      for (srnr = 0; srnr < rpm -> nr; ++srnr) {
	if (!(rpm -> sd[disk][srnr].grandstr[1]))
	  if (!(rpm -> sd[disk][srnr].grandstr[1] = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	    goto error;
      }
      actiflag = 1;
    }

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PGA3A))) {
      rpm -> inf_gauv[disk] -> srpr2 = &srpr_gau_pas;
      rpm -> inf_gauv[disk] -> rndmf_init2 = &rndmf_init_gau_pas;
      rpm -> inf_gauv[disk] -> getcloudnumber2 = gau_getcloudnumber_pas;
  }
    else {
      rpm -> inf_gauv[disk] -> srpr2 = &srpr_gau_act;
      rpm -> inf_gauv[disk] -> rndmf_init2 = &rndmf_init_gau_act;
      rpm -> inf_gauv[disk] -> getcloudnumber2 = gau_getcloudnumber_act;
      for (srnr = 0; srnr < rpm -> nr; ++srnr) {
	if (!(rpm -> sd[disk][srnr].grandstr[2]))
	  if (!(rpm -> sd[disk][srnr].grandstr[2] = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	    goto error;
      }
      actiflag = 1;
    }

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PGA4A))) {
      rpm -> inf_gauv[disk] -> srpr3 = &srpr_gau_pas;
      rpm -> inf_gauv[disk] -> rndmf_init3 = &rndmf_init_gau_pas;
      rpm -> inf_gauv[disk] -> getcloudnumber3 = gau_getcloudnumber_pas;
    }
    else {
      rpm -> inf_gauv[disk] -> srpr3 = &srpr_gau_act;
      rpm -> inf_gauv[disk] -> rndmf_init3 = &rndmf_init_gau_act;
      rpm -> inf_gauv[disk] -> getcloudnumber3 = gau_getcloudnumber_act;
      for (srnr = 0; srnr < rpm -> nr; ++srnr) {
	if (!(rpm -> sd[disk][srnr].grandstr[3]))
	  if (!(rpm -> sd[disk][srnr].grandstr[3] = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	    goto error;
      }
      actiflag = 1;
    }

    if ((actiflag)) {
      ;
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_gau(rpm -> inf_gauv[disk]);
    rpm -> inf_gauv[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* allocates an inf_gau struct */
static inf_gau *create_inf_gau(void)
{
  inf_gau *create_inf_gau = NULL;

  if (!(create_inf_gau = (inf_gau *) malloc(sizeof(inf_gau))))
    return create_inf_gau;

/*   for (i = 0; i < 4; ++i) */
/*     create_inf_gau -> randstr[i] = NULL; */

  return create_inf_gau;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* deallocates an inf_gau struct */
static int destroy_inf_gau(inf_gau *inf_gauv)
{
  if (!(inf_gauv))
    return 0;

/*   for (i = 0; i < 4; ++i) { */
/*     if ((inf_gauv -> randstr[i])) */
/*       free(inf_gauv -> randstr[i]); */
/*   } */
  free(inf_gauv);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates Gaussian surface brightness dispersion in rad and adds it to the subring */
 static void srpr_gau_act(void *rpm, int srnr, int number, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].gaudi[number] = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PGA1D+3*number)*prm -> nr+srnr]/prm -> modpar[PRADI*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
 static void srpr_gau_pas(void *rpm, int srnr, int number, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialises the rng internal to the calulation of sdis */
 static void rndmf_init_gau_act(void *rpm, int srnr, int n, int disk)
{
  ringparms *prm;
  int iseed[2];

  prm = (ringparms *) rpm;
  iseed[0] = prm -> iseed2+2+n;
  iseed[1] = srnr;

  /* Reset things */
  maths_rndmf_init(iseed, prm -> sd[disk][srnr].grandstr[n]);
  zprof(6, prm -> sd[disk][srnr].grandstr[n], &(prm -> sd[disk][srnr].y2));

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function doing nothing instead of rndmf_init_sdis_act */
 static void rndmf_init_gau_pas(void *rpm, int srnr, int n, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void gau_getcloudnumber_act(void *rpm, int srnr, int group, int disk)
{
  ringparms *prm;
  float ringflux;

  prm = (ringparms *) rpm;

  /* This defines the amplitude as a real peak value in total surface brightness */
  ringflux = SQRTOFTWOPI*prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PGA1A+3*group)*prm -> nr+srnr]*prm  -> sd[disk][srnr].gaudi[group];

/* This defines the amplitude as the surface brightness averaged over a complete ring */
/*   ringflux = TWOPI*prm -> modpar[PRADI*prm -> nr+srnr]*prm -> radsep*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PGA1A+3*group)*prm -> nr+srnr]; */

  /* This is the integral if there is no negative flux (because the integral of a harmonic function with order > 0 is 0) */
  prm -> sd[disk][srnr].ngaussian[group] = (long) fabs(ringflux/prm -> sd[disk][srnr].pf);
  prm -> sd[disk][srnr].n += prm -> sd[disk][srnr].ngaussian[group];

  /* Change the gridding method if the flux signum of the point sources differs from what we have in the constant expression */
  if (prm -> sd[disk][srnr].gridpoint == &gridpoint_norm) {
    if ((prm -> sd[disk][srnr].pf > 0 && ringflux < 0) || (prm -> sd[disk][srnr].pf < 0 && ringflux > 0)) {
        prm -> sd[disk][srnr].gridpoint = &gridpoint_mixed;
	prm -> sd[disk][srnr].srput = &srput_mixed;
    }
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates surface brightness sin component and adds it to the subring */
static void gau_getcloudnumber_pas(void *rpm, int srnr, int group, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* get azimuth from Gaussian descriptors */
static void gau_getaz(ringparms *prm, int pgaip, maths_rstrf *randstr, int pgaid, float *az, float *sinaz, float *cosaz, int srnr, int disk)
{
  *az = fmodf(prm -> modpar[pgaip*prm -> nr+srnr]+zprof(1, randstr, &(prm -> sd[disk][srnr].y2))*prm  -> sd[disk][srnr].gaudi[pgaid], TWOPI);
  while (*az < 0.0)
    *az = *az+TWOPI;
/* *az = prm -> modpar[pgaip*prm -> nr+srnr]+zprof(1, randstr)*prm  -> sd[disk][srnr].gaudi[pgaid]; */
/*   *az = prm -> modpar[(PRPARAMS+disk*NDPARAMS+pgaip)*prm -> nr+srnr]+zprof(1, randstr)*prm  -> sd[disk][srnr].gaudi[pgaid]; */
/*   az = prm -> modpar[(PRPARAMS+disk*NDPARAMS+pgaip)*prm -> nr+srnr]+zprof(1, randstr)*prm -> modpar[(PRPARAMS+disk*NDPARAMS+pgaid)*prm -> nr+srnr]; */
  *sinaz = sinf(*az);
  *cosaz = cosf(*az);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* allocates an inf_azi struct */
static inf_azi *create_inf_azi(void)
{
  inf_azi *create_inf_azi = NULL;

  if (!(create_inf_azi = (inf_azi *) malloc(sizeof(inf_azi))))
    return create_inf_azi;

  return create_inf_azi;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* deallocates an inf_azi struct */
static int destroy_inf_azi(inf_azi *inf_aziv)
{
  if (!(inf_aziv))
    return 0;

  free(inf_aziv);
  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm1 struct */
static int chkb_azi(ringparms *rpm, fitparms *fit)
{
  int actiflag, disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    actiflag = 0;

    if (!(rpm -> inf_aziv[disk]))
      if (!(rpm -> inf_aziv[disk] = create_inf_azi()))
	return 1;

    rpm -> inf_aziv[disk] -> pr0 = &pr_azi_pas;
    rpm -> inf_aziv[disk] -> pr1 = &pr_azi_pas;

    /* First range */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PAZ1W))) {
      rpm -> inf_aziv[disk] -> srpr0 = &srpr_azi_pas;
    }
    else {
      rpm -> inf_aziv[disk] -> srpr0 = &srpr_azi_act;
      rpm -> inf_aziv[disk] -> pr0 = &pr_azi_act;
      actiflag = 1;
    }

    /* Second range */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PAZ2W))) {
      rpm -> inf_aziv[disk] -> srpr1 = &srpr_azi_pas;
    }
    else {
      rpm -> inf_aziv[disk] -> srpr1 = &srpr_azi_act;
      rpm -> inf_aziv[disk] -> pr1 = &pr_azi_act;
      actiflag = 1;
    }

    rpm -> inf_aziv[disk] -> srshape = &srshape_azi_pas;
    rpm -> inf_aziv[disk] -> corrp = &corrp_azi_pas;
    rpm -> inf_aziv[disk] -> setoutrange = &setoutrange_azi_pas;

    if ((actiflag)) {
      rpm -> inf_aziv[disk] -> srshape = &srshape_azi_act;
      rpm -> inf_aziv[disk] -> corrp = &corrp_azi_act;
      rpm -> inf_aziv[disk] -> setoutrange = &setoutrange_azi_act;
    }
  }

  return 0;

}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates Gaussian surface brightness dispersion in rad and adds it to the subring */
static void srpr_azi_act(void *rpm, int srnr, int number, int disk)
{
  ringparms *prm;
  float azi;

  prm = (ringparms *) rpm;

  azi = fmodf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PAZ1P+2*number)*prm -> nr+srnr],TWOPI);

  while (azi < 0.0)
    azi = azi+TWOPI;

  prm -> sd[disk][srnr].ranges[number][0] = azi-0.5*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PAZ1W+2*number)*prm -> nr+srnr];
  prm -> sd[disk][srnr].ranges[number][1] = azi+0.5*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PAZ1W+2*number)*prm -> nr+srnr];

  if (prm -> sd[disk][srnr].ranges[number][1] > TWOPI) {
    prm -> sd[disk][srnr].ranges[number][2] = prm -> sd[disk][srnr].ranges[number][0]-TWOPI;
    prm -> sd[disk][srnr].ranges[number][3] = prm -> sd[disk][srnr].ranges[number][1]-TWOPI;
  }
  else {
    prm -> sd[disk][srnr].ranges[number][2] = prm -> sd[disk][srnr].ranges[number][0]+TWOPI;
    prm -> sd[disk][srnr].ranges[number][3] = prm -> sd[disk][srnr].ranges[number][1]+TWOPI;
  }

  prm -> sd[disk][srnr].outofrange = 1;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void srpr_azi_pas(void *rpm, int srnr, int number, int disk)
{
  ringparms *prm;
  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].outofrange = 0;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Check if azimuth is in allowed range and put switches */
static void pr_azi_pas(float *azi, float ranges[2][4], int *outofrange, int i)
{
/*   *outofrange = 0; */
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Check if azimuth is in allowed range and put switches */
static void setoutrange_azi_pas(int *outofrange)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Check if azimuth is in allowed range and put switches */
static void setoutrange_azi_act(int *outofrange)
{
  *outofrange = 1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Check if azimuth is in allowed range and put switches */
static void pr_azi_act(float *azi, float ranges[2][4], int *outofrange, int i)
{
/*   if ((*outofrange)) { */
/*     if (maths_checkinbetwf(ranges[i][0], ranges[i][1], *azi) || maths_checkinbetwf(ranges[i][2], ranges[i][3], *azi)) { */
/*       *outofrange = 0; */
/*     } */
/*   } */

/* Changed to this */
/*   *outofrange = 1; */
  if (maths_checkinbetwf(ranges[i][0], ranges[i][1], *azi) || maths_checkinbetwf(ranges[i][2], ranges[i][3], *azi)) {
    *outofrange = 0;
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static int srshape_azi_act(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  if ((outofrange)) {
    maths_rndmf(prm -> sd[disk][srnr].permrandstr);
    zprof(prm -> ltype[disk],  prm -> sd[disk][srnr].permrandstr, &(prm -> sd[disk][srnr].y2));

    /* This shift by 5000000 pixels should do, one could do more elegant, but I'm tired */
     pp[1] = 5000000.;
     return 1;
  }
  else {
    srshape(prm, pp, sinaz, cosaz, srnr, disk);
  }

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static int srshape_azi_pas(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  srshape(prm, pp, sinaz, cosaz, srnr, disk);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static int srshape_azi_actcool(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  if ((outofrange)) {
    maths_rndmf(prm -> sd[disk][srnr].permrandstr);
    zprof(prm -> ltype[disk],  prm -> sd[disk][srnr].permrandstr, &(prm -> sd[disk][srnr].y2));

    /* This shift by 5000000 pixels should do, one could do more elegant, but I'm tired */
     pp[1] = 5000000.;
     return 1;
  }
  else {
    srshapecool(prm, pp, sinaz, cosaz, srnr, disk);
  }

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static int srshape_azi_pascool(void *rpm, float *pp, float sinaz, float cosaz, int srnr, int outofrange, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  srshapecool(prm, pp, sinaz, cosaz, srnr, disk);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static void corrp_azi_act(void *rpm, int srnr, int *outofrange, int signum)
{
  /* ringparms *prm; */

  /* prm = (ringparms *) rpm; */

/*   if ((*outofrange)) { */
/*     --prm -> sd[disk][srnr].outn; */
/*   } */

  *outofrange = 1;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Generation of a pointsource list */
static void corrp_azi_pas(void *rpm, int srnr, int *outofrange, int signum)
{
 return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vrad  struct */   static inf_vrad *create_inf_vrad(void)    {    inf_vrad  *create_inf_vrad= NULL;    if (!(create_inf_vrad = (inf_vrad *) malloc(sizeof(inf_vrad))))    return create_inf_vrad;    return create_inf_vrad;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vver  struct */   static inf_vver *create_inf_vver(void)    {    inf_vver  *create_inf_vver= NULL;    if (!(create_inf_vver = (inf_vver *) malloc(sizeof(inf_vver))))    return create_inf_vver;    return create_inf_vver;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_dvro  struct */   static inf_dvro *create_inf_dvro(void)    {    inf_dvro  *create_inf_dvro= NULL;    if (!(create_inf_dvro = (inf_dvro *) malloc(sizeof(inf_dvro))))    return create_inf_dvro;    return create_inf_dvro;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_dvra  struct */   static inf_dvra *create_inf_dvra(void)    {    inf_dvra  *create_inf_dvra= NULL;    if (!(create_inf_dvra = (inf_dvra *) malloc(sizeof(inf_dvra))))    return create_inf_dvra;    return create_inf_dvra;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_dvve  struct */   static inf_dvve *create_inf_dvve(void)    {    inf_dvve  *create_inf_dvve= NULL;    if (!(create_inf_dvve = (inf_dvve *) malloc(sizeof(inf_dvve))))    return create_inf_dvve;    return create_inf_dvve;   }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vm0  struct */   static inf_vm0 *create_inf_vm0(void)    {    inf_vm0  *create_inf_vm0= NULL;    if (!(create_inf_vm0 = (inf_vm0 *) malloc(sizeof(inf_vm0))))    return create_inf_vm0;    return create_inf_vm0;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vm1 struct */    static inf_vm1 *create_inf_vm1(void)    {    inf_vm1 *create_inf_vm1 = NULL;    if (!(create_inf_vm1 = (inf_vm1 *) malloc(sizeof(inf_vm1))))    return create_inf_vm1;    return create_inf_vm1;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vm2 struct */    static inf_vm2 *create_inf_vm2(void)    {    inf_vm2 *create_inf_vm2 = NULL;    if (!(create_inf_vm2 = (inf_vm2 *) malloc(sizeof(inf_vm2))))    return create_inf_vm2;    return create_inf_vm2;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vm3 struct */    static inf_vm3 *create_inf_vm3(void)    {    inf_vm3 *create_inf_vm3 = NULL;    if (!(create_inf_vm3 = (inf_vm3 *) malloc(sizeof(inf_vm3))))    return create_inf_vm3;    return create_inf_vm3;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_vm4 struct */    static inf_vm4 *create_inf_vm4(void)    {    inf_vm4 *create_inf_vm4 = NULL;    if (!(create_inf_vm4 = (inf_vm4 *) malloc(sizeof(inf_vm4))))    return create_inf_vm4;    return create_inf_vm4;   }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ra1 struct */    static inf_ra1 *create_inf_ra1(void)    {    inf_ra1 *create_inf_ra1 = NULL;    if (!(create_inf_ra1 = (inf_ra1 *) malloc(sizeof(inf_ra1))))    return create_inf_ra1;    return create_inf_ra1;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ra2 struct */    static inf_ra2 *create_inf_ra2(void)    {    inf_ra2 *create_inf_ra2 = NULL;    if (!(create_inf_ra2 = (inf_ra2 *) malloc(sizeof(inf_ra2))))    return create_inf_ra2;    return create_inf_ra2;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ra3 struct */    static inf_ra3 *create_inf_ra3(void)    {    inf_ra3 *create_inf_ra3 = NULL;    if (!(create_inf_ra3 = (inf_ra3 *) malloc(sizeof(inf_ra3))))    return create_inf_ra3;    return create_inf_ra3;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ra4 struct */    static inf_ra4 *create_inf_ra4(void)    {    inf_ra4 *create_inf_ra4 = NULL;    if (!(create_inf_ra4 = (inf_ra4 *) malloc(sizeof(inf_ra4))))    return create_inf_ra4;    return create_inf_ra4;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ro1 struct */    static inf_ro1 *create_inf_ro1(void)    {    inf_ro1 *create_inf_ro1 = NULL;    if (!(create_inf_ro1 = (inf_ro1 *) malloc(sizeof(inf_ro1))))    return create_inf_ro1;    return create_inf_ro1;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ro2 struct */    static inf_ro2 *create_inf_ro2(void)    {    inf_ro2 *create_inf_ro2 = NULL;    if (!(create_inf_ro2 = (inf_ro2 *) malloc(sizeof(inf_ro2))))    return create_inf_ro2;    return create_inf_ro2;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ro3 struct */    static inf_ro3 *create_inf_ro3(void)    {    inf_ro3 *create_inf_ro3 = NULL;    if (!(create_inf_ro3 = (inf_ro3 *) malloc(sizeof(inf_ro3))))    return create_inf_ro3;    return create_inf_ro3;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ro4 struct */    static inf_ro4 *create_inf_ro4(void)    {    inf_ro4 *create_inf_ro4 = NULL;    if (!(create_inf_ro4 = (inf_ro4 *) malloc(sizeof(inf_ro4))))    return create_inf_ro4;    return create_inf_ro4;   }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_wm0   struct */    static inf_wm0   *create_inf_wm0  (void)    {    inf_wm0   *create_inf_wm0   = NULL;    if (!(create_inf_wm0   = (inf_wm0   *) malloc(sizeof(inf_wm0  ))))    return create_inf_wm0  ;    return create_inf_wm0  ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_wm1  struct */    static inf_wm1  *create_inf_wm1 (void)    {    inf_wm1  *create_inf_wm1  = NULL;    if (!(create_inf_wm1  = (inf_wm1  *) malloc(sizeof(inf_wm1 ))))    return create_inf_wm1 ;    return create_inf_wm1 ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_wm2  struct */    static inf_wm2  *create_inf_wm2 (void)    {    inf_wm2  *create_inf_wm2  = NULL;    if (!(create_inf_wm2  = (inf_wm2  *) malloc(sizeof(inf_wm2 ))))    return create_inf_wm2 ;    return create_inf_wm2 ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_wm3  struct */    static inf_wm3  *create_inf_wm3 (void)    {    inf_wm3  *create_inf_wm3  = NULL;    if (!(create_inf_wm3  = (inf_wm3  *) malloc(sizeof(inf_wm3 ))))    return create_inf_wm3 ;    return create_inf_wm3 ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_wm4  struct */    static inf_wm4  *create_inf_wm4 (void)    {    inf_wm4  *create_inf_wm4  = NULL;    if (!(create_inf_wm4  = (inf_wm4  *) malloc(sizeof(inf_wm4 ))))    return create_inf_wm4 ;    return create_inf_wm4 ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_ls0  struct */    static inf_ls0  *create_inf_ls0 (void)    {    inf_ls0  *create_inf_ls0  = NULL;    if (!(create_inf_ls0  = (inf_ls0  *) malloc(sizeof(inf_ls0 ))))    return create_inf_ls0 ;    return create_inf_ls0 ;   }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* allocates an inf_lc0  struct */    static inf_lc0  *create_inf_lc0 (void)    {    inf_lc0  *create_inf_lc0  = NULL;    if (!(create_inf_lc0  = (inf_lc0  *) malloc(sizeof(inf_lc0 ))))    return create_inf_lc0 ;    return create_inf_lc0 ;   }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_vrad (inf_vrad  *int_vradv )    {    if (!(int_vradv ))     return 0;    free(int_vradv );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_vver (inf_vver  *int_vverv )    {    if (!(int_vverv ))     return 0;    free(int_vverv );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_dvro (inf_dvro  *int_dvrov )    {    if (!(int_dvrov ))     return 0;    free(int_dvrov );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_dvra (inf_dvra  *int_dvrav )    {    if (!(int_dvrav ))     return 0;    free(int_dvrav );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_dvve (inf_dvve  *int_dvvev )    {    if (!(int_dvvev ))     return 0;    free(int_dvvev );    return 0;    }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm0  struct */    static int destroy_inf_vm0 (inf_vm0  *int_vm0v )    {    if (!(int_vm0v ))     return 0;    free(int_vm0v );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm1 struct */    static int destroy_inf_vm1(inf_vm1 *int_vm1v)    {    if (!(int_vm1v))    return 0;    free(int_vm1v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm2 struct */    static int destroy_inf_vm2(inf_vm2 *int_vm2v)    {    if (!(int_vm2v))    return 0;    free(int_vm2v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm3 struct */    static int destroy_inf_vm3(inf_vm3 *int_vm3v)    {    if (!(int_vm3v))    return 0;    free(int_vm3v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_vm4 struct */    static int destroy_inf_vm4(inf_vm4 *int_vm4v)    {    if (!(int_vm4v))    return 0;    free(int_vm4v);    return 0;    }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ra1 struct */    static int destroy_inf_ra1(inf_ra1 *int_ra1v)    {    if (!(int_ra1v))    return 0;    free(int_ra1v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ra2 struct */    static int destroy_inf_ra2(inf_ra2 *int_ra2v)    {    if (!(int_ra2v))    return 0;    free(int_ra2v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ra3 struct */    static int destroy_inf_ra3(inf_ra3 *int_ra3v)    {    if (!(int_ra3v))    return 0;    free(int_ra3v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ra4 struct */    static int destroy_inf_ra4(inf_ra4 *int_ra4v)    {    if (!(int_ra4v))    return 0;    free(int_ra4v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ro1 struct */    static int destroy_inf_ro1(inf_ro1 *int_ro1v)    {    if (!(int_ro1v))    return 0;    free(int_ro1v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ro2 struct */    static int destroy_inf_ro2(inf_ro2 *int_ro2v)    {    if (!(int_ro2v))    return 0;    free(int_ro2v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ro3 struct */    static int destroy_inf_ro3(inf_ro3 *int_ro3v)    {    if (!(int_ro3v))    return 0;    free(int_ro3v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ro4 struct */    static int destroy_inf_ro4(inf_ro4 *int_ro4v)    {    if (!(int_ro4v))    return 0;    free(int_ro4v);    return 0;    }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_wm0  struct */    static int destroy_inf_wm0 (inf_wm0  *int_wm0v )    {    if (!(int_wm0v ))     return 0;    free(int_wm0v );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_wm1 struct */    static int destroy_inf_wm1(inf_wm1 *int_wm1v)    {    if (!(int_wm1v))    return 0;    free(int_wm1v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_wm2 struct */    static int destroy_inf_wm2(inf_wm2 *int_wm2v)    {    if (!(int_wm2v))    return 0;    free(int_wm2v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_wm3 struct */    static int destroy_inf_wm3(inf_wm3 *int_wm3v)    {    if (!(int_wm3v))    return 0;    free(int_wm3v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_wm4 struct */    static int destroy_inf_wm4(inf_wm4 *int_wm4v)    {    if (!(int_wm4v))    return 0;    free(int_wm4v);    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_ls0  struct */    static int destroy_inf_ls0 (inf_ls0  *int_ls0v )    {    if (!(int_ls0v ))    return 0;    free(int_ls0v );    return 0;    }    /* ------------------------------------------------------------ */
/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */    /* deallocates an inf_lc0  struct */    static int destroy_inf_lc0 (inf_lc0  *int_lc0v )    {    if (!(int_lc0v ))    return 0;    free(int_lc0v );    return 0;    }    /* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialises the rng internal to the calulation of sdis */
static void rndmf_init_sdis_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].siseed[0] = prm -> iseed2+1+disk;
  prm -> sd[disk][srnr].siseed[1] = srnr;

  /* Reset things */
  maths_rndmf_init(prm -> sd[disk][srnr].siseed, prm -> sd[disk][srnr].srandstr);
  zprof(6, prm -> sd[disk][srnr].srandstr, &(prm -> sd[disk][srnr].y2));

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function doing nothing instead of rndmf_init_sdis_act */
static void rndmf_init_sdis_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Re-calculates point source numbers and fluxes depending on sub-cloud number */
static void chclfl_sdis_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;
  int clouds;

  prm = (ringparms *) rpm;

  prm -> sd[disk][srnr].nsubcl = (clouds = roundnormal(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PCLNR)*prm -> nr+srnr])) > 0?clouds:1;
  prm -> sd[disk][srnr].nsubclinv = 1.0/((float) prm -> sd[disk][srnr].nsubcl);

  prm -> sd[disk][srnr].pf = prm -> sd[disk][srnr].pf*prm -> sd[disk][srnr].nsubclinv;
  prm -> sd[disk][srnr].nharmnorm = prm -> sd[disk][srnr].nharmnorm*prm -> sd[disk][srnr].nsubcl;
  prm -> sd[disk][srnr].ngaussian[0] = prm -> sd[disk][srnr].ngaussian[0]*prm -> sd[disk][srnr].nsubcl;
  prm -> sd[disk][srnr].ngaussian[1] = prm -> sd[disk][srnr].ngaussian[1]*prm -> sd[disk][srnr].nsubcl;
  prm -> sd[disk][srnr].ngaussian[2] = prm -> sd[disk][srnr].ngaussian[2]*prm -> sd[disk][srnr].nsubcl;
  prm -> sd[disk][srnr].ngaussian[3] = prm -> sd[disk][srnr].ngaussian[3]*prm -> sd[disk][srnr].nsubcl;
  prm -> sd[disk][srnr].n = prm -> sd[disk][srnr].n *prm -> sd[disk][srnr].nsubcl;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Re-calculates point source numbers and fluxes depending on sub-cloud number */
static void chclfl_sdis_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */
/* LOOK HERE */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Initialises the rng internal to the calulation of sdis */
static void rndmf_init_smi_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].iseed[0] = prm -> iseed2+2+disk;
  prm -> sd[disk][srnr].iseed[1] = srnr+1;

  /* Reset the rng */
  maths_rndmf_init(prm -> sd[disk][srnr].iseed, prm -> sd[disk][srnr].randstr);

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function doing nothing instead of rndmf_init_sdis_act */
static void rndmf_init_smi_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_sdis_act */
static void pr_sdis_pas(void *rpm, float *v, float *vold, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates random velocity component and adds it to the input */
static void pr_sdis_act(void *rpm, float *v, float *vold, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *vold = *v;
  *v = *v+zprof(1, prm -> sd[disk][srnr].srandstr, &(prm -> sd[disk][srnr].y2))*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSDIS)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates random velocity component and adds it to the input, repeats the process a few times */
static void sdis_repeater_act(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk)
{
  ringparms *prm;
  int i;

  prm = (ringparms *) rpm;

  for (i = 1; i < prm -> sd[disk][srnr].nsubcl; ++i) {
    pp[5] = vold+zprof(1, prm -> sd[disk][srnr].srandstr, &(prm -> sd[disk][srnr].y2))*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSDIS)*prm -> nr+srnr];

#ifdef PBCORR
    (*(prm -> sd[disk][srnr].gridpoint))(hdr, prm -> fill_pbcfac, prm -> modpar, prm -> nr, prm -> sd, srnr, j, pp, signum, npoints, disk);
#else
    (*(prm -> sd[disk][srnr].gridpoint))(hdr, prm -> modpar, prm -> nr, prm -> sd, srnr, j, pp, signum, npoints, disk);
#endif

    (*(prm -> inf_aziv[disk] -> corrp))(rpm, srnr, &(prm -> sd[disk][srnr].outofrange), signum);
  }

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy */
static void sdis_repeater_pas(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates random velocity component and adds it to the input, repeats the process a few times */
static void sdis_repeater_actcool(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk)
{
  ringparms *prm;
  int i;

  prm = (ringparms *) rpm;

  for (i = 1; i < prm -> sd[disk][srnr].nsubcl; ++i) {
    /* pp[5] = vold+zprof(1, prm -> sd[disk][srnr].srandstr, &(prm -> sd[disk][srnr].y2))*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PSDIS)*prm -> nr+srnr]; */

#ifdef PBCORR
    (*(prm -> sd[disk][srnr].gridpoint))(hdr, prm -> fill_pbcfac, prm -> modpar, prm -> nr, prm -> sd, srnr, j, pp, signum, npoints, disk);
#else
    (*(prm -> sd[disk][srnr].gridpoint))(hdr, prm -> modpar, prm -> nr, prm -> sd, srnr, j, pp, signum, npoints, disk);
#endif

    (*(prm -> inf_aziv[disk] -> corrp))(rpm, srnr, &(prm -> sd[disk][srnr].outofrange), signum);
  }

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy */
static void sdis_repeater_pascool(void *rpm, float *pp, float vold, int srnr, hdrinf *hdr, long *j, int signum, long *npoints, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_sdis_act */
static void pr_sdis_empty_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates random velocity component and adds it to the input */
static void pr_sdis_empty_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;
  int i;

  prm = (ringparms *) rpm;

  for (i = 0; i < prm -> sd[disk][srnr].nsubcl; ++i)
    zprof(1, prm -> sd[disk][srnr].srandstr, &(prm -> sd[disk][srnr].y2));

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vrad_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVRAD)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_vrad_pas(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a vertical velocity component and adds it to the input */
static void pr_vver_act(void *rpm, float *point, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  /* Now, this is a bit more complex */
  if (point[2] > 0.0)
    point[5] = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVVER)*prm -> nr+srnr];
  else
    point[5] = -prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVVER)*prm -> nr+srnr];

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_vver_pas(void *rpm, float *point, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vver_rota_act(void *rpm, float *vz, float *vz2, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  *vz2 = *vz2+*vz*prm -> sd[disk][srnr].cosi;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_vver_rota_pas(void *rpm, float *vz, float *vz2, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_dvro_act(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  point[4] = point[4]+cosaz*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVRO)*prm -> nr+srnr]*fabs(point[2]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input, starting at zdro */
static void pr_dvro_act2(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  if (fabs(point[2]) >= fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDRO)*prm -> nr+srnr])) {
    point[4] = point[4]+cosaz*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVRO)*prm -> nr+srnr]*(fabs(point[2])-fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDRO)*prm -> nr+srnr]));
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_dvro_pas(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_dvra_act(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

    prm = (ringparms *) rpm;
    point[4] = point[4]+sinaz*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVRA)*prm -> nr+srnr]*fabs(point[2]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input, starting at zdra */
static void pr_dvra_act2(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

    prm = (ringparms *) rpm;
    if (fabs(point[2]) > fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDRA)*prm -> nr+srnr]))
      point[4] = point[4]+sinaz*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVRA)*prm -> nr+srnr]*(fabs(point[2]) - fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVRA)*prm -> nr+srnr]));
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_dvra_pas(void *rpm, float *point, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_dvve_act(void *rpm, float *point, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  /* Now, this should do, the signum of the z-component is the signum of z */
 point[5] = point[5]+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVVE)*prm -> nr+srnr]*point[2];

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input, if the scale height is above a certain value */
static void pr_dvve_act2(void *rpm, float *point, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;

  /* Now, this should do, the signum of the z-component is the signum of z */
  if (fabs(point[2]) > fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDVE)*prm -> nr+srnr])) {
    if (point[2] > 0.0)
      point[5] = point[5]+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVVE)*prm -> nr+srnr]*(point[2]-fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDVE)*prm -> nr+srnr]));
    else
      point[5] = point[5]+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PDVVE)*prm -> nr+srnr]*(point[2]+fabs(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PZDVE)*prm -> nr+srnr]));
  }
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Dummy */
static void pr_dvve_pas(void *rpm, float *point, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function */
static void srpr_vmi_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm1s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vps1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM1A)*prm -> nr+srnr]*sinf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm1c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vpc1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM1A)*prm -> nr+srnr]*cosf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm2s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vps2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM2A)*prm -> nr+srnr]*sinf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm2c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vpc2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM2A)*prm -> nr+srnr]*cosf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm3s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vps3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM3A)*prm -> nr+srnr]*sinf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm3c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vpc3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM3A)*prm -> nr+srnr]*cosf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm4s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vps4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM4A)*prm -> nr+srnr]*sinf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_vm4c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].vpc4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM4A)*prm -> nr+srnr]*cosf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_vmis/c_act */
static void pr_vmi_pas(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm0_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PVM0A)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*prm -> sd[disk][srnr].vps1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(2.0*sinaz*cosaz)* prm -> sd[disk][srnr].vps2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(3.0*sinaz-4.0*sinaz*sinaz*sinaz)*prm  -> sd[disk][srnr].vps3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(8.0*sinaz*cosaz*cosaz*cosaz-4.0*sinaz*cosaz)* prm -> sd[disk][srnr].vps4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz* prm -> sd[disk][srnr].vpc1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(1.0-2.0*sinaz*sinaz)*prm -> sd[disk][srnr].vpc2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(4.0*cosaz*cosaz*cosaz-3.0*cosaz)*prm -> sd[disk][srnr].vpc3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_vm4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+(8.0*cosaz*cosaz*cosaz*cosaz-8.0*cosaz*cosaz+1.0)*prm -> sd[disk][srnr].vpc4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function */
static void srpr_rai_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra1s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ras1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA1A)*prm -> nr+srnr]*sinf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra1c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].rac1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA1A)*prm -> nr+srnr]*cosf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra2s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ras2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA2A)*prm -> nr+srnr]*sinf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra2c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].rac2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA2A)*prm -> nr+srnr]*cosf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra3s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ras3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA3A)*prm -> nr+srnr]*sinf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra3c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].rac3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA3A)*prm -> nr+srnr]*cosf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra4s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ras4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA4A)*prm -> nr+srnr]*sinf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ra4c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].rac4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA4A)*prm -> nr+srnr]*cosf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRA4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_rais/c_act */
static void pr_rai_pas(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*sinaz*prm -> sd[disk][srnr].ras1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(2.0*sinaz*cosaz)* prm -> sd[disk][srnr].ras2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(3.0*sinaz-4.0*sinaz*sinaz*sinaz)*prm  -> sd[disk][srnr].ras3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(8.0*sinaz*cosaz*cosaz*cosaz-4.0*sinaz*cosaz)* prm -> sd[disk][srnr].ras4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*cosaz* prm -> sd[disk][srnr].rac1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(1.0-2.0*sinaz*sinaz)*prm -> sd[disk][srnr].rac2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(4.0*cosaz*cosaz*cosaz-3.0*cosaz)*prm -> sd[disk][srnr].rac3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ra4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+sinaz*(8.0*cosaz*cosaz*cosaz*cosaz-8.0*cosaz*cosaz+1.0)*prm -> sd[disk][srnr].rac4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function */
static void srpr_roi_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro1s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ros1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO1A)*prm -> nr+srnr]*sinf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro1c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].roc1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO1A)*prm -> nr+srnr]*cosf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro2s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ros2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO2A)*prm -> nr+srnr]*sinf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro2c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].roc2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO2A)*prm -> nr+srnr]*cosf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro3s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ros3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO3A)*prm -> nr+srnr]*sinf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro3c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].roc3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO3A)*prm -> nr+srnr]*cosf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro4s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].ros4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO4A)*prm -> nr+srnr]*sinf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates velocity sin component and adds it to the subring */
static void srpr_ro4c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].roc4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO4A)*prm -> nr+srnr]*cosf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PRO4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_rois/c_act */
static void pr_roi_pas(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro1s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*sinaz*prm -> sd[disk][srnr].ros1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro2s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(2.0*sinaz*cosaz)* prm -> sd[disk][srnr].ros2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro3s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(3.0*sinaz-4.0*sinaz*sinaz*sinaz)*prm  -> sd[disk][srnr].ros3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro4s_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(8.0*sinaz*cosaz*cosaz*cosaz-4.0*sinaz*cosaz)* prm -> sd[disk][srnr].ros4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro1c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*cosaz* prm -> sd[disk][srnr].roc1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro2c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(1.0-2.0*sinaz*sinaz)*prm -> sd[disk][srnr].roc2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro3c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(4.0*cosaz*cosaz*cosaz-3.0*cosaz)*prm -> sd[disk][srnr].roc3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ro4c_act(void *rpm, float *v, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *v = *v+cosaz*(8.0*cosaz*cosaz*cosaz*cosaz-8.0*cosaz*cosaz+1.0)*prm -> sd[disk][srnr].roc4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp sin component and adds it to the subring */
static void srpr_wm1s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wps1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM1A)*prm -> nr+srnr]*sinf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy function */
static void srpr_wmi_pas(void *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp cos component and adds it to the subring */
static void srpr_wm1c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wpc1 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM1A)*prm -> nr+srnr]*cosf(prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM1P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp sin component and adds it to the subring */
static void srpr_wm2s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wps2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM2A)*prm -> nr+srnr]*sinf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp cos component and adds it to the subring */
static void srpr_wm2c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wpc2 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM2A)*prm -> nr+srnr]*cosf(2.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM2P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp sin component and adds it to the subring */
static void srpr_wm3s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wps3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM3A)*prm -> nr+srnr]*sinf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp cos component and adds it to the subring */
static void srpr_wm3c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wpc3 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM3A)*prm -> nr+srnr]*cosf(3.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM3P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp sin component and adds it to the subring */
static void srpr_wm4s_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wps4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM4A)*prm -> nr+srnr]*sinf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates warp cos component and adds it to the subring */
static void srpr_wm4c_act(void *rpm, int srnr, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  prm -> sd[disk][srnr].wpc4 = prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM4A)*prm -> nr+srnr]*cosf(4.0*prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM4P)*prm -> nr+srnr]);
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_wmis/c_act */
static void pr_wmi_pas(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp m=0 component and adds it to the input */
static void pr_wm0_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PWM0A)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm1s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+sinaz*prm -> sd[disk][srnr].wps1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm2s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(2.0*sinaz*cosaz)* prm -> sd[disk][srnr].wps2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm3s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(3.0*sinaz-4.0*sinaz*sinaz*sinaz)*prm  -> sd[disk][srnr].wps3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm4s_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(8.0*sinaz*cosaz*cosaz*cosaz-4.0*sinaz*cosaz)* prm -> sd[disk][srnr].wps4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm1c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+cosaz* prm -> sd[disk][srnr].wpc1;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm2c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(1.0-2.0*sinaz*sinaz)*prm -> sd[disk][srnr].wpc2;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm3c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(4.0*cosaz*cosaz*cosaz-3.0*cosaz)*prm -> sd[disk][srnr].wpc3;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a warp component and adds it to the input */
static void pr_wm4c_act(void *rpm, float *z, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *z = *z+(8.0*cosaz*cosaz*cosaz*cosaz-8.0*cosaz*cosaz+1.0)*prm -> sd[disk][srnr].wpc4;
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_ls0_act */
static void pr_ls0_pas(void *rpm, float *y, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_ls0_act(void *rpm, float *y, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *y = *y+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PLS0)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* dummy instead of pr_lc0_act */
static void pr_lc0_pas(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* calculates a radial velocity component and adds it to the input */
static void pr_lc0_act(void *rpm, float *x, int srnr, float sinaz, float cosaz, int disk)
{
  ringparms *prm;

  prm = (ringparms *) rpm;
  *x = *x+prm -> modpar[(PRPARAMS+disk*NDPARAMS+PLC0)*prm -> nr+srnr];
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call userdble_c from gipsy */
static  int userdble_tir(simparse_scn_arel **arel, double *anarray, int *elements, int *defaultstat, char *keyword, char *message)
{
  int nread, nreturned, keypres;
  double *retarray = NULL;
  int i;

  int ndef = 0, min = 0, max = -1, keyreq = 0, ltmax = 0;

  /*
  def 0/1: no default/default
  def 2: hidden
  def 4 exact number
  from doc:
  All these routines are integer functions which return the number of items entered by the user

  0 --- no default is possible
  1 --- user is prompted, but default is taken when user types RETURN
  2 --- user is not prompted and default is taken unless the input was pre-specified
  4 --- (added to any of the above values) the user is required to enter the exact number of items
  */

  min = *elements;
  max = *elements;

  if (*defaultstat & 1) {
    /* user is prompted, but default is taken when user types RETURN: keyreq = 1 */
    ndef = *elements; keyreq = 1; ltmax = 0;
  }
  else {
    /* No default is possible:  */
    ndef = 0; keyreq = 1; ltmax = 0;
  }
  if (*defaultstat & 2) {
    /* user is not prompted and default is taken unless the input was pre-specified */
    ndef = *elements; keyreq = 0; ltmax = 0;
  }
  if (*defaultstat & 4) {

    /* the user is required to enter the exact number of items */
    ndef = 0; ltmax = 1;
  }

  if (simparse_scn_arel_readval_double(arel, keyword, message, ndef, anarray, min, max, keyreq, ltmax, &keypres, &nread, &nreturned, &retarray)) {
    if (retarray)
      free(retarray);
    return -1;
  }

  nreturned = (nreturned > *elements)?*elements:nreturned;

  for (i = 0; i < nreturned; ++i)
   anarray[i] = retarray[i];

  if (retarray) {
    free(retarray);
  }

  return nread;

/*  fint felements, fdefaultstat; */
 /*  int userdble_tir; */

 /*  felements = (fint) *elements; */
 /*  fdefaultstat = (fint) *defaultstat; */

 /*  userdble_tir = (int) userdble_c(anarray, &felements, &fdefaultstat, tofchar(keyword), tofchar(message)); */

 /* *elements = (int) felements; */
 /* *defaultstat = (int) fdefaultstat; */

 /* return userdble_tir; */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call userreal_c from gipsy */
static  int userreal_tir(simparse_scn_arel **arel, float *anarray, int *elements, int *defaultstat, char *keyword, char *message)
{
  int nread, nreturned, keypres;
  float *retarray = NULL;
  int i;

  int ndef = 0, min = 0, max = -1, keyreq = 0, ltmax = 0;

  /*
  def 0/1: no default/default
  def 2: hidden
  def 4 exact number
  from doc:
  All these routines are integer functions which return the number of items entered by the user

  0 --- no default is possible
  1 --- user is prompted, but default is taken when user types RETURN
  2 --- user is not prompted and default is taken unless the input was pre-specified
  4 --- (added to any of the above values) the user is required to enter the exact number of items
  */

  min = *elements;
  max = *elements;

  if (*defaultstat & 1) {
    /* user is prompted, but default is taken when user types RETURN: keyreq = 1 */
    ndef = *elements; keyreq = 1; ltmax = 0;
  }
  else {
    /* No default is possible:  */
    ndef = 0; keyreq = 1; ltmax = 0;
  }
  if (*defaultstat & 2) {
    /* user is not prompted and default is taken unless the input was pre-specified */
    ndef = *elements; keyreq = 0; ltmax = 0;
  }
  if (*defaultstat & 4) {

    /* the user is required to enter the exact number of items */
    ndef = 0; ltmax = 1;
  }

  if (simparse_scn_arel_readval_float(arel, keyword, message, ndef, anarray, min, max, keyreq, ltmax, &keypres, &nread, &nreturned, &retarray)) {
    if (retarray)
      free(retarray);
    return -1;
  }

  nreturned = (nreturned > *elements)?*elements:nreturned;

  for (i = 0; i < nreturned; ++i)
   anarray[i] = retarray[i];

  if (retarray) {
    free(retarray);
  }

  return nread;

 /*  fint felements, fdefaultstat; */
 /*  int userreal_tir; */

 /*  felements = (fint) *elements; */
 /*  fdefaultstat = (fint) *defaultstat; */

 /*  userreal_tir = (int) userreal_c(anarray, &felements, &fdefaultstat, tofchar(keyword), tofchar(message)); */

 /* *elements = (int) felements; */
 /* *defaultstat = (int) fdefaultstat; */

 /* return userreal_tir; */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to imitate userint_c from gipsy */
static  int userint_tir(simparse_scn_arel **arel, int *anarray, int *elements, int *defaultstat, char *keyword, char *message)
{
  int nread, nreturned, keypres;
  int *retarray = NULL;
  int i;

  int ndef = 0, min = 0, max = -1, keyreq = 0, ltmax = 0;

  /*
  def 0/1: no default/default
  def 2: hidden
  def 4 exact number
  from doc:
  All these routines are integer functions which return the number of items entered by the user

  0 --- no default is possible
  1 --- user is prompted, but default is taken when user types RETURN
  2 --- user is not prompted and default is taken unless the input was pre-specified
  4 --- (added to any of the above values) the user is required to enter the exact number of items
  */
  min = *elements;
  max = *elements;

  if (*defaultstat & 1) {
    /* user is prompted, but default is taken when user types RETURN: keyreq = 1 */
    ndef = *elements; keyreq = 1; ltmax = 0;
  }
  else {
    /* No default is possible:  */
    ndef = 0; keyreq = 1; ltmax = 0;
  }
  if (*defaultstat & 2) {
    /* user is not prompted and default is taken unless the input was pre-specified */
    ndef = *elements; keyreq = 0; ltmax = 0;
  }
  if (*defaultstat & 4) {

    /* the user is required to enter the exact number of items */
    ndef = 0; ltmax = 1;
  }

  if (simparse_scn_arel_readval_int(arel, keyword, message, ndef, anarray, min, max, keyreq, ltmax, &keypres, &nread, &nreturned, &retarray)) {
    if (retarray)
      free(retarray);
    return -1;
  }

  nreturned = (nreturned > *elements)?*elements:nreturned;

  for (i = 0; i < nreturned; ++i)
   anarray[i] = retarray[i];

  if (retarray) {
    free(retarray);
  }

  /* I think it's this silly choice */
  /* All these routines are integer functions which return the number of items entered by the user. */
  return nread;

 /*  fint *fanarray, felements, fdefaultstat; */
 /*  int i, userint_tir; */

 /*  if (*elements > 0){ */
 /*    if (!(fanarray = (fint *) malloc(*elements*sizeof(fint)))) */
 /*      return -1; */
 /*  } */
 /*  else  */
 /*    fanarray = NULL; */

 /*  for (i = 0; i < *elements; ++i) { */
 /*    fanarray[i] = (fint) anarray[i]; */
 /*  } */

 /*  felements = (fint) *elements; */
 /*  fdefaultstat = (fint) *defaultstat; */

 /*  userint_tir = (int) userint_c(fanarray, &felements, &fdefaultstat, tofchar(keyword), tofchar(message)); */

 /* for (i = 0; i < *elements; ++i) { */
 /*    anarray[i] = (int) fanarray[i]; */
 /*  } */

 /* *elements = (int) felements; */
 /* *defaultstat = (int) fdefaultstat; */

 /* return userint_tir; */
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call error_c from gipsy */
static  int error_tir(int *device, char *message)
{
 /*  fint fdevice; */

 /*  fdevice = (fint) *device; */

 /*  error_c(&fdevice, tofchar(message)); */

 /* *device = (int) fdevice; */

  fprintf(stderr, "shitty%s\n", message);

  if (*device == 4) {
    exit(1);
  }

 return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call anyout_c from gipsy */
static  int anyout_tir(int *device, char *message)
{
 /*  fint fdevice; */

 /*  fdevice = (fint) *device; */

 /*  anyout_c(&fdevice, tofchar(message)); */

 /* *device = (int) fdevice; */

  printf("%s\n", message);

 return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call anyout_c from gipsy */
/* static  int anyout_cor(FILE *device, char *message) */
/* { */
/*   if ((device)) */
/*     fprintf(device, "%s\n", message); */
/*   else */
/*     printf("%s\n", message); */

/*  return 0; */
/* } */

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* wrapper to call cancel_c from gipsy */
static  int cancel_tir(simparse_scn_arel **arelv, char *parname, int depth)
{
  /* cancel_c(tofchar(parname)); */
  simparse_scn_arel_deepcancelkey(arelv, parname, depth);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the sdis struct */
static int chkb_sdis(ringparms *rpm, fitparms *fit)
{

  int disk, srnr;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the sdis struct */
    if (!rpm -> inf_sdisv[disk])
      if (!(rpm -> inf_sdisv[disk] = create_inf_sdis()))
	return 1;

    rpm -> inf_sdisv[disk] -> repeater = &sdis_repeater_pas;
    rpm -> inf_sdisv[disk] -> chclfl = &chclfl_sdis_pas;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PSDIS))) {

      /* We point to the right functions */
      rpm -> inf_sdisv[disk] -> rndmf_init = &rndmf_init_sdis_pas;
      rpm -> inf_sdisv[disk] -> pr = &pr_sdis_pas;
      rpm -> inf_sdisv[disk] -> pr_empty = &pr_sdis_empty_pas;
    }
    else {

      /* we allocate the rng */
      for (srnr = 0; srnr < rpm -> nr; ++srnr) {
	if (!(rpm -> sd[disk][srnr].srandstr))
	  if (!(rpm -> sd[disk][srnr].srandstr = (maths_rstrf *) malloc(sizeof(maths_rstrf))))
	    goto error;
      }

      /* We point to the right functions */
      rpm -> inf_sdisv[disk] -> rndmf_init = &rndmf_init_sdis_act;
      rpm -> inf_sdisv[disk] -> pr = &pr_sdis_act;
      rpm -> inf_sdisv[disk] -> pr_empty = &pr_sdis_empty_act;

      /* Do we fit more than one subcloud ? */
      if (!(chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PCLNR))) {
	rpm -> inf_sdisv[disk] -> repeater = &sdis_repeater_act;
	rpm -> inf_sdisv[disk] -> chclfl = &chclfl_sdis_act;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_sdis(rpm -> inf_sdisv[disk]);
    rpm -> inf_sdisv[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_vrad(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the vrad struct */

    if (!(rpm -> inf_vradv[disk]))
      if (!(rpm -> inf_vradv[disk] = create_inf_vrad()))
	goto error;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVRAD))) {
      /* We point to the right functions */
      rpm -> inf_vradv[disk] -> pr = &pr_vrad_pas;

    }
    else {

      /* We point to the right functions */
    rpm -> inf_vradv[disk] -> pr = &pr_vrad_act;
    }
  }

  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vrad(rpm -> inf_vradv[disk]);
    rpm -> inf_vradv[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_vver(ringparms *rpm, fitparms *fit)
{

  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the vver struct */
    if (!(rpm -> inf_vverv[disk])) {
      if (!(rpm -> inf_vverv[disk] = create_inf_vver()))
	goto error;
    }

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVVER))) {
      /* We point to the right functions */
      rpm -> inf_vverv[disk] -> pr = &pr_vver_pas;
      rpm -> inf_vverv[disk] -> pr_rota = &pr_vver_rota_pas;
    }
    else {

      /* We point to the right functions */
      rpm -> inf_vverv[disk] -> pr = &pr_vver_act;
      rpm -> inf_vverv[disk] -> pr_rota = &pr_vver_rota_act;
    }

  }
    return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vver(rpm -> inf_vverv[disk]);
    rpm -> inf_vverv[disk] = NULL;
  }
  return 1;

}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_dvro(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the dvro struct */
    if (!(rpm -> inf_dvrov[disk]))
      if (!(rpm -> inf_dvrov[disk] = create_inf_dvro()))
	goto error;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PDVRO))) {

    /* We point to the right functions */
      rpm -> inf_dvrov[disk] -> pr = &pr_dvro_pas;

    }
    else {

      /* If we fit with an inner flat part */

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PZDRO))) {
	rpm -> inf_dvrov[disk] -> pr = &pr_dvro_act;
      }
      else {
	rpm -> inf_dvrov[disk] -> pr = &pr_dvro_act2;
      }
    }
  }

  return 0;
 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_dvro(rpm -> inf_dvrov[disk]);
    rpm -> inf_dvrov[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_dvra(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the vrad struct */
    if (!(rpm -> inf_dvrav[disk]))
      if (!(rpm -> inf_dvrav[disk] = create_inf_dvra()))
	goto error;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PDVRA))) {
      /* We point to the right functions */
      rpm -> inf_dvrav[disk] -> pr = &pr_dvra_pas;

    }
    else {

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PZDRA))) {
      /* We point to the right functions */
	rpm -> inf_dvrav[disk] -> pr = &pr_dvra_act;
      }
      else {
	rpm -> inf_dvrav[disk] -> pr = &pr_dvra_act2;
      }
    }
  }
  return 0;
 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_dvra(rpm -> inf_dvrav[disk]);
    rpm -> inf_dvrav[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_dvve(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the vrad struct */
    if (!(rpm -> inf_dvvev[disk]))
      if (!(rpm -> inf_dvvev[disk] = create_inf_dvve()))
	goto error;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PDVVE))) {

      /* We point to the right functions */
      rpm -> inf_dvvev[disk] -> pr = &pr_dvve_pas;

    }
    else {

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PZDVE))) {

	/* We point to the right functions */
	rpm -> inf_dvvev[disk] -> pr = &pr_dvve_act;
      }
      else {
	rpm -> inf_dvvev[disk] -> pr = &pr_dvve_act2;
      }

      /* allocate the vver struct*/
      chkb_vver((void *) rpm, fit);

      /* Ensure that the right type of rotation takes place ERROR SOURCE?*/
      rpm -> inf_vverv[disk] -> pr_rota = &pr_vver_rota_act;

    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_dvve(rpm -> inf_dvvev[disk]);
    rpm -> inf_dvvev[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm0 struct */
static int chkb_vm0(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the vm0 struct */
    if (!(rpm -> inf_vm0v[disk]))
      if (!(rpm -> inf_vm0v[disk] = create_inf_vm0()))
	goto error;

  /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM0A))) {
      /* We point to the right functions */
      rpm -> inf_vm0v[disk] -> pr = &pr_vmi_pas;

    }
    else {

    /* We point to the right functions */

      rpm -> inf_vm0v[disk] -> pr = &pr_vm0_act;
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vm0(rpm -> inf_vm0v[disk]);
    rpm -> inf_vm0v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm1 struct */
static int chkb_vm1(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_vm1v[disk]))
      if (!(rpm -> inf_vm1v[disk] = create_inf_vm1()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM1A))) {
      rpm -> inf_vm1v[disk] -> prs = rpm -> inf_vm1v[disk] -> prc = &pr_vmi_pas;
      rpm -> inf_vm1v[disk] -> srprs = rpm -> inf_vm1v[disk] -> srprc = &srpr_vmi_pas;
    }
    else {
      rpm -> inf_vm1v[disk] -> prs = &pr_vm1s_act;
      rpm -> inf_vm1v[disk] -> prc = &pr_vm1c_act;
      rpm -> inf_vm1v[disk] -> srprs = &srpr_vm1s_act;
      rpm -> inf_vm1v[disk] -> srprc = &srpr_vm1c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM1P))) {
	rpm -> inf_vm1v[disk] -> prs = &pr_vmi_pas;
	rpm -> inf_vm1v[disk] -> srprs = &srpr_vmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM1P, PIHALF))) {
	rpm -> inf_vm1v[disk] -> prc = &pr_vmi_pas;
	rpm -> inf_vm1v[disk] -> srprc = &srpr_vmi_pas;
      }
    }
  }

  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vm1(rpm -> inf_vm1v[disk]);
      rpm -> inf_vm1v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm2 struct */
static int chkb_vm2(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_vm2v[disk]))
      if (!(rpm -> inf_vm2v[disk] = create_inf_vm2()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM2A))) {
      rpm -> inf_vm2v[disk] -> prs = rpm -> inf_vm2v[disk] -> prc = &pr_vmi_pas;
    rpm -> inf_vm2v[disk] -> srprs = rpm -> inf_vm2v[disk] -> srprc = &srpr_vmi_pas;
    }
    else {
      rpm -> inf_vm2v[disk] -> prs = &pr_vm2s_act;
      rpm -> inf_vm2v[disk] -> prc = &pr_vm2c_act;
      rpm -> inf_vm2v[disk] -> srprs = &srpr_vm2s_act;
      rpm -> inf_vm2v[disk] -> srprc = &srpr_vm2c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM2P))) {
      rpm -> inf_vm2v[disk] -> prs = &pr_vmi_pas;
      rpm -> inf_vm2v[disk] -> srprs = &srpr_vmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM2P, PIHALF))) {
	rpm -> inf_vm2v[disk] -> prs = &pr_vmi_pas;
	rpm -> inf_vm2v[disk] -> srprs = &srpr_vmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vm2(rpm -> inf_vm2v[disk]);
    rpm -> inf_vm2v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm3 struct */
static int chkb_vm3(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_vm3v[disk]))
      if (!(rpm -> inf_vm3v[disk] = create_inf_vm3()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM3A))) {
      rpm -> inf_vm3v[disk] -> prs = rpm -> inf_vm3v[disk] -> prc = &pr_vmi_pas;
      rpm -> inf_vm3v[disk] -> srprs = rpm -> inf_vm3v[disk] -> srprc = &srpr_vmi_pas;
    }
    else {
      rpm -> inf_vm3v[disk] -> prs = &pr_vm3s_act;
      rpm -> inf_vm3v[disk] -> prc = &pr_vm3c_act;
      rpm -> inf_vm3v[disk] -> srprs = &srpr_vm3s_act;
      rpm -> inf_vm3v[disk] -> srprc = &srpr_vm3c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM3P))) {
	rpm -> inf_vm3v[disk] -> prs = &pr_vmi_pas;
	rpm -> inf_vm3v[disk] -> srprs = &srpr_vmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM3P, PIHALF))) {
	rpm -> inf_vm3v[disk] -> prc = &pr_vmi_pas;
	rpm -> inf_vm3v[disk] -> srprc = &srpr_vmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vm3(rpm -> inf_vm3v[disk]);
    rpm -> inf_vm3v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the vm4 struct */
static int chkb_vm4(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_vm4v[disk]))
      if (!(rpm -> inf_vm4v[disk] = create_inf_vm4()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM4A))) {
      rpm -> inf_vm4v[disk] -> prs = rpm -> inf_vm4v[disk] -> prc = &pr_vmi_pas;
      rpm -> inf_vm4v[disk] -> srprs = rpm -> inf_vm4v[disk] -> srprc = &srpr_vmi_pas;
    }
    else {
      rpm -> inf_vm4v[disk] -> prs = &pr_vm4s_act;
      rpm -> inf_vm4v[disk] -> prc = &pr_vm4c_act;
      rpm -> inf_vm4v[disk] -> srprs = &srpr_vm4s_act;
      rpm -> inf_vm4v[disk] -> srprc = &srpr_vm4c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM4P))) {
	rpm -> inf_vm4v[disk] -> prs = &pr_vmi_pas;
	rpm -> inf_vm4v[disk] -> srprs = &srpr_vmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PVM4P, PIHALF))) {
	rpm -> inf_vm4v[disk] -> prs = &pr_vmi_pas;
	rpm -> inf_vm4v[disk] -> srprs = &srpr_vmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_vm4(rpm -> inf_vm4v[disk]);
    rpm -> inf_vm4v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ra1 struct */
static int chkb_ra1(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ra1v[disk]))
      if (!(rpm -> inf_ra1v[disk] = create_inf_ra1()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA1A))) {
      rpm -> inf_ra1v[disk] -> prs = rpm -> inf_ra1v[disk] -> prc = &pr_rai_pas;
      rpm -> inf_ra1v[disk] -> srprs = rpm -> inf_ra1v[disk] -> srprc = &srpr_rai_pas;
    }
    else {
      rpm -> inf_ra1v[disk] -> prs = &pr_ra1s_act;
      rpm -> inf_ra1v[disk] -> prc = &pr_ra1c_act;
      rpm -> inf_ra1v[disk] -> srprs = &srpr_ra1s_act;
      rpm -> inf_ra1v[disk] -> srprc = &srpr_ra1c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA1P))) {
	rpm -> inf_ra1v[disk] -> prs = &pr_rai_pas;
	rpm -> inf_ra1v[disk] -> srprs = &srpr_rai_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA1P, PIHALF))) {
	rpm -> inf_ra1v[disk] -> prc = &pr_rai_pas;
	rpm -> inf_ra1v[disk] -> srprc = &srpr_rai_pas;
      }
    }
  }

  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ra1(rpm -> inf_ra1v[disk]);
      rpm -> inf_ra1v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ra2 struct */
static int chkb_ra2(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ra2v[disk]))
      if (!(rpm -> inf_ra2v[disk] = create_inf_ra2()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA2A))) {
      rpm -> inf_ra2v[disk] -> prs = rpm -> inf_ra2v[disk] -> prc = &pr_rai_pas;
    rpm -> inf_ra2v[disk] -> srprs = rpm -> inf_ra2v[disk] -> srprc = &srpr_rai_pas;
    }
    else {
      rpm -> inf_ra2v[disk] -> prs = &pr_ra2s_act;
      rpm -> inf_ra2v[disk] -> prc = &pr_ra2c_act;
      rpm -> inf_ra2v[disk] -> srprs = &srpr_ra2s_act;
      rpm -> inf_ra2v[disk] -> srprc = &srpr_ra2c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA2P))) {
      rpm -> inf_ra2v[disk] -> prs = &pr_rai_pas;
      rpm -> inf_ra2v[disk] -> srprs = &srpr_rai_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA2P, PIHALF))) {
	rpm -> inf_ra2v[disk] -> prs = &pr_rai_pas;
	rpm -> inf_ra2v[disk] -> srprs = &srpr_rai_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ra2(rpm -> inf_ra2v[disk]);
    rpm -> inf_ra2v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ra3 struct */
static int chkb_ra3(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ra3v[disk]))
      if (!(rpm -> inf_ra3v[disk] = create_inf_ra3()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA3A))) {
      rpm -> inf_ra3v[disk] -> prs = rpm -> inf_ra3v[disk] -> prc = &pr_rai_pas;
      rpm -> inf_ra3v[disk] -> srprs = rpm -> inf_ra3v[disk] -> srprc = &srpr_rai_pas;
    }
    else {
      rpm -> inf_ra3v[disk] -> prs = &pr_ra3s_act;
      rpm -> inf_ra3v[disk] -> prc = &pr_ra3c_act;
      rpm -> inf_ra3v[disk] -> srprs = &srpr_ra3s_act;
      rpm -> inf_ra3v[disk] -> srprc = &srpr_ra3c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA3P))) {
	rpm -> inf_ra3v[disk] -> prs = &pr_rai_pas;
	rpm -> inf_ra3v[disk] -> srprs = &srpr_rai_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA3P, PIHALF))) {
	rpm -> inf_ra3v[disk] -> prc = &pr_rai_pas;
	rpm -> inf_ra3v[disk] -> srprc = &srpr_rai_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ra3(rpm -> inf_ra3v[disk]);
    rpm -> inf_ra3v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ra4 struct */
static int chkb_ra4(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ra4v[disk]))
      if (!(rpm -> inf_ra4v[disk] = create_inf_ra4()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA4A))) {
      rpm -> inf_ra4v[disk] -> prs = rpm -> inf_ra4v[disk] -> prc = &pr_rai_pas;
      rpm -> inf_ra4v[disk] -> srprs = rpm -> inf_ra4v[disk] -> srprc = &srpr_rai_pas;
    }
    else {
      rpm -> inf_ra4v[disk] -> prs = &pr_ra4s_act;
      rpm -> inf_ra4v[disk] -> prc = &pr_ra4c_act;
      rpm -> inf_ra4v[disk] -> srprs = &srpr_ra4s_act;
      rpm -> inf_ra4v[disk] -> srprc = &srpr_ra4c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA4P))) {
	rpm -> inf_ra4v[disk] -> prs = &pr_rai_pas;
	rpm -> inf_ra4v[disk] -> srprs = &srpr_rai_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRA4P, PIHALF))) {
	rpm -> inf_ra4v[disk] -> prs = &pr_rai_pas;
	rpm -> inf_ra4v[disk] -> srprs = &srpr_rai_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ra4(rpm -> inf_ra4v[disk]);
    rpm -> inf_ra4v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ro1 struct */
static int chkb_ro1(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ro1v[disk]))
      if (!(rpm -> inf_ro1v[disk] = create_inf_ro1()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO1A))) {
      rpm -> inf_ro1v[disk] -> prs = rpm -> inf_ro1v[disk] -> prc = &pr_roi_pas;
      rpm -> inf_ro1v[disk] -> srprs = rpm -> inf_ro1v[disk] -> srprc = &srpr_roi_pas;
    }
    else {
      rpm -> inf_ro1v[disk] -> prs = &pr_ro1s_act;
      rpm -> inf_ro1v[disk] -> prc = &pr_ro1c_act;
      rpm -> inf_ro1v[disk] -> srprs = &srpr_ro1s_act;
      rpm -> inf_ro1v[disk] -> srprc = &srpr_ro1c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO1P))) {
	rpm -> inf_ro1v[disk] -> prs = &pr_roi_pas;
	rpm -> inf_ro1v[disk] -> srprs = &srpr_roi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO1P, PIHALF))) {
	rpm -> inf_ro1v[disk] -> prc = &pr_roi_pas;
	rpm -> inf_ro1v[disk] -> srprc = &srpr_roi_pas;
      }
    }
  }

  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ro1(rpm -> inf_ro1v[disk]);
      rpm -> inf_ro1v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ro2 struct */
static int chkb_ro2(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ro2v[disk]))
      if (!(rpm -> inf_ro2v[disk] = create_inf_ro2()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO2A))) {
      rpm -> inf_ro2v[disk] -> prs = rpm -> inf_ro2v[disk] -> prc = &pr_roi_pas;
    rpm -> inf_ro2v[disk] -> srprs = rpm -> inf_ro2v[disk] -> srprc = &srpr_roi_pas;
    }
    else {
      rpm -> inf_ro2v[disk] -> prs = &pr_ro2s_act;
      rpm -> inf_ro2v[disk] -> prc = &pr_ro2c_act;
      rpm -> inf_ro2v[disk] -> srprs = &srpr_ro2s_act;
      rpm -> inf_ro2v[disk] -> srprc = &srpr_ro2c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO2P))) {
      rpm -> inf_ro2v[disk] -> prs = &pr_roi_pas;
      rpm -> inf_ro2v[disk] -> srprs = &srpr_roi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO2P, PIHALF))) {
	rpm -> inf_ro2v[disk] -> prs = &pr_roi_pas;
	rpm -> inf_ro2v[disk] -> srprs = &srpr_roi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ro2(rpm -> inf_ro2v[disk]);
    rpm -> inf_ro2v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ro3 struct */
static int chkb_ro3(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ro3v[disk]))
      if (!(rpm -> inf_ro3v[disk] = create_inf_ro3()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO3A))) {
      rpm -> inf_ro3v[disk] -> prs = rpm -> inf_ro3v[disk] -> prc = &pr_roi_pas;
      rpm -> inf_ro3v[disk] -> srprs = rpm -> inf_ro3v[disk] -> srprc = &srpr_roi_pas;
    }
    else {
      rpm -> inf_ro3v[disk] -> prs = &pr_ro3s_act;
      rpm -> inf_ro3v[disk] -> prc = &pr_ro3c_act;
      rpm -> inf_ro3v[disk] -> srprs = &srpr_ro3s_act;
      rpm -> inf_ro3v[disk] -> srprc = &srpr_ro3c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO3P))) {
	rpm -> inf_ro3v[disk] -> prs = &pr_roi_pas;
	rpm -> inf_ro3v[disk] -> srprs = &srpr_roi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO3P, PIHALF))) {
	rpm -> inf_ro3v[disk] -> prc = &pr_roi_pas;
	rpm -> inf_ro3v[disk] -> srprc = &srpr_roi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ro3(rpm -> inf_ro3v[disk]);
    rpm -> inf_ro3v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ro4 struct */
static int chkb_ro4(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    if (!(rpm -> inf_ro4v[disk]))
      if (!(rpm -> inf_ro4v[disk] = create_inf_ro4()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO4A))) {
      rpm -> inf_ro4v[disk] -> prs = rpm -> inf_ro4v[disk] -> prc = &pr_roi_pas;
      rpm -> inf_ro4v[disk] -> srprs = rpm -> inf_ro4v[disk] -> srprc = &srpr_roi_pas;
    }
    else {
      rpm -> inf_ro4v[disk] -> prs = &pr_ro4s_act;
      rpm -> inf_ro4v[disk] -> prc = &pr_ro4c_act;
      rpm -> inf_ro4v[disk] -> srprs = &srpr_ro4s_act;
      rpm -> inf_ro4v[disk] -> srprc = &srpr_ro4c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO4P))) {
	rpm -> inf_ro4v[disk] -> prs = &pr_roi_pas;
	rpm -> inf_ro4v[disk] -> srprs = &srpr_roi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PRO4P, PIHALF))) {
	rpm -> inf_ro4v[disk] -> prs = &pr_roi_pas;
	rpm -> inf_ro4v[disk] -> srprs = &srpr_roi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ro4(rpm -> inf_ro4v[disk]);
    rpm -> inf_ro4v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the wm0 struct */
static int chkb_wm0(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {

    /* We allocate the wm0 struct */
    if (!(rpm -> inf_wm0v[disk]))
      if (!(rpm -> inf_wm0v[disk] = create_inf_wm0()))
	goto error;

    /* If we fit ... */
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM0A))) {
      /* We point to the right functions */
      rpm -> inf_wm0v[disk] -> pr = &pr_wmi_pas;

    }
    else {

      /* We point to the right functions */
      rpm -> inf_wm0v[disk] -> pr = &pr_wm0_act;
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_wm0(rpm -> inf_wm0v[disk]);
    rpm -> inf_wm0v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the wm1 struct */
static int chkb_wm1(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_wm1v[disk]))
      if (!(rpm -> inf_wm1v[disk] = create_inf_wm1()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM1A))) {
      rpm -> inf_wm1v[disk] -> prs = rpm -> inf_wm1v[disk] -> prc = &pr_wmi_pas;
      rpm -> inf_wm1v[disk] -> srprs = rpm -> inf_wm1v[disk] -> srprc = &srpr_wmi_pas;
    }
    else {
      rpm -> inf_wm1v[disk] -> prs = &pr_wm1s_act;
      rpm -> inf_wm1v[disk] -> prc = &pr_wm1c_act;
      rpm -> inf_wm1v[disk] -> srprs = &srpr_wm1s_act;
      rpm -> inf_wm1v[disk] -> srprc = &srpr_wm1c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM1P))) {
	rpm -> inf_wm1v[disk] -> prs = &pr_wmi_pas;
	rpm -> inf_wm1v[disk] -> srprs = &srpr_wmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM1P, PIHALF))) {
	rpm -> inf_wm1v[disk] -> prc = &pr_wmi_pas;
	rpm -> inf_wm1v[disk] -> srprc = &srpr_wmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_wm1(rpm -> inf_wm1v[disk]);
    rpm -> inf_wm1v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the wm2 struct */
static int chkb_wm2(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_wm2v[disk]))
      if (!(rpm -> inf_wm2v[disk] = create_inf_wm2()))
	goto error;
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM2A))) {
      rpm -> inf_wm2v[disk] -> prs = rpm -> inf_wm2v[disk] -> prc = &pr_wmi_pas;
      rpm -> inf_wm2v[disk] -> srprs = rpm -> inf_wm2v[disk] -> srprc = &srpr_wmi_pas;
    }
    else {
      rpm -> inf_wm2v[disk] -> prs = &pr_wm2s_act;
      rpm -> inf_wm2v[disk] -> prc = &pr_wm2c_act;
      rpm -> inf_wm2v[disk] -> srprs = &srpr_wm2s_act;
      rpm -> inf_wm2v[disk] -> srprc = &srpr_wm2c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM2P))) {
	rpm -> inf_wm2v[disk] -> prs = &pr_wmi_pas;
	rpm -> inf_wm2v[disk] -> srprs = &srpr_wmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM2P, PIHALF))) {
	rpm -> inf_wm2v[disk] -> prs = &pr_wmi_pas;
	rpm -> inf_wm2v[disk] -> srprs = &srpr_wmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_wm2(rpm -> inf_wm2v[disk]);
    rpm -> inf_wm2v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the wm3 struct */
static int chkb_wm3(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_wm3v[disk]))
      if (!(rpm -> inf_wm3v[disk] = create_inf_wm3()))
	goto error;
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM3A))) {
      rpm -> inf_wm3v[disk] -> prs = rpm -> inf_wm3v[disk] -> prc = &pr_wmi_pas;
      rpm -> inf_wm3v[disk] -> srprs = rpm -> inf_wm3v[disk] -> srprc = &srpr_wmi_pas;
    }
    else {
      rpm -> inf_wm3v[disk] -> prs = &pr_wm3s_act;
      rpm -> inf_wm3v[disk] -> prc = &pr_wm3c_act;
      rpm -> inf_wm3v[disk] -> srprs = &srpr_wm3s_act;
      rpm -> inf_wm3v[disk] -> srprc = &srpr_wm3c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM3P))) {
	rpm -> inf_wm3v[disk] -> prs = &pr_wmi_pas;
	rpm -> inf_wm3v[disk] -> srprs = &srpr_wmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM3P, PIHALF))) {
	rpm -> inf_wm3v[disk] -> prc = &pr_wmi_pas;
	rpm -> inf_wm3v[disk] -> srprc = &srpr_wmi_pas;
      }
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_wm3(rpm -> inf_wm3v[disk]);
    rpm -> inf_wm3v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the wm4 struct */
static int chkb_wm4(ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_wm4v[disk]))
      if (!(rpm -> inf_wm4v[disk] = create_inf_wm4()))
	goto error;
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM4A))) {
      rpm -> inf_wm4v[disk] -> prs = rpm -> inf_wm4v[disk] -> prc = &pr_wmi_pas;
      rpm -> inf_wm4v[disk] -> srprs = rpm -> inf_wm4v[disk] -> srprc = &srpr_wmi_pas;
    }
    else {
      rpm -> inf_wm4v[disk] -> prs = &pr_wm4s_act;
      rpm -> inf_wm4v[disk] -> prc = &pr_wm4c_act;
      rpm -> inf_wm4v[disk] -> srprs = &srpr_wm4s_act;
      rpm -> inf_wm4v[disk] -> srprc = &srpr_wm4c_act;

      if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM4P))) {
      rpm -> inf_wm4v[disk] -> prs = &pr_wmi_pas;
      rpm -> inf_wm4v[disk] -> srprs = &srpr_wmi_pas;
      }
      else if ((chkb_val(rpm, fit, PRPARAMS+disk*NDPARAMS+PWM4P, PIHALF))) {
	rpm -> inf_wm4v[disk] -> prs = &pr_wmi_pas;
	rpm -> inf_wm4v[disk] -> srprs = &srpr_wmi_pas;
      }
    }
  }
  return 0;

  error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_wm4(rpm -> inf_wm4v[disk]);
    rpm -> inf_wm4v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the ls0  struct */
static int chkb_ls0 (ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_ls0v[disk]))
      if (!(rpm -> inf_ls0v[disk]  = create_inf_ls0 ()))
	goto error;

    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PLS0 ))) {
      rpm -> inf_ls0v[disk]  -> pr = &pr_ls0_pas;
    }
    else {
      rpm -> inf_ls0v[disk]  -> pr = &pr_ls0_act;
    }
  }
  return 0;

 error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_ls0(rpm -> inf_ls0v[disk]);
    rpm -> inf_ls0v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Optionally allocates and puts correct switches in the lc0  struct */
static int chkb_lc0 (ringparms *rpm, fitparms *fit)
{
  int disk;

  for (disk = 0; disk < rpm -> ndisks; ++ disk) {
    if (!(rpm -> inf_lc0v[disk]))
      if (!(rpm -> inf_lc0v[disk]  = create_inf_lc0 ()))
	goto error;
    if ((chkb_zero(rpm, fit, PRPARAMS+disk*NDPARAMS+PLC0 ))) {
      rpm -> inf_lc0v[disk]  -> pr = &pr_lc0_pas;
    }
    else {
      rpm -> inf_lc0v[disk]  -> pr = &pr_lc0_act;
    }
  }
  return 0;

  error:
  for (disk = 0; disk < rpm -> ndisks; ++disk) {
    destroy_inf_lc0(rpm -> inf_lc0v[disk]);
    rpm -> inf_lc0v[disk] = NULL;
  }
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* check if the function should be activated */
static int chkb_zero(ringparms *rpm, fitparms *fit, int ident)
{
  return chkb_val(rpm, fit, ident, 0.0);
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* check if the function should be activated */
static int chkb_val(ringparms *rpm, fitparms *fit, int ident, double val)
{
  int i, yesno = 1;
  varlel *varele;

  /* We check if this is unequal zero in the input */
  for (i=0; i < rpm -> nur; ++i) {
    if (rpm -> par[ident*rpm -> nur+i] != val) {
      yesno = 0;
      break;
    }
  }

  /* We check if this is fitted going through all the elements */
  varele = fit -> varylist;
  while ((varele)) {
    for (i = 0; i < varele -> nelem; ++i) {
      if (varele -> elements[i]/rpm -> nur == ident)
 yesno = 0;
    }
    varele = varele -> next;
  }

  return yesno;
}

/* ------------------------------------------------------------ */

/*************/
/* Addendums under construction */
/*************/
/* #include "constr.c" */
/*************/

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Constructs a NULL-terminated array of n (empty) reg_containers */
static reg_cont **reg_cont_const(int nregs)
{
  reg_cont **reg_cont_const = NULL;
  int i;

  if (nregs < 0)
    return NULL;

  if (!(reg_cont_const = (reg_cont **) malloc ((nregs+1)*sizeof(reg_cont *))))
    return NULL;

  for (i = 0; i <= nregs; ++i)
    reg_cont_const[i] = NULL;

  for (i = 0; i < nregs; ++i) {
    if (!(reg_cont_const[i] = (reg_cont *) malloc (sizeof(reg_cont)))) {
      reg_cont_destr(reg_cont_const);
      return NULL;
    }
  }

  for (i = 0; i < nregs; ++i) {
    if (!(reg_cont_const[i] -> fc = fourat_container_const())) {
      reg_cont_destr(reg_cont_const);
      return NULL;
    }
  }

  return reg_cont_const;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Constructs a NULL-terminated array of n (empty) reg_containers */
static int reg_cont_destr(reg_cont **reg_contv)
{
  int i = 0;

  if (!reg_contv)
    return 1;

  while ((reg_contv[i])) {
    if ((reg_contv[i] -> fc)) {
      fourat_container_destr(reg_contv[i] -> fc);
    }
    free(reg_contv[i]);
    ++i;
  }

  free(reg_contv);

  return 0;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Get the regularisation list from user input */
static reg_cont **reg_cont_get(startinf *startinfv, hdrinf *hdr, ringparms *rpm, fitparms *fit)
{
  reg_cont **reg_cont_get = NULL;

  /**************/
   /**************/
/*   int obsint = 0; */
/*   char obsmes[200]; */
/*   double *obsdouble; */
  /**************/

  /* Simple control stuff */
  int nel, def, i, j, k;
  char mes[81];  /* Any message */
  int errcode = 1, outside = 0; /* another error code */

  char *varyhstr= NULL;
  char **varystr = NULL;
  char *dummystr = NULL;
  decomp_control decomp_controlv = NULL;
  decomp_listel *decomp_listelvact = NULL;
  decomp_listel *decomp_listelvden = NULL;
  decomp_listel *decomp_listelvnum = NULL;
  decomp_listel *decomp_listelvdum = NULL;
  char *dcperr;
  int par = 0;
  int maxorder;
  int nregs;
  int anint;

  double *regthre = NULL, *regwidt = NULL, *regampl = NULL, *regaste = NULL, *regampd = NULL;

  int nreadl, nreturned, keypres;

  /* The complicated varystr */
  /*   if (!(varystr = (char **) malloc(VARYSTRELES*sizeof(char *)))) */
  /*     goto error; */
  /* if (!(varyhstr = getfcharray(VARYHSTRELES, NULL))) */
  /*   goto error; */

  /* get the dcp control structure */
  if (!(decomp_controlv = decomp_init()))
    goto error;

  /* Fill the dcp control structure with parameter information */
  if ((dec_fill(rpm, decomp_controlv)))
    goto error;

  /* First we fetch the list of parameters that should be regulated */
  errcode = 1;

  /* Get the array */
  while (errcode) {

    nel = 0;
    def = 1;

    if (errcode == 2)
      cancel_tir(startinfv -> arel, "REGPARA=", 2);

    /* sprintf(mes, "Give parameters to regularise"); */
    /* flushfcharray(VARYHSTRELES, varyhstr); */
    /* nel = usertext_tir(varyhstr, &def, "REGPARA=", mes); */
    if ((varyhstr)) {
      free(varyhstr);
      varyhstr = NULL;
    }
    if (simparse_scn_arel_readval_string(startinfv -> arel, "REGPARA", "Give parameters to regularise.", 0, "", 0, -1, 0, 0, &keypres, &nreadl, &nreturned, &varyhstr))
      goto error;

    /* Interlude: Change the case if it is lower case */
    i = 0;
    while (varyhstr[i]) {
      if (varyhstr[i] >= 'a' && varyhstr[i] <= 'z') {
	varyhstr[i] = varyhstr[i]+'A'-'a';
      }
      ++i;
    }

    decomp_putsep(decomp_controlv, ',', '\0', ':');
    if ((decomp_listelvact))
      decomp_list_dest(decomp_listelvact);
    decomp_listelvact = NULL;

    /* Interpret this */
    if ((errcode = decomp_get(decomp_controlv, varyhstr, &decomp_listelvact, 0))){
      if (errcode == 1)
	goto error;
      else {
	sprintf(mes, "REGPARA: ");
	if ((dcperr = decomp_errmsg(decomp_controlv)))
	  strncpy(mes+9, dcperr, 71);
	anyout_tir(&def, mes);
      }
    }

    /* Now do a sanity check: no group is allowed to point to intrinsically different elements */

    outside = 0;

    if (decomp_listelvact) {
      i = 0;
      nregs = 0;
      while ((decomp_listelvact+i) -> nuel != -1) {
	++nregs;
	if (((decomp_listelvact+i) -> nuel)) {
	  par = (decomp_listelvact+i) -> poli[0] / rpm -> nur;
	}
	for (j = 0; j < (decomp_listelvact+i) -> nuel; ++j){
	  if (par != (decomp_listelvact+i) -> poli[j] / rpm -> nur) {
	    outside = 1;
	  }
	  par = (decomp_listelvact+i) -> poli[j] / rpm -> nur;
	}
	++i;
      }
    }
    else {
      nregs = 0;
    }

    if ((outside)) {
      sprintf(mes,"REGPARA: one parameter only between commas.");
      anyout_tir(&def, mes);
      errcode |= 2;
    }
  }

  /* Provide an array of reg_conts */
  if (!(reg_cont_get = reg_cont_const(nregs)))
    goto error;

  /* proceed if there is more than 0 elements */
  if ((nregs)) {
    /* Now read in the lists */

    /* calculate the maximum order */
    maxorder = rpm -> nur/2;

    /* Read in an array of arrays from den */

    /* Reallocate the thingy */
    decomp_dest(decomp_controlv);
    if (!(decomp_controlv = decomp_init()))
      goto error;

    /* Feed it with exactly one thing */
    /*     if ((decomp_inp(decomp_controlv, "D", 0, maxorder)))  */
    if ((decomp_inp(decomp_controlv, "D", 1, maxorder)))
      goto error;
    decomp_putsep(decomp_controlv, '\0', '\0', ':');

    errcode = 3;
    def = 1;

    while (errcode) {

      if (errcode != 3)
	cancel_tir(startinfv -> arel, "REGDENO=", 2);

      errcode = 0;

      sprintf(mes, "Enter denominator");
      /* flushfcharray(VARYHSTRELES, varyhstr); */
      /* nel = usertext_tir(varyhstr, &def, "REGDENO=", mes); */
      if ((varyhstr)) {
	free(varyhstr);
	varyhstr = NULL;
      }

      if (simparse_scn_arel_readval_string(startinfv -> arel, "REGDENO", mes, 0, "", 0, -1, 0, 0, &keypres, &nreadl, &nreturned, &varyhstr))
	goto error;

      /* Is this empty? */
      if ((varystr)) {
	freeparsed(varystr);
	/* 	i = 0; */
	/* 	while(varystr[i]) { */
	/* 	  free(varystr[i]); */
	/* 	  ++i; */
	/* 	} */

	/* 	free(varystr); */
	varystr = NULL;
      }

      if (!(varystr = sparsenext(",", "", "\t", "", "", "", -1, &varyhstr, &anint, 0, 1))) {
	sprintf(mes,"Please enter sufficient parameters for REGDENO.");
	anyout_tir(&def, mes);
	errcode = 1;
      }
      else {

	/* It has to have exactly nreg elements, and determine the maximum length of the arrays */
	i = 0;
	j = 0;
	while ((varystr[i])) {
	  if ((k = strlen(varystr[i])) > j) {
	    j = k;
	  }
	  ++i;
	}

	if (i != nregs) {
	  sprintf(mes,"Please enter sufficient parameters for REGDENO.");
	  anyout_tir(&def, mes);
	  errcode = 1;
	}
	else {

	  if (!(decomp_listelvden = (decomp_listel *) malloc((nregs+1)*sizeof(decomp_listel))))
	    goto error;

	  /* Now read in the single arrays for regd */
	  if ((dummystr)) {
	    free(dummystr);
	    dummystr = NULL;
	  }
	  if (!(dummystr = (char *) malloc((j+3)*sizeof(char))))
	    goto error;

	  for (i = 0; i < nregs; ++i) {
	    sprintf(dummystr,"D ");
	    sprintf(dummystr+2,"%s",varystr[i]);

	    if ((decomp_listelvdum)) {
	      free(decomp_listelvdum);
	      decomp_listelvdum = NULL;
	    }

	    if ((errcode = decomp_get(decomp_controlv, dummystr, &decomp_listelvdum, 1))){
	      if (errcode == 1)
		goto error;
	      else {
		sprintf(mes, "REGDENO: ");
		if ((dcperr = decomp_errmsg(decomp_controlv)))
		  strncpy(mes+9, dcperr, 71);
		anyout_tir(&def, mes);
	      }
	    }
	    if (decomp_listelvdum) {
	      if (decomp_listelvdum -> nuel < 1) {
		sprintf(mes,"Enter sufficient parameters for REGDENO.");
		anyout_tir(&def, mes);
		errcode = 1;
	      }
	      else {
		for (k = 0; k < decomp_listelvdum -> nuel; ++k) {
		  if ((decomp_listelvdum -> poli[k] < 0) || (decomp_listelvdum -> poli[k] > maxorder)) {
		    errcode = 1;
		    break;
		  }
		}
		if (errcode == 1) {
		  sprintf(mes,"Order is between %i and %i", 0, maxorder);
		  anyout_tir(&def, mes);
		}
	      }
	    }
	    if ((errcode)) {
	      break;
	    }
	    (decomp_listelvden+i) -> nuel = decomp_listelvdum -> nuel;
	    (decomp_listelvden+i) -> poli = decomp_listelvdum -> poli;
	  }
	  while (i < nregs) {
	    (decomp_listelvden+i) -> nuel = 0;
	    (decomp_listelvden+i) -> poli = NULL;
	    ++i;
	  }
	  (decomp_listelvden+nregs) -> nuel = -1;
	  (decomp_listelvden+nregs) -> poli = NULL;
	}
      }
    }

    errcode = 3;

    while (errcode) {

      if (errcode != 3)
	cancel_tir(startinfv -> arel, "REGNUME=", 2);

      errcode = 0;
      /* flushfcharray(VARYHSTRELES, varyhstr); */
      /* nel = usertext_tir(varyhstr, &def, "REGNUME=", mes); */

      if ((varyhstr)) {
	free(varyhstr);
	varyhstr = NULL;
      }
      sprintf(mes,"Please enter sufficient parameters for REGNUME.");
      if (simparse_scn_arel_readval_string(startinfv -> arel, "REGNUME", mes, 0, "", 0, -1, 0, 0, &keypres, &nreadl, &nreturned, &varyhstr))
	goto error;

      /* Is this empty? */
      if ((varystr)) {
	freeparsed(varystr);
	/* 	i = 0; */
	/* 	while(varystr[i]) { */
	/* 	  free(varystr[i]); */
	/* 	  ++i; */
	/* 	} */

	/* 	free(varystr); */
	varystr = NULL;
      }

      if (!(varystr = sparsenext(",", "", "\t", "", "", "", -1, &varyhstr, &anint, 0, 1))) {
	sprintf(mes,"Please enter sufficient parameters for REGNUME.");
	anyout_tir(&def, mes);
	errcode = 1;
      }
      else {

	/* It has to have exactly nreg elements, and determine the maximum length of the arrays */
	i = 0;
	j = 0;
	while ((varystr[i])) {
	  if ((k = strlen(varystr[i])) > j) {
	    j = k;
	  }
	  ++i;
	}
	if (i != nregs) {
	  sprintf(mes,"Please enter sufficient parameters for REGNUME.");
	  anyout_tir(&def, mes);
	  errcode = 1;
	}
	else {

	  if (!(decomp_listelvnum = (decomp_listel *) malloc((nregs+1)*sizeof(decomp_listel))))
	    goto error;

	  /* Now read in the single arrays for regd */
	  if ((dummystr)) {
	    free(dummystr);
	    dummystr = NULL;
	  }
	  if (!(dummystr = (char *) malloc((j+3)*sizeof(char))))
	    goto error;

	  for (i = 0; i < nregs; ++i) {
	    sprintf(dummystr,"D ");
	    sprintf(dummystr+2,"%s",varystr[i]);

	    if ((decomp_listelvdum)) {
	      free(decomp_listelvdum);
	      decomp_listelvdum = NULL;
	    }

	    if ((errcode = decomp_get(decomp_controlv, dummystr, &decomp_listelvdum, 1))){
	      if (errcode == 1)
		goto error;
	      else {
		sprintf(mes, "REGNUME: ");
		if ((dcperr = decomp_errmsg(decomp_controlv)))
		  strncpy(mes+9, dcperr, 71);
		anyout_tir(&def, mes);
	      }
	    }
	    if (decomp_listelvdum) {
	      if (decomp_listelvdum -> nuel < 1) {
		sprintf(mes,"Please enter sufficient parameters for REGNUME.");
		anyout_tir(&def, mes);
		errcode = 1;
	      }
	      else {
		for (k = 0; k < decomp_listelvdum -> nuel; ++k) {
		  if ((decomp_listelvdum -> poli[k] < 0) || (decomp_listelvdum -> poli[k] > maxorder)) {
		    errcode = 1;
		    break;
		  }
		}
		if (errcode == 1) {
		  sprintf(mes,"Order is between %i and %i", 0, maxorder);
		  anyout_tir(&def, mes);
		}
	      }
	    }

	    if ((errcode)) {
	      break;
	    }
	    (decomp_listelvnum+i) -> nuel = decomp_listelvdum -> nuel;
	    (decomp_listelvnum+i) -> poli = decomp_listelvdum -> poli;
	  }
	  while (i < nregs) {
	    (decomp_listelvnum+i) -> nuel = 0;
	    (decomp_listelvnum+i) -> poli = NULL;
	    ++i;
	  }
	  (decomp_listelvnum+nregs) -> nuel = -1;
	  (decomp_listelvnum+nregs) -> poli = NULL;
	}
      }
    }

    /* Allocate and read in the three additional quantities */
    if (!(regthre = (double *) malloc(nregs*sizeof(double))))
      goto error;
    if (!(regwidt = (double *) malloc(nregs*sizeof(double))))
      goto error;
    if (!(regampl = (double *) malloc(nregs*sizeof(double))))
      goto error;
    if (!(regaste = (double *) malloc(nregs*sizeof(double))))
    goto error;
    if (!(regampd = (double *) malloc(nregs*sizeof(double))))
    goto error;

    def = 0;

    /* Get the regthre */
    errcode = 1;
    sprintf(mes, "Give ratio threshold (in the same order)");
    while (errcode) {
      errcode = 0;
      nel = userdble_tir(startinfv -> arel, regthre, &nregs, &def, "REGTHRE=", mes);
      if (!nel) {
	sprintf(mes, "Something went wrong. Give REGTHRE=");
	cancel_tir(startinfv -> arel, "REGTHRE=", 2);
	errcode = 1;
      }
      while (nel < nregs) {
	regthre[nel] = regthre[nel-1];
	++nel;
      }
    }

    /* Get the regwidt */
    errcode = 1;
    sprintf(mes, "Give ratio step width (in the same order)");
    while (errcode) {
      errcode = 0;
      nel = userdble_tir(startinfv -> arel, regwidt, &nregs, &def, "REGWIDT=", mes);
      if (!nel) {
	sprintf(mes, "Something went wrong. Give REGWIDT=");
	cancel_tir(startinfv -> arel, "REGWIDT=", 2);
	errcode = 1;
      }
      while (nel < nregs) {
	regwidt[nel] = regwidt[nel-1];
	++nel;
      }
    }

    /* Get the regampl */
    errcode = 1;
    sprintf(mes, "Give parameter step amplitude (in the same order)");
    while (errcode) {
      errcode = 0;
      nel = userdble_tir(startinfv -> arel, regampl, &nregs, &def, "REGAMPL=", mes);
      if (!nel) {
	sprintf(mes, "Something went wrong. Give REGAMPL=");
	cancel_tir(startinfv -> arel, "REGAMPL=", 2);
	errcode = 1;
      }
      while (nel < nregs) {
	regampl[nel] = regampl[nel-1];
	++nel;
      }
    }

    /* Get the regaste */
    errcode = 1;
    /* Notice that this is additive; the chisquared of an empty cube is N_x*N_y*N_v */
    sprintf(mes, "Give parameter amplitude increase per loop");
    while (errcode) {
      errcode = 0;
      nel = userdble_tir(startinfv -> arel, regaste, &nregs, &def, "REGASTE=", mes);
      if (!nel) {
	sprintf(mes, "Something went wrong. Give REGASTE=");
	cancel_tir(startinfv -> arel, "REGASTE=", 2);
	errcode = 1;
      }
      while (nel < nregs) {
	regaste[nel] = regaste[nel-1];
	++nel;
      }
    }

    /* Get the regampd */
    errcode = 1;
    /* Notice that this is additive; the chisquared of an empty cube is N_x*N_y*N_v */
    sprintf(mes, "Give absolute denominator (>0)");
    while (errcode) {
      errcode = 0;
      nel = userdble_tir(startinfv -> arel, regampd, &nregs, &def, "REGAMPD=", mes);
      if (!nel) {
	sprintf(mes, "Something went wrong. Give REGAMPD=");
	cancel_tir(startinfv -> arel, "REGAMPD=", 2);
	errcode = 1;
      }
      while (nel < nregs) {
	regampd[nel] = regampd[nel-1];
	++nel;
      }
    }
  }

  /* Now that we have the three arrays of listels, we continue with filling and initialising the fourat structure */
  for (i = 0; i < nregs; ++i) {
    fourat_put_length(reg_cont_get[i] -> fc, rpm -> nur, (decomp_listelvact+i) -> nuel, (decomp_listelvnum+i) -> nuel, (decomp_listelvden+i) -> nuel, HUGE_DBL);

    if (fourat_meminit(reg_cont_get[i] -> fc)) {
      goto error;
    }

    /* Put the position of the first element into the struct */
    reg_cont_get[i] -> posoffirst = ((decomp_listelvact+i) -> poli[0]/rpm -> nur)*rpm -> nur;
    reg_cont_get[i] -> first = rpm -> par + reg_cont_get[i] -> posoffirst;

    /* Recalculate the numbers from the active parameters to the relative positions w.r.t. the first element */
    for (j = 0; j < (decomp_listelvact+i) -> nuel; ++j)
      (decomp_listelvact+i) -> poli[j] = (decomp_listelvact+i) -> poli[j] % rpm -> nur;

    /* Then read in the vectors */
    fourat_put_vectors(reg_cont_get[i] -> fc, reg_cont_get[i] -> first, (decomp_listelvact+i) -> poli, (decomp_listelvnum+i) -> poli, (decomp_listelvden+i) -> poli);

    /* Initialise again */
    fourat_init(reg_cont_get[i] -> fc);

    /* clear up the other parameters */
    reg_cont_get[i] -> regthre = regthre[i];
    reg_cont_get[i] -> regwidt = regwidt[i];
    reg_cont_get[i] -> regampl = regampl[i];
    reg_cont_get[i] -> regaste = regaste[i];

    /* Transfer to intrinsic coordinates and include normalisation */
    if (regampd[i] > 0.0){
      reg_cont_get[i] -> regampd = ((double) rpm -> nur) * fabs(dparamtointern(regampd[i], reg_cont_get[i] -> posoffirst/rpm -> nur+1, hdr, rpm -> ndisks));
    }
    else {
      reg_cont_get[i] -> regampd = regampd[i];
    }
  }

  if ((varyhstr))
    free(varyhstr);
  if ((varystr))
    freeparsed(varystr);
  if ((decomp_controlv))
    decomp_dest(decomp_controlv);
  if ((decomp_listelvact))
    decomp_list_dest(decomp_listelvact);
  if ((decomp_listelvden))
    decomp_list_dest(decomp_listelvden);
  if ((decomp_listelvnum))
    decomp_list_dest(decomp_listelvnum);
  if ((dummystr))
    free(dummystr);
  if((regthre))
    free(regthre);
  if ((regwidt))
    free(regwidt);
  if ((regampl))
    free(regampl);
  if ((regaste))
    free(regaste);
  if ((regampd))
    free(regampd);

  /**********/
  /**********/
  /**********/

  /* Provide an overview, testing only */

/*   sprintf(obsmes,"Testing things"); */
/*   anyout_tir(&obsint, obsmes); */

/*   if (!(obsdouble = (double *) malloc(rpm -> nur * sizeof(double)))) */
/*     goto error; */

  /* Count the numbers of regularisation groups */
/*   for (nregs = 0; reg_cont_get[nregs]; ++nregs) */
/*     ; */

  /* Go through the list and read out the input */
/*   for (i = 0; i < nregs; ++i) { */

/*     sprintf(obsmes, "Group %i, parameter ", i); */

     /* what is the name of the first element? */
/*     ftstab_putcoltitl(obsmes+strlen(obsmes), reg_cont_get[i] -> posoffirst/rpm -> nur+1); */
/*     anyout_tir(&obsint, obsmes); */

    /* what are the values (note that this requires hdr, which is not usually passed by the function and has to be included in the input for this test */

/*     sprintf(obsmes, "Values: "); */

/*     for (j = 0; j < rpm -> nur; ++j) { */
/*       sprintf(obsmes+strlen(obsmes), "%.1E ", dinterntoparam(*(reg_cont_get[i] -> first+j), reg_cont_get[i] -> posoffirst/rpm -> nur+1, hdr, rpm -> ndisks)); */
/*     } */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Active ringnumbers: "); */
/*     for (j = 0; j < reg_cont_get[i] -> fc -> nact; ++j) { */
/*       sprintf(obsmes+strlen(obsmes), "%i ", reg_cont_get[i] -> fc -> act[j]); */
/*     } */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Orders numerator: "); */
/*     for (j = 0; j < reg_cont_get[i] -> fc -> nnum; ++j) { */
/*       sprintf(obsmes+strlen(obsmes), "%i ", reg_cont_get[i] -> fc -> num[j]); */
/*     } */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Orders denominator: "); */
/*     for (j = 0; j < reg_cont_get[i] -> fc -> nden; ++j) { */
/*       sprintf(obsmes+strlen(obsmes), "%i ", reg_cont_get[i] -> fc -> den[j]); */
/*     } */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Huge value: %.1E %.1E", reg_cont_get[i] -> fc -> huge_dbl, HUGE_DBL); */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Regthre: %.1E", reg_cont_get[i] -> regthre); */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Regwidt: %.1E", reg_cont_get[i] -> regwidt); */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Regampl: %.1E", reg_cont_get[i] -> regampl); */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Regaste: %.1E", reg_cont_get[i] -> regaste); */
/*       anyout_tir(&obsint, obsmes); */

/*       sprintf(obsmes, "Regampd: %.1E", reg_cont_get[i] -> regampd); */
/*       anyout_tir(&obsint, obsmes); */

      /* Usage of smoothstep */
/*       sprintf(obsmes, "Smoothstep: f(%.1E) = %.1E,  f(%.1E) = %.1E, f(%.1E) = %.1E", reg_cont_get[i] -> regthre, maths_hard_step(reg_cont_get[i] -> regthre, reg_cont_get[i] -> regwidt, 0.0, reg_cont_get[i] -> regampl, reg_cont_get[i] -> regthre), reg_cont_get[i] -> regthre+reg_cont_get[i] -> regwidt/2, maths_hard_step(reg_cont_get[i] -> regthre, reg_cont_get[i] -> regwidt, 0.0, reg_cont_get[i] -> regampl, reg_cont_get[i] -> regthre+reg_cont_get[i] -> regwidt/2), reg_cont_get[i] -> regthre+reg_cont_get[i] -> regwidt, maths_hard_step(reg_cont_get[i] -> regthre, reg_cont_get[i] -> regwidt, 0.0, reg_cont_get[i] -> regampl-1.0, reg_cont_get[i] -> regthre+reg_cont_get[i] -> regwidt)); */
/*       anyout_tir(&obsint, obsmes); */

/*   } */
  /**********/

  /* done */
  return reg_cont_get;

 error:
 if (varyhstr)
   free(varyhstr);
  if ((varystr))
    freeparsed(varystr);
  if ((decomp_controlv))
    decomp_dest(decomp_controlv);
  if ((decomp_listelvact))
    decomp_list_dest(decomp_listelvact);
  if ((decomp_listelvden))
    decomp_list_dest(decomp_listelvden);
  if ((decomp_listelvnum))
    decomp_list_dest(decomp_listelvnum);
  reg_cont_destr(reg_cont_get);
  if ((dummystr))
    free(dummystr);
  if((regthre))
    free(regthre);
  if ((regwidt))
    free(regwidt);
  if ((regampl))
    free(regampl);
  if ((regaste))
    free(regaste);
  if ((regampd))
    free(regampd);

 return NULL;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Constructs a NULL-terminated array of n (empty) reg_containers */
static double reg_do(reg_cont **reg_contv, int loopnr, double chisquare)
{
  double reg_do = 0.0;
  double addchisq = 0.0;
  int i = 0;
  int def = 0;
  char mes[100];

  /**************/
   /**************/
/*   int obsint = 0; */
/*   char obsmes[200]; */
  /**************/

  if (!reg_contv)
    return 1.0;

  while ((reg_contv[i])) {

    /* read in the parameter */
    fourat_put_array(reg_contv[i] -> fc, reg_contv[i] -> first);

    /* Calculate the ratio */
    if (reg_contv[i] -> regampd > 0.0) {
      fourat_rat(reg_contv[i] -> fc, &(reg_contv[i] -> ratio), FOURAT_RAT_SUM);
      /*********/
/*       sprintf(mes, "Amp (reg): %.2E Amp (par): %.2E Amp (fourat): %.2E", reg_contv[i] -> regampd, *(reg_contv[i] -> first), reg_contv[i] -> ratio); */
/*       anyout_tir(&def, mes); */

      reg_contv[i] -> ratio = reg_contv[i] -> ratio/reg_contv[i] -> regampd;
    }
    else {
      fourat_rat(reg_contv[i] -> fc, &(reg_contv[i] -> ratio), FOURAT_RAT_RATIO);
    }
    addchisq = maths_hard_step(reg_contv[i] -> regthre, reg_contv[i] -> regwidt, 0, (reg_contv[i] -> regampl+loopnr*reg_contv[i] -> regaste), reg_contv[i] -> ratio);

    /* Calculate reg_do */
    reg_do = reg_do+addchisq;

    sprintf(mes, "REG group: %i, mode ratio: %.2E, additional chi2: %.2E", i+1, reg_contv[i] -> ratio, addchisq);
    anyout_tir(&def, mes);

    ++i;
  }

  if ((i)) {
    sprintf(mes, "REG total additional chi2: %.2E", reg_do);
    anyout_tir(&def, mes);
  }

  /* That's it */
  return reg_do+chisquare;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

static int dec_fill(ringparms *rpm, decomp_control *decomp_controlv)
{
  int disk;
  char placer[9];

  /* ndisk construction */

  /* radially dependent parameters */
  if ((decomp_inp(decomp_controlv, "RADI", rpm -> nur*PRADI, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VROT", rpm -> nur*PVROT, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VRAD", rpm -> nur*PVRAD, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VVER", rpm -> nur*PVVER, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "DVRO", rpm -> nur*PDVRO, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "DVRA", rpm -> nur*PDVRA, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "DVVE", rpm -> nur*PDVVE, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "ZDRO", rpm -> nur*PZDRO, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "ZDRA", rpm -> nur*PZDRA, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "ZDVE", rpm -> nur*PZDVE, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "Z0",   rpm -> nur*PZ0  , rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SBR",  rpm -> nur*PSBR , rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM1A", rpm -> nur*PSM1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM1P", rpm -> nur*PSM1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM2A", rpm -> nur*PSM2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM2P", rpm -> nur*PSM2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM3A", rpm -> nur*PSM3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM3P", rpm -> nur*PSM3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM4A", rpm -> nur*PSM4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SM4P", rpm -> nur*PSM4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA1A", rpm -> nur*PGA1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA1P", rpm -> nur*PGA1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA1D", rpm -> nur*PGA1D, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA2A", rpm -> nur*PGA2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA2P", rpm -> nur*PGA2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA2D", rpm -> nur*PGA2D, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA3A", rpm -> nur*PGA3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA3P", rpm -> nur*PGA3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA3D", rpm -> nur*PGA3D, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA4A", rpm -> nur*PGA4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA4P", rpm -> nur*PGA4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "GA4D", rpm -> nur*PGA4D, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "AZ1P", rpm -> nur*PAZ1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "AZ1W", rpm -> nur*PAZ1W, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "AZ2P", rpm -> nur*PAZ2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "AZ2W", rpm -> nur*PAZ2W, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "INCL", rpm -> nur*PINCL, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "PA",   rpm -> nur*PPA  , rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "XPOS", rpm -> nur*PXPOS, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "YPOS", rpm -> nur*PYPOS, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VSYS", rpm -> nur*PVSYS, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "SDIS", rpm -> nur*PSDIS, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "CLNR", rpm -> nur*PCLNR, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM0A", rpm -> nur*PVM0A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM1A", rpm -> nur*PVM1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM1P", rpm -> nur*PVM1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM2A", rpm -> nur*PVM2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM2P", rpm -> nur*PVM2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM3A", rpm -> nur*PVM3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM3P", rpm -> nur*PVM3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM4A", rpm -> nur*PVM4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "VM4P", rpm -> nur*PVM4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA1A", rpm -> nur*PRA1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA1P", rpm -> nur*PRA1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA2A", rpm -> nur*PRA2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA2P", rpm -> nur*PRA2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA3A", rpm -> nur*PRA3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA3P", rpm -> nur*PRA3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA4A", rpm -> nur*PRA4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RA4P", rpm -> nur*PRA4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO1A", rpm -> nur*PRO1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO1P", rpm -> nur*PRO1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO2A", rpm -> nur*PRO2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO2P", rpm -> nur*PRO2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO3A", rpm -> nur*PRO3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO3P", rpm -> nur*PRO3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO4A", rpm -> nur*PRO4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "RO4P", rpm -> nur*PRO4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM0A", rpm -> nur*PWM0A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM1A", rpm -> nur*PWM1A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM1P", rpm -> nur*PWM1P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM2A", rpm -> nur*PWM2A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM2P", rpm -> nur*PWM2P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM3A", rpm -> nur*PWM3A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM3P", rpm -> nur*PWM3P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM4A", rpm -> nur*PWM4A, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "WM4P", rpm -> nur*PWM4P, rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "LS0",  rpm -> nur*PLS0 , rpm -> nur))) goto error;
  if ((decomp_inp(decomp_controlv, "LC0",  rpm -> nur*PLC0 , rpm -> nur))) goto error;

  for (disk = 1; disk < rpm -> ndisks; ++disk) {
    sprintf(placer, "VROT_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVROT)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VRAD_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVRAD)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VVER_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVVER)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "DVRO_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PDVRO)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "DVRA_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PDVRA)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "DVVE_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PDVVE)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "ZDRO_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PZDRO)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "ZDRA_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PZDRA)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "ZDVE_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PZDVE)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "Z0_%i"  , disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PZ0  )*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SBR_%i" , disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSBR )*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SM4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSM4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA1D_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA1D)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA2D_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA2D)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA3D_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA3D)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "GA4D_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PGA4D)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "AZ1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PAZ1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "AZ1W_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PAZ1W)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "AZ2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PAZ2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "AZ2W_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PAZ2W)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "INCL_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PINCL)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "PA_%i"  , disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PPA  )*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "XPOS_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PXPOS)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "YPOS_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PYPOS)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VSYS_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVSYS)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "SDIS_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PSDIS)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "CLNR_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PCLNR)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM0A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM0A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "VM4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PVM4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RO4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRO4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "RA4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PRA4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM0A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM0A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM1A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM1A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM1P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM1P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM2A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM2A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM2P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM2P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM3A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM3A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM3P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM3P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM4A_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM4A)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "WM4P_%i", disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PWM4P)*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "LS0_%i" , disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PLS0 )*rpm -> nur, rpm -> nur))) goto error;
    sprintf(placer, "LC0_%i" , disk+1); if ((decomp_inp(decomp_controlv, placer, (PRPARAMS+disk*NDPARAMS+PLC0 )*rpm -> nur, rpm -> nur))) goto error;
  }
  /* global parameters, this needs to be changed somewhat when there is more than one */
  if ((decomp_inp(decomp_controlv, "CONDISP", rpm -> nur*(NPARAMS + (rpm -> ndisks - 1)*NDPARAMS), 0))) goto error;

  return 0;

 error:
  decomp_dest(decomp_controlv);
  return 1;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Creates a decomp-readable list from inputofvarymult and inputofvarysing and puts it into varyhstr */
static char *gluetodecomp(char **inputofvarymult, char **inputofvarysing)
{
  int i, length = 0;
  char *returnstring = NULL;

  /* varyhstr[0] = '\0'; */
  i = 0;
  while (inputofvarymult[i] != NULL) {
    if (strpbrk(inputofvarymult[i],"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) {
      length = length + strlen(", !");
      length = length + strlen(inputofvarymult[i]);
    }
    else {
      length = length + strlen(" ");
      length = length + strlen(inputofvarymult[i]);
    }
    ++i;
  }
  i = 0;
  while (inputofvarysing[i] != NULL) {
    if (strpbrk(inputofvarysing[i],"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) {
      length = length + strlen(", ");
      length = length + strlen(inputofvarysing[i]);
    }
    else {
      length = length + strlen(" ");
      length = length + strlen(inputofvarysing[i]);
    }
    ++i;
  }

  if (length > 1) {
    if (!(returnstring = (char *) malloc((length+1)*sizeof(char))))
      return NULL;
    returnstring[length] = '\0';
  }
  else {
    if (!(returnstring = (char *) malloc(2*sizeof(char))))
      return NULL;
    returnstring[0] = '\0';
    returnstring[1] = '\0';
  }

  i = length = 0;
  while (inputofvarymult[i] != NULL) {
    if (strpbrk(inputofvarymult[i],"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) {
      strcpy(returnstring+length, ", !");
      length = length + strlen(", !");
      strcpy(returnstring+length, inputofvarymult[i]);
      length = length + strlen(inputofvarymult[i]);
    }
    else {
	strncpy(returnstring+length, " ", 1);
      length = length + strlen(" ");
      strcpy(returnstring+length, inputofvarymult[i]);
      length = length + strlen(inputofvarymult[i]);
    }
    ++i;
  }

  while (inputofvarysing[i] != NULL) {
    if (strpbrk(inputofvarysing[i],"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) {
      strcpy(returnstring+length, ", ");
      length = length + strlen(", ");
      strcpy(returnstring+length, inputofvarysing[i]);
      length = length + strlen(inputofvarysing[i]);
    }
    else {
      strcpy(returnstring+length, " ");
      length = length + strlen(" ");
      strcpy(returnstring+length, inputofvarysing[i]);
      length = length + strlen(inputofvarysing[i]);
    }
    ++i;
  }

  if (strlen(returnstring))
    returnstring[0] = ' ';

  return returnstring;
}

/* ------------------------------------------------------------ */

#ifdef PBCORR

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Allocate memory for primary beam factors */
static void alloc_pbcfac_act(ringparms *rpm, int srnr, int disk)
{
  static char mes[180];
  static int err = 1;
  static long length;

  if (!(length = rpm -> sd[disk][srnr].n))
    length = 1;

  if (!(rpm -> sd[disk][srnr].pbfac = (float *) malloc(length*sizeof(float)))) {
    /* Catastrophy, simply stop */
    sprintf(mes, "Too many pointsources, increase PFLUX");
    error_tir(&err, mes);
  }

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Allocate memory for primary beam factors, dummy */
static void alloc_pbcfac_pas(ringparms *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Deallocate memory for primary beam factors */
static void dealloc_pbcfac_act(ringparms *rpm, int srnr, int disk)
{
  if ((rpm -> sd[disk][srnr].pbfac)){
    free(rpm -> sd[disk][srnr].pbfac);
    rpm -> sd[disk][srnr].pbfac = NULL;
  }

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Deallocate memory for primary beam factors, dummy */
static void dealloc_pbcfac_pas(ringparms *rpm, int srnr, int disk)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Fill the pbfac array with the right numbers */
static void fill_pbcfac_act(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid)
{
  sd[disk][srnr].pbfac[*pnr] = hdr -> primbeam[grid[0]+ hdr -> bsize1*(grid[1])];

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Fill the pbfac array with the right numbers, dummy */
static void fill_pbcfac_pas(hdrinf *hdr, struct srd **sd, int disk, int srnr, long *pnr, int *grid)
{
  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Function to fold in the primary beam factor list when constructing the cube */
static void corr_pbcfac_act(struct srd **sd, int disk, int srnr, long pnr)
{
  *(sd[disk][srnr].pl[pnr]) += sd[disk][srnr].pf*sd[disk][srnr].pbfac[pnr];

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Function to fold in the primary beam factor list when constructing the cube */
static void corr_pbcfac_pas(struct srd **sd, int disk, int srnr, long pnr)
{

  *(sd[disk][srnr].pl[pnr]) += sd[disk][srnr].pf;

  return;
}

/* ------------------------------------------------------------ */

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */

/* Function to fold in the primary beam factor list when constructing the cube */
static void chkb_pbcorr(hdrinf *hdr, ringparms *rpm)
{

  if (hdr -> primbeam) {
    rpm -> alloc_pbcfac = alloc_pbcfac_act;
    rpm -> dealloc_pbcfac = dealloc_pbcfac_act;
    rpm -> fill_pbcfac = fill_pbcfac_act;
    rpm -> corr_pbcfac = corr_pbcfac_act;
  }
  else {
    rpm -> alloc_pbcfac = alloc_pbcfac_pas;
    rpm -> dealloc_pbcfac = dealloc_pbcfac_pas;
    rpm -> fill_pbcfac = fill_pbcfac_pas;
    rpm -> corr_pbcfac = corr_pbcfac_pas;
  }
}

/* ------------------------------------------------------------ */

#endif

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

   $Log: tirific_new.c,v $
   Revision 1.26  2011/05/25 22:25:26  jozsa
   Left work

   Revision 1.25  2011/05/11 13:37:12  jozsa
   Left work

   Revision 1.24  2011/05/10 00:30:16  jozsa
   Left work

   Revision 1.23  2011/05/04 01:51:03  jozsa
   test

   Revision 1.22  2011/05/04 01:08:25  jozsa
   Left work

   Revision 1.21  2011/05/04 01:03:41  jozsa
   several changes to make genfitting possible

   Revision 1.20  2011/03/23 22:32:29  jozsa
   removed hdu 1 and 2, with that all storage of input parameters, left simple check whether tirific has created the file

   Revision 1.19  2010/10/14 12:09:46  jozsa
   Bugfix: With multiple disks, chkchange did not recognise the disk number correctly

   Revision 1.18  2010/07/28 23:04:19  jozsa
   Left work

   Revision 1.17  2010/04/12 23:15:45  jozsa
   included a few things, next is correction of coolgal

   Revision 1.16  2010/04/01 09:24:19  jozsa
   included and hopefully debugged: radial/vertical movement/gradients of those in z/azimuthal harmonics in velocity and surface brightness. To do 1) subclouds 2) Gaussian variations in azimuth 3) portions of a disk 4) 4 disks

   Revision 1.15  2010/03/18 15:49:39  jozsa
   implemented interpolation over passive parameters: indexing; implemented new syntax for parameter specification

   Revision 1.14  2010/03/08 23:55:38  jozsa
   left work

   Revision 1.13  2010/03/02 08:23:08  jozsa
   several changes, from the following versions on hdu2 is only partially checked for changes against the .def file

   Revision 1.12  2009/08/04 16:28:33  jozsa
   Left work

   Revision 1.11  2009/05/27 15:07:38  jozsa
   Left work

   Revision 1.10  2008/10/10 15:42:40  jozsa
   Introduced radial motion VPS1=

   Revision 1.9  2008/07/30 16:22:42  jozsa
   Some issue with accuracy in fillhdvarele()

   Revision 1.8  2008/06/05 13:04:09  jozsa
   left work

   Revision 1.12  2008/02/18 16:47:23  gjozsa
   graphics SDIS output

   Revision 1.11  2008/02/13 16:43:47  gjozsa
   silly bug

   Revision 1.10  2008/01/16 11:17:24  gjozsa
   bugfix concerning sdis

   Revision 1.9  2008/01/09 17:50:50  gjozsa
   minor bug

   Revision 1.8  2008/01/09 17:25:52  gjozsa
   introduced ring-dependent dispersion without performance loss

   Revision 1.7  2007/08/23 15:23:26  gjozsa
   Left work

   Revision 1.5  2007/08/16 15:12:05  gjozsa
   Left work

   Revision 1.4  2007/08/15 16:28:23  gjozsa
   Left work

   Revision 1.3  2007/08/14 17:09:58  gjozsa
   Left work

   Revision 1.2  2007/07/25 17:17:09  gjozsa
   Left work

   Revision 1.1  2007/07/05 16:16:24  gjozsa
   added to cvs control

   Revision 1.66  2007/03/23 17:21:09  gjozsa
   Changed back the changes from rev. 1.64, instead corrected the gridding: If the velocity increases with channel number, the pa changes by 180 deg w.r.t version pre-1.64, otherways it stays. For post-1.64 one has to change the pa by changing its signum and adding or subtracting 180 deg.

   Revision 1.65  2007/02/23 10:28:10  gjozsa
   BUGFIX in tirout: Works now for TIRACC > 6. Enlargened accuracy in textlog.

   Revision 1.64  2007/01/17 15:54:52  gjozsa
   Changed coordinate system in srconst by mirroring pp[0] to get a right hand coordinate system. In order not to change the pa definition changed the conversion functions interntoglob globtointern etc. Also did some changes to the graphics functions of which I don't know the effect. One can spot the changes via searching for 180.0 and DEGTORAD in the source

   Revision 1.63  2006/12/11 12:42:07  gjozsa
   BUGFIX: removed reading beam from header: too much confusion

   Revision 1.62  2006/11/22 14:16:21  gjozsa
   Bugfix concerning RASH and horizontal/vertical lines

   Revision 1.61  2006/11/10 15:53:10  gjozsa
   minor bugfix

   Revision 1.60  2006/11/09 14:42:55  gjozsa
   minor change

   Revision 1.59  2006/11/08 14:05:03  gjozsa
   included line drawing with keywords GR_VERL_i GR_HORL_i GR_VLVA_i GR_HLVA_i GR_VLCA_i GR_HLCA_i

   Revision 1.58  2006/11/03 12:08:59  gjozsa
   Small bugfix

   Revision 1.57  2006/11/03 10:57:38  gjozsa
   Introduced logarithmic scaling keywords: GR_XLOG, GR_YLOG_i, introduced hms dms for xpos and ypos in graphics output, introduced keywords RFREQ (restfrequency in Hertz) and ITOU (conversion factor from intensity in Jy/squarearcsec in u/squarecentimeter), changed DOUBLE_ACCURACY to 3E-15 to account for near zero events

   Revision 1.56  2006/07/18 09:33:02  gjozsa
   Left work

   Revision 1.55  2006/04/11 11:46:00  gjozsa
   Removed the positive SBR restriction in input

   Revision 1.54  2006/04/06 10:40:25  gjozsa
   Bugfix: Call of engalmod_chflgs() after changing the input cube after chisquare initialisation

   Revision 1.53  2006/04/03 11:47:57  gjozsa
   Left work

   Revision 1.52  2005/10/12 14:50:59  gjozsa
   Not really a Bugfix: Corrected the calculation of the ring normal vector

   Revision 1.51  2005/10/12 09:53:45  gjozsa
   Included Brigg's plots

   Revision 1.50  2005/09/29 17:46:00  gjozsa
   BUGFIX in the golden_section() function: refreshing pointsource lists is a crucial point

   Revision 1.49  2005/08/25 10:15:05  gjozsa
   Slight bug in the plot routines

   Revision 1.48  2005/08/18 13:06:52  gjozsa
   Left work

   Revision 1.47  2005/08/15 13:15:03  gjozsa
   BUGFIX: At 12523, not copying to the par array will result in funny results, when the only output is a .def file. Don't know whether this will cause sequals

   Revision 1.45  2005/07/27 14:27:34  gjozsa
   Again improved the graphics output

   Revision 1.44  2005/07/27 14:01:30  gjozsa
   Improved the graphics output

   Revision 1.43  2005/06/28 13:28:08  gjozsa
   Changed the out of range behaviour in golden_section()

   Revision 1.42  2005/06/24 16:44:51  gjozsa
   added interpolation possibility for the TIRDEF= output, not yet for TIRSMOOTH=

   Revision 1.41  2005/06/24 12:00:30  gjozsa
   Left work

   Revision 1.43  2005/06/17 14:56:45  gjozsa
   Bugfix

   Revision 1.42  2005/06/17 14:50:45  gjozsa
   Bugfix

   Revision 1.41  2005/06/17 14:23:48  gjozsa
   Added penalty for outliers

   Revision 1.40  2005/06/13 10:40:29  gjozsa
   Added possibility just to examine results

   Revision 1.39  2005/06/09 14:07:45  gjozsa
   Left work

   Revision 1.38  2005/06/09 08:22:58  gjozsa
   BUGFIX: Multiple Parameter fitting was not working properly, fixed that

   Revision 1.37  2005/05/25 15:47:39  gjozsa
   Added inclinogram output

   Revision 1.36  2005/05/24 15:59:08  gjozsa
   Added LON and LMV to table output

   Revision 1.34  2005/05/24 10:42:03  gjozsa
   Included graphics

   Revision 1.33  2005/05/03 12:42:18  gjozsa
   Left work

   Revision 1.32  2005/04/28 12:44:44  gjozsa
   bugfix

   Revision 1.31  2005/04/28 10:13:47  gjozsa
   Full introduction of pointsource lists

   Revision 1.28  2005/04/26 11:44:53  gjozsa
   Seems to work

   Revision 1.25  2005/04/20 14:33:39  gjozsa
   bug

   Revision 1.24  2005/04/20 13:26:25  gjozsa
   Left work

   Revision 1.23  2005/04/19 13:58:50  gjozsa
   Left work

   Revision 1.22  2005/04/19 15:29:28  gjozsa
   Finished the output functions

   Revision 1.21  2005/04/19 10:59:13  gjozsa
   Extended the possibilities for the histogram output

   Revision 1.19  2005/04/19 07:44:43  gjozsa
   Left work

   Revision 1.18  2005/04/18 15:53:40  gjozsa
   Added histogram functions

   Revision 1.17  2005/04/18 15:02:02  gjozsa
   Included TIR functions

   Revision 1.16  2005/04/15 15:52:09  gjozsa
   Left work

   Revision 1.15  2005/04/15 15:39:13  gjozsa
   Bugfix: in fct get_ringparms, documented as BUGFIX , in fct decodestring, also reported

   Revision 1.14  2005/04/14 14:26:05  gjozsa
   Left work

   Revision 1.13  2005/04/14 10:32:16  gjozsa
   Left work

   Revision 1.10  2005/04/12 14:54:33  gjozsa
   Changed the character of PARMAX= and PARMIN=

   Revision 1.9  2005/04/11 14:23:37  gjozsa
   Left work

   Revision 1.8  2005/04/08 15:30:40  gjozsa
   Taking into account the whole cube now, no counting for the user

   Revision 1.7  2005/04/08 07:27:44  gjozsa
   Bugfixes

   Revision 1.6  2005/04/08 07:25:59  gjozsa
   Bugfixes

   Revision 1.5  2005/04/07 15:15:16  gjozsa
   Bugfix in galmod(): subring velocity was overwritten by a radius, I hacked a bit, not nic at the moment

   Revision 1.3  2005/04/06 15:46:25  gjozsa
   Bugfixes, included monitoring of golden_section

   Revision 1.2  2005/04/05 16:06:06  gjozsa
   Left work

   Revision 1.1  2005/04/05 11:07:37  gjozsa
   The former tiridev, officially release 1

   Revision 1.41  2005/04/04 08:42:09  gjozsa
   removed bug

   Revision 1.40  2005/04/01 15:31:54  gjozsa
   Introduced writecubup and a lot of debugging, check whether the output is not too large

   Revision 1.39  2005/03/29 15:56:24  gjozsa
   left work

   Revision 1.36  2005/03/25 18:17:20  gjozsa
   Left work

   Revision 1.35  2005/03/23 17:48:49  gjozsa
   Implemented hdu_3 support, seems to work

   Revision 1.32  2005/03/23 13:44:33  gjozsa
   Implemented and tested 2nd hdu i/o

   Revision 1.31  2005/03/22 17:48:07  gjozsa
   Left work

   Revision 1.30  2005/03/21 18:54:17  gjozsa
   Left work

   Revision 1.29  2005/03/19 17:55:52  gjozsa
   Left work

   Revision 1.26  2005/03/17 18:00:50  gjozsa
   Left work

   Revision 1.25  2005/03/16 17:52:00  gjozsa
   Left work

   Revision 1.23  2005/03/15 18:53:08  gjozsa
   Left work

   Revision 1.22  2005/03/15 17:28:59  gjozsa
   Last changes to get a clear program structure, not ideal, but ok. Some debugging, deleting the fortran thingies

   Revision 1.21  2005/03/12 16:48:33  gjozsa
   Removed all clutter from readringparms and associated structs

   Revision 1.19  2005/03/12 13:24:49  gjozsa
   Removed all clutter from hdrinit

   Revision 1.17  2005/03/12 11:37:46  gjozsa
   Rearranged completely galmod, debugged and tested version of new galmod, including convolution routines, changed position angle to angle with respect to minor

   Revision 1.16  2005/03/11 17:45:55  gjozsa
   Left work

   Revision 1.15  2005/03/10 17:56:39  gjozsa
   Left work

   Revision 1.13  2005/03/08 17:55:07  gjozsa
   Left work

   Revision 1.12  2005/03/05 17:56:09  gjozsa
   Left work

   Revision 1.11  2005/03/04 18:13:53  gjozsa
   Left work

   Revision 1.10  2005/03/03 18:00:49  gjozsa
   Left work

   Revision 1.9  2005/03/02 17:56:09  gjozsa
   Left work

   Revision 1.8  2005/03/01 17:46:21  gjozsa
   Left work

   Revision 1.6  2005/02/25 18:13:08  gjozsa
   Left work

   Revision 1.5  2005/02/25 13:34:29  gjozsa
   cube io finished

   Revision 1.4  2005/02/25 11:38:27  gjozsa
   Created a header struct

   Revision 1.3  2005/02/24 17:48:46  gjozsa
   Left work

   Revision 1.2  2004/12/09 16:17:14  gjozsa
   Changed some floating point operations from double to float accuracy

   Revision 1.1.1.1  2004/10/29 11:13:20  gjozsa
   Added to CVS control

   ------------------------------------------------------------ */

max_stars_repo_name: kernsuite-debian/tirific

max_issues_repo_name: gigjozsa/tirific

max_forks_repo_name: kernsuite-debian/tirific