From 74e1e3fd6cbe9b2b85beac1b9b35c2610352ab55 Mon Sep 17 00:00:00 2001 From: "Timothy W. Juliano" Date: Thu, 24 Feb 2022 14:41:29 -0700 Subject: [PATCH] Fixing bug in calc_dfdx and calc_dfdy --- geogrid/src/process_tile_module.F | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/geogrid/src/process_tile_module.F b/geogrid/src/process_tile_module.F index bd7ffac..8dea88c 100644 --- a/geogrid/src/process_tile_module.F +++ b/geogrid/src/process_tile_module.F @@ -962,9 +962,9 @@ module process_tile_module i1=field_count,i2=NUM_FIELDS-NUM_AUTOMATIC_FIELDS,s1=gradname) if (grid_type == 'C') then - call calc_dfdx(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, mapfac_ptr_x) + call calc_dfdx(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, sub_x, mapfac_ptr_x) else if (grid_type == 'E') then - call calc_dfdx(field, slp_field, sm1, sm2, min_level, em1, em2, max_level) + call calc_dfdx(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, sub_x) end if call write_field(sm1, em1, sm2, em2, & min_level, max_level, trim(gradname), datestr, real_array=slp_field) @@ -979,9 +979,9 @@ module process_tile_module i1=field_count,i2=NUM_FIELDS-NUM_AUTOMATIC_FIELDS,s1=gradname) if (grid_type == 'C') then - call calc_dfdy(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, mapfac_ptr_y) + call calc_dfdy(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, sub_y, mapfac_ptr_y) else if (grid_type == 'E') then - call calc_dfdy(field, slp_field, sm1, sm2, min_level, em1, em2, max_level) + call calc_dfdy(field, slp_field, sm1, sm2, min_level, em1, em2, max_level, sub_y) end if call write_field(sm1, em1, sm2, em2, & min_level, max_level, trim(gradname), datestr, real_array=slp_field) @@ -2043,7 +2043,7 @@ module process_tile_module ! the result in dst_array. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine calc_dfdy(src_arr, dst_arr, start_mem_i, start_mem_j, start_mem_k, & - end_mem_i, end_mem_j, end_mem_k, mapfac) + end_mem_i, end_mem_j, end_mem_k, sr_y, mapfac) ! Modules use gridinfo_module @@ -2054,6 +2054,7 @@ module process_tile_module integer, intent(in) :: start_mem_i, start_mem_j, start_mem_k, end_mem_i, end_mem_j, end_mem_k real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j,start_mem_k:end_mem_k), intent(in) :: src_arr real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j,start_mem_k:end_mem_k), intent(out) :: dst_arr + integer, intent(in) :: sr_y real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j), intent(in), optional :: mapfac ! Local variables @@ -2063,32 +2064,32 @@ module process_tile_module do k=start_mem_k,end_mem_k do i=start_mem_i, end_mem_i do j=start_mem_j+1, end_mem_j-1 - dst_arr(i,j,k) = (src_arr(i,j+1,k) - src_arr(i,j-1,k))/(2.*dykm*mapfac(i,j)) + dst_arr(i,j,k) = (src_arr(i,j+1,k) - src_arr(i,j-1,k))/(2.*dykm*mapfac(i,j)/sr_y) end do end do do i=start_mem_i, end_mem_i - dst_arr(i,start_mem_j,k) = (src_arr(i,start_mem_j+1,k) - src_arr(i,start_mem_j,k))/(dykm*mapfac(i,j)) + dst_arr(i,start_mem_j,k) = (src_arr(i,start_mem_j+1,k) - src_arr(i,start_mem_j,k))/(dykm*mapfac(i,j)/sr_y) end do do i=start_mem_i, end_mem_i - dst_arr(i,end_mem_j,k) = (src_arr(i,end_mem_j,k) - src_arr(i,end_mem_j-1,k))/(dykm*mapfac(i,j)) + dst_arr(i,end_mem_j,k) = (src_arr(i,end_mem_j,k) - src_arr(i,end_mem_j-1,k))/(dykm*mapfac(i,j)/sr_y) end do end do else do k=start_mem_k,end_mem_k do i=start_mem_i, end_mem_i do j=start_mem_j+1, end_mem_j-1 - dst_arr(i,j,k) = (src_arr(i,j+1,k) - src_arr(i,j-1,k))/(2.*dykm) + dst_arr(i,j,k) = (src_arr(i,j+1,k) - src_arr(i,j-1,k))/(2.*dykm/sr_y) end do end do do i=start_mem_i, end_mem_i - dst_arr(i,start_mem_j,k) = (src_arr(i,start_mem_j+1,k) - src_arr(i,start_mem_j,k))/(dykm) + dst_arr(i,start_mem_j,k) = (src_arr(i,start_mem_j+1,k) - src_arr(i,start_mem_j,k))/(dykm/sr_y) end do do i=start_mem_i, end_mem_i - dst_arr(i,end_mem_j,k) = (src_arr(i,end_mem_j,k) - src_arr(i,end_mem_j-1,k))/(dykm) + dst_arr(i,end_mem_j,k) = (src_arr(i,end_mem_j,k) - src_arr(i,end_mem_j-1,k))/(dykm/sr_y) end do end do end if @@ -2103,7 +2104,7 @@ module process_tile_module ! the result in dst_array. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine calc_dfdx(src_arr, dst_arr, start_mem_i, start_mem_j, & - start_mem_k, end_mem_i, end_mem_j, end_mem_k, mapfac) + start_mem_k, end_mem_i, end_mem_j, end_mem_k, sr_x, mapfac) ! Modules use gridinfo_module @@ -2114,6 +2115,7 @@ module process_tile_module integer, intent(in) :: start_mem_i, start_mem_j, start_mem_k, end_mem_i, end_mem_j, end_mem_k real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j, start_mem_k:end_mem_k), intent(in) :: src_arr real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j, start_mem_k:end_mem_k), intent(out) :: dst_arr + integer, intent(in) :: sr_x real, dimension(start_mem_i:end_mem_i, start_mem_j:end_mem_j), intent(in), optional :: mapfac ! Local variables @@ -2123,32 +2125,32 @@ module process_tile_module do k=start_mem_k, end_mem_k do i=start_mem_i+1, end_mem_i-1 do j=start_mem_j, end_mem_j - dst_arr(i,j,k) = (src_arr(i+1,j,k) - src_arr(i-1,j,k))/(2.*dxkm*mapfac(i,j)) + dst_arr(i,j,k) = (src_arr(i+1,j,k) - src_arr(i-1,j,k))/(2.*dxkm*mapfac(i,j)/sr_x) end do end do do j=start_mem_j, end_mem_j - dst_arr(start_mem_i,j,k) = (src_arr(start_mem_i+1,j,k) - src_arr(start_mem_i,j,k))/(dxkm*mapfac(i,j)) + dst_arr(start_mem_i,j,k) = (src_arr(start_mem_i+1,j,k) - src_arr(start_mem_i,j,k))/(dxkm*mapfac(i,j)/sr_x) end do do j=start_mem_j, end_mem_j - dst_arr(end_mem_i,j,k) = (src_arr(end_mem_i,j,k) - src_arr(end_mem_i-1,j,k))/(dxkm*mapfac(i,j)) + dst_arr(end_mem_i,j,k) = (src_arr(end_mem_i,j,k) - src_arr(end_mem_i-1,j,k))/(dxkm*mapfac(i,j)/sr_x) end do end do else do k=start_mem_k, end_mem_k do i=start_mem_i+1, end_mem_i-1 do j=start_mem_j, end_mem_j - dst_arr(i,j,k) = (src_arr(i+1,j,k) - src_arr(i-1,j,k))/(2.*dxkm) + dst_arr(i,j,k) = (src_arr(i+1,j,k) - src_arr(i-1,j,k))/(2.*dxkm/sr_x) end do end do do j=start_mem_j, end_mem_j - dst_arr(start_mem_i,j,k) = (src_arr(start_mem_i+1,j,k) - src_arr(start_mem_i,j,k))/(dxkm) + dst_arr(start_mem_i,j,k) = (src_arr(start_mem_i+1,j,k) - src_arr(start_mem_i,j,k))/(dxkm/sr_x) end do do j=start_mem_j, end_mem_j - dst_arr(end_mem_i,j,k) = (src_arr(end_mem_i,j,k) - src_arr(end_mem_i-1,j,k))/(dxkm) + dst_arr(end_mem_i,j,k) = (src_arr(end_mem_i,j,k) - src_arr(end_mem_i-1,j,k))/(dxkm/sr_x) end do end do end if -- 2.11.4.GIT