/*===========================================================================
  Copyright (C) 1995-2009 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++++++ SC interface module scd +++++++++++++++++++++++
.LANGUAGE C
.IDENTIFICATION Module scd.c
.AUTHOR         K. Banse 		ESO - Garching
.KEYWORDS       standard interfaces, descriptors
.ENVIRONMENT    VMS and UNIX
.COMMENTS
holds SCDRDx (x=C,D,I,R,L, Z,X)

.VERSION  [2.00] 871125:  new and hopefully final version ...

090326		last modif
----------------------------------------------------------------------------*/


#include <stdio.h>
#include <stdlib.h>

#include <fileexts.h>
#include <proto_st.h>


static char  realdescr[52], help[72];

static int  dsclen;

/*

*/

int SCDRDC(imno,descr,noelm,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a character descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char  *descr  	 /* IN : descriptor name */;
int noelm   	 /* IN : no. of "elements" in type, i.e. CHAR*noelm */;
int felem	 /* IN : position of 1st element to be accessed */;
int maxvals  	 /* IN : max. no. of values to be returned */;
int *actvals 	 /* OUT: actual no. of values returned */;
char  *values 	 /* OUT: array of type char */;
int  *unit  	 /* OUT: unit pointer    */;
int *null	 /* OUT: no. of null values in data         \
                         will only be applied, if not -1   */;

{
int   mm, kk, koff;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;

if (unlikely(fctpntr->LINK[0] >= 2))		/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
dtype[0] = 'C';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		    &noelem,&dunit,&dblock,&dindx,help);
if (status != ERR_NORMAL) goto end_of_it;

mm = noelem * bytelem;			/* real size of descr. */
koff = (felem-1) * noelm;		/* requested offset */
kk = mm - koff; 			/* size available */

	
/*  check parameters   */
 
if ( (felem <= 0) || (noelm < 1) || (kk < noelm) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
kk /= noelm; 		/* no. of elements/values available */


/*  now go + get the data  */
 
first = koff + 1;			/* first byte to access */
if (kk > maxvals) kk = maxvals;		/*  minimize no. of data   */
mm = kk * noelm;

snull = -1;

(void) MID_RDSCRC(chanl,dblock,dindx,first,mm,values,&snull);

*null = snull;
*actvals = kk;
*unit = dunit;
return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDD(imno,descr,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a double precision descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	/* IN : no. of data frame */;
char   *descr   /* IN : descriptor name */;
int    felem	/* IN : position of 1st element to be accessed */;
int    maxvals  /* IN : max. no. of values to be returned */;
int    *actvals /* OUT: actual no. of values returned */;
double *values	/* OUT: array of type double */;
int    *unit	/* OUT: unit pointer    */;
int    *null	 /* OUT: no. of null values in data
                         will only be applied, if not -1   */;

{
int   actv, n, *ipntr;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;





*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except START goes to father */
   if (strcmp(realdescr,"START") == 0)
      goto next_step;

   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

next_step:
fcbp = fctpntr->FZP;
chanl = fctpntr->IOCHAN;


/*  find descriptor in directory  */
 
dtype[0] = 'D';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,help);

if (status != ERR_NORMAL) 
   {					/* see if real descr instead */
   dtype[0] = 'R';
   status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                          &noelem,&dunit,&dblock,&dindx,help);
   }
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type D is handled via integer descriptors...  */

snull = -1;
if (dtype[0] == 'R')
   {
   float  *rvals;
   char   *mypntr;

   n = (int) sizeof(float) * actv;
   mypntr = malloc((size_t) n);
   if (mypntr == (char *) 0)
      {
      status = ERR_MEMOUT;
      goto end_of_it;
      }
   rvals = (float *)mypntr;

   (void) MID_RDSCRR(chanl,dblock,dindx,felem,actv,rvals,&snull);
   for (n=0; n<actv; n++) values[n] = (double) *rvals++;
   (void) free (mypntr);
   }
else
   {
   n = DD_SIZE / II_SIZE;
   first = n*felem - 1;			
   actv *= n;
   ipntr = (int *) values;
   MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);
   }
*null = snull;
*unit = dunit;

return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDS(imno,descr,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a size_t descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	/* IN : no. of data frame */;
char   *descr   /* IN : descriptor name */;
int    felem	/* IN : position of 1st element to be accessed */;
int    maxvals  /* IN : max. no. of values to be returned */;
int    *actvals /* OUT: actual no. of values returned */;
size_t *values	/* OUT: array of type size_t */;
int    *unit	/* OUT: unit pointer    */;
int    *null	/* OUT: no. of null values in data         
                         will only be applied, if not -1   */;

{
int   actv, n, *ipntr;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except START goes to father */
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

fcbp = fctpntr->FZP;
chanl = fctpntr->IOCHAN;


/*  find descriptor in directory  */
 
dtype[0] = 'S';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,help);
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type S is handled via integer descriptors...  */

snull = -1;
n = SS_SIZE / II_SIZE;
first = n*felem - 1;			
actv *= n;
ipntr = (int *) values;
MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);
*null = snull;
*unit = dunit;

return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDL(imno,descr,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a logical descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
int  *values  /* OUT: array of type int */;
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data   
                         will only be applied, if not -1   */;

{
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, *iptr;
register int  nr;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) )
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);  /* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */

dtype[0] = 'L';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,help);
if (status != ERR_NORMAL) goto end_of_it;



/*  check parameters   */

if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) )
   {
   status = ERR_INPINV;                 /* invalid input parameters  */
   goto end_of_it;
   }


/*  minimize no. of data   */

*actvals = noelem - felem + 1;                  /* max. no. of values */
if (*actvals > maxvals) *actvals = maxvals;


/*  now go + get the data */

snull = -1;
(void) MID_RDSCRI(chanl,dblock,dindx,felem,*actvals,values,&snull);

iptr = values;
for (nr=0; nr<*actvals; nr++)
   {
   if (*iptr != 0) *iptr = 1;		/* enforce 0/1 as only output */
   iptr++;
   }

*null = snull;
*unit = dunit;
return status;


end_of_it:                              /*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDI(imno,descr,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of an integer descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
int  *values  /* OUT: array of type int */;
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data  
                         will only be applied, if not -1   */;

{
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;



 
*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except NAXIS, NPIX => father */
   if (strcmp(realdescr,"NAXIS") == 0)
      goto next_step;
   else if (strcmp(realdescr,"NPIX") == 0) 
      goto next_step;
       
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

next_step:
chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
dtype[0] = 'I';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		       &noelem,&dunit,&dblock,&dindx,help);
if (status != ERR_NORMAL) goto end_of_it;


	
/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
*actvals = noelem - felem + 1;			/* max. no. of values */
if (*actvals > maxvals) *actvals = maxvals;
	

/*  now go + get the data */

snull = -1;
(void) MID_RDSCRI(chanl,dblock,dindx,felem,*actvals,values,&snull);
*null = snull;
*unit = dunit;
return status;

	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDR(imno,descr,felem,maxvals,actvals,values,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a real descriptor and its extensions 
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
float    *values  /* OUT: array of type real */;
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data 
                         will only be applied, if not -1   */;

{
int   n, actv;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




*actvals = 0;

if ( (imno < 0) || (imno >= FCT.MAXENT) )		/*  check imno */
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
dtype[0] = 'R';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,help);

if (status != ERR_NORMAL)
   {					/* see if double descr instead */
   dtype[0] = 'D';
   status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,help);
   }
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type D is handled via integer descriptors...  */

snull = -1;
if (dtype[0] == 'D')
   {
   int    *ipntr;
   double *dvals;
   char   *mypntr;

   n = (int) sizeof(double) * actv;
   mypntr = malloc((size_t) n);		/* allocate space for */
   if (mypntr == (char *) 0)			/* for double temp data */
      {
      status = ERR_MEMOUT;
      goto end_of_it;
      }
   dvals = (double *)mypntr;

   n = DD_SIZE / II_SIZE;			/* double stuff is stored */
   first = n*felem - 1;				/* integer data */
   actv *= n;
   ipntr = (int *)mypntr;
   (void) MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);

   for (n=0; n<actv; n++) values[n] = (float) *dvals++;
   (void) free (mypntr);
   }
else
   (void) MID_RDSCRR(chanl,dblock,dindx,felem,actv,values,&snull);

*null = snull;
*unit = dunit;
return status;
 
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDH(imno,descr,felem,maxvals,actvals,values,totvals)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the help text of descriptor and its extensions 
.ALGORITHM
`actval' will be set to the actual no. of values returned
if no help text, `totvals' = -1
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno		/* IN : no. of data frame */;
char  *descr		/* IN : descriptor name */;
int felem		/* IN : position of 1st element to be accessed */;
int maxvals		/* IN : max. no. of values to be returned */;
int *actvals		/* OUT: actual no. of values returned */;
char   *values		/* OUT: char. buf for help text  */;
int *totvals		/* OUT: total size of help string */;

{
int   kk, dunit;
int   status, chanl, bytelem, noelem, dblock, dindx;

char  dtype[80];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

*actvals = 0;
fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */

dtype[0] = ' ';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                    &noelem,&dunit,&dblock,&dindx,dtype);
kk = (int) strlen(dtype);
if (kk < 1)
   *totvals = -1;
else
   {
   if (kk > maxvals) kk = maxvals;
   (void) memcpy(values,dtype,(size_t)(kk+1));
   *totvals = *actvals = kk;
   }
return status;

end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDRDZ(imno,dirsize,direlem)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
display the descriptor directory
.ALGORITHM
use MID_xDSCDIR to do the job
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int imno	/* IN : no. of data frame */;
int *dirsize	/* OUT : no. of chars. used by descr-directory */;
int *direlem	/* OUT : no. of descr. (incl. directory) */;

{
int   dblock, dindx, dunit;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




if ( (imno < 0) || (imno >= FCT.MAXENT) )
   {
   MID_E2(6,imno,"Z-DIRECORY.MIDAS",ERR_INPINV,1);
   return ERR_INPINV;
   }

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

fcbp = fctpntr->FZP;
(void) MID_YDSCDIR(imno,'Z',dtype,dtype,dirsize,direlem,
                      &dunit,&dblock,&dindx,help);

return ERR_NORMAL;
}
/*

*/

int SCDRDX(imno,flag,name,type,bytelem,noelem,hnc)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
in 1. step get complete descriptor directory
next return descriptor info like SCDINF
.ALGORITHM
use MID_xDSCDIR to do the job
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int imno;	/* IN: imno of data frame */
int flag;	/* IN: action flag
		       = 0,  free space again
		       = 1,  read in complete descr. directory
		       = 2,  as 1 and also return total no. of descriptors
		       = 10, return descr. info of next descr. */
char  *name;	/* OUT: name of next descr.  = ' ' if no more descr. */
char  *type;	/* OUT: type of next descr. */
int *bytelem;	/* OUT: no. of bytes per element */
int *noelem;	/* OUT: no. of elements */
int *hnc;	/* OUT: no. of help text chars */

{
int   status, chanl, nullo;
static int dirlen, nlen, myimno=-1;

char   *dscpntr;
static char  *cpt, *xdscdir = (char *) 0;

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




fctpntr = FCT.ENTRIES + imno;

if (flag == 0)
   {
   if (xdscdir != (char *) 0)
      {
      free (xdscdir);
      xdscdir = (char *) 0;
      }
   return ERR_NORMAL;
   }


if ( (imno < 0) || (imno >= FCT.MAXENT) )
   {
   status= ERR_INPINV;                  /* wrong argument `npos'  */
   goto end_of_it;
   }

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


dscpntr = (char *) &YDSCDIR_ENTRY;

if (flag != 10)
   {
   myimno = imno;
   dirlen = fcbp->DFILLED;

   if (xdscdir != (char *) 0) (void)free (xdscdir);
   xdscdir = (char *) malloc((size_t) (dirlen+4));

   nullo = -1;
   (void) MID_RDSCRC(chanl,fcbp->PTRLDB,0,1,dirlen,xdscdir,&nullo);
   cpt = xdscdir;


   /* for flag = 2, we have to go through directory once */
   
   if (flag == 2)
      {
      register int nr, npos;

      nr = 0; npos = 0;
      while (nr < dirlen)
         {
         if (*cpt != '\0') npos ++;     /* test if deleted descr. */
         cpt += fcbp->DIRENTRY;  nr += fcbp->DIRENTRY;
         }
      *noelem = npos;
      cpt = xdscdir;			/* set back to start */
      }

   cpt += fcbp->DIRENTRY;  		/* skip directory itself */
   nlen = fcbp->DIRENTRY;  		/* set to already used length */
   }

else
   {
   if (myimno != imno)		/* no call with flag=1 before... */
      {
      status = ERR_INPINV;
      goto end_of_it;
      }

  dYloop:
   if (nlen < dirlen)
      {
      if (*cpt == '\0')              /* test if deleted entry */
         {
         cpt += fcbp->DIRENTRY;  nlen += fcbp->DIRENTRY;
         goto dYloop;
         }
      else
         (void) memcpy(dscpntr,cpt,(size_t)fcbp->DIRENTRY);

      cpt += fcbp->DIRENTRY;  
      nlen += fcbp->DIRENTRY;		/* follow with pointer */
      }
   else
      {
      if (xdscdir != (char *) 0) 
         {
         (void)free (xdscdir);
         xdscdir = (char *) 0;
         }
      *name = ' ';
      *noelem = -1;			/* mark the end */
      return ERR_NORMAL;
      }

   (void) memcpy(name,YDSC_PNTR->NAMESTR,(size_t)YDSC_PNTR->NAMELEN);
   *(name + YDSC_PNTR->NAMELEN) = '\0';
			/* passed param `type' must be at least 4 chars */
   (void) MID_TYPINFO(YDSC_PNTR->TYPE,YDSC_PNTR->BYTELEM,type,4);
   *noelem = YDSC_PNTR->NOELEM;
   *bytelem = YDSC_PNTR->BYTELEM;
   *hnc = YDSC_PNTR->HELPLEN;
   }

return ERR_NORMAL;


end_of_it:
MID_E2(6,imno,"descriptor.directory",status,1);
return status;
}
/*

*/

int SCDHRC(imno,descr,noelm,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a character descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char  *descr  	 /* IN : descriptor name */;
int noelm   	 /* IN : no. of "elements" in type, i.e. CHAR*noelm */;
int felem	 /* IN : position of 1st element to be accessed */;
int maxvals  	 /* IN : max. no. of values to be returned */;
int *actvals 	 /* OUT: actual no. of values returned */;
char  *values 	 /* OUT: array for descriptor data */;
char  *htxt; 	 /* OUT: help text */
int  hmax;  	 /* OUT: max. no. of chars in help text */
int  *unit  	 /* OUT: unit pointer    */;
int *null	 /* OUT: no. of null values in data 
                         will only be applied, if not -1   */;

{
int   mm, kk, koff;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
htxt[0] = '\0';
dtype[0] = 'C';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		    &noelem,&dunit,&dblock,&dindx,htxt);
if (status != ERR_NORMAL) goto end_of_it;

mm = noelem * bytelem;			/* real size of descr. */
koff = (felem-1) * noelm;		/* requested offset */
kk = mm - koff; 			/* size available */

	
/*  check parameters   */
 
if ( (felem <= 0) || (noelm < 1) || (kk < noelm) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
kk /= noelm; 		/* no. of elements/values available */


/*  now go + get the data  */
 
first = koff + 1;			/* first byte to access */
if (kk > maxvals) kk = maxvals;		/*  minimize no. of data   */
mm = kk * noelm;

snull = -1;
(void) MID_RDSCRC(chanl,dblock,dindx,first,mm,values,&snull);

*null = snull;
*actvals = kk;
*unit = dunit;
return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDHRD(imno,descr,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a double precision descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	/* IN : no. of data frame */;
char   *descr   /* IN : descriptor name */;
int    felem	/* IN : position of 1st element to be accessed */;
int    maxvals  /* IN : max. no. of values to be returned */;
int    *actvals /* OUT: actual no. of values returned */;
double *values	/* OUT: array of type double */;
char  *htxt;	/* OUT: help text */
int    hmax;	/* IN : max. no. of chars. for help text */
int    *unit	/* OUT: unit pointer    */;
int    *null	 /* OUT: no. of null values in data    
                         will only be applied, if not -1   */;

{
int   actv, n, *ipntr;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;






if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except START goes to father */
   if (strcmp(realdescr,"START") == 0)
         goto next_step;
       
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

next_step:
fcbp = fctpntr->FZP;
chanl = fctpntr->IOCHAN;


/*  find descriptor in directory  */
 
htxt[0] = '\0';
dtype[0] = 'D';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		    &noelem,&dunit,&dblock,&dindx,htxt);
if (status != ERR_NORMAL) 
   {					/* see if real descr instead */
   dtype[0] = 'R';
   status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                          &noelem,&dunit,&dblock,&dindx,htxt);
   }
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type D is handled via integer descriptors...  */

snull = -1;
if (dtype[0] == 'R')
   {
   float  *rvals;
   char   *mypntr;

   n = (int)sizeof(float) * actv;
   mypntr = malloc((size_t) n);
   if (mypntr == (char *) 0)
      {
      status = ERR_MEMOUT;
      goto end_of_it;
      }
   rvals = (float *)mypntr;

   (void) MID_RDSCRR(chanl,dblock,dindx,felem,actv,rvals,&snull);
   for (n=0; n<actv; n++) values[n] = (double) *rvals++;
   (void) free (mypntr);
   }
else
   {
   n = DD_SIZE / II_SIZE;
   first = n*felem - 1;			
   actv *= n;
   ipntr = (int *) values;
   MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);
   }
*null = snull;
*unit = dunit;
return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDHRS(imno,descr,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a size_t descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	/* IN : no. of data frame */;
char   *descr   /* IN : descriptor name */;
int    felem	/* IN : position of 1st element to be accessed */;
int    maxvals  /* IN : max. no. of values to be returned */;
int    *actvals /* OUT: actual no. of values returned */;
size_t *values 	/* OUT: array of type size_t */;
char  *htxt;	/* OUT: help text */
int    hmax;	/* IN : max. no. of chars. for help text */
int    *unit	/* OUT: unit pointer    */;
int    *null	 /* OUT: no. of null values in data   
                         will only be applied, if not -1   */;

{
int   actv, n, *ipntr;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;





if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except START goes to father */
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

fcbp = fctpntr->FZP;
chanl = fctpntr->IOCHAN;


/*  find descriptor in directory  */
 
htxt[0] = '\0';
dtype[0] = 'S';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		    &noelem,&dunit,&dblock,&dindx,htxt);
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type S is handled via integer descriptors...  */

snull = -1;
n = SS_SIZE / II_SIZE;
first = n*felem - 1;			
actv *= n;
ipntr = (int *) values;
MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);
*null = snull;
*unit = dunit;
return status;
	
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDHRL(imno,descr,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a logical descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
int  *values  /* OUT: array of type int */;
char  *htxt;	/* OUT: help text */
int    hmax;	/* IN : max. no. of chars. for help text */
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data 
                         will only be applied, if not -1   */;

{
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




 
if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   { 
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */

htxt[0] = '\0';
dtype[0] = 'L';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                     &noelem,&dunit,&dblock,&dindx,htxt);
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */

if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) )
   {
   status = ERR_INPINV;                 /* invalid input parameters  */
   goto end_of_it;
   }


/*  minimize no. of data   */

*actvals = noelem - felem + 1;                  /* max. no. of values */
if (*actvals > maxvals) *actvals = maxvals;


/*  now go + get the data */

snull = -1;
(void) MID_RDSCRI(chanl,dblock,dindx,felem,*actvals,values,&snull);
*null = snull;
*unit = dunit;
return status;


end_of_it:                              /*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDHRI(imno,descr,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of an integer descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
int  *values  /* OUT: array of type int */;
char  *htxt;	/* OUT: help text */
int    hmax;	/* IN : max. no. of chars. for help text */
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data
                         will only be applied, if not -1   */;

{
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;



 
if ( (imno < 0) || (imno >= FCT.MAXENT) ) 
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {					/* all except NAXIS, NPIX => father */
   if (strcmp(realdescr,"NAXIS") == 0)
      goto next_step;
   else if (strcmp(realdescr,"NPIX") == 0) 
      goto next_step;

   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

next_step:
chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
htxt[0] = '\0';
dtype[0] = 'I';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
		    &noelem,&dunit,&dblock,&dindx,htxt);
if (status != ERR_NORMAL) goto end_of_it;

	
/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
*actvals = noelem - felem + 1;			/* max. no. of values */
if (*actvals > maxvals) *actvals = maxvals;
	

/*  now go + get the data */

snull = -1;
(void) MID_RDSCRI(chanl,dblock,dindx,felem,*actvals,values,&snull);
*null = snull;
*unit = dunit;
return status;

end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
/*

*/

int SCDHRR(imno,descr,felem,maxvals,actvals,values,htxt,hmax,unit,null)

/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
read the contents of a real descriptor and its help text
.ALGORITHM
'actval' will be set to the actual no. of values returned
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   imno	 /* IN : no. of data frame */;
char    *descr   /* IN : descriptor name */;
int  felem	 /* IN : position of 1st element to be accessed */;
int  maxvals  /* IN : max. no. of values to be returned */;
int  *actvals /* OUT: actual no. of values returned */;
float   *values  /* OUT: array of type real */;
char  *htxt;	/* OUT: help text */
int    hmax;	/* IN : max. no. of chars. for help text */
int    *unit	/* OUT: unit pointer    */;
int  *null	 /* OUT: no. of null values in data   
                         will only be applied, if not -1   */;

{
int   n, actv;
int   status, chanl, bytelem, noelem, dblock, dindx;
int   dunit, snull, first;

char  dtype[4];

struct FCB_STRUCT  *fcbp;

struct FCT_STRUCT  *fctpntr;




if ( (imno < 0) || (imno >= FCT.MAXENT) )		/*  check imno */
   {
   status = ERR_INPINV;
   goto end_of_it;
   }

dsclen = DSCNAM_COPY(realdescr,descr);	/* build uppercase name */

fctpntr = FCT.ENTRIES + imno;
if (unlikely(fctpntr->LINK[0] >= 2))	/*  if son, use father's imno */
   {
   imno = fctpntr->LINK[1];
   fctpntr = FCT.ENTRIES + imno;
   }

chanl = fctpntr->IOCHAN;
fcbp = fctpntr->FZP;


/*  find descriptor in directory  */
 
htxt[0] = '\0';
dtype[0] = 'R';
status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,htxt);

if (status != ERR_NORMAL)
   {					/* see if double descr instead */
   dtype[0] = 'D';
   status = MID_YDSCDIR(imno,'F',realdescr,dtype,&bytelem,
                       &noelem,&dunit,&dblock,&dindx,htxt);
   }
if (status != ERR_NORMAL) goto end_of_it;


/*  check parameters   */
 
if ( (felem <= 0) || (felem > noelem) || (maxvals <= 0) ) 
   {
   status = ERR_INPINV;			/* invalid input parameters  */
   goto end_of_it;
   }
	

/*  minimize no. of data   */
 
actv = noelem - felem + 1;			/* max. no. of values */
if (actv > maxvals) actv = maxvals;
*actvals = actv;
	

/*  now go + get the data  -  type D is handled via integer descriptors...  */

snull = -1;
if (dtype[0] == 'D')
   {
   int    *ipntr;
   double *dvals;
   char   *mypntr;

   n = (int)sizeof(double) * actv;
   mypntr = malloc((size_t) n);		/* allocate space for */
   if (mypntr == (char *) 0)			/* for double temp data */
      {
      status = ERR_MEMOUT;
      goto end_of_it;
      }
   dvals = (double *)mypntr;

   n = DD_SIZE / II_SIZE;			/* double stuff is stored */
   first = n*felem - 1;				/* integer data */
   actv *= n;
   ipntr = (int *)mypntr;
   (void) MID_RDSCRI(chanl,dblock,dindx,first,actv,ipntr,&snull);

   for (n=0; n<actv; n++) values[n] = (float) *dvals++;
   (void) free (mypntr);
   }
else
   (void) MID_RDSCRR(chanl,dblock,dindx,felem,actv,values,&snull);

*null = snull;
*unit = dunit;
return status;
 
end_of_it:				/*  here for errors  */
MID_E2(6,imno,descr,status,1);
return status;
}
 
