/* @(#)scda.c	17.1.1.2 (ESO-DMD) 02/25/02 17:53:44 */
/*===========================================================================
  Copyright (C) 1995 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 SCDA +++++++++++++++++++++++
.LANGUAGE C
.IDENTIFICATION Module SCDA
.AUTHOR         K. Banse 		ESO - Garching
.KEYWORDS       standard interfaces, descriptors
.ENVIRONMENT    VMS and UNIX
.COMMENTS
holds ZSCDCOP, YSCDCOP
.VERSION  [1.00] 920211:  pulled out from scd.c

 020207		last modif

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

#include <fileexts.h>
#include <stdlib.h>


#define DATA_ISIZE   2048			/* 2048 int's  */
#define DATA_CSIZE   DATA_ISIZE*II_SIZE		/* in bytes */
#define DATA_DSIZE   DATA_CSIZE/DD_SIZE		/* no. of double's */

#define DISK_REC     512			/* size of disk record */

static int  mapdat = -1;
static int  maxdim[4] = {DATA_ISIZE,DATA_ISIZE,DATA_CSIZE-1,DATA_DSIZE};


static char *datpntr;

static char  stand0[] = "NAXIS";
static char  stand1[] = "NPIX";
static char  stand2[] = "START";
static char  stand3[] = "STEP";
static char  stand4[] = "CUNIT";
static char  stand5[] = "IDENT";
static char  stand6[] = "LHCUTS";
static char  stand7[] = "DISPLAY_DATA";
static char  stand8[] = "HIST_BINS";
static char  stand9[] = "HISTOGRAM";
static char  stand10[] = "STATISTIC";
static char  stand11[] = "WINDOW_TO";
static char  stand12[] = "WINDOW_FROM";

static char  *stand[13] = {stand0,stand1,stand2,stand3,stand4,stand5,stand6,
                           stand7,stand8,stand9,stand10,stand11,stand12};
static char  tstand0[] = "TBLENGTH";
static char  tstand1[] = "TBLOFFST";
static char  tstand2[] = "TBLCONTR";
static char  tstand3[] = "TSELTABL";

static char  *tstand[4] = {tstand0,tstand1,tstand2,tstand3};


/*

*/

int ZSCDCOP(from,to,mask,dsc)
/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
Copy descriptors from one frame to another
.ALGORITHM
Depending on 'mask' the relevant descriptors are read from
the source frame + written to the destination frame.
.REMARKS
mask for copying: = 1 , copy all descriptors
		  = 2 , copy only standard desc.
                  = 3 , copy all but standard descriptors
		  = 4 , copy descriptors specified by DSClist (max. 8) 
		  = 5 , copy all but extended list of standard descriptors

                  = 6 , copy all descriptors except descr specified by DSClist
                  = 7 , copy standard descriptors, except DSClist
                  = 8 , copy all but standard descriptors, except DSClist
                  = 10, copy all but extended list of standard descriptors,
                        except descr from.DSClist
		  = 100 + mask as described above indicates, that we want
		        to clear existing descr's completely before being
			overwritten with (shorter) source descr's
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   from;		/* IN: no. of source frame  */
int   to;		/* IN: no. of destination frame  */
int   mask;		/* IN: copy_mask  */
char  *dsc;		/* IN: DSClist = names of descr. to copy 
			       separated by comma */

{
int   iav, nval, nfr, no_elem, byt_elem, cleanem, ncleanem;
int   total, dblock, dindx, hblock, hindx, dunit, status, mm, e_c, e_l;
int   chanl, nullo, stuff_read, dsc_count, hnc, hno_elem, dsc_exist;
int   tcount, diroff, dirlen, dirbytes;
int   fcbDFILLED, fcbPTRLDB, fcbDIREXT, dirb2, dirb3;
int   patflag, patlen, pat1flag, pat1len, *ibuf;
int   dsclen;
register int  nr;
static int  mapdscdir = -1;

float *rbuf;
double *dbuf;

char  *cbuf, dtype[4], filty, descr[88];
char  *zdscpntr, *dscptr[8], *dscbptr;
register char  *cpt, *dpt;
static char  *dscdir;

struct FCT_STRUCT  *fctfrom, *fctto;

struct FCB_STRUCT  *fcbp;
 



 
if (mapdat < 0)                         /* allocate working buffer */
   {                                    /* for descr. data */
   datpntr = malloc((unsigned int)DATA_CSIZE);
   mapdat = 1;
   }

cbuf = datpntr;
ibuf = (int *) datpntr;
rbuf = (float *) datpntr;
dbuf = (double *) datpntr;

fctfrom = FCT.ENTRIES + from;
fctto = FCT.ENTRIES + to;

filty = fctfrom->CATALOG[0];			/* get file type */
chanl = fctfrom->IOCHAN;
fcbp = fctfrom->FZP;


status = ERR_INPINV;
e_c = ERRO_CONT;   ERRO_CONT = 1;
e_l = ERRO_LOG;    ERRO_LOG = 0;

total = 1; 
patflag = 0;
dsc_exist = 1;				/* default => SCDWRz */
if (mask > 99)
   {
   cleanem = 1;
   mask -= 100;
   }
else
   cleanem = 0;

if (mask > 5)
   {
   tcount = (int) strlen(dsc);
   mask -= 5;
   }
else
   tcount = 0; 


switch (mask)			/* sort out mask business, */
   {				/* set tcount as necessary */
   case 1:
   case 3:
   case 5:
    break;

   case 2:
    if (filty == 'T')
       total = 4;
    else
       total = 7;
    break;

   case 4:				/* pass DSClist */
    tcount = (int) strlen(dsc);
    if (tcount < 1) 			/* we need a descr name */
       goto end0;
    break;

   default:
    mask = 1;
   }


if (tcount > 0)				/* we got descriptors in DSClist */
   {		
   for (nr=0; nr<tcount; nr++)
      {
      if (dsc[nr] == ' ')	/* cut off trailing blanks (FORTRAN...) */
         {
         tcount = nr;
         if (tcount < 1) goto end_of_it;
         break;
         }
      }

   mm = CGN_INDEXC(dsc,'|');		/* do we have incl-patt|excl-patt? */
   if (mm > 1)				/* only considered for mask=4 ...  */
      {
      dscptr[0] = malloc((unsigned int)tcount);
      dscptr[1] = malloc((unsigned int)tcount);

      if (dsc[0] == '*')
         {
         if (dsc[mm-1] == '*')		/* we have 1. pattern  `*abc*'  */
            {
            patflag = 11;
            patlen = mm - 2;
            }
         else				/* we have 1. pattern  `*abc '  */
            {
            patflag = 12;
            patlen = mm - 1;
            }
         if (patlen < 1) goto patt_end;

         (void) CGN_UPCOPY(dscptr[0],dsc+1,patlen);  /* copy in upper case */
         *(dscptr[0]+patlen) = '\0';
         }
      else if (dsc[mm-1] == '*')	/* we have 1. pattern  ` abc*'  */
         {
         patflag = 13;
         patlen = mm - 1;
         if (patlen < 1) goto patt_end;
      
         (void) CGN_UPCOPY(dscptr[0],dsc,patlen);
         *(dscptr[0]+patlen) = '\0';
         }

      mm ++;					/* point to excl-pattern */
      if (dsc[mm] == '*')
         {
         if (dsc[tcount-1] == '*')	/* we have 2. pattern  `*abc*'  */
            {
            pat1flag = 1;
            pat1len = tcount - mm - 2;
            }
         else				/* we have 2. pattern  `*abc '  */
            {
            pat1flag = 2;
            pat1len = tcount - mm - 1;
            }
         if (pat1len < 1) goto patt_end;

         (void) CGN_UPCOPY(dscptr[1],dsc+mm+1,pat1len);
         *(dscptr[1]+pat1len) = '\0';
         }
      else if (dsc[tcount-1] == '*')	/* we have 2. pattern  ` abc*'  */
         {
         pat1flag = 3;
         pat1len = tcount - mm - 1;
         if (pat1len < 1) goto patt_end;
      
         (void) CGN_UPCOPY(dscptr[1],dsc,pat1len);
         *(dscptr[1]+pat1len) = '\0';
         }

      tcount = 2;			/* we use two pointers */
      goto do_FCB_stuff;

     patt_end:				/* problems, problems, ...  */
      free (dscptr[0]);
      free (dscptr[1]);
      goto end0;
      }
 

   if (dsc[0] == '*')
      {
      if (dsc[tcount-1] == '*')		/* we have a pattern  `*abc*'  */
         {
         patflag = 1;
         patlen = tcount - 2;
         }
      else				/* we have a pattern  `*abc '  */
         {
         patflag = 2;
         patlen = tcount - 1;
         }
      if (patlen < 1) goto end_of_it;
      dscptr[0] = malloc((unsigned int)(patlen+1));
      (void) CGN_UPCOPY(dscptr[0],dsc+1,patlen);  /* in uper case to 1. ptr */
      *(dscptr[0]+patlen) = '\0';
      tcount = 1;
      }

   else if (dsc[tcount-1] == '*')	/* we have a pattern  ` abc*'  */
      {
      patflag = 3;
      patlen = tcount - 1;
      if (patlen < 1) goto end_of_it;
      dscptr[0] = malloc((unsigned int)(patlen+1));
      (void) CGN_UPCOPY(dscptr[0],dsc,patlen);	/* in upper case to 1. ptr */
      *(dscptr[0]+patlen) = '\0';
      tcount = 1;
      }

   else
      {					/* list of up to 8 descrs' */
      dscptr[0] = malloc((unsigned int)(tcount+1));
      (void) CGN_UPCOPY(dscptr[0],dsc,tcount);	/* in upper case to 1. ptr */
      *(dscptr[0]+tcount) = '\0';

      cpt = dscptr[0];
      tcount = 1;			/* use as counter of dscptr[] */
      for (nr=1; nr<8; nr++)
         {
         mm = CGN_INDEXC(cpt,',');
         if (mm > 0)
            {
            *(dscptr[nr-1]+mm) = '\0';
            tcount++;
            cpt += (mm+1);
            dscptr[nr] = malloc((unsigned int)80);
            (void) CGN_UPCOPY(dscptr[nr],cpt,80);
            *(dscptr[nr]+79) = '\0';
            }
         }
      if (mask == 4) total = tcount;
      }
   }



do_FCB_stuff:
status = ERR_NORMAL;
fcbDFILLED = fcbp->DFILLED;
if (fcbp->DFILLED > fcbp->DIREXT)
   fcbDIREXT = fcbp->DFILLED;
else
   fcbDIREXT = fcbp->DIREXT;
fcbPTRLDB = fcbp->PTRLDB;
dirb2 = 2 * fcbp->DIRENTRY;
dirb3 = 3 * fcbp->DIRENTRY;


/* allocate working buffer for descr. directory */

if (mapdscdir < 0)                      /* allocate working buffer */
   {                                    /* for descr. directory */
   dscdir = malloc((unsigned int)fcbDIREXT);		/* at least 1500 */
   mapdscdir = 1;
   }
zdscpntr = (char *) &ZDSCDIR_ENTRY;


/*  main loop - read descriptor name + copy, if name o.k.  */


if (mask == 5)
   {
   register int  mr;

   (void) XSCDINF(fctto->IOCHAN,to,tcount,99,descr,10,&dsc_count);
   dtype[3] = '\0';
   status = SCDRDX(to,1,descr,dtype,&byt_elem,&no_elem,&hnc);
   dscbptr = malloc((unsigned int) (dsc_count*50));	/* holds all descrs */
   dpt = dscbptr;				    /* in destination frame */
   nval = dsc_count;

   for (mr=0; mr<nval; mr++)
      {
      status = SCDRDX(to,10,dpt,dtype,&byt_elem,&no_elem,&hnc);

      if (filty == 'T')			/* compare with descriptors which */
         {				/* are not copied */
         for (nr=0; nr<4; nr++)
            {
            if ((strcmp(dpt,tstand[nr]) == 0) || (strncmp(dpt,"TLABL",5) == 0))
               {
               dsc_count --;
               dpt -= 50;		/* overwrite dsc name again */
               break;
               }
            }
         }
      else
         {
         for (nr=0; nr<13; nr++)
            {
            if (strcmp(dpt,stand[nr]) == 0) 
               {
               dsc_count --;
               dpt -= 50;		/* overwrite dsc name again */
               break;
               }
            }	
         }

      dpt += 50;			/* for next dsc name */
      }

   status = SCDRDX(to,0,descr,dtype,&byt_elem,&no_elem,&hnc);	/* free space */
   }



diroff = 0;
nullo = -1;
dirlen = fcbDFILLED;

(void) MID_RDSCRC(chanl,fcbPTRLDB,0,1,dirlen,dscdir,&nullo);
cpt = dscdir;

if (*cpt == '2')		/* first read gives us descr. directory */
   dirbytes = dirb2;
else 
   dirbytes = dirb3;
cpt += dirbytes;  		/* skip descr. directory */
stuff_read = dirbytes;
dtype[1] = dtype[2] = ' '; dtype[3] = '\0';

read_next_entry:
if (stuff_read < dirlen)
   {
   if (*cpt == '2')
      dirbytes = dirb2;
   else if (*cpt == '3')
      dirbytes = dirb3;
   else 
      dirbytes = fcbp->DIRENTRY;

   stuff_read += dirbytes;
   if (*(cpt+1) != '_')              /* test if just fill_in block */
      {
      CGN_COPYALL(zdscpntr,cpt,dirbytes);	/* get directory entry */
      cpt += dirbytes; 
      dsclen = CGN_COPY(descr,ZDSC_PNTR->NAME);	/* exactly as in ZDSCDIR */
      dtype[0] = ZDSC_PNTR->TYPE;		/* FIND section */
      byt_elem = ZDSC_PNTR->BYTELEM;
      hno_elem = ZDSC_PNTR->HNOELEM;
      no_elem = ZDSC_PNTR->NOELEM;
      dunit = ZDSC_PNTR->UNIT;
      dblock = ZDSC_PNTR->START;
      dindx = (int) ZDSC_PNTR->INDEX -1;
      hblock = ZDSC_PNTR->HSTART;
      hindx = (int) ZDSC_PNTR->HINDEX -1;
      goto check_mask;
      }
   else
      {
      cpt += dirbytes; 
      goto read_next_entry;
      }
   }

goto end_of_it;					/* we're finished */
 



/*  if 'mask' = 4, compare descriptor with dscptr[0],[1],...  */

check_mask:
if (mask == 4) 
   {
   if (patflag != 0)		/* test for pattern match */
      {
      if (patflag == 3)
         {	
         if (strncmp(descr,dscptr[0],patlen) == 0) goto find_descr;
         }
      else if (patflag == 2)
         {
         mm = (int) strlen(descr) - patlen;
         if (mm > -1)
            {
            if (strcmp(descr+mm,dscptr[0]) == 0) goto find_descr;
            }
         }
      else if (patflag == 1)
         {
         if (CGN_INDEXS(descr,dscptr[0]) > -1) goto find_descr;
         }

      else
         {				/* patflag 11, 12, 13 */
         if (patflag == 13)
            {
            if (strncmp(descr,dscptr[0],patlen) == 0) goto test_excl_pat;
            }
         else if (patflag == 12)
            {
            mm = (int) strlen(descr) - patlen;
            if (mm > -1)
               {
               if (strcmp(descr+mm,dscptr[0]) == 0) goto test_excl_pat;
               }
            }
         else 
            {
            if (CGN_INDEXS(descr,dscptr[0]) > -1) goto test_excl_pat;
            }
         goto read_next_entry;		/* descr not in incl-pattern */
    
        test_excl_pat:
         if (pat1flag == 3)
            {
            if (strncmp(descr,dscptr[1],pat1len) == 0) goto read_next_entry;
            }
         else if (pat1flag == 2)
            {
            mm = (int) strlen(descr) - pat1len;
            if (mm > -1)
               {
               if (strcmp(descr+mm,dscptr[1]) == 0) goto read_next_entry;
               }
            }
         else 
            {
            if (CGN_INDEXS(descr,dscptr[1]) > -1) goto read_next_entry;
            }
         goto find_descr;		/* descr not in excl-pattern */
         }
      }

   else
      {
      for (nr=0; nr<tcount; nr++)
         {
         if (strcmp(dscptr[nr],descr) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   goto read_next_entry;
   }


/*  for all other options check for excluded descrs' */

if (patflag != 0)		/* test for pattern match */
   {
   if (patflag == 3)
      {	
      if (strncmp(descr,dscptr[0],patlen) == 0) goto read_next_entry;
      }
   else if (patflag == 2)
      {
      mm = (int) strlen(descr) - patlen;
      if (mm > -1)
         {
         if (strcmp(descr+mm,dscptr[0]) == 0) goto find_descr;
         }
      }
   else
      {
      if (CGN_INDEXS(descr,dscptr[0]) > -1) goto read_next_entry;
      }
   }

else
   {
   for (nr=0; nr<tcount; nr++)
      {
      if (strcmp(dscptr[nr],descr) == 0) goto read_next_entry;
      }
   }


/*  if mask = 2, compare descriptor with list of standard descriptors
    and only copy these  */

if (mask == 2)
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if (strcmp(descr,tstand[nr]) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   else
      {
      for (nr=0; nr<7; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   goto read_next_entry;
   }


/* mask = 3, compare descriptor with list of standard descriptors 
   to exclude them from copying */

if (mask == 3) 
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if ((strcmp(descr,tstand[nr]) == 0)  || 
             (strncmp(descr,"TLABL",5) == 0)) goto read_next_entry;
         }
      }
   else
      {
      for (nr=0; nr<7; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0) goto read_next_entry;
         }
      }
   }


/* if mask = 5, exclude descriptors of extended list of stand. descrs'
   from copying, and copy all others  */

if (mask == 5) 
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if ((strcmp(descr,tstand[nr]) == 0)  || 
             (strncmp(descr,"TLABL",5) == 0)) goto read_next_entry;
         }
      }
   else
      {
      for (nr=0; nr<13; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0) goto read_next_entry;
         }	
      }

   dsc_exist = 0;			/* check, if same dest.descr. exists */
   dpt = dscbptr;			/* start of dest. descr list */

   for (nr=0; nr<dsc_count; nr++)
      {
      if (strcmp(descr,dpt) == 0) 
         {
         dsc_exist = 1;
         break;
         }
      dpt += 50;
      }	
   }



find_descr:
nfr = 1;
ncleanem = cleanem;


data_loop:
nval = no_elem - nfr + 1;
nullo = -1;

if (dtype[0] == 'I')			/*  integer descriptor  */
   {
   if (nval > maxdim[0]) nval = maxdim[0];

   (void) MID_RDSCRI(chanl,dblock,dindx,nfr,nval,ibuf,&nullo);
   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi, ii;

         status = MID_ZDSCDIR(to,'F',descr,dsclen,dtype,&bby,&nno,
                              &ddu,&ddb,&ddi);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = nno - nval;
            ii = 0;
            (void) MID_WDSCRI(fctto->IOCHAN,ddb,ddi,&ii,1,nval+1,mm);
            }
         }
      status = SCDWRI(to,descr,ibuf,nfr,nval,&dunit);
      }
   else
      status = xSCDWRI(to,descr,ibuf,nfr,nval,&dunit);
   }

else if (dtype[0] == 'R') 		/* real descriptor  */
   {
   if (nval > maxdim[1]) nval = maxdim[1];

   (void) MID_RDSCRR(chanl,dblock,dindx,nfr,nval,rbuf,&nullo);
   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi;
         float  rr;

         status = MID_ZDSCDIR(to,'F',descr,dsclen,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = nno - nval;
            rr = 0.;
            (void) MID_WDSCRR(fctto->IOCHAN,ddb,ddi,&rr,1,nval+1,mm);
            }
         }
      status = SCDWRR(to,descr,rbuf,nfr,nval,&dunit);
      }
   else
      status = xSCDWRR(to,descr,rbuf,nfr,nval,&dunit);
   }

else if (dtype[0] == 'C')   		/*   character descriptor  */
   {
   if (byt_elem > 1)
      {
      mm = maxdim[2] / byt_elem;
      if (mm < 0)
         {
         (void) sprintf
         (cbuf,"bytes_per_element = %d > %d, descr %s not copied!",
          byt_elem,maxdim[2],descr);
         SCTPUT(cbuf);
         if (total > 0)
            goto read_next_entry;
         else
            goto end_of_it;
         }
      if (nval > mm) nval = mm;
      mm = nval*byt_elem;
      iav = (nfr-1)*byt_elem + 1;
      }
   else
      {
      if (nval > maxdim[2]) nval = maxdim[2];
      mm = nval;
      iav = nfr;
      }

   
   (void) MID_RDSCRC(chanl,dblock,dindx,iav,mm,cbuf,&nullo);
   cbuf[mm] = '\0';
   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi;
         char  cc;

         status = MID_ZDSCDIR(to,'F',descr,dsclen,dtype,&bby,&nno,
                              &ddu,&ddb,&ddi);
         ddu = 0;
         mm = bby * nno;
         if ((status == ERR_NORMAL) && (mm > (byt_elem*nval)))
            {
            bby = byt_elem * nval;
            mm -= bby;
            cc = ' ';
            (void) MID_WDSCRC(fctto->IOCHAN,ddb,ddi,&cc,1,bby+1,mm);
            }
         }
      status = SCDWRC(to,descr,byt_elem,cbuf,nfr,nval,&dunit);
      }
   else
      status = xSCDWRC(to,descr,byt_elem,cbuf,nfr,nval,&dunit);
   }

else					/*   double precision descriptor  */
   {
   if (nval > maxdim[3]) nval = maxdim[3];

   nr = DD_SIZE / II_SIZE;		/* we use integers for double descr */
   iav = (nfr-1)*nr + 1;		/* first element in double buf */
   mm = nval * nr;
   (void) MID_RDSCRI(chanl,dblock,dindx,iav,mm,ibuf,&nullo);

   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi, ii;

         status = MID_ZDSCDIR(to,'F',descr,dsclen,dtype,&bby,&nno,
                              &ddu,&ddb,&ddi);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = (nno - nval) * nr;
            bby = ((nval+1)*nr) - 1;
            ii = 0;
            (void) MID_WDSCRI(fctto->IOCHAN,ddb,ddi,&ii,1,bby,mm);
            }
         }
      status = SCDWRD(to,descr,dbuf,nfr,nval,&dunit);	/* ibuf <-> dbuf */
      }
   else
      status = xSCDWRD(to,descr,dbuf,nfr,nval,&dunit);	/* ibuf <-> dbuf */
   }

if (status != ERR_NORMAL) goto end_of_it;

   
if ((nval+nfr) <= no_elem)	/* test, if descriptor was copied completely */
   {
   nfr += nval;
   dsc_exist = 1;
   ncleanem = 0;
   goto data_loop;
   }


/* finally, look if help text exists for the descriptor we just copied */

   /* if ((hno_elem > 0) && (dsc_exist == 0)) */
if (hno_elem > 0) 
   {
   nullo = -1;
   (void) MID_RDSCRC(chanl,hblock,hindx,1,hno_elem,cbuf,&nullo);
   cbuf[hno_elem] = '\0';
   status = SCDWRH(to,descr,cbuf,1,hno_elem);
   if (status != ERR_NORMAL) goto end_of_it;
   }
else
   status = ERR_NORMAL;

if (total > 0) goto read_next_entry;

	

end_of_it:
if (mask == 5) free(dscbptr);
free(dscdir);
mapdscdir = -1;


end0:
ERRO_CONT = e_c;  ERRO_LOG = e_l;		/* reset error flags  */

if (tcount != 0)			/* free the `dscptr' allocations */
   {
   free(dscptr[0]);
   tcount --;
   nr = 1;
   while (tcount > 0)
      {
      free(dscptr[nr++]);
      tcount --;
      }
   }


if (status != ERR_NORMAL) MID_E2(8,from,descr,status,1);
return status;
}

/*

*/

int YSCDCOP(from,to,mask,dsc)
/*++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE
Copy descriptors from one frame to another
.ALGORITHM
Depending on 'mask' the relevant descriptors are read from
the source frame + written to the destination frame.
.REMARKS
mask for copying: = 1 , copy all descriptors
		  = 2 , copy only standard desc.
                  = 3 , copy all but standard descriptors
		  = 4 , copy descriptors specified by DSClist (max. 8) 
		  = 5 , copy all but extended list of standard descriptors

                  = 6 , copy all descriptors except descr specified by DSClist
                  = 7 , copy standard descriptors, except DSClist
                  = 8 , copy all but standard descriptors, except DSClist
                  = 10, copy all but extended list of standard descriptors,
                        except descr from.DSClist
		  = 100 + mask as described above indicates, that we want
		        to clear existing descr's completely before being
			overwritten with (shorter) source descr's
.RETURNS
return status  ( 0 = o.k. )
--------------------------------------------------*/

int   from;		/* IN: no. of source frame  */
int   to;		/* IN: no. of destination frame  */
int   mask;		/* IN: copy_mask  */
char  *dsc;		/* IN: DSClist = names of descr. to copy 
			       separated by comma */

{
int   iav, nval, nfr, no_elem, byt_elem, cleanem, ncleanem;
int   total, dblock, dindx, dunit, status, mm, e_c, e_l;
int   chanl, nullo, stuff_read, dsc_count, hnc, hno_elem, dsc_exist;
int   tcount, diroff, dirlen;
int   fcbDFILLED, fcbPTRLDB, fcbDIREXT;
int   patflag, patlen, pat1flag, pat1len, *ibuf;
register int  nr;
static int  mapdscdir = -1;

float *rbuf;
double *dbuf;

char  *cbuf, dtype[4], filty, descr[88], help[72], htxt[72];
char  *zdscpntr, *dscptr[8], *dscbptr;
register char  *cpt, *dpt;
static char  *dscdir;


struct FCT_STRUCT  *fctfrom, *fctto;

struct FCB_STRUCT  *fcbp;
 


 
fctfrom = FCT.ENTRIES + from;
fctto = FCT.ENTRIES + to;

filty = fctfrom->CATALOG[0];			/* get file type */
chanl = fctfrom->IOCHAN;
fcbp = fctfrom->FZP;


status = ERR_INPINV;
e_c = ERRO_CONT;   ERRO_CONT = 1;
e_l = ERRO_LOG;    ERRO_LOG = 0;

total = 1; 
patflag = 0;
dsc_exist = 1;				/* default => SCDWRz */
if (mask > 99)
   {
   cleanem = 1;
   mask -= 100;
   }
else
   cleanem = 0;

if (mask > 5)
   {
   tcount = (int) strlen(dsc);
   mask -= 5;
   }
else
   tcount = 0; 


switch (mask)			/* sort out mask business, */
   {				/* set tcount as necessary */
   case 1:
   case 3:
   case 5:
    break;

   case 2:
    if (filty == 'T')
       total = 4;
    else
       total = 7;
    break;

   case 4:				/* pass DSClist */
    tcount = (int) strlen(dsc);
    if (tcount < 1) 			/* we need a descr name */
       goto end0;
    break;

   default:
    mask = 1;
   }


if (tcount > 0)				/* we got descriptors in DSClist */
   {		
   for (nr=0; nr<tcount; nr++)
      {
      if (dsc[nr] == ' ')	/* cut off trailing blanks (FORTRAN...) */
         {
         tcount = nr;
         if (tcount < 1) goto end_of_it;
         break;
         }
      }

   mm = CGN_INDEXC(dsc,'|');		/* do we have incl-patt|excl-patt? */
   if (mm > 1)				/* only considered for mask=4 ...  */
      {
      dscptr[0] = malloc((unsigned int)tcount);
      dscptr[1] = malloc((unsigned int)tcount);

      if (dsc[0] == '*')
         {
         if (dsc[mm-1] == '*')		/* we have 1. pattern  `*abc*'  */
            {
            patflag = 11;
            patlen = mm - 2;
            }
         else				/* we have 1. pattern  `*abc '  */
            {
            patflag = 12;
            patlen = mm - 1;
            }
         if (patlen < 1) goto patt_end;

         (void) CGN_UPCOPY(dscptr[0],dsc+1,patlen);  /* copy in upper case */
         *(dscptr[0]+patlen) = '\0';
         }
      else if (dsc[mm-1] == '*')	/* we have 1. pattern  ` abc*'  */
         {
         patflag = 13;
         patlen = mm - 1;
         if (patlen < 1) goto patt_end;
      
         (void) CGN_UPCOPY(dscptr[0],dsc,patlen);
         *(dscptr[0]+patlen) = '\0';
         }

      mm ++;					/* point to excl-pattern */
      if (dsc[mm] == '*')
         {
         if (dsc[tcount-1] == '*')	/* we have 2. pattern  `*abc*'  */
            {
            pat1flag = 1;
            pat1len = tcount - mm - 2;
            }
         else				/* we have 2. pattern  `*abc '  */
            {
            pat1flag = 2;
            pat1len = tcount - mm - 1;
            }
         if (pat1len < 1) goto patt_end;

         (void) CGN_UPCOPY(dscptr[1],dsc+mm+1,pat1len);
         *(dscptr[1]+pat1len) = '\0';
         }
      else if (dsc[tcount-1] == '*')	/* we have 2. pattern  ` abc*'  */
         {
         pat1flag = 3;
         pat1len = tcount - mm - 1;
         if (pat1len < 1) goto patt_end;
      
         (void) CGN_UPCOPY(dscptr[1],dsc,pat1len);
         *(dscptr[1]+pat1len) = '\0';
         }

      tcount = 2;			/* we use two pointers */
      goto do_FCB_stuff;

     patt_end:				/* problems, problems, ...  */
      free (dscptr[0]);
      free (dscptr[1]);
      goto end0;
      }
 

   if (dsc[0] == '*')
      {
      if (dsc[tcount-1] == '*')		/* we have a pattern  `*abc*'  */
         {
         patflag = 1;
         patlen = tcount - 2;
         }
      else				/* we have a pattern  `*abc '  */
         {
         patflag = 2;
         patlen = tcount - 1;
         }
      if (patlen < 1) goto end_of_it;
      dscptr[0] = malloc((unsigned int)(patlen+1));
      (void) CGN_UPCOPY(dscptr[0],dsc+1,patlen);  /* in upper case to 1. ptr */
      *(dscptr[0]+patlen) = '\0';
      tcount = 1;
      }

   else if (dsc[tcount-1] == '*')	/* we have a pattern  ` abc*'  */
      {
      patflag = 3;
      patlen = tcount - 1;
      if (patlen < 1) goto end_of_it;
      dscptr[0] = malloc((unsigned int)(patlen+1));
      (void) CGN_UPCOPY(dscptr[0],dsc,patlen);	/* in upper case to 1. ptr */
      *(dscptr[0]+patlen) = '\0';
      tcount = 1;
      }

   else
      {					/* list of up to 8 descrs' */
      dscptr[0] = malloc((unsigned int)(tcount+1));
      (void) CGN_UPCOPY(dscptr[0],dsc,tcount);	/* in upper case to 1. ptr */
      *(dscptr[0]+tcount) = '\0';

      cpt = dscptr[0];
      tcount = 1;			/* use as counter of dscptr[] */
      for (nr=1; nr<8; nr++)
         {
         mm = CGN_INDEXC(cpt,',');
         if (mm > 0)
            {
            *(dscptr[nr-1]+mm) = '\0';
            tcount++;
            cpt += (mm+1);
            dscptr[nr] = malloc((unsigned int)80);
            (void) CGN_UPCOPY(dscptr[nr],cpt,80);
            *(dscptr[nr]+79) = '\0';
            }
         }
      if (mask == 4) total = tcount;
      }
   }



do_FCB_stuff:
status = ERR_NORMAL;
fcbDFILLED = fcbp->DFILLED;
if (fcbp->DFILLED > fcbp->DIREXT)
   fcbDIREXT = fcbp->DFILLED;
else
   fcbDIREXT = fcbp->DIREXT;
fcbPTRLDB = fcbp->PTRLDB;


/* allocate working buffer for descr. directory and data */

if (mapdscdir < 0)                      /* buffer for descr. directory */
   {     
   dscdir = (char *) malloc((unsigned int)fcbDIREXT);		

   /*
   printf("we just allocated %d bytes for mapdscdir, pointer = %x\n",
   fcbDIREXT,dscdir);
   */

   mapdscdir = 1;				/* at least 2500 */
   }
zdscpntr = (char *) &YDSCDIR_ENTRY;

if (mapdat < 0)                         /* buffer for descr. data */
   {       
   datpntr = malloc((unsigned int)DATA_CSIZE);

   /*
   printf("we just allocated %d bytesfor mapdata, pointer = %x\n",
   DATA_CSIZE,datpntr);
   */

   mapdat = 1;
   }

cbuf = datpntr;
ibuf = (int *) datpntr;
rbuf = (float *) datpntr;
dbuf = (double *) datpntr;



/*  main loop - read descriptor name + copy, if name o.k.  */


if (mask == 5)
   {
   register int  mr;

   (void) XSCDINF(fctto->IOCHAN,to,tcount,99,descr,10,&dsc_count);
   dtype[3] = '\0';
   status = SCDRDX(to,1,descr,dtype,&byt_elem,&no_elem,&hnc);
   dscbptr = malloc((unsigned int) (dsc_count*50));	/* holds all descrs */
   dpt = dscbptr;				    /* in destination frame */
   nval = dsc_count;

   for (mr=0; mr<nval; mr++)
      {
      status = SCDRDX(to,10,dpt,dtype,&byt_elem,&no_elem,&hnc);

      if (filty == 'T')			/* compare with descriptors which */
         {				/* are not copied */
         for (nr=0; nr<4; nr++)
            {
            if ((strcmp(dpt,tstand[nr]) == 0) || (strncmp(dpt,"TLABL",5) == 0))
               {
               dsc_count --;
               dpt -= 50;		/* overwrite dsc name again */
               break;
               }
            }
         }
      else
         {
         for (nr=0; nr<13; nr++)
            {
            if (strcmp(dpt,stand[nr]) == 0) 
               {
               dsc_count --;
               dpt -= 50;		/* overwrite dsc name again */
               break;
               }
            }	
         }

      dpt += 50;			/* for next dsc name */
      }

   status = SCDRDX(to,0,descr,dtype,&byt_elem,&no_elem,&hnc);	/* free space */
   }



diroff = 0;
nullo = -1;
dirlen = fcbDFILLED;

(void) MID_RDSCRC(chanl,fcbPTRLDB,0,1,dirlen,dscdir,&nullo);
cpt = dscdir;			/* first read gives us descr. directory */
cpt += fcbp->DIRENTRY;  		/* skip descr. directory */
stuff_read = fcbp->DIRENTRY;
dtype[1] = dtype[2] = ' '; dtype[3] = '\0';

read_next_entry:
if (stuff_read < dirlen)
   {
   stuff_read += fcbp->DIRENTRY;
   if (*cpt != '\0')  
      {						/* get a dir. entry */
      (void) memcpy(zdscpntr,cpt,(size_t)fcbp->DIRENTRY);
      cpt += fcbp->DIRENTRY; 

      (void) memcpy(descr,YDSC_PNTR->NAMESTR,(size_t)(YDSC_PNTR->NAMELEN+1));
      dtype[0] = YDSC_PNTR->TYPE;	
      byt_elem = (int) YDSC_PNTR->BYTELEM;
      hno_elem = (int) YDSC_PNTR->HELPLEN;
      if (hno_elem > 0)
         {
         mm = YDSC_PNTR->NAMELEN + 1;		/* offset of help string */
         (void) memcpy(htxt,YDSC_PNTR->NAMESTR+mm,(size_t)(hno_elem+1));
         }
      else
         htxt[0] = '\0';
      dunit = (int) YDSC_PNTR->UNIT;
      no_elem = YDSC_PNTR->NOELEM;
      dblock = YDSC_PNTR->START;
      dindx =  YDSC_PNTR->INDEX -1;
      /*
      printf("descr: %s, dblock = %d, dindx = %d, noelem = %d\n",
      YDSC_PNTR->NAMESTR, dblock,dindx,no_elem);
      */

      goto check_mask;
      }
   else
      {
      cpt += fcbp->DIRENTRY; 
      goto read_next_entry;
      }
   }

goto end_of_it;					/* we're finished */
 



/*  if 'mask' = 4, compare descriptor with dscptr[0],[1],...  */

check_mask:
if (mask == 4) 
   {
   if (patflag != 0)		/* test for pattern match */
      {
      if (patflag == 3)
         {	
         if (strncmp(descr,dscptr[0],patlen) == 0) goto find_descr;
         }
      else if (patflag == 2)
         {
         mm = (int) strlen(descr) - patlen;
         if (mm > -1)
            {
            if (strcmp(descr+mm,dscptr[0]) == 0) goto find_descr;
            }
         }
      else if (patflag == 1)
         {
         if (CGN_INDEXS(descr,dscptr[0]) > -1) goto find_descr;
         }

      else
         {				/* patflag 11, 12, 13 */
         if (patflag == 13)
            {
            if (strncmp(descr,dscptr[0],patlen) == 0) goto test_excl_pat;
            }
         else if (patflag == 12)
            {
            mm = (int) strlen(descr) - patlen;
            if (mm > -1)
               {
               if (strcmp(descr+mm,dscptr[0]) == 0) goto test_excl_pat;
               }
            }
         else 
            {
            if (CGN_INDEXS(descr,dscptr[0]) > -1) goto test_excl_pat;
            }
         goto read_next_entry;		/* descr not in incl-pattern */
    
        test_excl_pat:
         if (pat1flag == 3)
            {
            if (strncmp(descr,dscptr[1],pat1len) == 0) goto read_next_entry;
            }
         else if (pat1flag == 2)
            {
            mm = (int) strlen(descr) - pat1len;
            if (mm > -1)
               {
               if (strcmp(descr+mm,dscptr[1]) == 0) goto read_next_entry;
               }
            }
         else 
            {
            if (CGN_INDEXS(descr,dscptr[1]) > -1) goto read_next_entry;
            }
         goto find_descr;		/* descr not in excl-pattern */
         }
      }

   else
      {
      for (nr=0; nr<tcount; nr++)
         {
         if (strcmp(dscptr[nr],descr) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   goto read_next_entry;
   }


/*  for all other options check for excluded descrs' */

if (patflag != 0)		/* test for pattern match */
   {
   if (patflag == 3)
      {	
      if (strncmp(descr,dscptr[0],patlen) == 0) goto read_next_entry;
      }
   else if (patflag == 2)
      {
      mm = (int) strlen(descr) - patlen;
      if (mm > -1)
         {
         if (strcmp(descr+mm,dscptr[0]) == 0) goto find_descr;
         }
      }
   else
      {
      if (CGN_INDEXS(descr,dscptr[0]) > -1) goto read_next_entry;
      }
   }

else
   {
   for (nr=0; nr<tcount; nr++)
      {
      if (strcmp(dscptr[nr],descr) == 0) goto read_next_entry;
      }
   }


/*  if mask = 2, compare descriptor with list of standard descriptors
    and only copy these  */

if (mask == 2)
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if (strcmp(descr,tstand[nr]) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   else
      {
      for (nr=0; nr<7; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0)
            {
            total --;
            goto find_descr;
            }
         }
      }
   goto read_next_entry;
   }


/* mask = 3, compare descriptor with list of standard descriptors 
   to exclude them from copying */

if (mask == 3) 
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if ((strcmp(descr,tstand[nr]) == 0)  || 
             (strncmp(descr,"TLABL",5) == 0)) goto read_next_entry;
         }
      }
   else
      {
      for (nr=0; nr<7; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0) goto read_next_entry;
         }
      }
   }


/* if mask = 5, exclude descriptors of extended list of stand. descrs'
   from copying, and copy all others  */

if (mask == 5) 
   {
   if (filty == 'T')
      {
      for (nr=0; nr<4; nr++)
         {
         if ((strcmp(descr,tstand[nr]) == 0)  || 
             (strncmp(descr,"TLABL",5) == 0)) goto read_next_entry;
         }
      }
   else
      {
      for (nr=0; nr<13; nr++)
         {
         if (strcmp(descr,stand[nr]) == 0) goto read_next_entry;
         }	
      }

   dsc_exist = 0;			/* check, if same dest.descr. exists */
   dpt = dscbptr;			/* start of dest. descr list */

   for (nr=0; nr<dsc_count; nr++)
      {
      if (strcmp(descr,dpt) == 0) 
         {
         dsc_exist = 1;
         break;
         }
      dpt += 50;
      }	
   }



find_descr:
nfr = 1;
ncleanem = cleanem;



data_loop:
nval = no_elem - nfr + 1;
nullo = -1;

if (dtype[0] == 'I')			/*  integer descriptor  */
   {
   if (nval > maxdim[0]) nval = maxdim[0];

   (void) MID_RDSCRI(chanl,dblock,dindx,nfr,nval,ibuf,&nullo);
   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi, ii;
         char  realdescr[52];

         (void) DSCNAM_COPY(realdescr,descr);  /* build uppercase name */
         status = MID_YDSCDIR(to,'F',realdescr,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi,help);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = nno - nval;
            ii = 0;
            (void) MID_WDSCRI(fctto->IOCHAN,ddb,ddi,&ii,1,nval+1,mm);
            }
         }
      status = SCDHWI(to,descr,ibuf,nfr,nval,&dunit,htxt);
      }
   else
      status = xSCDHWI(to,descr,ibuf,nfr,nval,&dunit,htxt);
   }

else if (dtype[0] == 'R') 		/* real descriptor  */
   {
   if (nval > maxdim[1]) nval = maxdim[1];

   (void) MID_RDSCRR(chanl,dblock,dindx,nfr,nval,rbuf,&nullo);
   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi;
         float  rr;
         char  realdescr[52];

         (void) DSCNAM_COPY(realdescr,descr);  /* build uppercase name */
         status = MID_YDSCDIR(to,'F',realdescr,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi,help);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = nno - nval;
            rr = 0.;
            (void) MID_WDSCRR(fctto->IOCHAN,ddb,ddi,&rr,1,nval+1,mm);
            }
         }
      status = SCDHWR(to,descr,rbuf,nfr,nval,&dunit,htxt);
      }
   else
      status = xSCDHWR(to,descr,rbuf,nfr,nval,&dunit,htxt);
   }

else if (dtype[0] == 'C')   		/*   character descriptor  */
   {
   if (byt_elem > 1)
      {
      mm = maxdim[2] / byt_elem;
      if (mm < 0)
         {
         (void) sprintf
         (cbuf,"bytes_per_element = %d > %d, descr %s not copied!",
          byt_elem,maxdim[2],descr);
         SCTPUT(cbuf);
         if (total > 0)
            goto read_next_entry;
         else
            goto end_of_it;
         }
      if (nval > mm) nval = mm;
      mm = nval*byt_elem;
      iav = (nfr-1)*byt_elem + 1;
      }
   else
      {
      if (nval > maxdim[2]) nval = maxdim[2];
      mm = nval;
      iav = nfr;
      }

   
   (void) MID_RDSCRC(chanl,dblock,dindx,iav,mm,cbuf,&nullo);
   cbuf[mm] = '\0';

   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi;
         char  realdescr[52];
         char  cc;

         (void) DSCNAM_COPY(realdescr,descr);  /* build uppercase name */
         status = MID_YDSCDIR(to,'F',realdescr,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi,help);
         ddu = 0;
         mm = bby * nno;
         if ((status == ERR_NORMAL) && (mm > (byt_elem*nval)))
            {
            bby = byt_elem * nval;
            mm -= bby;
            cc = ' ';
            (void) MID_WDSCRC(fctto->IOCHAN,ddb,ddi,&cc,1,bby+1,mm);
            }
         }
      status = SCDHWC(to,descr,byt_elem,cbuf,nfr,nval,&dunit,htxt);
      }
   else
      status = xSCDHWC(to,descr,byt_elem,cbuf,nfr,nval,&dunit,htxt);
   }

else if (dtype[0] == 'D')		/*   double precision descriptor  */
   {
   if (nval > maxdim[3]) nval = maxdim[3];

   nr = DD_SIZE / II_SIZE;		/* we use integers for double descr */
   iav = (nfr-1)*nr + 1;		/* first element in double buf */
   mm = nval * nr;
   (void) MID_RDSCRI(chanl,dblock,dindx,iav,mm,ibuf,&nullo);

   if (dsc_exist == 1)
      {
      if (ncleanem == 1) 		/* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi, ii;
         char  realdescr[52];

         (void) DSCNAM_COPY(realdescr,descr);  /* build uppercase name */
         status = MID_YDSCDIR(to,'F',realdescr,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi,help);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = (nno - nval) * nr;
            bby = ((nval+1)*nr) - 1;
            ii = 0;
            (void) MID_WDSCRI(fctto->IOCHAN,ddb,ddi,&ii,1,bby,mm);
            }
         }
      status = SCDHWD(to,descr,dbuf,nfr,nval,&dunit,htxt);
      }
   else
      status = xSCDHWD(to,descr,dbuf,nfr,nval,&dunit,htxt);
   }

else 					/*  remains logical descriptor  */
   {
   if (nval > maxdim[0]) nval = maxdim[0];

   (void) MID_RDSCRI(chanl,dblock,dindx,nfr,nval,ibuf,&nullo);
   if (dsc_exist == 1)
      {
      if (ncleanem == 1)                /* see, if dest. descr. bigger */
         {
         int  bby, nno, ddu, ddb, ddi, ii;
         char  realdescr[52];

         (void) DSCNAM_COPY(realdescr,descr);  /* build uppercase name */
         status = MID_YDSCDIR(to,'F',realdescr,dtype,&bby,&nno,&ddu,
                              &ddb,&ddi,help);
         ddu = 0;
         if ((status == ERR_NORMAL) && (nno > nval))
            {
            mm = nno - nval;
            ii = 0;
            (void) MID_WDSCRI(fctto->IOCHAN,ddb,ddi,&ii,1,nval+1,mm);
            }
         }
      status = SCDHWL(to,descr,ibuf,nfr,nval,&dunit,htxt);
      }
   else
      status = xSCDHWL(to,descr,ibuf,nfr,nval,&dunit,htxt);
   }

if (status != ERR_NORMAL) goto end_of_it;

   
if ((nval+nfr) <= no_elem)	/* test, if descriptor was copied completely */
   {
   nfr += nval;
   dsc_exist = 1;
   ncleanem = 0;
   goto data_loop;
   }


if (total > 0) goto read_next_entry;

	

end_of_it:
if (mask == 5) free(dscbptr);
free(dscdir);
mapdscdir = -1;


end0:
ERRO_CONT = e_c;  ERRO_LOG = e_l;		/* reset error flags  */

if (tcount != 0)			/* free the `dscptr' allocations */
   {
   free(dscptr[0]);
   tcount --;
   nr = 1;
   while (tcount > 0)
      {
      free(dscptr[nr++]);
      tcount --;
      }
   }


if (status != ERR_NORMAL) MID_E2(8,from,descr,status,1);
return status;
}