/* 
 * Copyright 1987 by William Toth, Harvard-Smithsonian Center for Astrophysics, Cambridge, Massachusetts  02138.
 * Do not modify this code without clearly identifying each deletion, addition, or change.
 */ 

#include <ctype.h>
#include <stdio.h>
#include <strings.h>

extern char *blstruct();
extern char *date();
extern char *detectors();
extern char *idstring();
extern char *site();
extern long aeng1_();
extern long aeng2_();
extern long aid_();
extern long aidstr_();
extern long aline_();
extern long aload_();
extern long arast_();
extern long aspect_();
extern long data();
extern long header();
extern unsigned long checksum();
extern unsigned long lswab();
extern void consis();
extern void conv1();
extern void conv2();
extern void conv3();
extern void init();
extern void machdep();
extern void seedoc();
extern void termin();

#define NBID 1
#define NBENG1 3
#define NBENG2 24
#define NBLINE 30
#define NBRAST 28
#define NBSPECT 21
#define IID 180
#define IENG1 4860
#define VIENG1 (121 * 40)
#define IENG2 3360
#define ILINE 4620
#define IRAST 4950
#define ISPECT 5010
#define OID 18
#define OENG1 (121 * 13)
#define OENG2 (336 * 4)
#define OLINE (132 * 14)
#define ORAST (132 * 15)
#define OSPECT (501 * 4)
#define MAXID (IID * NBID)
#define MAXENG1 (IENG1 * NBENG1)
#define MAXENG2 (IENG2 * NBENG2)
#define MAXLINE (ILINE * NBLINE)
#define MAXRAST (IRAST * NBRAST)
#define MAXSPECT (ISPECT * NBSPECT)
#define MAXSCIEN MAXRAST    /* MAXRAST == MAXLINE == 138600 > 105210 == MAXSPECT */

static char id[MAXID];
static char eng1[MAXENG1];
static char eng2[MAXENG2];
static char scien[MAXSCIEN];
static long nbid;
static long nbeng1;
static long nbeng2;
static long nbline;
static long nbrast;
static long nbspect;
static long nbtotal;
static long ncid;
static long nceng1;
static long nceng2;
static long ncline;
static long ncrast;
static long ncspect;
static long nctotal;
static long endian;

static long idlocal[OID];








long aload_(filename)
char *filename;
   {
   FILE *pfile;
   long nchars;
   long check;
   long ndata;

   init();
   termin(filename);
   fprintf(stderr, "opening file %s\n", filename);
   if ((pfile = fopen(filename, "r")) == NULL)
       {
       fprintf(stderr, "failed to open file |%s|\n", filename);
       return(-1);
       }
   machdep(pfile);
   while(0 < header(pfile, &nchars, &check))
       {
       ndata = 0;
       switch (nchars)
           {
           case IID:
               if (IID > MAXID - ncid)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", IID, MAXID - ncid);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               ncid += (ndata = data(pfile, &id[ncid], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbid, ++nbtotal, check);
               break;
           case IENG1:
               if (IENG1 > MAXENG1 - nceng1)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", IENG1, MAXENG1 - nceng1);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               nceng1 += (ndata = data(pfile, &eng1[nceng1], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbeng1, ++nbtotal, check);
               break;
           case IENG2:
               if (IENG2 > MAXENG2 - nceng2)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", IENG2, MAXENG2 - nceng2);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               nceng2 += (ndata = data(pfile, &eng2[nceng2], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbeng2, ++nbtotal, check);
               break;
           case ILINE:
               if (ILINE > MAXLINE - ncline)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", ILINE, MAXLINE - ncline);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               ncline += (ndata = data(pfile, &scien[ncline], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbline, ++nbtotal, check);
               break;
           case IRAST:
               if (IRAST > MAXRAST - ncrast)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", IRAST, MAXRAST - ncrast);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               ncrast += (ndata = data(pfile, &scien[ncrast], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbrast, ++nbtotal, check);
               break;
           case ISPECT:
               if (ISPECT > MAXSPECT - ncspect)
                   {
                   fprintf(stderr, "aborted load of %d bytes into hidden array having space for %d\n", ISPECT, MAXSPECT - ncspect);
                   fprintf(stderr, "this should be impossible\n");
                   break;
                   }
               ncspect += (ndata = data(pfile, &scien[ncspect], nchars, check));
               fprintf(stderr, "%4d %2d %2d %6d\n", ndata, ++nbspect, ++nbtotal, check);
               break;
           default:
               fprintf(stderr, "unclassifiable value %d for block size\n", nchars);
               seedoc("30");
               break;
           }
       nctotal += (ndata + sizeof(nchars) + sizeof(check));
       }
   consis();
   fprintf(stderr, "closing file %s\n", filename);
   (void) fclose(pfile);
   return(nctotal);
   }












long aidstr_(string)
register char *string;
   {
   (void) strcpy(string, idstring());
   return(strlen(string));
   }










long aid_(words)
register long *words;
   {
   long dummy;
   register long i;
   register long j;

   if (ncid != MAXID)
       {
       fprintf(stderr, "the number of packed id bytes, %d, is not %d\n", ncid, MAXID);
       seedoc("30");
       }
   for (i = 0, j = 0; i < ncid; i += 10, j++)
       {
       if (j > OID * NBID)
           {
           fprintf(stderr, "aborted attempt to produce more than %d id integer values\n", OID * NBID);
           seedoc("30");
           continue;
           }
       conv1(&id[i + 0], &dummy);
       if (dummy != 0)
           {
           fprintf(stderr, "non-zero high order 30 bits of %d-th original 60-bit id word\n", j + 1);
           seedoc("30");
           }
       conv1(&id[i + 5], &words[j + 0]);
       }
   if (j != OID * NBID)
       {
       fprintf(stderr, "the return value of aid, %d, is not %d\n", j, OID * NBID);
       seedoc("30");
       }
   return(j);
   }







long aeng1_(words)
register long *words;
   {
   register long i;
   register long j;
   register long k;
   register long ktemp;
   long nfill;
   long dummy;

   if (nceng1 % IENG1 != 0)
       {
       fprintf(stderr, "the number of packed ENG1 bytes, %d, is not a multiple of %d\n", nceng1, IENG1);
       seedoc("31");
       }
   k = 0;
   ktemp = 0;
   nfill = 0;
   for (i = 0; i < nceng1; i += IENG1)
       {
       for (j = i, k = ktemp; j < i + VIENG1; j += 40, k += 13)
           {
           if (k > OENG1 * NBENG1)
               {
               fprintf(stderr, "aborted attempt to produce more than %d ENG1 integer values\n", OENG1 * NBENG1);
               seedoc("31");
               continue;
               }
           conv1(&eng1[j + 0], &dummy);
           if (dummy == 0x3fffffff)
               {
               nfill++;
               }
           else if (dummy != 0)
               {
               fprintf(stderr, "non-zero non-fill data in high-order 30 bits of %d-th original ENG1 60-bit value %10d (10) %08x (16)\n", k + 1, dummy, dummy);
               fprintf(stderr, "this should be impossible\n");
               }
           conv1(&eng1[j +  5], &words[k +  0]);
           conv2(&eng1[j + 10], &words[k +  1]);
           conv2(&eng1[j + 15], &words[k +  3]);
           conv2(&eng1[j + 20], &words[k +  5]);
           conv2(&eng1[j + 25], &words[k +  7]);
           conv2(&eng1[j + 30], &words[k +  9]);
           conv2(&eng1[j + 35], &words[k + 11]);
           }
       ktemp = k;
       }
   if (nfill > 0)
       {
       fprintf(stderr, "%d instances of non-zero fill data in high-order 30 bits of an original ENG1 60-bit value\n", nfill);
       }
   if (k == 0)
       {
       fprintf(stderr, "no eng1 data\n");
       seedoc("30");
       }
   else if (k % OENG1 != 0)
       {
       fprintf(stderr, "the return value of aeng1, %d, is not a multiple of %d\n", k, OENG1);
       seedoc("31");
       }
   return(k);
   }










long aeng2_(words)
register long *words;
   {
   register long i;
   register long j;

   if (nceng2 % IENG2 != 0)
       {
       fprintf(stderr, "the number of packed ENG2 bytes, %d, is not a multiple of %d\n", nceng2, IENG2);
       seedoc("36");
       }
   for (i = 0, j = 0; i < nceng2; i += 10, j += 4)
       {
       if (j > OENG2 * NBENG2)
           {
           fprintf(stderr, "aborted attempt to produce more than %d ENG2 integer values\n", OENG2 * NBENG2);
           seedoc("36");
           continue;
           }
       conv1(&eng2[i + 0], &words[j + 0]);
       conv3(&eng2[i + 5], &words[j + 1]);
       }
   if (j == 0)
       {
       fprintf(stderr, "no eng2 data\n");
       seedoc("30");
       }
   else if (j % OENG2 != 0)
       {
       fprintf(stderr, "the return value of aeng2, %d, is not a multiple of %d\n", j, OENG2);
       seedoc("36");
       }
   return(j);
   }












long aline_(words)
register long *words;
   {
   register long i;
   register long j;

   if (ncline % ILINE != 0)
       {
       fprintf(stderr, "the number of packed line scan data bytes, %d, is not a multiple of %d\n", ncline, ILINE);
       seedoc("39");
       }
   for (i = 0, j = 0; i < ncline; i += 5, j += 2)
       {
       if (j > OLINE * NBLINE)
           {
           fprintf(stderr, "aborted attempt to produce more than %d line scan integer values\n", OLINE * NBLINE);
           seedoc("39");
           continue;
           }
       conv2(&scien[i], &words[j]);
       }
   if (j == 0)
       {
       fprintf(stderr, "no line scan data\n");
       }
   else if (j % OLINE != 0)
       {
       fprintf(stderr, "the return value of aline, %d, is not a multiple of %d\n", j, OLINE);
       seedoc("39");
       }
   return(j);
   }








long arast_(words)
register long *words;
   {
   register long i;
   register long j;

   if (ncrast % IRAST != 0)
       {
       fprintf(stderr, "the number of packed raster data bytes, %d, is not a multiple of %d\n", ncrast, IRAST);
       seedoc("38");
       }
   for (i = 0, j = 0; i < ncrast; i += 5, j += 2)
       {
       if (j > ORAST * NBRAST)
           {
           fprintf(stderr, "aborted attempt to produce more than %d raster integer values\n", ORAST * NBRAST);
           seedoc("38");
           continue;
           }
       conv2(&scien[i + 0], &words[j + 0]);
       }
   if (j == 0)
       {
       fprintf(stderr, "no raster data\n");
       }
   else if (j % ORAST != 0)
       {
       fprintf(stderr, "the return value of arast, %d, is not a multiple of %d\n", j, ORAST);
       seedoc("38");
       }
   return(j);
   }














long aspect_(words)
register long *words;
   {
   register long i;
   register long j;

   if (ncspect % ISPECT != 0)
       {
       fprintf(stderr, "the number of packed spectral data bytes, %d, is not a multiple of %d\n", ncspect, ISPECT);
       seedoc("37");
       }
   for (i = 0, j = 0; i < ncspect; i += 5, j += 2)
       {
       if (j > OSPECT * NBSPECT)
           {
           fprintf(stderr, "aborted attempt to produce more than %d spectral integer values\n", OSPECT * NBSPECT);
           seedoc("37");
           continue;
           }
       conv2(&scien[i + 0], &words[j + 0]);
       }
   if (j == 0)
       {
       fprintf(stderr, "no spectral data\n");
       }
   else if (j % OSPECT != 0)
       {
       fprintf(stderr, "the return value of aline, %d, is not a multiple of %d\n", j, OSPECT);
       seedoc("37");
       }
   return(j);
   }








void init()
   {
   nbid = 0;
   nbeng1 = 0;
   nbeng2 = 0;
   nbline = 0;
   nbrast = 0;
   nbspect = 0;
   nbtotal = 0;
   ncid = 0;
   nceng1 = 0;
   nceng2 = 0;
   ncline = 0;
   ncrast = 0;
   ncspect = 0;
   nctotal = 0;
   }











void consis()
   {
   (void) aid_(&idlocal[0]);
   fprintf(stderr, "|%s|\n", idstring());
   if (nbid != NBID)
       {
       fprintf(stderr, "id block count is %d, not %d\n", nbid, NBID);
       seedoc("30");
       }
   /* i/o errors in data() could give rise to condition that NBENG1 >= nbeng1 even if IENG1 <= MAXENG1 - nceng1 in aload() */
   if (nbeng1 < 1 || NBENG1 < nbeng1)
       {
       fprintf(stderr, "ENG1 block count is %d, not within range 1 to %d\n", nbeng1, NBENG1);
       seedoc("30");
       }
   if (nbeng2 < 1 || NBENG2 < nbeng2)
       {
       fprintf(stderr, "ENG2 block count is %d, not within range 1 to %d\n", nbeng2, NBENG2);
       seedoc("30");
       }
   if (nbline < 0 || NBLINE < nbline)
       {
       fprintf(stderr, "line scan data block count is %d, not within range 0 to %d\n", nbline, NBLINE);
       seedoc("30");
       }
   if (nbrast < 0 || NBRAST < nbrast)
       {
       fprintf(stderr, "raster data block count is %d, not within range 0 to %d\n", nbrast, NBRAST);
       seedoc("30");
       }
   if (nbspect < 0 || NBSPECT < nbspect)
       {
       fprintf(stderr, "spectral data block count is %d, not within range 0 to %d\n", NBSPECT);
       seedoc("30");
       }
   if ((nbeng1 + nbeng2) != idlocal[14])
       {
       fprintf(stderr, "id data calls for %d engineering blocks\n", idlocal[14]);
       fprintf(stderr, "actually found %d ENG1 and %d ENG2 blocks\n", nbeng1, nbeng2);
       seedoc("32");
       }
   if (nbline + nbrast + nbspect != idlocal[15])
       {
       fprintf(stderr, "id data calls for %d blocks of scientific data\n", idlocal[15]);
       fprintf(stderr, "actually found %d line scan, %d raster, and %d spectral data blocks\n", nbline, nbrast, nbspect);
       fprintf(stderr, "this should be impossible--assume the scientific data is corrupted\n");
       }
   if (((nbline > 0 ? 1 : 0) + (nbrast > 0 ? 1 : 0) + (nbspect > 0 ? 1 : 0) != 1) ||
       ((ncline > 0 ? 1 : 0) + (ncrast > 0 ? 1 : 0) + (ncspect > 0 ? 1 : 0) != 1))
       {
       fprintf(stderr, "scientific data in this file is not of a unique kind (line scan, raster, spectral)\n");
       fprintf(stderr, "this should be impossible--assume the scientific data is corrupted\n");
       }
   }










void seedoc(page)
register char *page;
   {
   fprintf(stderr, "this should be impossible--see p. %s of SO55/ATM Scientific User Tape Guide by Henry T. Wadzinski\n", page);
   }







void termin(string)
char *string;
   {
   while(isgraph(*string++))
       ;
   *(string - 1) = '\0';
   }







void conv1(bytes, word)
register char *bytes;
register long *word;
   {
   *word = 0;
   *word |= ((*(bytes + 0) & 0x3f) << 24);
   *word |= ((*(bytes + 1) & 0x3f) << 18);
   *word |= ((*(bytes + 2) & 0x3f) << 12);
   *word |= ((*(bytes + 3) & 0x3f) <<  6);
   *word |= ((*(bytes + 4) & 0x3f) <<  0);
   }






void conv2(bytes, words)
register char *bytes;
register long *words;
   {
   *(words + 0) = 0;
   *(words + 0) |= ((*(bytes + 0) & 0x3f) <<  9);
   *(words + 0) |= ((*(bytes + 1) & 0x3f) <<  3);
   *(words + 0) |= ((*(bytes + 2) & 0x38) >>  3);
   *(words + 1) = 0;
   *(words + 1) |= ((*(bytes + 2) & 0x07) << 12);
   *(words + 1) |= ((*(bytes + 3) & 0x3f) <<  6);
   *(words + 1) |= ((*(bytes + 4) & 0x3f) <<  0);
   }







void conv3(bytes, words)
register char *bytes;
register long *words;
   {
   *(words + 0) = 0;
   *(words + 0) |= ((*(bytes + 0) & 0x3f) << 4);
   *(words + 0) |= ((*(bytes + 1) & 0x3c) >> 2);
   *(words + 1) = 0;
   *(words + 1) |= ((*(bytes + 1) & 0x03) << 8);
   *(words + 1) |= ((*(bytes + 2) & 0x3f) << 2);
   *(words + 1) |= ((*(bytes + 3) & 0x30) >> 4);
   *(words + 2) = 0;
   *(words + 2) |= ((*(bytes + 3) & 0x0f) << 6);
   *(words + 2) |= ((*(bytes + 4) & 0x3f) << 0);
   }







long header(pfile, nchars, check)
FILE *pfile;
long *nchars;
long *check;
   {
   *nchars = getw(pfile);
   if (feof(pfile) != 0)
       {
       return(0);
       }
   if (ferror(pfile) != 0)
       {
       fprintf(stderr, "error on attempt to read checksum value\n");
       clearerr(pfile);
       return(-1);
       }
   *nchars = lswab((unsigned long) *nchars);
   *check = getw(pfile);
   if (feof(pfile) != 0)
       {
       fprintf(stderr, "eof on attempt to read checksum value\n");
       fprintf(stderr, "this should be impossible\n");
       return(-1);
       }
   if (ferror(pfile) != 0)
       {
       fprintf(stderr, "error on attempt to read checksum value\n");
       clearerr(pfile);
       return(-1);
       }
   *check = lswab((unsigned long) *check);
   return(1);
   }









long data(pfile, buff, nchars, check)
FILE *pfile; 
register char *buff;
register long nchars;
register long check;
   {
   long nread;

   if (0 != (nread = fread(buff, sizeof(*buff), (unsigned) nchars, pfile)))    /* why does lint complain about third argument? */
       {
       if (checksum(buff, (long) nread) != check)
           {
           fprintf(stderr, "bad checksum on block of size %d bytes\n", nchars);
           }
       }
   else
       {
       fprintf(stderr, "end of file on attempt to read data block of size %d bytes\n", nchars);
       fprintf(stderr, "this should be impossible\n");
       }
   if (nread != nchars)
       {
       fprintf(stderr, "%d bytes actually read on attempt to read data block of size %d bytes\n", nread, nchars);
       fprintf(stderr, "this should be impossible\n");
       }
   return(nread);
   }









unsigned long checksum(buff, nchars)
register char *buff;
register long nchars;
   {
   register long i;
   register long sum;

   sum = 0;
   for (i = 0; i < nchars; i++)
       {
       sum += buff[i] & 0xff;
       }
   return(sum);
   }

#define LITTLE 0
#define BIG 1










void machdep(pfile)
FILE *pfile;
   {
   unsigned long first;

   if (sizeof(long) != 4)
       {
       fprintf(stderr, "sizeof(long) is %d\n", sizeof(long));
       fprintf(stderr, "this is fatal--atmlib routines will not work correctly if sizeof(long) is not 4\n");
       exit(1);
       }
   else if (sizeof(int) != 4)
       {
       fprintf(stderr, "sizeof(long) is %d but sizeof(int) is %d\n", sizeof(long), sizeof(int));
       fprintf(stderr, "does your fortran compiler interpret 'integer' as a declaration for 32-bit two's complement signed integer?\n");
       }
   if ((first = getw(pfile)) == 180)
       {
       endian = BIG;
       }
   else
       {
       endian = LITTLE;
       }
   (void) fseek(pfile, 0L, 0);
   if (lswab(first) == 180)
       {
       switch (endian)
           {
           case BIG:
               fprintf(stderr, "\"big-endian\" integer byte order mode\n");
               break;
           case LITTLE:
               fprintf(stderr, "\"little-endian\" integer byte order mode\n");
               break;
           default:
               fprintf(stderr, "\"impossible\" value %d for endian\n", endian);
               break;
           }
       }
   else
       {
       fprintf(stderr, "evidently the disk file contains corrupted data\n");
       fprintf(stderr, "or this processor uses neither the \"big-endian\" nor the \"little-endian\" integer byte order format\n");
       /*
        * big-endian (address of a long integer coincident with address of its highest-order byte) processors:
        * Intel 80x86, Motorola MC680x0, IBM 43xx, IBM 370
        * little-endian (address of a long integer coincident with address of its lowest-order byte) processors:
        * DEC PDP-11, DEC VAX, National 320xx
        */
       exit(1);
       }
   }










unsigned long lswab(n)
register unsigned long n;
   {
   register unsigned long m;

   switch(endian)
       {
       case LITTLE:
           m = 0;
           m |= ((n & 0x000000ff) << 24);
           m |= ((n & 0x0000ff00) <<  8);
           m |= ((n & 0x00ff0000) >>  8);
           m |= ((n & 0xff000000) >> 24);
           break;
       case BIG:
           m = n;
           break;
       default:
           m = n;
           fprintf(stderr, "[lswab] unclassifiable value %d for endian\n", endian);
           break;
       }
   return(m);
   }

#define HOUR 3600000    /* msec per hour */
#define MINUTE 60000    /* msec per minute */
#define SECOND 1000     /* msec per second */









char *blstruct(nsci, stormode)
register long nsci;
register long stormode;
   {
   static char string[32];

   switch(stormode)
       {
       case 0:
           (void) sprintf(string, "%d+%dE,%dS", nbeng1, nbeng2, nsci);
           break;
       case 1:
           (void) sprintf(string, "%d+%dE,%dr", nbeng1, nbeng2, nsci);
           break;
       case 2:
           (void) sprintf(string, "%d+%dE,%dL", nbeng1, nbeng2, nsci);
           break;
       case 3:
           (void) sprintf(string, "%d+%dE,%dR", nbeng1, nbeng2, nsci);
           break;
       default:
           (void) sprintf(string, "?????????");
           fprintf(stderr, "unclassifiable value %d for storage mode\n", stormode);
           seedoc("30");
           break;
       }
   return(string);
   }










char *date(ddd, msec)
register long ddd;
register long msec;
   {
   static char string[32];
   register long hh;
   register long mm;
   register long ss;
   register long fff;

   hh = msec / HOUR;
   mm = (msec % HOUR) / MINUTE;
   ss = (msec % MINUTE) / SECOND;
   fff = msec % SECOND;
   (void) sprintf(string, "%03d:%02d:%02d:%02d.%03d", ddd, hh, mm, ss, fff);
   return(string);
   }










char *detectors(det)
register long *det;
   {
   static char string[16];
   register long i;
   register long j;

   j = 0;
   for (i = 0; i < 7; i++)
       {
       if (det[i] == 1)
           {
           string[j++] = i + 1 + '0';
           }
       else if (det[i] == 0)
           {
           string[j++] = '_';
           }
       else
           {
           string[j++] = '?';
           fprintf(stderr, "unclassifiable value %d for detector %d\n", det[i], i + 6);
           seedoc("32");
           }
       }
   return(string);
   }








char *idstring()
   {
   static char string[128];

   (void) sprintf(string, "%5d/%03d %16s|%-4d %7s %-9s %-s",
     idlocal[0],
     idlocal[1],
     date(idlocal[4], idlocal[5]),
     idlocal[16],
     detectors(&idlocal[6]),
     blstruct(idlocal[15], idlocal[13]),
     site(idlocal[2]));
   return(string);
   }








char *site(code)
register long code;
   {
   register long dlc;
   register long skylab;
   static char string[32];
   char stub[8];

   /*
    * what is the largest value to expect for day/night cycle number? (here we just guess 9999)
    * tape cy020-1 has a file with site code value 401005--in apparent disagreement with specification for id word 3
    * see p. 32 of SO55/ATM Scientific User Tape Guide by Henry T. Wadzinski
    * Wadzinski seems to be wrong here, so we assume 100000, not 1000000, is the intended coefficient for SL number
    */
   if (100000 <= code && code <= 409999)
       {
       skylab = code / 100000;
       dlc = code % 100000;
       (void) sprintf(string, "SL%1d dlc%03d", skylab, dlc);
       fprintf(stderr, "site code value %d is not of form 'SL number * 1000000 + day/night cycle number'\n", code);
       fprintf(stderr, "but site code value %d is of form 'SL number * 100000 + day/night cycle number'\n", code);
       seedoc("32");
       }
   else
       {
       switch(code)
           {
           case 0:
               (void) sprintf(string, "unknown");
               break;
           case 48:
               (void) sprintf(string, "Mila");
               break;
           case 49:
               (void) sprintf(string, "Bermuda");
               break;
           case 50:
               (void) sprintf(string, "Ascension");
               break;
           case 51:
               (void) sprintf(string, "Canary Islands");
               break;
           case 52:
               (void) sprintf(string, "Madrid");
               break;
           case 53:
               (void) sprintf(string, "Carnarvon");
               break;
           case 54:
               (void) sprintf(string, "Honeysuckle Creek");
               break;
           case 55:
               (void) sprintf(string, "Guam");
               break;
           case 56:
               (void) sprintf(string, "Newfoundland");
               break;
           case 57:
               (void) sprintf(string, "Hawaii");
               break;
           case 58:
               (void) sprintf(string, "(site 58)");
               fprintf(stderr, "undocumented value %d for site code\n", code);
               fprintf(stderr, "see p. 33 of SO55/ATM Scientific User Tape Guide by Henry T. Wadzinski\n");
               break;
           case 59:
               (void) sprintf(string, "Goldstone");
               break;
           case 60:
               (void) sprintf(string, "Texas");
               break;
           case 61:
               (void) sprintf(string, "Vanguard");
               break;
           default:
               /* in view of above comments, what if site code value here is between 1000000 and 4009999? */
               (void) sprintf(string, "site code %d?", code);
               fprintf(stderr, "unclassifiable value %d for site code\n", code);
               seedoc("33");
               break;
           }
       }
   if (idlocal[3] != 1973)
       {
       (void) sprintf(stub, " %4d", idlocal[3]);
       (void) strcat(string, stub);
       fprintf(stderr, "id year value is %d, not 1973\n", idlocal[3]);
       seedoc("32");
       }
   return(string);
   }