/* created by combine 2.0 */
/* file ADFAAA2.c */
/***********************************************************************
   ADF Core:
   Glue routines between the FORTRAN interface and the C interface.

***********************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "ADF.h"
#include "ADF_internals.h"
#ifdef MEM_DEBUG
#include "cg_malloc.h"
#endif

/* end of file ADFAAA2.c */
/* file ADFCNA2.c */
/***********************************************************************
ADFCNAM   ADF_Children_Names:
***********************************************************************/
void    FNAME(adfcna2,ADFCNA2)(
                const Fdouble *PID,
                const Fint *istart,
                const Fint *imaxnum,
                const Fint *idim,
                const Fint *name_length,
                Fint *inum_ret,
                Fchar names,
                Fint *error_return )
{
int i;
char *pstr, *tmp_names;

if( *idim != *name_length ) {  /** inconsistency **/
   *error_return = BAD_DIMENSION_VALUE ;  /** not really what this error code
                                              was meant for but it might do **/
   return ;
   } /* end if */

pstr = F2CP(names);

tmp_names = (char *) malloc( (*imaxnum) * (*name_length + 1) * (sizeof(char)) ) ;
if( tmp_names == NULL ) {
   *error_return = MEMORY_ALLOCATION_FAILED ;
   return ;
   } /* end if */

ADF_Children_Names( *PID, *istart, *imaxnum, *name_length, inum_ret,
   tmp_names, error_return ) ;
if( *error_return != NO_ERROR ) {
   free( tmp_names ) ;
   return ;
   } /* end if */

for( i=0; i<*inum_ret; i++ )   { /* Blank-fill the names */
   if( strlen( &tmp_names[ i * (*name_length+1) ]) == *name_length ) {
/** string is maximum length, do not null terminate or blank fill **/
      strncpy( &pstr[ i * (*name_length) ], &tmp_names[ i * (*name_length+1) ],
               *name_length ) ;
      }
   else {
/** string is short enough, blank fill remainder **/
      strcpy( &pstr[ i * (*name_length) ], &tmp_names[ i * (*name_length+1) ] ) ;
      ADFI_blank_fill_string( &pstr[ i * (*name_length) ], *name_length ) ;
      } /* end if */
   } /* end for */

free( tmp_names ) ;
}
/* end of file ADFCNA2.c */
/* file ADFCID2.c */
/***********************************************************************
ADFCNAM   ADF_Children_IDs:
***********************************************************************/
void    FNAME(adfcid2,ADFCID2)(
                const Fdouble *PID,
                const Fint *istart,
                const Fint *imaxnum,
                Fint *inum_ret,
                Fdouble *CIDs,
                Fint *error_return )
{
ADF_Children_IDs( *PID, *istart, *imaxnum, inum_ret, CIDs, error_return ) ;
}
/* end of file ADFCID2.c */
/* file ADFCRE2.c */
/***********************************************************************
ADFCRE    ADF_Create:
***********************************************************************/
void    FNAME(adfcre2,ADFCRE2)(
                const Fdouble *PID,
                const Fchar name,
		const Fint *name_length,
                Fdouble *ID,
                Fint *error_return )
{
char	c_name[ ADF_NAME_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(name), MIN(ADF_NAME_LENGTH, *name_length), c_name,
	error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Create( *PID, c_name, ID, error_return ) ;
}
/* end of file ADFCRE2.c */
/* file ADFDCL2.c */
/***********************************************************************
ADFDCLO   ADF_Database_Close:
***********************************************************************/
void    FNAME(adfdcl2,ADFDCL2)(
                const Fdouble *Root_ID,
                Fint *error_return )
{
ADF_Database_Close( *Root_ID, error_return ) ;
}
/* end of file ADFDCL2.c */
/* file ADFDDE2.c */
/***********************************************************************
ADFDDEL   ADF_Database_Delete:
***********************************************************************/
void    FNAME(adfdde2,ADFDDE2)(
                const Fchar filename,
		const Fint *name_length,
                Fint *error_return )
{
char	c_name[ ADF_FILENAME_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(filename), MIN(ADF_FILENAME_LENGTH, *name_length),
	c_name, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADF_Database_Delete( c_name, error_return ) ;
}
/* end of file ADFDDE2.c */
/* file ADFDEL2.c */
/***********************************************************************
ADFDEL    ADF_Delete:
***********************************************************************/
void    FNAME(adfdel2,ADFDEL2)(
                const Fdouble *PID,
                const Fdouble *ID,
                Fint *error_return )
{
ADF_Delete( *PID, *ID, error_return ) ;
}
/* end of file ADFDEL2.c */
/* file ADFDGC2.c */
/***********************************************************************
ADFDGC    ADF_Database_Garbage_Collection:
***********************************************************************/
void    FNAME(adfdgc2,ADFDGC2)(
                const Fdouble *ID,
                Fint *error_return )
{
ADF_Database_Garbage_Collection( *ID, error_return ) ;
}
/* end of file ADFDGC2.c */
/* file ADFDGF2.c */
/***********************************************************************
ADFDGF    ADF_Database_Get_Format:
***********************************************************************/
void    FNAME(adfdgf2,ADFDGF2)(
                const Fdouble *Root_ID,
                Fchar format,
                const Fint *format_length,
                Fint *error_return )
{
ADF_Database_Get_Format( *Root_ID, F2CP(format), error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADFI_blank_fill_string( F2CP(format), *format_length ) ;
}
/* end of file ADFDGF2.c */
/* file ADFDOP2.c */
/***********************************************************************
ADFDOPN   ADF_Database_Open:
***********************************************************************/
void    FNAME(adfdop2,ADFDOP2)(
                const Fchar filename,
		const Fint *filename_length,
                Fchar status_in,
		const Fint *status_length,
                const Fchar format,
		const Fint *format_length,
                Fdouble *Root_ID,
                Fint *error_return )
{
char	c_filename[ ADF_FILENAME_LENGTH + 1 ],
	c_status[ ADF_NAME_LENGTH+1 ],
	c_format[ ADF_NAME_LENGTH+1 ] ;

ADFI_string_2_C_string( F2CP(filename),
        MIN(ADF_FILENAME_LENGTH, *filename_length),
	c_filename, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADFI_string_2_C_string( F2CP(status_in),
        MIN(ADF_NAME_LENGTH, *status_length),
	c_status, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADFI_string_2_C_string( F2CP(format),
        MIN(ADF_NAME_LENGTH, *format_length), c_format,
	error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Database_Open( c_filename, c_status, c_format,
                Root_ID, error_return ) ;
}
/* end of file ADFDOP2.c */
/* file ADFDSF2.c */
/***********************************************************************
ADFDSF    ADF_Database_Set_Format:
***********************************************************************/
void    FNAME(adfdsf2,ADFDSF2)(
                const Fdouble *Root_ID,
                const Fchar format,
		const Fint *format_length,
                Fint *error_return )
{
char	c_format[ ADF_NAME_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(format),
        MIN(ADF_NAME_LENGTH, *format_length), c_format,
	error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Database_Set_Format( *Root_ID, c_format, error_return ) ;
}
/* end of file ADFDSF2.c */
/* file ADFDVE2.c */
/***********************************************************************
ADVDVER   ADF_Database_Version:
***********************************************************************/
void    FNAME(adfdve2,ADFDVE2)(
                const Fdouble *Root_ID,
                Fchar version,
                Fchar creation_date,
                Fchar modification_date,
		const Fint *v_length,
		const Fint *c_length,
		const Fint *m_length,
                Fint *error_return )
{
ADF_Database_Version( *Root_ID, F2CP(version), F2CP(creation_date),
                F2CP(modification_date), error_return ) ;

ADFI_blank_fill_string( F2CP(version), *v_length ) ;
ADFI_blank_fill_string( F2CP(creation_date), *c_length ) ;
ADFI_blank_fill_string( F2CP(modification_date), *m_length ) ;
}
/* end of file ADFDVE2.c */
/* file ADFERR2.c */
/***********************************************************************
ADFERR    ADF_Error_Message:
***********************************************************************/
void    FNAME(adferr2,ADFERR2)(
                const Fint *error_return_input,
                Fchar error_string,
                const Fint *str_length )
{
char  msg_buf[ADF_MAX_ERROR_STR_LENGTH+1] ;

ADF_Error_Message( *error_return_input, msg_buf ) ;
strncpy( F2CP(error_string), msg_buf, *str_length ) ;
ADFI_blank_fill_string( F2CP(error_string), *str_length ) ;
}
/* end of file ADFERR2.c */
/* file ADFFTD2.c */
/***********************************************************************
ADFFTD    ADF_Flush_to_Disk:
***********************************************************************/
void    FNAME(adfftd2,ADFFTD2)(
                const Fdouble *ID,
                Fint *error_return )
{
ADF_Flush_to_Disk( *ID, error_return ) ;
}
/* end of file ADFFTD2.c */
/* file ADFGDT2.c */
/***********************************************************************
ADFGDT    ADF_Get_Data_Type:
***********************************************************************/
void    FNAME(adfgdt2,ADFGDT2)(
                const Fdouble *ID,
                Fchar data_type,
                const Fint *data_type_length,
                Fint *error_return )
{
char  ctype[ ADF_DATA_TYPE_LENGTH + 1 ] ;

ADF_Get_Data_Type( *ID, ctype, error_return ) ;
if( *error_return == NO_ERROR ) {
   if( strlen( ctype ) < *data_type_length ) {
      strcpy( F2CP(data_type), ctype ) ;
      ADFI_blank_fill_string( F2CP(data_type), *data_type_length ) ;
      }
   else {
      strncpy( F2CP(data_type), ctype, *data_type_length ) ;
      } /* end if */
   } /* end if */
}
/* end of file ADFGDT2.c */
/* file ADFGDV2.c */
/***********************************************************************
ADFGDV    ADF_Get_Dimension_Values:
***********************************************************************/
void    FNAME(adfgdv2,ADFGDV2)(
                const Fdouble *ID,
                Fint dim_vals[],
                Fint *error_return )
{
ADF_Get_Dimension_Values( *ID, dim_vals, error_return ) ;
}
/* end of file ADFGDV2.c */
/* file ADFGES2.c */
/***********************************************************************
ADFGES    ADF_Get_Error_State:
***********************************************************************/
void    FNAME(adfges2,ADFGES2)(
                Fint *error_state,
                Fint *error_return )
{
ADF_Get_Error_State( error_state, error_return ) ;
}
/* end of file ADFGES2.c */
/* file ADFGLB2.c */
/***********************************************************************
ADFGLB    ADF_Get_Label:
***********************************************************************/
void    FNAME(adfglb2,ADFGLB2)(
                const Fdouble *ID,
                Fchar label,
                const Fint *label_length,
                Fint *error_return )
{
char  clabel[ ADF_LABEL_LENGTH + 1 ] ;

ADF_Get_Label( *ID, clabel, error_return ) ;
if( *error_return == NO_ERROR ) {
   if( strlen( clabel ) < *label_length ) {
      strcpy( F2CP(label), clabel ) ;
      ADFI_blank_fill_string( F2CP(label), *label_length ) ;
      }
   else {
      strncpy( F2CP(label), clabel, *label_length ) ;
      } /* end if */
   } /* end if */
}
/* end of file ADFGLB2.c */
/* file ADFGLK2.c */
/***********************************************************************
ADFGLKP   ADF_Get_Link_Path:
***********************************************************************/
void    FNAME(adfglk2,ADFGLK2)(
                const Fdouble *ID,
                Fchar filename,
                const Fint *filename_length,
                Fchar link_path,
                const Fint *link_path_length,
                Fint *error_return )
{
char  cpath[ ADF_MAX_LINK_DATA_SIZE + 1 ],
      cfilename[ ADF_FILENAME_LENGTH + 1 ] ;

ADF_Get_Link_Path( *ID, cfilename, cpath, error_return ) ;
if( *error_return == NO_ERROR ) {
   if( strlen(cfilename) < *filename_length ) {
      strcpy( F2CP(filename), cfilename ) ;
      ADFI_blank_fill_string( F2CP(filename), *filename_length ) ;
      }
   else {
      strncpy( F2CP(filename), cfilename, *filename_length ) ;
      } /* end if */

   if( strlen(cpath) < *link_path_length ) {
      strcpy( F2CP(link_path), cpath ) ;
      ADFI_blank_fill_string( F2CP(link_path), *link_path_length ) ;
      }
   else {
      strncpy( F2CP(link_path), cpath, *link_path_length ) ;
      } /* end if */
   } /* end if */
}
/* end of file ADFGLK2.c */
/* file ADFGNA2.c */
/***********************************************************************
ADFGNAM   ADF_Get_Name:
***********************************************************************/
void    FNAME(adfgna2,ADFGNA2)(
                const Fdouble *ID,
                Fchar name,
                const Fint *name_length,
                Fint *error_return )
{
char  cname[ ADF_NAME_LENGTH + 1 ] ;

ADF_Get_Name( *ID, cname, error_return ) ;
if( *error_return == NO_ERROR ) {
   if( strlen( cname ) < *name_length ) {
      strcpy( F2CP(name), cname ) ;
      ADFI_blank_fill_string( F2CP(name), *name_length ) ;
      }
   else {
      strncpy( F2CP(name), cname, *name_length ) ;
      } /* end if */
   } /* end if */
}
/* end of file ADFGNA2.c */
/* file ADFGND2.c */
/***********************************************************************
ADFGND    ADF_Get_Number_of_Dimensions:
***********************************************************************/
void    FNAME(adfgnd2,ADFGND2)(
                const Fdouble *ID,
                Fint *num_dims,
                Fint *error_return )
{
ADF_Get_Number_of_Dimensions( *ID, num_dims, error_return ) ;
}
/* end of file ADFGND2.c */
/* file ADFGNI2.c */
/***********************************************************************
ADFGNID   ADF_Get_Node_ID:
***********************************************************************/
void    FNAME(adfgni2,ADFGNI2)(
                const Fdouble *PID,
                const Fchar name,
		const Fint *name_length,
                Fdouble *ID,
                Fint *error_return )
{
char	c_name[ ADF_FILENAME_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(name), MIN(ADF_FILENAME_LENGTH, *name_length),
	c_name, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADF_Get_Node_ID( *PID, c_name, ID, error_return ) ;
}
/* end of file ADFGNI2.c */
/* file ADFGRI2.c */
/***********************************************************************
ADFGRID   ADF_Get_Root_ID:
***********************************************************************/
void    FNAME(adfgri2,ADFGRI2)(
                const Fdouble *ID,
                Fdouble *Root_ID,
                Fint *error_return )
{
ADF_Get_Root_ID( *ID, Root_ID, error_return ) ;
}
/* end of file ADFGRI2.c */
/* file ADFISL2.c */
/***********************************************************************
ADFISLK   ADF_Is_Link:
***********************************************************************/
void    FNAME(adfisl2,ADFISL2)(
                const Fdouble *ID,
                Fint *link_path_length,
                Fint *error_return )
{
ADF_Is_Link( *ID, link_path_length, error_return ) ;
}
/* end of file ADFISL2.c */
/* file ADFLIN2.c */
/***********************************************************************
ADFLINK   ADF_Link:
***********************************************************************/
void    FNAME(adflin2,ADFLIN2)(
                const Fdouble *PID,
                const Fchar name,
                const Fchar file,
                const Fchar name_in_file,
		const Fint *name_length,
		const Fint *file_length,
		const Fint *nfile_length,
                Fdouble *ID,
                Fint *error_return )
{
char	c_name[ ADF_FILENAME_LENGTH + 1 ],
	c_file[ ADF_FILENAME_LENGTH + 1 ],
	c_nfile[ ADF_MAX_LINK_DATA_SIZE + 1 ] ;

ADFI_string_2_C_string( F2CP(name),
                MIN(ADF_FILENAME_LENGTH, *name_length),
		c_name, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADFI_string_2_C_string( F2CP(file),
                MIN(ADF_FILENAME_LENGTH, *file_length),
		c_file, error_return ) ;
if( *error_return != NO_ERROR )
   return ;
ADFI_string_2_C_string( F2CP(name_in_file),
                MIN(ADF_MAX_LINK_DATA_SIZE, *nfile_length),
		c_nfile,
	error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Link( *PID, c_name, c_file, c_nfile, ID, error_return ) ;
}
/* end of file ADFLIN2.c */
/* file ADFLVE2.c */
/***********************************************************************
ADFLVER   ADF_Library_Version:
***********************************************************************/
void    FNAME(adflve2,ADFLVE2)(
                Fchar version,
		const Fint *version_length,
                Fint *error_return )
{
ADF_Library_Version( F2CP(version), error_return ) ;
ADFI_blank_fill_string ( F2CP(version), *version_length );
}
/* end of file ADFLVE2.c */
/* file ADFMOV2.c */
/***********************************************************************
ADFMOVE   ADF_Move_Child:
***********************************************************************/
void    FNAME(adfmov2,ADFMOV2)(
                const Fdouble *PID,
                const Fdouble *ID,
                const Fdouble *NPID,
                Fint *error_return )
{
ADF_Move_Child( *PID, *ID, *NPID, error_return ) ;
}
/* end of file ADFMOV2.c */
/* file ADFNCL2.c */
/***********************************************************************
ADFNCLD   ADF_Number_of_Children:
***********************************************************************/
void    FNAME(adfncl2,ADFNCL2)(
                const Fdouble *ID,
                Fint *num_children,
                Fint *error_return )
{
ADF_Number_of_Children( *ID, num_children, error_return ) ;
}
/* end of file ADFNCL2.c */
/* file ADFPDI2.c */
/***********************************************************************
ADFPDIM   ADF_Put_Dimension_Information:
***********************************************************************/
void    FNAME(adfpdi2,ADFPDI2)(
                const Fdouble *ID,
                const Fchar data_type,
                const Fint *data_type_length,
                const Fint *dims,
                const Fint dim_vals[],
                Fint *error_return )
{
char    c_data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;

/* CMLU */
int i;
for (i=0;i<ADF_DATA_TYPE_LENGTH;i++)
   c_data_type[i] = ' ';
c_data_type[i] = '\0';


ADFI_string_2_C_string( F2CP(data_type),
        MIN(ADF_DATA_TYPE_LENGTH, *data_type_length),
        c_data_type, error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Put_Dimension_Information( *ID, c_data_type, *dims, dim_vals,
                error_return ) ;
}
/* end of file ADFPDI2.c */
/* file ADFPNA2.c */
/***********************************************************************
ADFPNAM   ADF_Put_Name:
***********************************************************************/
void    FNAME(adfpna2,ADFPNA2)(
                const Fdouble *PID,
                const Fdouble *ID,
                const Fchar name,
                const Fint *name_length,
                Fint *error_return )
{
char    c_name[ ADF_NAME_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(name),
                MIN(ADF_NAME_LENGTH, *name_length), c_name,
                error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Put_Name( *PID, *ID, c_name, error_return ) ;
}
/* end of file ADFPNA2.c */
/* file ADFRAL2.c */
/* end of file ADFRAL2.c */
/* file ADFRALL.c */
/***********************************************************************
ADFRALL   ADF_Read_All_Data:
   Read all data from a Node.  Reads all the node's data and returns
   it into a contiguous memory space.

   input:   real*8          ID             The ID of the node to use.
   output:  character *(*)  data           The start of the data in memory.
   output:  integer         error_return   Error flag.
***********************************************************************/
void    FNAME(adfrall,ADFRALL)(
                const Fdouble *ID,
                Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** see ADFWALL() for more details **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      printf( "%s\n", errmsg ) ;
      printf( "Unrecoverable ADF error.  ADFRALL\n" ) ;
      printf( "Cannot determine data type, so cannot determine function\n" ) ;
      printf( "argument list (character arrays are different than other\n" ) ;
      printf( "types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Read_All_Data( *ID, F2CP(data), error_return ) ;
      }
   else {
/** expecting non-character data type **/

      ADF_Read_All_Data( *ID, data.c_pointer, (int *)data.fcd_len ) ;
      }

#else

   ADF_Read_All_Data( *ID, F2CP(data), error_return ) ;

#endif
}
/* end of file ADFRALL.c */
/* file ADFRBLK.c */
/***********************************************************************
ADFRBLK   ADF_Read_Block_Data:
   Read block of data from a Node.  Reads a block of the node's data and
   returns it into a contiguous memory space.

   input:   real*8  ID               The ID of the node to use.
   input:   const int b_start	     The starting point in block in token space
   input:   const int b_end          The ending point in block in token space
   output:  character *(*) data      The start of the data in memory.
   output:  integer   error_return   Error flag.
***********************************************************************/
void    FNAME(adfrblk,ADFRBLK)(
                const Fdouble *ID,
                const Fint *b_start,
                const Fint *b_end,
                Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** see ADFWALL() for more details **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      fprintf(stderr,"%s\n", errmsg ) ;
      fprintf(stderr,"Unrecoverable ADF error.  ADFRBLK\n" ) ;
      fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
      fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
      fprintf(stderr,"types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
               F2CP(data), error_return ) ;
      }
   else {
/** expecting non-character data type **/

      ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
               data.c_pointer, (int *)data.fcd_len ) ;
      }

#else

   ADF_Read_Block_Data( *ID, (long) *b_start, (long) *b_end,
               F2CP(data), error_return ) ;

#endif
}
/* end of file ADFRBLK.c */
/* file ADFREA2.c */
/* end of file ADFREA2.c */
/* file ADFREAD.c */
/***********************************************************************
ADFREAD   ADF_Read_Data:

   A 1-based system is used with all index values  (the first element has
   an index of 1, not 0).
   R1: Read data from a node, with partial capabilities.  The partial
   capabilities are both in the node's data and also in memory.
   Vectors of integers are used to indicate the data to be accessed
   from the node, and another set of integer vectors is used to
   describe the memory location for the data.
    Note:  If the data-type of the node is a compound data-type ("I4[3],R8")
   for example, the partial capabilities will access one or more of
   these 20-byte data entities.  You cannot access a subset of an
   occurrence of the data-type.

   f77: ADFREAD( ID, sstart[], send[], sstrid[], mnumd,
       mdims[], mstart[], mend[], mstrid[], data, ierr )
   input:  real*8  ID            The ID of the node to use.
   input:  integer sstart(12)    The starting dimension values to use
                                 in the database (node).
   input:  integer send(12)      The ending dimension values to use in
                                 the database (node).
   input:  integer sstrid(12)    The stride values to use in the
                                 database (node).
   input:  integer mnumd         The number of dimensions to use in memory.
   input:  integer mdims(mnumd)  The dimensionality to use in memory.
   input:  integer mstart(mnumd) The starting dimension values
                                 to use in memory.
   input:  integer mend(mnumd)   The ending dimension values to
                                 use in memory.
   input:  integer mstrid(mnumd) The stride values to use
                                 in memory.
   output:  character*(*) data   The start of the data in memory.
   output:  integer ierr

***********************************************************************/
void    FNAME(adfread,ADFREAD)(
                const Fdouble *ID,
                const Fint s_start[],
                const Fint s_end[],
                const Fint s_stride[],
                const Fint *m_num_dims,
                const Fint m_dims[],
                const Fint m_start[],
                const Fint m_end[],
                const Fint m_stride[],
                Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** see ADFWALL() for more details **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      fprintf(stderr,"%s\n", errmsg ) ;
      fprintf(stderr,"Unrecoverable ADF error.  ADFREAD\n" ) ;
      fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
      fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
      fprintf(stderr,"types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                     m_start, m_end, m_stride, F2CP(data), error_return ) ;
   }
   else {
/** expecting non-character data type **/

      ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                     m_start, m_end, m_stride,
                     data.c_pointer, (int *)data.fcd_len ) ;
   }

#else

   ADF_Read_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                  m_start, m_end, m_stride, F2CP(data), error_return ) ;

#endif
}
/* end of file ADFREAD.c */
/* file ADFSES2.c */
/***********************************************************************
ADFSES    ADF_Set_Error_State:
***********************************************************************/
void    FNAME(adfses2,ADFSES2)(
                const Fint *error_state,
                Fint *error_return )
{
ADF_Set_Error_State( *error_state, error_return ) ;
}
/* end of file ADFSES2.c */
/* file ADFSLB2.c */
/***********************************************************************
ADFSLB    ADF_Set_Label:
***********************************************************************/
void    FNAME(adfslb2,ADFSLB2)(
                const Fdouble *ID,
                const Fchar label,
                const Fint *label_length,
                Fint *error_return )
{
char    c_label[ ADF_LABEL_LENGTH + 1 ] ;

ADFI_string_2_C_string( F2CP(label),
                MIN(ADF_LABEL_LENGTH, *label_length),
                c_label, error_return ) ;
if( *error_return != NO_ERROR )
   return ;

ADF_Set_Label( *ID, c_label, error_return ) ;
}
/* end of file ADFSLB2.c */
/* file ADFWAL2.c */
/* end of file ADFWAL2.c */
/* file ADFWALL.c */
/***********************************************************************
ADFWALL   ADF_Write_All_Data:
   Write all data to a Node.  Writes all the node's data from a
   contiguous memory space.

   input:    real*8         ID             The node's id.
   input:    character *(*) data           The start of data in memory.
   output:   integer        error_return   Error flag.
***********************************************************************/
void    FNAME(adfwall,ADFWALL)(
                const Fdouble *ID,
                const Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** On Crays with 64 bit addresses (like Tritons), Fortran
    character arrays occupy two 64 bit words on argument stacks
    (see <fortran.h>).  Other data (INTEGER, REAL, etc) occupy one word.
    To accommodate both situations with one function, some tricks
    need to be employed... **/

/** First, find the data type that ADF is expecting and assume the
    function is being called with that kind of argument.  This
    function is defined with character data in mind and deviates
    from that if necessary. **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      fprintf(stderr,"%s\n", errmsg ) ;
      fprintf(stderr,"Unrecoverable ADF error.  ADFWALL\n" ) ;
      fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
      fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
      fprintf(stderr,"types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Write_All_Data( *ID, F2CP(data), error_return ) ;
   }
   else {

/** expecting data type other than character - the stack is not as
    long as is with character data and so "error_return" does not
    correspond to anything valid.  Since "data" is declared Fchar but
    the actual argument is not, the second half of "data" contains
    the error flag argument (the stack is assumed to be contiguous). **/

      ADF_Write_All_Data( *ID, data.c_pointer, (int *)data.fcd_len ) ;
   }

#else

/** In other CRAY environments the declared length is encoded in
    unused portions of pointers and the F2CP macro handles its
    conversion.
    In other environments, the character array declared length
    mystery argument is assumed to be on the end of the stack and
    is ignored here (F2CP macro does nothing). **/

   ADF_Write_All_Data( *ID, F2CP(data), error_return ) ;

#endif
}
/* end of file ADFWALL.c */
/* file ADFWBLK.c */
/***********************************************************************
ADFWBLK   ADF_Write_Block_Data:
   Write block of data from a Node.  Writes a block of the node's data and
   returns it into a contiguous memory space.

   input:   real*8    ID               The ID of the node to use.
   input:   const int b_start          The starting point in block in token space
   input:   const int b_end            The ending point in block in token space
   output:  character *(*)  data       The start of the data in memory.
   output:  integer   error_return     Error flag.
***********************************************************************/
void    FNAME(adfwblk,ADFWBLK)(
                const Fdouble *ID,
                const Fint *b_start,
                const Fint *b_end,
                Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** see ADFWALL() for more details **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      fprintf(stderr,"%s\n", errmsg ) ;
      fprintf(stderr,"Unrecoverable ADF error.  ADFWBLK\n" ) ;
      fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
      fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
      fprintf(stderr,"types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
		 	    F2CP(data), error_return ) ;
      }
   else {
/** expecting non-character data type **/

      ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
                data.c_pointer, (int *)data.fcd_len ) ;
      }

#else

   ADF_Write_Block_Data( *ID, (long) *b_start, (long) *b_end,
                F2CP(data), error_return ) ;

#endif
}
/* end of file ADFWBLK.c */
/* file ADFWRI2.c */
/* end of file ADFWRI2.c */
/* file ADFWRIT.c */
/***********************************************************************
ADFWRIT   ADF_Write_Data:
   Write data to a Node, with partial capabilities.
   See ADF_Read_Data for description.

   f77: ADFWRIT( ID, sstart[], send[], sstrid[], mnumd,
                 mdims[], mstart[], mend[], mstrid[], data, ierr )
   input:  real*8 ID             The ID of the node to use.
   input:  integer sstart(12)    The starting dimension values to use
                                 in the database (node).
   input:  integer send(12)      The ending dimension values to use in
                                 the database (node).
   input:  integer sstrid(12)    The stride values to use in the
                                 database (node).
   input:  integer mnumd         The number of dimensions to use in memory.
   input:  integer mdims(mnumd)  The dimensionality to use in memory.
   input:  integer mstart(mnumd) The starting dimension values to use
                                 in memory.
   input:  integer mend(mnumd)   The ending dimension values to use in
                                  memory.
   input:  integer mstrid(mnumd) The stride values to use in memory.
   input:  character*(*) data    The start of the data in memory.
   output: integer ierr


***********************************************************************/
void    FNAME(adfwrit,ADFWRIT)(
                const Fdouble *ID,
                const Fint s_start[],
                const Fint s_end[],
                const Fint s_stride[],
                const Fint *m_num_dims,
                const Fint m_dims[],
                const Fint m_start[],
                const Fint m_end[],
                const Fint m_stride[],
                const Fchar data,
                Fint *error_return )
{

#if  defined(cray) && defined(_ADDR64)

int  local_error ;
char data_type[ ADF_DATA_TYPE_LENGTH + 1 ] ;
char errmsg[ ADF_MAX_ERROR_STR_LENGTH + 1 ] ;

/** see ADFWALL() for more details **/

   ADF_Get_Data_Type( *ID, data_type, &local_error ) ;
   if( local_error != NO_ERROR ) {
      ADF_Error_Message( local_error, errmsg ) ;
      fprintf(stderr,"%s\n", errmsg ) ;
      fprintf(stderr,"Unrecoverable ADF error.  ADFWRIT\n" ) ;
      fprintf(stderr,"Cannot determine data type, so cannot determine function\n" ) ;
      fprintf(stderr,"argument list (character arrays are different than other\n" ) ;
      fprintf(stderr,"types in this environment), so cannot set error_return.\n" ) ;
      abort () ;
      } /* end if */

   if ( ADFI_stridx_c( data_type, "C1" ) >= 0 ) {
/** expecting character data type **/

      ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                      m_start, m_end, m_stride, F2CP(data), error_return ) ;
   }
   else {
/** expecting non-character data type **/

      ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                      m_start, m_end, m_stride,
                      data.c_pointer, (int *)data.fcd_len ) ;
   }

#else
   ADF_Write_Data( *ID, s_start, s_end, s_stride, *m_num_dims, m_dims,
                   m_start, m_end, m_stride, F2CP(data), error_return ) ;

#endif
}
/* end of file ADFWRIT.c */
/* end of combine 2.0 */
