Function make_array_declaration

src/gpre/languages/ftn.cpp:3586–3671

//

static void make_array_declaration( const ref* reference)
{
	const gpre_fld* field = reference->ref_field;
	const SCHAR* const name = field->fld_symbol->sym_string;

	// Check to see if the array already has been
	// declared in this routine or subroutine
	if (array_decl_list)
	{
		for (adl* loop_array = array_decl_list; loop_array; loop_array = loop_array->adl_next)
		{
			if (field->fld_array_info->ary_ident == loop_array->adl_gds_ident)
			{
				return;
			}
        }
    }

	// If not, add it to the "declared" list and declare it
	adl* this_array = (adl*) MSC_alloc(ADL_LEN);
	this_array->adl_gds_ident = field->fld_array_info->ary_ident;
	if (array_decl_list)
		this_array->adl_next = array_decl_list;
	else
		this_array->adl_next = NULL;
	array_decl_list = this_array;

	switch (field->fld_array_info->ary_dtype)
	{
	case dtype_short:
		fprintf(gpreGlob.out_file, "%sINTEGER*2%s", COLUMN, COLUMN);
		break;

	case dtype_long:
		fprintf(gpreGlob.out_file, "%sINTEGER*4%s", COLUMN, COLUMN);
		break;

	case dtype_date:
	case dtype_blob:
	case dtype_quad:
		fprintf(gpreGlob.out_file, "%sINTEGER*4%s", COLUMN, COLUMN);
		break;

	case dtype_text:
		fprintf(gpreGlob.out_file, "%sCHARACTER*%d%s", COLUMN, field->fld_array->fld_length, COLUMN);
		break;

	case dtype_real:
		fprintf(gpreGlob.out_file, "%sREAL%s", COLUMN, COLUMN);
		break;

	case dtype_double:
		fprintf(gpreGlob.out_file, "%s%s%s", COLUMN, DOUBLE_DCL, COLUMN);
		break;

	default:
	    {
			TEXT s[64];