Function make_array_declaration

src/gpre/languages/cob.cpp:3712–3826

//

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

	// Don't generate multiple declarations for the array.  V3 Bug 569.

	if (field->fld_array_info->ary_declared)
		return;

	field->fld_array_info->ary_declared = true;

	fprintf(gpreGlob.out_file, "%s01  %s%dL.\n", names[COLUMN_0], names[isc_a_pos],
			   field->fld_array_info->ary_ident);
	TEXT space[128];
	strcpy(space, "       ");

	// Print out the dimension part of the declaration
	const dim* dimension = field->fld_array_info->ary_dimension;
	int i = 3;
	for (; dimension->dim_next; dimension = dimension->dim_next, i += 2)
	{
		const int dimension_size = dimension->dim_upper - dimension->dim_lower + 1;
		printa(space, false, "%02d  %s%d%s%d OCCURS %d TIMES.",
			   i, names[isc_a_pos], field->fld_array_info->ary_ident,
			   names[UNDER], i, dimension_size);
		strcat(space, "   "); // Will overflow at 41 dimensions, is it relevant?
	}

	TEXT string1[256];
	TEXT* p = string1;
	const int dimension_size = dimension->dim_upper - dimension->dim_lower + 1;
	sprintf(p, "%02d  %s%d OCCURS %d TIMES ",
			i, names[isc_a_pos], field->fld_array_info->ary_ident, dimension_size);
	while (*p)
		p++;

	SSHORT digits, scale;

	switch (field->fld_array_info->ary_dtype)
	{
	case dtype_short:
	case dtype_long:
		digits = (field->fld_array_info->ary_dtype == dtype_short) ? 4 : 9;
		scale = field->fld_array->fld_scale;
		strcpy(p, "PIC S");
		while (*p)
			p++;
		if (scale >= -digits && scale <= 0)
		{
			if (scale > -digits)
				sprintf(p, "9(%d)", digits + scale);
			while (*p)
				p++;
			if (scale)
				sprintf(p, "V9(%d)", digits - (digits + scale));
		}
		else if (scale > 0)