From ced3a9fe6bbcb1273bda799274aea2bc0da3e2c5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 21 Jan 2025 17:39:04 -0500 Subject: [PATCH 1/2] Fix rotation in set_coupler_type_data `rotate_array` in `set_coupler_type_data` was trying to rotate an array to another of different size when `idim` and `jdim` are present. Some compilers seemed to let this through, but it raised a double-deallocation error in GCC. I'm guessing it's because the rotation was implicitly allocating to a new array which was automatically deallocated. But I did not confirm this. This was modified to rotate onto a new array of the same size. The `idim` and `jdim` are passed to `CT_set_data`, which (hopefully) sorts out the indexing. --- src/framework/MOM_coupler_types.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 index b931a2ddd2..b76912beb6 100644 --- a/src/framework/MOM_coupler_types.F90 +++ b/src/framework/MOM_coupler_types.F90 @@ -453,14 +453,12 @@ subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_fact ! as array_in [A] integer :: subfield ! An integer indicating which field to set. integer :: q_turns ! The number of quarter turns through which array_in is rotated - integer :: is, ie, js, je, halo q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) subfield = ind_csurf if (present(solubility)) then ; if (solubility) subfield = ind_alpha ; endif if (present(field_index)) subfield = field_index - halo = 0 ; if (present(halo_size)) halo = halo_size ! The case with non-trivial grid rotation is complicated by the fact that the data fields ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. @@ -468,12 +466,19 @@ subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_fact call CT_set_data(array_in, bc_index, subfield, var, & scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) elseif (present(idim) .and. present(jdim)) then - ! Work only on the computational domain plus symmetric halos. - is = idim(2)-halo ; ie = idim(3)+halo ; js = jdim(2)-halo ; je = jdim(3)+halo - call allocate_rotated_array(array_in(is:ie,js:je), [1,1], -q_turns, array_unrot) + call allocate_rotated_array(array_in, [1,1], -q_turns, array_unrot) call rotate_array(array_in, -q_turns, array_unrot) - call CT_set_data(array_unrot, bc_index, subfield, var, & - scale_factor=scale_factor, halo_size=halo_size) + + if (modulo(q_turns, 2) /= 0) then + call CT_set_data(array_unrot, bc_index, subfield, var, & + idim=jdim, jdim=idim, & + scale_factor=scale_factor, halo_size=halo_size) + else + call CT_set_data(array_unrot, bc_index, subfield, var, & + idim=idim, jdim=jdim, & + scale_factor=scale_factor, halo_size=halo_size) + endif + deallocate(array_unrot) else call allocate_rotated_array(array_in, [1,1], -q_turns, array_unrot) From 32922a4f8db6ed1fa465dad3d6e6a5425df92ae7 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 22 Jan 2025 19:58:36 -0500 Subject: [PATCH 2/2] Remove implicit copies in CT_extract_data rotation Following on the previous commit, the implicit copies in `extract_coupler_type_data`'s `allocate_rotated_array` and `rotate_array` are replaced with the full-sized arrays, with halos managed by `idim` and `jdim` arguments to `CT_extract_data`. I tested this in a rotated `Baltic` test and saw no answer changes. The `ocean.stats` and CFC restart files agree, but there are still known rotation reordering and negative-zero errors in `MOM.res.nc` output. --- src/framework/MOM_coupler_types.F90 | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 index b76912beb6..25a2937aaa 100644 --- a/src/framework/MOM_coupler_types.F90 +++ b/src/framework/MOM_coupler_types.F90 @@ -391,27 +391,33 @@ subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, ! Local variables real, allocatable :: array_unrot(:,:) ! Array on the unrotated grid in arbitrary units [A] integer :: q_turns ! The number of quarter turns through which array_out is to be rotated - integer :: index, is, ie, js, je, halo + integer :: index index = ind_flux ; if (present(field_index)) index = field_index q_turns = 0 ; if (present(turns)) q_turns = modulo(turns, 4) - halo = 0 ; if (present(halo_size)) halo = halo_size ! The case with non-trivial grid rotation is complicated by the fact that the data fields ! in the coupler_2d_bc_type are never rotated, so they need to be handled separately. if (q_turns == 0) then call CT_extract_data(var_in, bc_index, index, array_out, & - scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) elseif (present(idim) .and. present(jdim)) then - ! Work only on the computational domain plus symmetric halos. - is = idim(2)-halo ; ie = idim(3)+halo ; js = jdim(2)-halo ; je = jdim(3)+halo - call allocate_rotated_array(array_out(is:ie,js:je), [1,1], -q_turns, array_unrot) - call CT_extract_data(var_in, bc_index, index, array_unrot, scale_factor=scale_factor, halo_size=halo) - call rotate_array(array_unrot, q_turns, array_out(is:ie,js:je)) + call allocate_rotated_array(array_out, [1,1], -q_turns, array_unrot) + + if (modulo(q_turns, 2) /= 0) then + call CT_extract_data(var_in, bc_index, index, array_unrot, & + idim=jdim, jdim=idim, scale_factor=scale_factor, halo_size=halo_size) + else + call CT_extract_data(var_in, bc_index, index, array_unrot, & + idim=idim, jdim=jdim, scale_factor=scale_factor, halo_size=halo_size) + endif + + call rotate_array(array_unrot, q_turns, array_out) deallocate(array_unrot) else call allocate_rotated_array(array_out, [1,1], -q_turns, array_unrot) - call CT_extract_data(var_in, bc_index, index, array_unrot, scale_factor=scale_factor, halo_size=halo) + call CT_extract_data(var_in, bc_index, index, array_unrot, & + scale_factor=scale_factor, halo_size=halo_size) call rotate_array(array_unrot, q_turns, array_out) deallocate(array_unrot) endif