Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Newgrid #918

Closed
wants to merge 2 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
99 changes: 62 additions & 37 deletions cicecore/cicedyn/dynamics/ice_transport_remap.F90
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,25 @@ module ice_transport_remap
! if false, area flux is determined internally
! and is passed out

! REMOVE? I
! geometric quantities used for remapping transport
! real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: &
! xav , & ! mean T-cell value of x
! yav , & ! mean T-cell value of y
! xxav , & ! mean T-cell value of xx
! xyav , & ! mean T-cell value of xy
! yyav , & ! mean T-cell value of yy
! yyav ! mean T-cell value of yy
! xxxav, & ! mean T-cell value of xxx
! xxyav, & ! mean T-cell value of xxy
! xyyav, & ! mean T-cell value of xyy
! yyyav ! mean T-cell value of yyy

real (kind=dbl_kind), parameter :: xav=c0
real (kind=dbl_kind), parameter :: yav=c0
real (kind=dbl_kind), parameter :: xxav=c1/c12
real (kind=dbl_kind), parameter :: yyav=c1/c12

logical (kind=log_kind), parameter :: bugcheck = .false.

!=======================================================================
Expand Down Expand Up @@ -261,13 +280,13 @@ module ice_transport_remap

subroutine init_remap

use ice_domain, only: nblocks
use ice_grid, only: xav, yav, xxav, yyav
! use ice_domain, only: nblocks
! use ice_grid, only: xav, yav, xxav, yyav
! dxT, dyT, xyav, &
! xxxav, xxyav, xyyav, yyyav

integer (kind=int_kind) :: &
i, j, iblk ! standard indices
! integer (kind=int_kind) :: &
! i, j, iblk ! standard indices

character(len=*), parameter :: subname = '(init_remap)'

Expand All @@ -278,26 +297,26 @@ subroutine init_remap
! of x or y = 0.

!$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime)
do iblk = 1, nblocks
do j = 1, ny_block
do i = 1, nx_block
xav(i,j,iblk) = c0
yav(i,j,iblk) = c0
! do iblk = 1, nblocks
! do j = 1, ny_block
! do i = 1, nx_block
! xav(i,j,iblk) = c0
! yav(i,j,iblk) = c0
!!! These formulas would be used on a rectangular grid
!!! with dimensions (dxT, dyT):
!!! xxav(i,j,iblk) = dxT(i,j,iblk)**2 / c12
!!! yyav(i,j,iblk) = dyT(i,j,iblk)**2 / c12
xxav(i,j,iblk) = c1/c12
yyav(i,j,iblk) = c1/c12
! xxav(i,j,iblk) = c1/c12
! yyav(i,j,iblk) = c1/c12
! xyav(i,j,iblk) = c0
! xxxav(i,j,iblk) = c0
! xxyav(i,j,iblk) = c0
! xyyav(i,j,iblk) = c0
! yyyav(i,j,iblk) = c0
enddo
enddo
enddo
!$OMP END PARALLEL DO
! enddo
! enddo
! enddo
! !$OMP END PARALLEL DO

!-------------------------------------------------------------------
! Set logical l_fixed_area depending of the grid type.
Expand Down Expand Up @@ -356,8 +375,8 @@ subroutine horizontal_remap (dt, ntrace, &
use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_remap
use ice_blocks, only: block, get_block, nghost
use ice_grid, only: HTE, HTN, dxu, dyu, &
earea, narea, tarear, hm, &
xav, yav, xxav, yyav
earea, narea, tarear, hm!, &
! xav, yav, xxav, yyav
! xyav, xxxav, xxyav, xyyav, yyyav
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

Expand Down Expand Up @@ -519,9 +538,10 @@ subroutine horizontal_remap (dt, ntrace, &
tracer_type, depend, &
has_dependents, icellsnc(0,iblk), &
indxinc(:,0), indxjnc(:,0), &
hm (:,:,iblk), xav (:,:,iblk), &
yav (:,:,iblk), xxav (:,:,iblk), &
yyav (:,:,iblk), &
hm (:,:,iblk), &
! xav (:,:,iblk), &
! yav (:,:,iblk), xxav (:,:,iblk), &
! yyav (:,:,iblk), &
! xyav (:,:,iblk), &
! xxxav (:,:,iblk), xxyav (:,:,iblk), &
! xyyav (:,:,iblk), yyyav (:,:,iblk), &
Expand All @@ -539,9 +559,10 @@ subroutine horizontal_remap (dt, ntrace, &
tracer_type, depend, &
has_dependents, icellsnc (n,iblk), &
indxinc (:,n), indxjnc(:,n), &
hm (:,:,iblk), xav (:,:,iblk), &
yav (:,:,iblk), xxav (:,:,iblk), &
yyav (:,:,iblk), &
hm (:,:,iblk), &
! xav (:,:,iblk), &
! yav (:,:,iblk), xxav (:,:,iblk), &
! yyav (:,:,iblk), &
! xyav (:,:,iblk), &
! xxxav (:,:,iblk), xxyav (:,:,iblk), &
! xyyav (:,:,iblk), yyyav (:,:,iblk), &
Expand Down Expand Up @@ -1052,9 +1073,10 @@ subroutine construct_fields (nx_block, ny_block, &
tracer_type, depend, &
has_dependents, icells, &
indxi, indxj, &
hm, xav, &
yav, xxav, &
yyav, &
hm, &
! xav, &
! yav, xxav, &
! yyav, &
! xyav, &
! xxxav, xxyav, &
! xyyav, yyyav, &
Expand Down Expand Up @@ -1084,9 +1106,9 @@ subroutine construct_fields (nx_block, ny_block, &
indxj

real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: &
hm , & ! land/boundary mask, thickness (T-cell)
xav, yav , & ! mean T-cell values of x, y
xxav, yyav ! mean T-cell values of xx, yy
hm !, & ! land/boundary mask, thickness (T-cell)
! xav, yav , & ! mean T-cell values of x, y
! xxav, yyav ! mean T-cell values of xx, yy
! xyav, , & ! mean T-cell values of xy
! xxxav,xxyav,xyyav,yyyav ! mean T-cell values of xxx, xxy, xyy, yyy

Expand Down Expand Up @@ -1205,7 +1227,7 @@ subroutine construct_fields (nx_block, ny_block, &
ilo, ihi, jlo, jhi, &
nghost, &
mm, hm, &
xav, yav, &
! xav, yav, &
mx, my)

do ij = 1,icells ! ice is present
Expand All @@ -1231,11 +1253,12 @@ subroutine construct_fields (nx_block, ny_block, &

! center of mass (mxav,myav) for each cell
! echmod: xyav = 0
mxav(i,j) = (mx(i,j)*xxav(i,j) &
+ mc(i,j)*xav (i,j)) / mm(i,j)
myav(i,j) = (my(i,j)*yyav(i,j) &
+ mc(i,j)*yav(i,j)) / mm(i,j)

mxav(i,j) = (mx(i,j)*xxav & !(i,j) &
! + mc(i,j)*xav (i,j)) / mm(i,j)
+ mc(i,j)*xav ) / mm(i,j)
myav(i,j) = (my(i,j)*yyav &!(i,j) &
! + mc(i,j)*yav(i,j)) / mm(i,j)
+ mc(i,j)*yav) / mm(i,j)
! mxav(i,j) = (mx(i,j)*xxav(i,j) &
! + my(i,j)*xyav(i,j) &
! + mc(i,j)*xav (i,j)) / mm(i,j)
Expand Down Expand Up @@ -1287,9 +1310,11 @@ subroutine construct_fields (nx_block, ny_block, &
! w6 = my(i,j)*ty(i,j,nt)
w7 = c1 / (mm(i,j)*tm(i,j,nt))
! echmod: grid arrays = 0
mtxav(i,j,nt) = (w1*xav (i,j) + w2*xxav (i,j)) &
! mtxav(i,j,nt) = (w1*xav (i,j) + w2*xxav (i,j)) &
mtxav(i,j,nt) = (w1*xav + w2*xxav) &
* w7
mtyav(i,j,nt) = (w1*yav(i,j) + w3*yyav(i,j)) &
mtyav(i,j,nt) = (w1*yav + w3*yyav &
! mtyav(i,j,nt) = (w1*yav + w3*yyav) &
* w7

! mtxav(i,j,nt) = (w1*xav (i,j) + w2*xxav (i,j) &
Expand Down
28 changes: 0 additions & 28 deletions cicecore/cicedyn/infrastructure/ice_grid.F90
Original file line number Diff line number Diff line change
Expand Up @@ -154,26 +154,6 @@ module ice_grid
lone_bounds, & ! longitude of gridbox corners for E point
late_bounds ! latitude of gridbox corners for E point

! geometric quantities used for remapping transport
real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: &
xav , & ! mean T-cell value of x
yav , & ! mean T-cell value of y
xxav , & ! mean T-cell value of xx
! xyav , & ! mean T-cell value of xy
! yyav , & ! mean T-cell value of yy
yyav ! mean T-cell value of yy
! xxxav, & ! mean T-cell value of xxx
! xxyav, & ! mean T-cell value of xxy
! xyyav, & ! mean T-cell value of xyy
! yyyav ! mean T-cell value of yyy

real (kind=dbl_kind), &
dimension (:,:,:,:,:), allocatable, public :: &
mne, & ! matrices used for coordinate transformations in remapping
mnw, & ! ne = northeast corner, nw = northwest, etc.
mse, &
msw

! masks
real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: &
hm , & ! land/boundary mask, thickness (T-cell)
Expand Down Expand Up @@ -262,10 +242,6 @@ subroutine alloc_grid
cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTS
dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW)
dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS)
xav (nx_block,ny_block,max_blocks), & ! mean T-cell value of x
yav (nx_block,ny_block,max_blocks), & ! mean T-cell value of y
xxav (nx_block,ny_block,max_blocks), & ! mean T-cell value of xx
yyav (nx_block,ny_block,max_blocks), & ! mean T-cell value of yy
hm (nx_block,ny_block,max_blocks), & ! land/boundary mask, thickness (T-cell)
bm (nx_block,ny_block,max_blocks), & ! task/block id
uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) - water in case of all water point
Expand All @@ -288,10 +264,6 @@ subroutine alloc_grid
latn_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for N point
lone_bounds(4,nx_block,ny_block,max_blocks), & ! longitude of gridbox corners for E point
late_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for E point
mne (2,2,nx_block,ny_block,max_blocks), & ! matrices used for coordinate transformations in remapping
mnw (2,2,nx_block,ny_block,max_blocks), & ! ne = northeast corner, nw = northwest, etc.
mse (2,2,nx_block,ny_block,max_blocks), &
msw (2,2,nx_block,ny_block,max_blocks), &
stat=ierr)
if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1')

Expand Down
Loading