Skip to content

Commit

Permalink
cleaning subgrid code in wps and fixing a bug when sr_?=1
Browse files Browse the repository at this point in the history
  • Loading branch information
@jbeezley
jbeezley committed Nov 21, 2010
1 parent 992475d commit fa26d08
Show file tree
Hide file tree
Showing 7 changed files with 195 additions and 197 deletions.
103 changes: 50 additions & 53 deletions WPS/geogrid/src/output_module.F
View file
Expand Up @@ -28,7 +28,7 @@ module output_module
integer :: ndims, istagger
integer, dimension(MAX_DIMENSIONS) :: dom_start, mem_start, patch_start
integer, dimension(MAX_DIMENSIONS) :: dom_end, mem_end, patch_end
integer :: sr_x, sr_y
logical :: is_subgrid
real, pointer, dimension(:,:,:) :: rdata_arr

character (len=128), dimension(MAX_DIMENSIONS) :: dimnames
Expand Down Expand Up @@ -422,6 +422,7 @@ subroutine init_output_fields(nest_num, grid_type, &
use storage_module
#endif
use parallel_module
use gridinfo_module, only : subgrid_ratio_x, subgrid_ratio_y

implicit none

Expand All @@ -445,7 +446,14 @@ subroutine init_output_fields(nest_num, grid_type, &
character (len=128) :: memorder, units, description
character (len=128), dimension(3) :: dimnames
integer :: sr_x, sr_y, istatus

logical :: subgrid_var

!
! Get local nest subgrid refinement ratio
!
sr_x=subgrid_ratio_x(nest_num)
sr_y=subgrid_ratio_y(nest_num)

!
! First find out how many fields there are
!
Expand All @@ -457,7 +465,7 @@ subroutine init_output_fields(nest_num, grid_type, &
call get_next_output_fieldname(nest_num, fieldname, ndims, &
min_category, max_category, &
istagger, memorder, dimnames, &
units, description, sr_x, sr_y, ifieldstatus)
units, description, subgrid_var, ifieldstatus)

if (ifieldstatus == 0) nfields = nfields + 1
end do
Expand All @@ -473,10 +481,6 @@ subroutine init_output_fields(nest_num, grid_type, &
NUM_FIELDS = nfields+NUM_AUTOMATIC_FIELDS
allocate(fields(NUM_FIELDS))

! Automatic fields will always be on the non-refined grid
sr_x=1
sr_y=1

!
! There are some fields that will always be computed
! Initialize those fields first, followed by all user-specified fields
Expand Down Expand Up @@ -635,8 +639,7 @@ subroutine init_output_fields(nest_num, grid_type, &
fields(i)%dimnames(3) = ' '
fields(i)%mem_order = 'XY'
fields(i)%stagger = 'M'
fields(i)%sr_x = 1
fields(i)%sr_y = 1
fields(i)%is_subgrid = .false.
if (grid_type == 'C') then
fields(i)%istagger = M
else if (grid_type == 'E') then
Expand Down Expand Up @@ -774,29 +777,23 @@ subroutine init_output_fields(nest_num, grid_type, &
! Perform adjustments for subgrid lat/lon fields
!
do i=23,24

call get_subgrid_dim_default(nest_num,fields(i)%dimnames, &
fields(i)%sr_x,fields(i)%sr_y,istatus)
sr_x=fields(i)%sr_x
sr_y=fields(i)%sr_y

if(sr_x.gt.1.and.sr_y.gt.1)then
fields(i)%mem_start(1) = (fields(i)%mem_start(1) - 1)*sr_x + 1
fields(i)%patch_start(1) = (fields(i)%patch_start(1) - 1)*sr_x + 1
fields(i)%dom_start(1) = (fields(i)%dom_start(1) - 1)*sr_x + 1

fields(i)%mem_end(1) = (fields(i)%mem_end(1) + 1)*sr_x
fields(i)%patch_end(1) = (fields(i)%patch_end(1) + 1)*sr_x
fields(i)%dom_end(1) = (fields(i)%dom_end(1) + 1)*sr_x

fields(i)%mem_start(2) = (fields(i)%mem_start(2) - 1)*sr_y + 1
fields(i)%patch_start(2) = (fields(i)%patch_start(2) - 1)*sr_y + 1
fields(i)%dom_start(2) = (fields(i)%dom_start(2) - 1)*sr_y + 1

fields(i)%mem_end(2) = (fields(i)%mem_end(2) + 1)*sr_y
fields(i)%patch_end(2) = (fields(i)%patch_end(2) + 1)*sr_y
fields(i)%dom_end(2) = (fields(i)%dom_end(2) + 1)*sr_y
end if
fields(i)%is_subgrid=.true.
call get_subgrid_dim_name(fields(i)%dimnames(1:2))
fields(i)%mem_start(1) = (fields(i)%mem_start(1) - 1)*sr_x + 1
fields(i)%patch_start(1) = (fields(i)%patch_start(1) - 1)*sr_x + 1
fields(i)%dom_start(1) = (fields(i)%dom_start(1) - 1)*sr_x + 1

fields(i)%mem_end(1) = (fields(i)%mem_end(1) + 1)*sr_x
fields(i)%patch_end(1) = (fields(i)%patch_end(1) + 1)*sr_x
fields(i)%dom_end(1) = (fields(i)%dom_end(1) + 1)*sr_x

fields(i)%mem_start(2) = (fields(i)%mem_start(2) - 1)*sr_y + 1
fields(i)%patch_start(2) = (fields(i)%patch_start(2) - 1)*sr_y + 1
fields(i)%dom_start(2) = (fields(i)%dom_start(2) - 1)*sr_y + 1

fields(i)%mem_end(2) = (fields(i)%mem_end(2) + 1)*sr_y
fields(i)%patch_end(2) = (fields(i)%patch_end(2) + 1)*sr_y
fields(i)%dom_end(2) = (fields(i)%dom_end(2) + 1)*sr_y
enddo

else if (grid_type == 'E') then
Expand Down Expand Up @@ -829,7 +826,7 @@ subroutine init_output_fields(nest_num, grid_type, &
call get_next_output_fieldname(nest_num, fieldname, ndims, &
min_category, max_category, &
istagger, memorder, dimnames, &
units, description, sr_x, sr_y, ifieldstatus)
units, description, subgrid_var, ifieldstatus)

if (ifieldstatus == 0) then !{

Expand Down Expand Up @@ -874,22 +871,21 @@ subroutine init_output_fields(nest_num, grid_type, &
fields(nfields)%patch_end(2) = end_patch_2
fields(nfields)%patch_end(3) = max_category

fields(nfields)%sr_x=sr_x
fields(nfields)%sr_y=sr_y
fields(nfields)%is_subgrid=subgrid_var

if (extra_col .and. (istagger == U .or. sr_x > 1)) then !{
if (extra_col .and. (istagger == U .or. subgrid_var)) then !{
fields(nfields)%dom_end(1) = fields(nfields)%dom_end(1) + 1
fields(nfields)%mem_end(1) = fields(nfields)%mem_end(1) + 1
fields(nfields)%patch_end(1) = fields(nfields)%patch_end(1) + 1
else if ((istagger == U .or. sr_x > 1) .and. my_proc_id == IO_NODE .and. .not. do_tiled_output) then
else if ((istagger == U .or. subgrid_var) .and. my_proc_id == IO_NODE .and. .not. do_tiled_output) then
fields(nfields)%dom_end(1)=fields(nfields)%dom_end(1) + 1
end if !}

if (extra_row .and. (istagger == V .or. sr_y > 1)) then !{
if (extra_row .and. (istagger == V .or. subgrid_var)) then !{
fields(nfields)%dom_end(2) = fields(nfields)%dom_end(2) + 1
fields(nfields)%mem_end(2) = fields(nfields)%mem_end(2) + 1
fields(nfields)%patch_end(2) = fields(nfields)%patch_end(2) + 1
else if ((istagger == V .or. sr_y > 1) .and. my_proc_id == IO_NODE .and. .not. do_tiled_output) then
else if ((istagger == V .or. subgrid_var) .and. my_proc_id == IO_NODE .and. .not. do_tiled_output) then
fields(nfields)%dom_end(2)=fields(nfields)%dom_end(2) + 1
end if !}

Expand All @@ -905,7 +901,7 @@ subroutine init_output_fields(nest_num, grid_type, &
thalo_width = 0
#endif

if (sr_x > 1 .and. sr_y > 1) then
if (subgrid_var) then
fields(nfields)%mem_start(1) = (fields(nfields)%mem_start(1) + lhalo_width - 1)*sr_x + 1 - lhalo_width
fields(nfields)%patch_start(1) = (fields(nfields)%patch_start(1) - 1)*sr_x + 1
fields(nfields)%dom_start(1) = (fields(nfields)%dom_start(1) - 1)*sr_x + 1
Expand Down Expand Up @@ -962,6 +958,7 @@ subroutine write_field(start_mem_i, end_mem_i, &
integer, dimension(3) :: sd, ed, sp, ep, sm, em
real, pointer, dimension(:,:,:) :: real_dom_array
logical :: allocated_real_locally
integer :: is_subgrid

allocated_real_locally = .false.

Expand Down Expand Up @@ -1014,7 +1011,13 @@ subroutine write_field(start_mem_i, end_mem_i, &
do i=1,NUM_FIELDS
if ( (index(cname, trim(fields(i)%fieldname) ) /= 0) .and. &
(len_trim(cname) == len_trim(fields(i)%fieldname)) ) then


if (fields(i)%is_subgrid) then
is_subgrid=1
else
is_subgrid=0
end if

! Here, the output array has dimensions of the full grid if it was gathered together
! from all processors
if (my_proc_id == IO_NODE .and. nprocs > 1 .and. .not. do_tiled_output) then
Expand Down Expand Up @@ -1072,10 +1075,8 @@ subroutine write_field(start_mem_i, end_mem_i, &
trim(fields(i)%fieldname), trim(fields(i)%descr), istatus)
call ext_int_put_var_ti_char(handle, 'stagger', &
trim(fields(i)%fieldname), trim(fields(i)%stagger), istatus)
call ext_int_put_var_ti_integer(handle,'sr_x', &
trim(fields(i)%fieldname),(/fields(i)%sr_x/),1, istatus)
call ext_int_put_var_ti_integer(handle,'sr_y', &
trim(fields(i)%fieldname),(/fields(i)%sr_y/),1, istatus)
call ext_int_put_var_ti_integer(handle,'subgrid', &
trim(fields(i)%fieldname),(/is_subgrid/),1, istatus)
end if
#endif
#ifdef IO_NETCDF
Expand All @@ -1086,10 +1087,8 @@ subroutine write_field(start_mem_i, end_mem_i, &
trim(fields(i)%fieldname), trim(fields(i)%descr), istatus)
call ext_ncd_put_var_ti_char(handle, 'stagger', &
trim(fields(i)%fieldname), trim(fields(i)%stagger), istatus)
call ext_ncd_put_var_ti_integer(handle,'sr_x', &
trim(fields(i)%fieldname),(/fields(i)%sr_x/),1, istatus)
call ext_ncd_put_var_ti_integer(handle,'sr_y', &
trim(fields(i)%fieldname),(/fields(i)%sr_y/),1, istatus)
call ext_ncd_put_var_ti_integer(handle,'subgrid', &
trim(fields(i)%fieldname),(/is_subgrid/),1, istatus)
end if
#endif
#ifdef IO_GRIB1
Expand All @@ -1100,10 +1099,8 @@ subroutine write_field(start_mem_i, end_mem_i, &
trim(fields(i)%fieldname), trim(fields(i)%descr), istatus)
call ext_gr1_put_var_ti_char(handle, 'stagger', &
trim(fields(i)%fieldname), trim(fields(i)%stagger), istatus)
call ext_gr1_put_var_ti_integer(handle,'sr_x', &
trim(fields(i)%fieldname),(/fields(i)%sr_x/),1, istatus)
call ext_gr1_put_var_ti_integer(handle,'sr_y', &
trim(fields(i)%fieldname),(/fields(i)%sr_y/),1, istatus)
call ext_gr1_put_var_ti_integer(handle,'subgrid', &
trim(fields(i)%fieldname),(/is_subgrid/),1, istatus)
end if
#endif
end if
Expand Down

0 comments on commit fa26d08

Please sign in to comment.