From 68211dc29614db44965aa2eb014fefddc1587a5b Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Fri, 8 May 2020 18:45:07 -0400 Subject: [PATCH 1/4] added sorting algorithm --- src/ALE/MOM_regridding.F90 | 45 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9bc71dd15f..84028c6cdf 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1923,6 +1923,51 @@ subroutine convective_adjustment(G, GV, h, tv) end subroutine convective_adjustment +!------------------------------------------------------------------------------ +!> Return the index of a sorted array of scalar values +subroutine sort_scalar_k(G, GV, h, tv, ksort) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables + integer, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: ksort !< An array of indicies for a + !! monotonically increasing scalar +!------------------------------------------------------------------------------ +! Check each water column to see if a given scalar is monotonically increasing. +! If not, return an array of the sorted indices (bubble sort algorithm). +! No need to return the sorted scalar array itself. +!------------------------------------------------------------------------------ + + ! Local variables + integer :: i, j, k + real :: T0, T1 ! temperatures + logical :: monotonic + + ! Loop on columns + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 + + ! Repeat swapping of indices until complete + do + monotonic = .true. + do k = 1,GV%ke-1 + ! Gather information of scalar value in current and next cells + T0 = tv%T(i,j,k) ; T1 = tv%T(i,j,k+1) + ! If the scalar value of the current cell is larger than the scalar + ! below it, we swap the cell indices + if ( T0 > T1 ) then + ksort(i,j,k) = k+1 ; ksort(i,j,k+1) = k + monotonic = .false. + endif + enddo ! k + + if ( monotonic ) exit + enddo + + enddo ; enddo ! i & j + +end subroutine sort_scalar_k !------------------------------------------------------------------------------ !> Return a uniform resolution vector in the units of the coordinate From 2c6b15a3092563bc360577925e5081a2511d7231 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Fri, 15 May 2020 12:36:34 -0400 Subject: [PATCH 2/4] changed tv to arbitrary scalar, phi --- src/ALE/MOM_regridding.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 84028c6cdf..fd47470919 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1925,12 +1925,13 @@ end subroutine convective_adjustment !------------------------------------------------------------------------------ !> Return the index of a sorted array of scalar values -subroutine sort_scalar_k(G, GV, h, tv, ksort) +subroutine sort_scalar_k(G, GV, h, phi, ksort) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV), & + intent(in) :: phi !< Array of scalar quantity to be sorted integer, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ksort !< An array of indicies for a !! monotonically increasing scalar @@ -1942,7 +1943,7 @@ subroutine sort_scalar_k(G, GV, h, tv, ksort) ! Local variables integer :: i, j, k - real :: T0, T1 ! temperatures + real :: P0, P1 ! temperatures logical :: monotonic ! Loop on columns @@ -1953,10 +1954,10 @@ subroutine sort_scalar_k(G, GV, h, tv, ksort) monotonic = .true. do k = 1,GV%ke-1 ! Gather information of scalar value in current and next cells - T0 = tv%T(i,j,k) ; T1 = tv%T(i,j,k+1) + P0 = phi(i,j,k) ; P1 = phi(i,j,k+1) ! If the scalar value of the current cell is larger than the scalar ! below it, we swap the cell indices - if ( T0 > T1 ) then + if ( P0 > P1 ) then ksort(i,j,k) = k+1 ; ksort(i,j,k+1) = k monotonic = .false. endif From 17d936262d2d023583a976ef48545a1c4f211dc5 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Fri, 15 May 2020 12:44:21 -0400 Subject: [PATCH 3/4] added subroutine to do sorting for 1d column (no i,j, looping) --- src/ALE/MOM_regridding.F90 | 44 +++++++++++++++++++++++++++++++++++--- 1 file changed, 41 insertions(+), 3 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index fd47470919..df54f589c0 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1925,11 +1925,49 @@ end subroutine convective_adjustment !------------------------------------------------------------------------------ !> Return the index of a sorted array of scalar values -subroutine sort_scalar_k(G, GV, h, phi, ksort) +subroutine sort_scalar_k_1d(G, GV, phi, ksort) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZK_(GV), & + intent(in) :: phi !< Array of scalar quantity to be sorted + integer, dimension(SZK_(GV)), & + intent(out) :: ksort !< An array of indicies for a + !! monotonically increasing scalar +!------------------------------------------------------------------------------ +! Check each water column to see if a given scalar is monotonically increasing. +! If not, return an array of the sorted indices (bubble sort algorithm). +! No need to return the sorted scalar array itself. +!------------------------------------------------------------------------------ + + ! Local variables + integer :: k + real :: P0, P1 ! temperatures + logical :: monotonic + + ! Repeat swapping of indices until complete + do + monotonic = .true. + do k = 1,GV%ke-1 + ! Gather information of scalar value in current and next cells + P0 = phi(k) ; P1 = phi(k+1) + ! If the scalar value of the current cell is larger than the scalar + ! below it, we swap the cell indices + if ( P0 > P1 ) then + ksort(k) = k+1 ; ksort(k+1) = k + monotonic = .false. + endif + enddo ! k + + if ( monotonic ) exit + enddo + +end subroutine sort_scalar_k_1d + +!------------------------------------------------------------------------------ +!> Return the index of a sorted array of scalar values +subroutine sort_scalar_k(G, GV, phi, ksort) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV), & intent(in) :: phi !< Array of scalar quantity to be sorted integer, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & From ac7fffb1e5c954e67fed3772fb6d5ea08c1854fd Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Fri, 15 May 2020 12:52:53 -0400 Subject: [PATCH 4/4] fixed missing parenthesis --- src/ALE/MOM_regridding.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index df54f589c0..99c2ac9799 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1928,7 +1928,7 @@ end subroutine convective_adjustment subroutine sort_scalar_k_1d(G, GV, phi, ksort) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZK_(GV), & + real, dimension(SZK_(GV)), & intent(in) :: phi !< Array of scalar quantity to be sorted integer, dimension(SZK_(GV)), & intent(out) :: ksort !< An array of indicies for a @@ -1968,7 +1968,7 @@ end subroutine sort_scalar_k_1d subroutine sort_scalar_k(G, GV, phi, ksort) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: phi !< Array of scalar quantity to be sorted integer, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: ksort !< An array of indicies for a