CCL Home Page
Up Directory CCL mmiof
/* Copyright 1995, Columbia University, all rights reserved.
 * Permission is granted to utilize and disseminate this code or
 *  document without charge, provided that (1) this copyright notice is 
 *  not removed, and (2) all changes made by other than members of the 
 *  MacroModel Development Group at Columbia University are, if further 
 *  disseminated, (a) noted as such; for example, by means of source-code 
 *  comment lines, and (b) communicated back to the author for possible 
 *  inclusion in subsequent versions. */

/****************************************************************************
 * $RCSfile: mmiof.c,v $
 * $Revision: 1.19 $
 * $Date: 1998/02/06 05:31:23 $
 ***************************************************************************/
#include 
#include "string.h"
#include "mmioc.h"
#include "mmio_def.h"
#define TRUE 1
#define FALSE 0

#if defined( COMBINED_API )
	#if defined( BIND_ )
		#define mmio_open mmiof_open_
		#define mmio_close mmiof_close_
		#define mmio_errfile mmiof_errfile_
		#define mmio_return_code mmiof_return_code_
		#define mmio_goto_ct mmiof_goto_ct_
		#define mmio_skip_ct mmiof_skip_ct_
		#define mmio_count_ct mmiof_count_ct_
		#define mmio_get_ct mmiof_get_ct_
		#define mmio_get_atom mmiof_get_atom_
		#define mmio_get_atomg mmiof_get_atomg_
		#define mmio_put_ct mmiof_put_ct_
		#define mmio_put_atom mmiof_put_atom_
		#define mmio_put_atomg mmiof_put_atomg_
		#define mmio_cleanup mmiof_cleanup_
	#elif defined( BIND__ )
		#define mmio_open mmiof_open__
		#define mmio_close mmiof_close__
		#define mmio_errfile mmiof_errfile__
		#define mmio_return_code mmiof_return_code__
		#define mmio_goto_ct mmiof_goto_ct__
		#define mmio_skip_ct mmiof_skip_ct__
		#define mmio_count_ct mmiof_count_ct__
		#define mmio_get_ct mmiof_get_ct__
		#define mmio_get_atom mmiof_get_atom__
		#define mmio_get_atomg mmiof_get_atomg__
		#define mmio_put_ct mmiof_put_ct__
		#define mmio_put_atom mmiof_put_atom__
		#define mmio_put_atomg mmiof_put_atomg__
		#define mmio_cleanup mmiof_cleanup__
	#elif defined( BINDCRAY )
		#define mmio_open MMIOF_OPEN
		#define mmio_close MMIOF_CLOSE
		#define mmio_errfile MMIOF_ERRFILE
		#define mmio_return_code MMIOF_RETURN_CODE
		#define mmio_goto_ct MMIOF_GOTO_CT
		#define mmio_skip_ct MMIOF_SKIP_CT
		#define mmio_count_ct MMIOF_COUNT_CT
		#define mmio_get_ct MMIOF_GET_CT
		#define mmio_get_atom MMIOF_GET_ATOM
		#define mmio_get_atomg MMIOF_GET_ATOMG
		#define mmio_put_ct MMIOF_PUT_CT
		#define mmio_put_atom MMIOF_PUT_ATOM
		#define mmio_put_atomg MMIOF_PUT_ATOMG
		#define mmio_cleanup MMIOF_CLEANUP
	#else
		#define mmio_open mmiof_open
		#define mmio_close mmiof_close
		#define mmio_errfile mmiof_errfile
		#define mmio_return_code mmiof_return_code
		#define mmio_goto_ct mmiof_goto_ct
		#define mmio_skip_ct mmiof_skip_ct
		#define mmio_count_ct mmiof_count_ct
		#define mmio_get_ct mmiof_get_ct
		#define mmio_get_atom mmiof_get_atom
		#define mmio_get_atomg mmiof_get_atomg
		#define mmio_put_ct mmiof_put_ct
		#define mmio_put_atom mmiof_put_atom
		#define mmio_put_atomg mmiof_put_atomg
		#define mmio_cleanup mmiof_cleanup
	#endif
#else
	#if defined( BIND_ )
		#define mmio_open mmio_open_
		#define mmio_close mmio_close_
		#define mmio_errfile mmio_errfile_
		#define mmio_return_code mmio_return_code_
		#define mmio_goto_ct mmio_goto_ct_
		#define mmio_skip_ct mmio_skip_ct_
		#define mmio_count_ct mmio_count_ct_
		#define mmio_get_ct mmio_get_ct_
		#define mmio_get_atom mmio_get_atom_
		#define mmio_get_atomg mmio_get_atomg_
		#define mmio_put_ct mmio_put_ct_
		#define mmio_put_atom mmio_put_atom_
		#define mmio_put_atomg mmio_put_atomg_
		#define mmio_cleanup mmio_cleanup_
	#elif defined( BIND__ )
		#define mmio_open mmio_open__
		#define mmio_close mmio_close__
		#define mmio_errfile mmio_errfile__
		#define mmio_return_code mmio_return_code__
		#define mmio_goto_ct mmio_goto_ct__
		#define mmio_skip_ct mmio_skip_ct__
		#define mmio_count_ct mmio_count_ct__
		#define mmio_get_ct mmio_get_ct__
		#define mmio_get_atom mmio_get_atom__
		#define mmio_get_atomg mmio_get_atomg__
		#define mmio_put_ct mmio_put_ct__
		#define mmio_put_atom mmio_put_atom__
		#define mmio_put_atomg mmio_put_atomg__
		#define mmio_cleanup mmio_cleanup__
	#elif defined( BINDCRAY )
		#define mmio_open MMIO_OPEN
		#define mmio_close MMIO_CLOSE
		#define mmio_errfile MMIO_ERRFILE
		#define mmio_return_code MMIO_RETURN_CODE
		#define mmio_goto_ct MMIO_GOTO_CT
		#define mmio_skip_ct MMIO_SKIP_CT
		#define mmio_count_ct MMIO_COUNT_CT
		#define mmio_get_ct MMIO_GET_CT
		#define mmio_get_atom MMIO_GET_ATOM
		#define mmio_get_atomg MMIO_GET_ATOMG
		#define mmio_get_atom MMIO_GET_ATOMG
		#define mmio_put_ct MMIO_PUT_CT
		#define mmio_put_atom MMIO_PUT_ATOM
		#define mmio_put_atomg MMIO_PUT_ATOMG
		#define mmio_cleanup MMIO_CLEANUP
	#endif
#endif

/* handle strings passed from Fortran: */
#if defined( STRINGCRAY )
	/* N.B.: we know that strings are always declared with length
	 *  MMIO_L_STRLEN or MMIO_S_STRLEN, and we know which ones are
	 *  declared which way;  so we never need to call _fcdlen().
	 * Functions that use strings passed from Fortran:
	 *	mmio_open
	 *	mmio_put_ct
	 *	mmio_put_atom
	 *	mmio_put_atomg
	 * Functions that pass strings back to Fortran:
	 *	mmio_return_code
	 *	mmio_get_ct
	 *	mmio_get_atom
	 *	mmio_get_atomg
	 */
	#include 
	#define FSTRING _fcd
	#define FSTR_TO_C( FSTR ) _fcdtocp( FSTR )
#else
	#define FSTRING char*
	#define FSTR_TO_C( FSTR ) FSTR
#endif
/****************************************************************************/
void mmio_open( int *idataset, FSTRING ffname, int *mode, int *status ) 
{
	char *ptr;
	char *fname = FSTR_TO_C( ffname );

	/* null-terminate the file-name string just after its last
	 *  non-blank character: */
	fname[ MMIO_L_STRLEN - 1 ] = '\0';
	for( ptr=fname+MMIO_L_STRLEN-2; ptr>=fname; --ptr ) {
		if( *ptr != ' ' ) {
			*( ptr + 1 ) = '\0';
			break;
		}
	}

	if( ptr < fname ) {
		/* we received a string of blanks! : */
		*fname = '\0';
	}

	*status = _file_open( idataset, fname, *mode );
	if( *status == MMIO_ERR ) {
		_error_mmio( "mmio_open: _file_open() fails\n" );
	}
}
/****************************************************************************/
void mmio_close( int *idataset, int *status ) 
{
	*status = _file_close( *idataset );
	if( *status == MMIO_ERR ) {
		_error_mmio( "mmio_close: _file_close() fails\n" );
	}
}
/****************************************************************************/
void mmio_errfile( int *iunit ) 
{
	_setf_errfile( *iunit );
}
/****************************************************************************/
void mmio_return_code( int *istatus, FSTRING fstring ) 
{
	int len;
	char *string = FSTR_TO_C( fstring );
	char *code_string;
	int istring;

	code_string = _return_code( *istatus );
	len = strlen( code_string );
	strncpy( string, code_string, len );

	for( istring=len; istring
  
Modified: Fri Feb 6 05:31:58 1998 GMT
Page accessed 4510 times since Sat Apr 17 21:58:00 1999 GMT