Skip to content
Snippets Groups Projects
Commit c4f5e02d authored by Yen-Chen Chen's avatar Yen-Chen Chen Committed by Pradipta Samanta
Browse files

Fix insert dimension (!112)


## What is the bug
The `insert_dimension` fails in ICON without the deleted if clause.
## How do you fix it
Recover the deleted code.

Merged-by: default avatarPradipta Samanta <samanta@dkrz.de>
Changelog: bugfix
parent 0f57ee7a
No related branches found
No related tags found
1 merge request!112Fix insert dimension
Pipeline #98859 passed
......@@ -2230,6 +2230,22 @@ CONTAINS
base_shape(2) = in_shape(2)
CALL insert_dimension_r_dp_3_2_s(ptr_out, ptr_in(1, 1), &
base_shape, new_dim_rank)
IF (in_stride(1) > 1 .OR. in_stride(2) > in_shape(1) &
.OR. base_shape(1) /= in_shape(1)) THEN
out_stride(1) = in_stride(1)
out_stride(2) = 1
out_shape(1:out_rank - 1) = in_shape
DO i = out_rank, new_dim_rank + 1, -1
out_shape(i) = out_shape(i - 1)
out_stride(i) = out_stride(i - 1)
END DO
out_stride(new_dim_rank) = 1
out_shape(new_dim_rank) = 1
out_shape = (out_shape - 1)*out_stride + 1
ptr_out => ptr_out(:out_shape(1):out_stride(1), &
& :out_shape(2):out_stride(2), &
& :out_shape(3):out_stride(3))
END IF
ELSE
out_shape(1:out_rank - 1) = SHAPE(ptr_in)
DO i = out_rank, new_dim_rank + 1, -1
......@@ -2291,6 +2307,22 @@ CONTAINS
base_shape(2) = in_shape(2)
CALL insert_dimension_r_sp_3_2_s(ptr_out, ptr_in(1, 1), &
base_shape, new_dim_rank)
IF (in_stride(1) > 1 .OR. in_stride(2) > in_shape(1) &
.OR. base_shape(1) /= in_shape(1)) THEN
out_stride(1) = in_stride(1)
out_stride(2) = 1
out_shape(1:out_rank - 1) = in_shape
DO i = out_rank, new_dim_rank + 1, -1
out_shape(i) = out_shape(i - 1)
out_stride(i) = out_stride(i - 1)
END DO
out_stride(new_dim_rank) = 1
out_shape(new_dim_rank) = 1
out_shape = (out_shape - 1)*out_stride + 1
ptr_out => ptr_out(:out_shape(1):out_stride(1), &
& :out_shape(2):out_stride(2), &
& :out_shape(3):out_stride(3))
END IF
ELSE
out_shape(1:out_rank - 1) = SHAPE(ptr_in)
DO i = out_rank, new_dim_rank + 1, -1
......@@ -2352,6 +2384,22 @@ CONTAINS
base_shape(2) = in_shape(2)
CALL insert_dimension_i4_3_2_s(ptr_out, ptr_in(1, 1), &
base_shape, new_dim_rank)
IF (in_stride(1) > 1 .OR. in_stride(2) > in_shape(1) &
.OR. base_shape(1) /= in_shape(1)) THEN
out_stride(1) = in_stride(1)
out_stride(2) = 1
out_shape(1:out_rank - 1) = in_shape
DO i = out_rank, new_dim_rank + 1, -1
out_shape(i) = out_shape(i - 1)
out_stride(i) = out_stride(i - 1)
END DO
out_stride(new_dim_rank) = 1
out_shape(new_dim_rank) = 1
out_shape = (out_shape - 1)*out_stride + 1
ptr_out => ptr_out(:out_shape(1):out_stride(1), &
& :out_shape(2):out_stride(2), &
& :out_shape(3):out_stride(3))
END IF
ELSE
out_shape(1:out_rank - 1) = SHAPE(ptr_in)
DO i = out_rank, new_dim_rank + 1, -1
......@@ -2411,6 +2459,22 @@ CONTAINS
base_shape(2) = in_shape(2)
CALL insert_dimension_l_3_2_s(ptr_out, ptr_in(1, 1), &
base_shape, new_dim_rank)
IF (in_stride(1) > 1 .OR. in_stride(2) > in_shape(1) &
.OR. base_shape(1) /= in_shape(1)) THEN
out_stride(1) = in_stride(1)
out_stride(2) = 1
out_shape(1:out_rank - 1) = in_shape
DO i = out_rank, new_dim_rank + 1, -1
out_shape(i) = out_shape(i - 1)
out_stride(i) = out_stride(i - 1)
END DO
out_stride(new_dim_rank) = 1
out_shape(new_dim_rank) = 1
out_shape = (out_shape - 1)*out_stride + 1
ptr_out => ptr_out(:out_shape(1):out_stride(1), &
& :out_shape(2):out_stride(2), &
& :out_shape(3):out_stride(3))
END IF
ELSE
out_shape(1:out_rank - 1) = SHAPE(ptr_in)
DO i = out_rank, new_dim_rank + 1, -1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment