diff srf2fastq/io_lib-1.12.2/io_lib/expFileIO.c @ 0:d901c9f41a6a default tip

Migrated tool version 1.0.1 from old tool shed archive to new tool shed repository

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/srf2fastq/io_lib-1.12.2/io_lib/expFileIO.c	Tue Jun 07 17:48:05 2011 -0400
@@ -0,0 +1,1251 @@
+/*
+ * Copyright (c) Medical Research Council 1994. All rights reserved.
+ *
+ * Permission to use, copy, modify and distribute this software and its
+ * documentation for any purpose is hereby granted without fee, provided that
+ * this copyright and notice appears in all copies.
+ *
+ * This file was written by James Bonfield, Simon Dear, Rodger Staden,
+ * as part of the Staden Package at the MRC Laboratory of Molecular
+ * Biology, Hills Road, Cambridge, CB2 2QH, United Kingdom.
+ *
+ * MRC disclaims all warranties with regard to this software.
+ */
+
+/*
+ * File: expFileIO.c
+ * Version:
+ *
+ * Description: Routines for reading and writing to experiment files.
+ *
+ * 1. Opening experiment files
+ * 2. Reading information from an experiment file
+ * 3. Appending to experiment files
+ * 4. Closing an opened experiment file
+ *
+ * Created:
+ * Updated:
+ *
+ */
+
+/*
+ * Tag format:
+ *
+ * 0        10 
+ * |----.----|-
+ * TG   TYPE S position..length
+ * TG        One or more comment lines starting at character position 10
+ * TG        Each line represents a line of tag.
+ * TG         Extra indentation is simply added to the comment.
+ *
+ * Where S is the strand, either "+", "-", or "=" (both).
+ * Eg:
+ *
+ * TG   COMM = 100..110
+ * TG        This comment contains
+ * TG          several lines.
+ *
+ * So the above is a COMMent tag on both strands from bases 100 to 110
+ * inclusive containing the annotation
+ * "This comment contains\n  several lines.\n"
+ *
+ * This is written using exp_put_str giving the multi line string:
+ * "COMM = 100..110\nThis comment contains\n  several lines."
+ *
+ * (ie the indentation is added by the experiment file format, not by the
+ *  calling routines. Similarly this indentation is stripped out again when
+ *  reading back.)
+ */
+
+
+#include <stdio.h>
+#include <string.h> /* IMPORT: strdup (hopefully!) */
+#include <ctype.h>
+
+/* 6/1/99 johnt - includes needed for Visual C++ */
+#ifdef _MSC_VER
+#  include <io.h>
+#  include <fcntl.h>
+#endif
+
+#include "io_lib/expFileIO.h"
+#include "io_lib/xalloc.h"
+#include "io_lib/misc.h"
+#include "io_lib/stdio_hack.h"
+
+/* Fixup for broken SunOS 4.x systems */
+#ifndef FOPEN_MAX
+#define FOPEN_MAX 20
+#endif
+
+static int exp_check_eid_read(Exp_info *e,int id);
+
+/*************************************************************
+ * Line types for experiment file
+ *************************************************************/
+
+char eflt_feature_ids[MAXIMUM_EFLTS][MAXIMUM_EFLT_LENGTH+1] = {
+    "CF", /*  0 cloning vector sequence file */
+    "CN", /*  1 clone name */
+    "CS", /*  2 cloning vector sequence present in sequence */
+    "CV", /*  3 cloning vector type */
+    "DR", /*  4 direction of read */
+    "DT", /*  5 date of experiment */
+    "EN", /*  6 experiment name */
+    "EX", /*  7 experimental notes */
+    "FM", /*  8 sequencing vector fragmentation method */
+    "LN", /*  9 local format trace file name */
+    "LT", /* 10 local format trace file type */
+    "MC", /* 11 machine on which experiment ran */
+    "MN", /* 12 machine generated trace file name */
+    "MT", /* 13 machine generated trace file type */
+    "OP", /* 14 operator */
+    "PN", /* 15 primer name */
+    "QR", /* 16 poor quality sequence present at right (3') end */
+    "SC", /* 17 sequencing vector cloning site */
+    "SF", /* 18 sequencing vector sequence file */
+    "SI", /* 19 sequencing vector insertion length */
+    "SL", /* 20 sequencing vector present at left (5') end */
+    "SP", /* 21 sequencing vector primer site (relative to cloning site) */
+    "SQ", /* 22 sequence */
+    "SR", /* 23 sequencing vector present at right (3') end */
+    "ST", /* 24 strands */
+    "SV", /* 25 sequencing vector type */
+    "TN", /* 26 template name */
+    "QL", /* 27 poor quality sequence present at left (5') end */
+    "PS", /* 28 processing status */
+    "CC", /* 29 comments */
+    "SS", /* 30 sequence to screen against */
+    /* added 27-May-93 */
+    "TG", /* 31 gel tag line */
+    "ID", /* 32 identifier */
+    /* added 24-Sep-93 */
+    "AQ", /* 33 average quality measure */
+    /* added 15-Oct-93 */
+    "PR", /* 34 primer type */
+    "LI", /* 35 subclone library (mtd) */
+    "LE", /* 36 subclone library entry (well) */
+    /* added 19-Apr-94 */
+    "TC", /* 37 contig tag line */
+    "AC", /* 38 accession number */
+    /* added 11-Nov-94 */
+    "BC", /* 39 base calling software */
+    "ON", /* 40 original base numbers (positions) */
+    "AV", /* 41 accuracy (quality) values */
+    "PC", /* 42 position in contig */
+    "SE", /* 43 sense, whether it is complemented */
+    /* added 5-4-95 */
+    "CL", /* 44 cloning vector left end*/
+    "CR", /* 45 cloning vector right end*/
+    "AP", /* 46 assembly position */
+    "CH", /* 47 special chemistry used (eg taq) */
+    "PD", /* 48 primer data - the sequence of a primer */
+    "WT", /* 49 wild type trace */
+    "NT", /* 50 note */
+    "GD", /* 51 Gap4 database file */
+    "WL", /* 52 wildtype trace left clip point */
+    "WR", /* 53 wildtype trace right clip point */
+    "FT", /* 54 EMBL format feature table */
+    "LG"  /* 55 LiGation: an amalgamation of LI and LE */
+};
+
+
+
+
+/*************************************************************
+ * Output/update lines
+ *************************************************************/
+
+static int exp_print_line_(FILE *fp, char *eflt, char *entry)
+/*
+ * Output an experiment file line
+ */
+{
+    return fprintf(fp,
+		   "%-5s%s\n",
+		   eflt,
+		   entry
+		   )  <  0;
+}
+
+int exp_print_line(FILE *fp, Exp_info *e, int eflt, int i)
+/*
+ * Output an experiment file line
+ */
+{
+    return exp_print_line_(fp,
+			   eflt_feature_ids[eflt], 
+			   arr(char *,e->entries[eflt],i)
+			   );
+}
+
+/*
+ * Outputs a multi-line experiment file line.
+ * Continuation lines are automatically added by adding 5 characters of extra
+ * indentation at the start of each continuation.
+ *
+ * returns -1 for failure, 0 for success.
+ */
+int exp_print_mline(FILE *fp, Exp_info *e, int eflt, int i) {
+    char *p, *c;
+
+    p = arr(char *, e->entries[eflt], i);
+
+    /* first line */
+    if (c = strchr(p, '\n'))
+	*c = '\0';
+    if (-1 == exp_print_line_(fp, eflt_feature_ids[eflt], p))
+	return -1;
+
+    while (c) {
+	*c = '\n';
+	p = c+1;
+	
+	if (c = strchr(p, '\n')) {
+	    *c = '\0';
+	}
+	
+	if (-1 == fprintf(fp, "%-10s%s\n", eflt_feature_ids[eflt], p))
+	    return -1;
+    }
+
+    return 0;
+}
+
+
+int exp_print_seq(FILE *fp, Exp_info *e, int eflt, int i)
+/*
+ * Output an experiment file multi line
+ */
+{
+    int j, l;
+    char *seq;
+    if (fprintf(fp,"%-5s",eflt_feature_ids[eflt])<0) return 1;
+
+    l = strlen(seq = arr(char *,e->entries[eflt],i));
+    for(j=0;j<l;j++) {
+	if (j%60==0) if ( fprintf(fp,"\n    ") < 0 ) return 1;
+	if (j%10==0) if ( fprintf(fp," ") < 0 ) return 1;
+	if ( fprintf(fp,"%c",seq[j]) < 0 ) return 1;
+    }
+    if ( fprintf(fp,"\n//\n") < 0 ) return 1;
+
+    return 0;
+}
+
+int exp_get_feature_index(char *e)
+{
+    int i;
+    for (i = 0; i < MAXIMUM_EFLTS; i++) {
+	if (eflt_feature_ids[i][0] == e[0] &&
+	    eflt_feature_ids[i][1] == e[1])
+	    return i;
+    }
+    
+    return -1;
+}
+
+
+/*************************************************************
+ * Utility routines
+ *************************************************************/
+
+/*
+ * Creates a string of 'range format' from the start and end points.
+ * The string (of form start..end) is also returned.
+ */
+char *exp_create_range(char *str, int start, int end) {
+    sprintf(str, "%d..%d", start, end);
+    return str;
+}
+
+/*
+ * Extracts the start and end points from a range string.
+ * Returns 0 for success and -1 for failure.
+ */
+int exp_extract_range(char *str, int *start, int *end) {
+    return sscanf(str, "%d..%d", start, end) != 2;
+}
+
+Exp_info *exp_create_info(void)
+/*
+ * Allocate space for new experiment file information
+ */
+{
+    Exp_info *new;
+    int i;
+    
+    new = (Exp_info *)xmalloc(sizeof(Exp_info));
+    if (new != NULL) {
+	for(i=0; i< MAXIMUM_EFLTS ; i++) {
+	    new->Nentries[i] = 0;
+	    new->entries[i] = ArrayCreate(sizeof(char *), 1/*one entry*/);
+	}
+	new->fp = NULL;
+    }
+    
+    return new;
+}
+
+
+void exp_destroy_info(Exp_info *e)
+/*
+ * Destroy experiment file information
+ */
+{
+    int i;
+    int j;
+    if (e != NULL_Exp_info) {
+	for (i = 0; i < MAXIMUM_EFLTS; i++) {
+	    Array a = e->entries[i];
+	    for(j=0;j<e->Nentries[i];j++)
+		if (arr(char *,a,j) != NULL) xfree(arr(char *,a,j));
+	    ArrayDestroy(a);
+	}
+	if (e->fp != NULL) fclose(e->fp);
+	xfree(e);
+    }
+}
+
+
+
+
+/*
+ * Read from file a sequence, discarding all white space til a // is
+ * encountered
+ */
+static char *exp_read_sequence(FILE *fp)
+{
+    char *seq = NULL;
+    size_t seq_len = 0, seq_alloc;
+    char line[EXP_FILE_LINE_LENGTH+1];
+    char *l;
+    static int valid_char[256], init = 0;
+
+    /* Initialise lookup tables for efficiency later on.*/
+    if (!init) {
+	int i;
+	for (i = 0; i < 256; i++) {
+	    if (i < 128 && !isspace(i) && !isdigit(i) && !iscntrl(i))
+		valid_char[i] = 1;
+	    else
+		valid_char[i] = 0;
+	}
+	init = 1;
+    }
+
+    /* Initialise memory */
+    seq_alloc = EXP_FILE_LINE_LENGTH * 8;
+    seq = (char *)xmalloc(seq_alloc);
+    if (NULL == seq)
+	return NULL;
+    seq[0] = '\0';
+
+    /* Reading line by line, until we get "//" */
+    l = fgets(line,EXP_FILE_LINE_LENGTH,fp);
+    while (l!= NULL && strncmp(l,"//",2)) {
+	char *a, *b;
+
+	/* make sure the seq buffer is large enough */
+	if (seq_len + EXP_FILE_LINE_LENGTH + 1 > seq_alloc) {
+	    seq_alloc *= 2;
+	    if (NULL == (seq = (char *)xrealloc(seq, seq_alloc)))
+		return NULL;
+	}
+
+	/* copy to seq, stripping spaces on the fly */
+	for(a=line, b = &seq[seq_len]; *a; a++)
+	    if (valid_char[(unsigned char)*a])
+		*b++ = *a;
+	*b = '\0';
+	seq_len = b-seq;
+
+	l = fgets(line,EXP_FILE_LINE_LENGTH,fp);
+    }
+
+    /* Shrink the allocated string to reduce memory usage */
+    seq = (char *)xrealloc(seq, seq_len + 1);
+    
+    return seq;
+}
+
+
+/*
+ * Converts the opos[] array into a char array.
+ * In doing so this shrinks the data size by using a .. notation.
+ * No check is made that buf is large enough. It is recommended that buf is
+ * allocated to 5*len which covers the worst case (for sequences less that
+ * 9999 bases long).
+ *
+ * Note that on older systems sprintf may return the first argument rather
+ * than the number of characters written.
+ * For this reason we have to do the counting ourselves.
+ */
+char *opos2str(int2 *opos, int len, char *buf) {
+    int i, st, f, dir = 0;
+    char *r = buf, *rs = buf;
+    
+    f = opos[st = 0];
+    for (i = 1; i < len; f=opos[i++]) {
+	if (dir == 0)
+	    if (opos[i] == f+1)
+		dir=1;
+	    else if (opos[i] == f-1)
+		dir=-1;
+
+	if (dir && opos[i] != f + dir) {
+	    if (st != i-1)
+		sprintf(buf, "%d..%d ", opos[st], opos[i-1]);
+	    else
+		sprintf(buf, "%d ", opos[st]);
+	    st = i;
+	    dir = 0;
+
+	    buf += strlen(buf);
+		
+	} else if (dir == 0) {
+	    sprintf(buf, "%d ", f);
+
+	    st = i;
+	    buf += strlen(buf);
+	}
+
+	if (buf - rs > 60) {
+	    *buf++ = '\n';
+	    *buf = '\0';
+	    rs = buf - 6;
+	}	
+    }
+    
+    if (st != i-1)
+	sprintf(buf, "%d..%d", opos[st], opos[i-1]);
+    else
+	sprintf(buf, "%d", opos[st]);
+    
+    return r;
+}
+
+
+
+/*
+ * Expands from the character string .. notation to the opos[] array, up to
+ * a maximum of len elements in opos[].
+ *
+ * Returns the length of the opos array.
+ */
+int str2opos(int2 *opos, int len, char *buf) {
+    /* int i, n1, n2, st, en, m, j = 0; */
+    int i, j = 0, st, en;
+    char *cp;
+
+    while (j < len && *buf) {
+	st = strtol(buf, &cp, 10);
+	if (buf == cp) {
+	    buf++;
+	    continue;
+	}
+	buf = cp;
+	if (buf[0] == '.' && buf[1] == '.') {
+	    en = strtol(buf += 2, &cp, 10);
+	    if (buf == cp) {
+		opos[j++] = st;
+		buf++;
+		continue;
+	    }
+	    buf = cp;
+
+	    if (en >= st)
+		for (i = st; i <= en && j < len; i++)
+		    opos[j++] = i;
+	    else
+		for (i = st; i >= en && j < len; i--)
+		    opos[j++] = i;
+	} else {
+	    opos[j++] = st;
+	}
+    }
+
+    return j;
+}
+
+
+/*
+ * Converts the accuracy value string (AV) to the confidence array up to
+ * a maximum of len elements in conf[].
+ *
+ * The AV string is of format:
+ * "x y z ..." where x, y and z are confidence values for the first three
+ * called bases. Or:
+ * "a,b,c,d e,f,g,h i,j,k,l ..." where the 4-tuples represent the four
+ * confidence values for each base.
+ *
+ * Returns: number of confidence values read, or -1 for error.
+ */
+int str2conf(int1 *conf, int len, char *buf) {
+    int ind = 0;
+
+    while (*buf && ind < len) {
+	char *new_buf;
+	int val1;
+
+	val1 = strtol(buf, &new_buf, 10);
+	if (new_buf == buf)
+	    break;
+
+	if (*new_buf == ',') {
+	    fprintf(stderr, "4-tuple system is currently unsupported\n");
+	    return -1;
+	}
+
+	conf[ind++] = val1;
+	buf = new_buf;
+    }
+
+    return ind;
+}
+
+
+/*
+ * Converts the confidence array to the accuracy value string (AV).
+ *
+ * Note no memory overrun checks are performed on buf. It is recommended
+ * that it is allocated to 4*len (worst case of "255 " for each base) plus.
+ * a couple of terminating newline and null plus another byte per 15 values
+ * to allow for the 60-char line length.
+ * For ease, allocating to 5*len+2 is more than sufficient.
+ *
+ * Returns the buf argument.
+ */
+char *conf2str(int1 *conf, int len, char *buf) {
+    int i;
+    char *ret = buf, *rs = buf;
+
+    for (i = 0; i < len; i++) {
+	sprintf(buf, "%d ", conf[i]);
+	buf += strlen(buf);
+
+	if (buf - rs > 60) {
+	    *buf++ = '\n';
+	    *buf = '\0';
+	    rs = buf - 6;
+	}
+    }
+
+    return ret;
+}
+
+/*************************************************************
+ * Main C interface routines
+ *************************************************************/
+
+
+/*
+ * Closes an experiment file (if open), but does not free it.
+ */
+void exp_close(Exp_info *e) {
+    if (e->fp) {
+	fclose(e->fp);
+	e->fp = NULL;
+    }
+}
+
+
+Exp_info *exp_read_info(char *file)
+/*
+ * Read in an experiment file and return handle
+ */
+{
+    Exp_info *e;
+    FILE *fp;
+    
+    /*
+     * open for read
+     */
+    if ((fp = fopen(file,"r"))==NULL) {
+	return NULL_Exp_info;
+    }
+
+    e = exp_fread_info(fp);
+    fclose(fp);
+
+    if (NULL_Exp_info == e) {
+	return NULL_Exp_info;
+    }	
+
+    /*
+     * reopen for appending
+     */
+    e->fp = fopen(file,"a");
+    
+    return e;
+    
+}
+
+
+/*
+ * Read in an experiment file and return handle
+ */
+Exp_info *exp_fread_info(FILE *fp)
+{
+    Exp_info *e;
+    char line[EXP_FILE_LINE_LENGTH+1];
+    char *aline;
+    int alloced_length = EXP_FILE_LINE_LENGTH+1;
+    int apos, len;
+    int last_entry = -1;
+    size_t entry_len = 0;
+    
+    e = exp_create_info();
+
+  
+    /*
+     * No longer has an effect due to mFILE already being loaded. Ifdef not
+     * triggered under mingw anyway.
+     */
+#ifdef _WIN32
+    /* 6/1/99 johnt - need to ensure text mode to translate \r\n to \n */
+    /* _setmode(fileno(fp),_O_TEXT); */
+    mfascii(fp);
+#endif
+    
+    /*
+     * open for read, set this temporarily in this function. Should be NULL
+     * when exiting as this isn't our file pointer to own, but the destroy
+     * function does attempt to automatically close it.
+     */
+    e->fp = fp;
+
+    if (NULL == (aline = (char *)xmalloc(alloced_length)))
+	return NULL;
+    
+    if (e != NULL_Exp_info) {
+	int at_end = 0;
+
+	for(;;) {
+	    char *c;
+	    int entry;
+
+	    /* Read into aline, joining and allocating as necessary */
+	    apos = 0;
+	    do {
+		if (fgets(line,EXP_FILE_LINE_LENGTH,e->fp) == NULL) {
+		    at_end = 1;
+		    break;
+		}
+
+		len = strlen(line);
+		if (apos + len >= alloced_length) {
+		    alloced_length *= 2;
+		    if (NULL == (aline = (char *)xrealloc(aline,
+							  alloced_length))) {
+			e->fp = NULL;
+			return NULL;
+		    }
+		}
+
+		strcpy(aline+apos, line);
+		apos += len;
+	    } while (line[len-1] != '\n');
+
+	    if (at_end)
+		break;
+
+	    /*
+	     * zero terminate first argument
+	     * set c to point to second argument
+	     *
+	     * FIXME: c should point to character 6 always. Indentation is
+	     * important when considering continuation lines.
+	     */
+	    for (c=aline;*c && !isspace(*c); c++) ;
+	    if (*c) {
+		*c++ = '\0';
+		for (;*c && isspace(*c); c++) ;
+	    }
+	    
+	    entry = exp_get_feature_index(aline);
+	    if (entry >= 0) {
+		/*
+		 * Tag lines may be split over multiple lines. If we have no
+		 * tag type then we append to the existing tag.
+		 */
+		if (entry == last_entry &&
+		    (int)(c-aline) >= 10/* continuation lines */
+		    && (entry == EFLT_TG || entry == EFLT_TC ||
+			entry == EFLT_ON || entry == EFLT_AV ||
+			entry == EFLT_NT || entry == EFLT_FT)) {
+		    char *en;
+		    size_t l1, l2;
+
+		    /*
+		     * Extend our current line by the appropriate amount
+		     */
+		    if( exp_check_eid_read(e,entry) )
+			return NULL;
+		    en = exp_get_entry(e,entry);
+		    l1 = entry_len;
+		    l2 = strlen(&aline[10]);
+
+		    if (NULL == (en = exp_get_entry(e, entry) =
+				 (char *)xrealloc(en, l1 + l2 + 1))) {
+			e->fp = NULL;
+			return NULL;
+		    }
+		    
+
+		    /*
+		     * Append the new line (without the \n char)
+		     */
+		    en[l1] = '\n';
+		    aline[l2+9] = '\0';
+		    strcpy(&en[l1+1], &aline[10]);
+
+		    entry_len += l2;
+		} else {
+		    /*
+		     * Increment number of entries for line type entry
+		     * This will force exp_get_entry() to return pointer to
+		     * next free element in array
+		     */
+		    (void)ArrayRef(e->entries[entry],e->Nentries[entry]++);
+		    
+		    if (entry == EFLT_SQ)
+			exp_get_entry(e,entry) = exp_read_sequence(e->fp);
+		    else {
+			char *eoln = strchr(c,'\n');
+			int i;
+
+			if (eoln!=NULL) *eoln='\0';
+
+			if (entry == EFLT_LT)
+			    for (i=3; isspace(c[i]) && i >= 0; c[i--]='\0');
+
+			exp_get_entry(e,entry) = (char *)strdup(c);
+			entry_len = strlen(c);
+		    }
+		}
+	    }
+
+	    last_entry = entry;
+	}
+    }
+
+    e->fp = NULL;
+    xfree(aline);
+    
+    return e;
+}
+
+static int exp_check_eid_read(Exp_info *e,int id)
+/*
+ * Check these are a valid combination and that
+ * an entry exists for read
+ */
+{
+    return (
+	    e == NULL ||
+	    id < 0 ||
+	    id >= MAXIMUM_EFLTS ||
+	    e->Nentries[id] == 0 ||
+	    eflt_feature_ids[id][0]=='\0'
+	    );
+}
+
+static int exp_check_eid_write(Exp_info *e,int id)
+/*
+ * Check these are a valid combination and that
+ * an entry exists for write
+ */
+{
+    return (e == NULL ||
+	    id < 0 ||
+	    id >= MAXIMUM_EFLTS ||
+	    e->fp == NULL ||
+	    eflt_feature_ids[id][0]=='\0');
+}
+
+
+
+
+
+
+int exp_get_int(Exp_info *e, int id, int *val)
+/*
+ * Get the integer for entry id
+ * returns:
+ *    0 - success
+ *    1 - no entry
+ */
+{
+    if ( exp_check_eid_read(e,id) ) return 1;
+    *val = atoi(exp_get_entry(e,id));
+    return 0;
+}
+
+
+int exp_get_rng(Exp_info *e, int id, int *from, int *to)
+/*
+ * Get the integer pair for entry id
+ * returns:
+ *    0 - success
+ *    1 - no entry
+ */
+{
+    if ( exp_check_eid_read(e,id) ) return 1;
+    (void)exp_extract_range(exp_get_entry(e,id), from, to);
+
+    return 0;
+}
+
+
+
+int exp_get_str(Exp_info *e, int id, char *s, f_implicit s_l)
+/*
+ * Get the string for entry id
+ * returns:
+ *    0 - success
+ *    1 - no entry
+ */
+{
+    if ( exp_check_eid_read(e,id) ) return 1;
+    strncpy(s,exp_get_entry(e,id),s_l);
+    
+    return 0;
+}
+
+
+static int exp_append_str(Exp_info *e, int id, char *s, int len)
+/*
+ * Append the string to experiment file for entry id
+ * returns:
+ *    0 - success
+ *    1 - no update
+ */
+{
+    (void)ArrayRef(e->entries[id],e->Nentries[id]++);
+    exp_get_entry(e,id) = (char *)xmalloc(len+1);
+    strncpy(exp_get_entry(e,id), s, len);
+    exp_get_entry(e,id)[len] = '\0';
+    
+    if ( id == EFLT_SQ )
+	return exp_print_seq(e->fp,e,id,e->Nentries[id]-1);
+    else if (id == EFLT_TG || id == EFLT_TC ||
+	     id == EFLT_ON || id == EFLT_AV ||
+	     id == EFLT_NT || id == EFLT_FT)
+	return exp_print_mline(e->fp,e,id,e->Nentries[id]-1);
+    else
+	return exp_print_line(e->fp,e,id,e->Nentries[id]-1);
+}
+
+
+int exp_put_int(Exp_info *e, int id, int *val)
+/*
+ * Append the integer for entry id to the experiment file
+ * returns:
+ *    0 - success
+ *    1 - no update
+ */
+{
+    char buf[EXP_FILE_LINE_LENGTH];
+    if ( exp_check_eid_write(e,id) ) return 1;
+    sprintf(buf,"%d",*val);
+    return exp_append_str(e,id,buf,strlen(buf));
+}
+
+
+int exp_put_rng(Exp_info *e, int id, int *from, int *to)
+/*
+ * Append the integer pair for entry id to the experiment file
+ * returns:
+ *    0 - success
+ *    1 - no update
+ */
+{
+    char buf[EXP_FILE_LINE_LENGTH];
+    if ( exp_check_eid_write(e,id) ) return 1;
+
+    (void )exp_create_range(buf, *from, *to);
+
+    return exp_append_str(e,id,buf,strlen(buf));
+}
+
+
+
+int exp_put_str(Exp_info *e, int id, char *s, f_implicit s_l)
+/*
+ * Append the string for entry id to the experiment file
+ * returns:
+ *    0 - success
+ *    1 - no update
+ */
+{
+    if ( exp_check_eid_write(e,id) ) return 1;
+    return exp_append_str(e,id,s,s_l);
+}
+
+
+/*************************************************************
+ * FORTRAN INTERFACE
+ *************************************************************/
+
+
+
+static int init_done = 0;
+static int NHandles = 0;
+static Exp_info **Handles = NULL;
+
+static int initialise(void)
+{
+    int i;
+    
+    if (init_done) return 0;
+    init_done++;
+    
+    NHandles = FOPEN_MAX;
+    
+    if ( (Handles = (Exp_info **)xmalloc(sizeof(Exp_info *) * NHandles)) == NULL) {
+	NHandles = 0;
+	return 1;
+    }
+    
+    for (i=0; i<NHandles; i++) Handles[i] = NULL;
+    
+    return 0;
+}
+
+
+static int get_free_handle(void)
+/*
+ * find a free entry in the Exp array
+ * returns -1 if there is none
+ */
+{
+    int i;
+    
+    (void) initialise();
+    
+    if (!NHandles) return -1; /* no slots! */
+    for (i=0; i<NHandles && Handles[i]!=NULL; i++) ;
+    return (i==NHandles)?-1:i;
+}
+
+
+static int check_handle(f_int *handle)
+{
+    return (handle == NULL ||
+	    (int) (*handle) <= 0 ||
+	    (int) (*handle) > NHandles);
+}
+
+
+
+f_int expopn_(char *fn, f_implicit fn_l)
+/*
+ * FORTRAN interface to exp_open_file()
+ */
+{
+    char cfn[1025];
+    int handle;
+    
+    if ( (handle = get_free_handle()) >= 0 ) {
+	f2cstr(fn,fn_l,cfn,1024);
+	Handles[handle] = exp_read_info(cfn);
+    }
+    
+    return (f_int) (handle+1);
+}
+
+
+
+f_proc_ret expkil_(f_int *handle)
+/*
+ * FORTRAN interface to exp_destroy_info
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) f_proc_return();
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    exp_destroy_info(e);
+    
+    Handles[(int)(*handle)-1] = NULL;
+    *handle = 0;
+    
+    f_proc_return();
+}
+
+f_int expri_(f_int *handle, f_int *id, f_int *val)
+/*
+ * FORTRAN interface to exp_get_int
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    return exp_get_int(e, (int)*id, (int *)val);
+}
+
+
+f_int exprr_(f_int *handle, f_int *id, f_int *from, f_int *to)
+/*
+ * FORTRAN interface to exp_get_rng
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    return exp_get_rng(e,(int)*id,(int *)from,(int *)to);
+    
+}
+
+/* ARGSUSED */
+f_int exprsa_(f_int *handle, f_int *id, char *s, f_int *max_len, f_implicit s_l)
+/*
+ * FORTRAN interface to exp_get_str workalike
+ * NOTE: for use with FORTRAN CHARACTER arrays instead CHARACTER strings
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    if ( exp_check_eid_read(e,*id) ) return 1;
+    c2fstr(exp_get_entry(e,*id),(int)*max_len,s,(int)*max_len);
+    return 0;
+}
+
+
+f_int exprs_(f_int *handle, f_int *id, char *s, f_implicit s_l)
+/*
+ * FORTRAN interface to exp_get_str workalike
+ * NOTE: for use with FORTRAN CHARACTER strings instead CHARACTER arrays
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    if ( exp_check_eid_read(e,*id) ) return 1;
+    c2fstr(exp_get_entry(e,*id),s_l,s,s_l);
+    return 0;
+}
+
+
+f_int expwi_(f_int *handle, f_int *id, f_int *val)
+/*
+ * FORTRAN interface to exp_put_int
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    return exp_put_int(e, (int)*id, (int *)val);
+}
+
+
+f_int expwr_(f_int *handle, f_int *id, f_int *from, f_int *to)
+/*
+ * FORTRAN interface to exp_put_rng
+ */
+{
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    return exp_put_rng(e, (int)*id, (int *)from, (int *)to);
+}
+
+
+/* ARGSUSED */
+f_int expwsa_(f_int *handle, f_int *id, char *s, f_int *max_len, f_implicit s_l)
+/*
+ * FORTRAN interface to exp_put_str workalike
+ * NOTE: for use with FORTRAN CHARACTER arrays instead CHARACTER strings
+ */
+{
+    Exp_info *e;
+    char buf[EXP_FILE_LINE_LENGTH];
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    
+    if ( exp_check_eid_write(e,*id) ) return 1;
+    /* don't allow multi-line entries to be written */
+    if (*id == EFLT_SQ ) return 1;
+    f2cstr(s,(int)*max_len,buf,sizeof(buf));
+    return exp_append_str(e,*id,buf,strlen(buf));
+    
+}
+
+f_int expws_(f_int *handle, f_int *id, char *s, f_implicit s_l)
+/*
+ * FORTRAN interface to exp_put_str workalike
+ * NOTE: for use with FORTRAN CHARACTER strings instead CHARACTER arrays
+ */
+{
+    char buf[EXP_FILE_LINE_LENGTH];
+    Exp_info *e;
+    if ( check_handle(handle) ) return 1;
+    e = (Exp_info *) Handles[(int)(*handle)-1];
+    
+    
+    if ( exp_check_eid_write(e,*id) ) return 1;
+    /* don't allow multi-line entries to be written */
+    if (*id == EFLT_SQ ) return 1;
+    f2cstr(s,s_l,buf,sizeof(buf));
+    return exp_append_str(e,*id,buf,s_l);
+}
+
+/*
+ * FORTRAN interface to exp_create_range()
+ */
+void expcr_(char *str, f_int *start, f_int *end, f_implicit str_l) {
+    exp_create_range(str, *start, *end);
+    c2fstr(str, str_l, str, str_l);
+
+    f_proc_return();
+}
+
+/*
+ * FORTRAN interface to exp_extract_range()
+ */
+/* ARGSUSED */
+f_int exper_(char *str, f_int *start, f_int *end, f_implicit str_l) {
+    return exp_extract_range(str, start, end);
+}
+
+
+
+
+/*************************************************************
+ * Go for it!
+ *************************************************************/
+
+static void print_line(FILE *fp, Exp_info *e, int eflt, int all)
+{
+    if (all) {
+	int i;
+	for(i=0;i<e->Nentries[eflt];i++) exp_print_line(fp,e,eflt,i);
+    } else if (e->Nentries[eflt] > 0) {
+	exp_print_line(fp,e,eflt,e->Nentries[eflt]-1);
+    }
+}
+
+
+static void print_mline(FILE *fp, Exp_info *e, int eflt, int all)
+{
+    if (all) {
+	int i;
+	for(i=0;i<e->Nentries[eflt];i++) exp_print_mline(fp,e,eflt,i);
+    } else if (e->Nentries[eflt] > 0) {
+	exp_print_mline(fp,e,eflt,e->Nentries[eflt]-1);
+    }
+}
+
+
+
+static void print_seq(FILE *fp, Exp_info *e, int eflt)
+{
+    if (e->Nentries[eflt] > 0)
+        exp_print_seq(fp,e,eflt,e->Nentries[eflt]-1);
+}
+
+
+
+
+void exp_print_file(FILE *fp, Exp_info *e)
+{
+    print_line(fp,e,EFLT_ID, 0);
+    print_line(fp,e,EFLT_AC, 0);
+    print_line(fp,e,EFLT_EN, 0);
+
+    print_line(fp,e,EFLT_CC, 1);
+    print_line(fp,e,EFLT_EX, 1);
+    print_line(fp,e,EFLT_PS, 1);
+
+    print_line(fp,e,EFLT_LN, 0);
+    print_line(fp,e,EFLT_LT, 0);
+
+    print_line(fp,e,EFLT_CF, 0);
+    print_line(fp,e,EFLT_CV, 0);
+    print_line(fp,e,EFLT_CS, 0);
+    print_line(fp,e,EFLT_CL, 0);
+    print_line(fp,e,EFLT_CR, 0);
+
+    print_line(fp,e,EFLT_SF, 0);
+    print_line(fp,e,EFLT_SV, 0);
+    print_line(fp,e,EFLT_SI, 0);
+    print_line(fp,e,EFLT_SC, 0);
+    print_line(fp,e,EFLT_SP, 0);
+    print_line(fp,e,EFLT_PD, 0);
+    print_line(fp,e,EFLT_FM, 0);
+    print_line(fp,e,EFLT_SL, 0);
+    print_line(fp,e,EFLT_SR, 0);
+
+    print_line(fp,e,EFLT_QL, 0);
+    print_line(fp,e,EFLT_QR, 0);
+
+    print_mline(fp,e,EFLT_TG,1);
+    print_mline(fp,e,EFLT_TC,1);
+    print_mline(fp,e,EFLT_NT,1);
+
+    print_line(fp,e,EFLT_CN, 0);
+    print_line(fp,e,EFLT_TN, 0);
+    print_line(fp,e,EFLT_PN, 0);
+    print_line(fp,e,EFLT_PR, 0);
+    print_line(fp,e,EFLT_LI, 0);
+    print_line(fp,e,EFLT_LE, 0);
+    print_line(fp,e,EFLT_CH, 0);
+
+    print_mline(fp,e,EFLT_ON,0);
+    print_line(fp,e,EFLT_AQ, 0);
+    print_mline(fp,e,EFLT_AV,0);
+
+    print_line(fp,e,EFLT_DR, 0);
+    print_line(fp,e,EFLT_SE, 0);
+    print_line(fp,e,EFLT_PC, 0);
+    print_line(fp,e,EFLT_AP, 0);
+    print_line(fp,e,EFLT_ST, 0);
+
+    print_line(fp,e,EFLT_DT, 0);
+    print_line(fp,e,EFLT_MC, 0);
+    print_line(fp,e,EFLT_MN, 0);
+    print_line(fp,e,EFLT_MT, 0);
+    print_line(fp,e,EFLT_OP, 1);
+    print_line(fp,e,EFLT_BC, 0);
+    print_line(fp,e,EFLT_SS, 0);
+
+    print_line(fp,e,EFLT_WT, 0);
+    print_line(fp,e,EFLT_WL, 0);
+    print_line(fp,e,EFLT_WR, 0);
+
+    print_mline(fp,e,EFLT_FT,1);
+
+    print_seq (fp,e,EFLT_SQ);
+}
+
+
+/*
+ * Allocate an set a new experiment file entry
+ */
+char *exp_set_entry(Exp_info *e, int eflt, char *str) {
+    char *s;
+    size_t l;
+
+    if (NULL == ArrayRef(e->entries[eflt], e->Nentries[eflt]))
+	return NULL;
+    else
+	e->Nentries[eflt]++;
+
+    l = strlen(str);
+    if (NULL == (s = exp_get_entry(e, eflt) = (char *)xmalloc(l+1))) {
+	e->Nentries[eflt]--;
+	return NULL;
+    }
+    strcpy(s, str);
+
+    return s;
+}