OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

matmul.m4, [...]: Allocate space if return value has NULL in its data field.

Browse Source 
2004-09-09  Victor Leikehman  <lei@il.ibm.com>

	* m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c,
	intrinsics/eoshift2.c, intrinsics/transpose_generic.c:
	Allocate space if return value has NULL in its data field.
	* generated/*.c: Regenerate.

From-SVN: r85717
This commit is contained in:
Victor Leikehman 2004-08-09 14:34:39 +00:00 committed by Paul Brook
parent 705debec1e
commit 883c9d4d12
16 changed files with 387 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
libgfortran/ChangeLog
View File

@ -1,3 +1,10 @@
2004-09-09 Victor Leikehman <lei@il.ibm.com>
* m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c,
intrinsics/eoshift2.c, intrinsics/transpose_generic.c:
Allocate space if return value has NULL in its data field.
* generated/*.c: Regenerate.
2004-08-06 Janne Blomqvist <jblomqvi@cc.hut.fi>
* intrinsics/env.c: New file.

32
libgfortran/generated/matmul_c4.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_COMPLEX_4) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

32
libgfortran/generated/matmul_c8.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_COMPLEX_8) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

32
libgfortran/generated/matmul_i4.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

32
libgfortran/generated/matmul_i8.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

30
libgfortran/generated/matmul_l4.c
View File

@ -50,6 +50,36 @@ __matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_LOGICAL_4) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{

30
libgfortran/generated/matmul_l8.c
View File

@ -50,6 +50,36 @@ __matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_LOGICAL_8) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{

32
libgfortran/generated/matmul_r4.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_REAL_4) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

32
libgfortran/generated/matmul_r8.c
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -51,6 +51,36 @@ __matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (GFC_REAL_8) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

8
libgfortran/generated/transpose_i4.c
View File

@ -40,9 +40,8 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
if (ret->data == NULL)
{
ret->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (source));
ret->base = 0;
ret->dtype = source->dtype;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
ret->dim[0].lbound = 0;
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@ -51,6 +50,9 @@ __transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source)
ret->dim[1].lbound = 0;
ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
ret->dim[1].stride = ret->dim[0].ubound+1;
ret->data = internal_malloc (sizeof (GFC_INTEGER_4) * size0 (ret));
ret->base = 0;
}
if (ret->dim[0].stride == 0)

8
libgfortran/generated/transpose_i8.c
View File

@ -40,9 +40,8 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
if (ret->data == NULL)
{
ret->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (source));
ret->base = 0;
ret->dtype = source->dtype;
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
assert (ret->dtype == source->dtype);
ret->dim[0].lbound = 0;
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
@ -51,6 +50,9 @@ __transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source)
ret->dim[1].lbound = 0;
ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
ret->dim[1].stride = ret->dim[0].ubound+1;
ret->data = internal_malloc (sizeof (GFC_INTEGER_8) * size0 (ret));
ret->base = 0;
}
if (ret->dim[0].stride == 0)

27
libgfortran/intrinsics/eoshift0.c
View File

@ -1,4 +1,4 @@
/* Generic implementation of the RESHAPE intrinsic
/* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
@ -32,7 +32,7 @@ static const char zeros[16] =
sizeof(int) < sizeof (index_type). */
static void
__eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const char * pbound, int which)
{
/* r.* indicates the return array. */
@ -60,6 +60,25 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
size = GFC_DESCRIPTOR_SIZE (ret);
if (ret->data == NULL)
{
int i;
ret->data = internal_malloc (size * size0 ((array_t *)array));
ret->base = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
ret->dim[i].lbound = 0;
ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
if (i == 0)
ret->dim[i].stride = 1;
else
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
which = which - 1;
extent[0] = 1;
@ -170,7 +189,7 @@ __eoshift0 (const gfc_array_char * ret, const gfc_array_char * array,
void
__eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const char * pbound,
const GFC_INTEGER_4 * pdim)
{
@ -179,7 +198,7 @@ __eoshift0_4 (const gfc_array_char * ret, const gfc_array_char * array,
void
__eoshift0_8 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const char * pbound,
const GFC_INTEGER_8 * pdim)
{

27
libgfortran/intrinsics/eoshift2.c
View File

@ -1,4 +1,4 @@
/* Generic implementation of the RESHAPE intrinsic
/* Generic implementation of the EOSHIFT intrinsic
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
@ -32,7 +32,7 @@ static const char zeros[16] =
sizeof(int) < sizeof (index_type). */
static void
__eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift2 (gfc_array_char * ret, const gfc_array_char * array,
int shift, const gfc_array_char * bound, int which)
{
/* r.* indicates the return array. */
@ -61,6 +61,25 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
size = GFC_DESCRIPTOR_SIZE (ret);
if (ret->data == NULL)
{
int i;
ret->data = internal_malloc (size * size0 ((array_t *)array));
ret->base = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
{
ret->dim[i].lbound = 0;
ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
if (i == 0)
ret->dim[i].stride = 1;
else
ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
}
}
which = which - 1;
extent[0] = 1;
@ -186,7 +205,7 @@ __eoshift2 (const gfc_array_char * ret, const gfc_array_char * array,
void
__eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift2_4 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_4 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_4 * pdim)
{
@ -195,7 +214,7 @@ __eoshift2_4 (const gfc_array_char * ret, const gfc_array_char * array,
void
__eoshift2_8 (const gfc_array_char * ret, const gfc_array_char * array,
__eoshift2_8 (gfc_array_char * ret, const gfc_array_char * array,
const GFC_INTEGER_8 * pshift, const gfc_array_char * bound,
const GFC_INTEGER_8 * pdim)
{

17
libgfortran/intrinsics/transpose_generic.c
View File

@ -43,6 +43,23 @@ __transpose (gfc_array_char * ret, gfc_array_char * source)
&& GFC_DESCRIPTOR_RANK (ret) == 2);
size = GFC_DESCRIPTOR_SIZE (source);
if (ret->data == NULL)
{
assert (ret->dtype == source->dtype);
ret->dim[0].lbound = 0;
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
ret->dim[0].stride = 1;
ret->dim[1].lbound = 0;
ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
ret->dim[1].stride = ret->dim[0].ubound+1;
ret->data = internal_malloc (size * size0 ((array_t*)ret));
ret->base = 0;
}
sxstride = source->dim[0].stride * size;
if (sxstride == 0)
sxstride = size;

32
libgfortran/m4/matmul.m4
View File

@ -2,7 +2,7 @@
Copyright 2002 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfor).
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -52,6 +52,36 @@ void
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
bbase = b->data;
dest = retarray->data;

30
libgfortran/m4/matmull.m4
View File

@ -51,6 +51,36 @@ void
assert (GFC_DESCRIPTOR_RANK (a) == 2
|| GFC_DESCRIPTOR_RANK (b) == 2);
if (retarray->data == NULL)
{
if (GFC_DESCRIPTOR_RANK (a) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[0].stride = 1;
}
else if (GFC_DESCRIPTOR_RANK (b) == 1)
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
}
else
{
retarray->dim[0].lbound = 0;
retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
retarray->dim[0].stride = 1;
retarray->dim[1].lbound = 0;
retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
retarray->dim[1].stride = retarray->dim[0].ubound+1;
}
retarray->data = internal_malloc (sizeof (rtype_name) * size0 (retarray));
retarray->base = 0;
}
abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4)
{