diff --git a/src/mo_fortran_tools.F90 b/src/mo_fortran_tools.F90 index 08c51387cfb18440dbca52741adf126587f4aa46..204ff1f7010a585172e9eb706969f9ecd335e847 100644 --- a/src/mo_fortran_tools.F90 +++ b/src/mo_fortran_tools.F90 @@ -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