Bug on Reshape with non contiguous array since 12.5

Hello

I’m using pgi/12.8 .

Since at least the pgi/12.5 version the reshape function doesn’t work correctly for non contiguous array passed as argument to subroutines .

Here is small example to extract interior points , with value 1, in 1D array from a 2D domain with ‘halo’ points value 0 .

OK Compiled with pgi/11.10 version :

test_halo_reshape_2D_1D
==== I2D=All 2D domaine ====
0 0 0 0
0 > 1 1 > 0
0 > 1 1 > 0
0 0 0 0
=== I1D=Interior Points ===
1 1 1 1

BUG Compiled with pgi/12.5 and over

test_halo_reshape_2D_1D
==== I2D=All 2D domaine ====
0 0 0 0
0 > 1 1 > 0
0 > 1 1 > 0
0 0 0 0
=== I1D=Interior Points ===
1 1 > 0 0

Here is the sample code compiled by

pgf90 -g test_halo_reshape_2D_1D.f90 -o test_halo_reshape_2D_1D


PROGRAM HALO_RESHAPE

  IMPLICIT NONE

  INTEGER, PARAMETER                    :: NI=2 , NHALO = 1 , NIEXT = NI + 2 * NHALO
  INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: I2D
  INTEGER, ALLOCATABLE, DIMENSION(:)    :: I1D

  INTEGER                               :: I,IIB,IIE

  ALLOCATE (I2D(NIEXT,NIEXT))
  ALLOCATE (I1D(NI*NI))

  IIB=1+NHALO
  IIE=NIEXT-NHALO
  !
  ! Field I2D with 1 in interior and 0 in the halo
  !
  I2D = 0
  I2D(IIB:IIE,IIB:IIE) = 1

  print*," ==== I2D=All 2D domaine ===="
  DO I=1,NIEXT
     print*,I2D(:,I)
  END DO

  !
  ! get linearized interior points
  !
  CALL  PACK_2D_1D(I2D(IIB:IIE,IIB:IIE),I1D )
  print*," === I1D=Interior Points ==="
  print*,I1D

CONTAINS
  SUBROUTINE PACK_2D_1D(K2D,K1D)
    IMPLICIT NONE
    INTEGER, DIMENSION(:,:), INTENT(IN) :: K2D
    INTEGER, DIMENSION(:),   INTENT(OUT):: K1D

    K1D=RESHAPE(K2D, (/ SIZE(K2D) /) )

  END SUBROUTINE PACK_2D_1D

END PROGRAM HALO_RESHAPE

A+

Juan

Hi Juan,

Thanks for the report. I’ve submitted a problem report (TPR#18936) and sent it on to engineering. It looks to me to be a problem with how we’re passing in the temp I2D array into PACK_2D_1D which in turn causes reshape to return the wrong values. The work around would be to not pass in I2D and call reshape from the main program:

% cat reshape.f90

PROGRAM HALO_RESHAPE

  IMPLICIT NONE

  INTEGER, PARAMETER                    :: NI=2 , NHALO = 1 , NIEXT = NI + 2 * NHALO
  INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: I2D
  INTEGER, ALLOCATABLE, DIMENSION(:)    :: I1D

  INTEGER                               :: I,IIB,IIE

  ALLOCATE (I2D(NIEXT,NIEXT))
  ALLOCATE (I1D(NI*NI))

  IIB=1+NHALO
  IIE=NIEXT-NHALO
  !
  ! Field I2D with 1 in interior and 0 in the halo
  !
  I2D = 0
  I2D(IIB:IIE,IIB:IIE) = 1

  print*," ==== I2D=All 2D domaine ===="
  DO I=1,NIEXT
     print*,I2D(:,I)
  END DO

  !
  ! get linearized interior points
  !
  !CALL  PACK_2D_1D(I2D(IIB:IIE,IIB:IIE),I1D )
  I1D=RESHAPE(I2D(IIB:IIE,IIB:IIE), (/ SIZE(I2D(IIB:IIE,IIB:IIE)) /) )
  print*," === I1D=Interior Points ==="
  print*,I1D

CONTAINS
  SUBROUTINE PACK_2D_1D(K2D,K1D)
    IMPLICIT NONE
    INTEGER, DIMENSION(:,:), INTENT(IN) :: K2D
    INTEGER, DIMENSION(:),   INTENT(OUT):: K1D
    K1D=RESHAPE(K2D, (/ SIZE(K2D) /) )

  END SUBROUTINE PACK_2D_1D

END PROGRAM HALO_RESHAPE 
% pgf90 reshape.f90 -V12.8
% a.out
  ==== I2D=All 2D domaine ====
            0            0            0            0
            0            1            1            0
            0            1            1            0
            0            0            0            0
  === I1D=Interior Points ===
            1            1            1            1

Thanks,
Mat

Hello Mat …

Thank you for the TPR#s

For the recent bugs have submitted …
… the original code is Meso-NH <=> 1 million lines fortran90 with array syntax + MPI
… I’m trying to port it to GPU …

;-) So not easy to isolate the bug
;-) and to in-line all the code in the main program …

A+

Juan

So not easy to isolate the bug

Understood and we do appreciate you isolating it down.

and to in-line all the code in the main program …

I figured the work around wouldn’t be practical, but thought I would offer it. - Sorry

Juan,

late update. TPR 18936 was fixed as of the 12.10 release last October.

regards,
dave