From 791bdf636dd6d2b73cf7194cd85ad9fae982a516 Mon Sep 17 00:00:00 2001 From: Douglas Jacobsen Date: Fri, 29 Apr 2016 11:30:13 -0600 Subject: [PATCH] Add option to disable scratch array init This commit adds an optional argument to the scratch field allocation routines that allows disabling of array initialization. This can be used to improve performance of allocating scratch arrays when initialization is not needed. --- src/framework/mpas_field_routines.F | 171 ++++++++++++++++++++++------ 1 file changed, 135 insertions(+), 36 deletions(-) diff --git a/src/framework/mpas_field_routines.F b/src/framework/mpas_field_routines.F index 85a2c16469..9429e8522e 100644 --- a/src/framework/mpas_field_routines.F +++ b/src/framework/mpas_field_routines.F @@ -121,10 +121,11 @@ module mpas_field_routines !> This routine allocates a 1D scratch integer field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in, init_array_in)!{{{ type (field1dInteger), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field1dInteger), pointer :: f_cursor integer :: threadNum @@ -138,6 +139,12 @@ subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -146,14 +153,18 @@ subroutine mpas_allocate_scratch_field1d_integer(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1))) - f_cursor % array(:) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1))) - f % array(:) = f % defaultValue + if ( init_array ) then + f % array(:) = f % defaultValue + end if end if end if end if @@ -172,10 +183,11 @@ end subroutine mpas_allocate_scratch_field1d_integer!}}} !> This routine allocates a 2D scratch integer field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in, init_array_in)!{{{ type (field2dInteger), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field2dInteger), pointer :: f_cursor integer :: threadNum @@ -189,6 +201,12 @@ subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -197,14 +215,18 @@ subroutine mpas_allocate_scratch_field2d_integer(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2))) - f_cursor % array(:, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2))) - f % array(:, :) = f % defaultValue + if ( init_array ) then + f % array(:, :) = f % defaultValue + end if end if end if end if @@ -223,10 +245,11 @@ end subroutine mpas_allocate_scratch_field2d_integer!}}} !> This routine allocates a 3D scratch integer field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in, init_array_in)!{{{ type (field3dInteger), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field3dInteger), pointer :: f_cursor integer :: threadNum @@ -240,6 +263,12 @@ subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -248,14 +277,18 @@ subroutine mpas_allocate_scratch_field3d_integer(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3))) - f_cursor % array(:, :, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3))) - f % array(:, :, :) = f % defaultValue + if ( init_array ) then + f % array(:, :, :) = f % defaultValue + end if end if end if end if @@ -274,10 +307,11 @@ end subroutine mpas_allocate_scratch_field3d_integer!}}} !> This routine allocates a 1D scratch real field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field1d_real(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field1d_real(f, single_block_in, init_array_in)!{{{ type (field1dReal), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field1dReal), pointer :: f_cursor integer :: threadNum @@ -291,6 +325,12 @@ subroutine mpas_allocate_scratch_field1d_real(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -299,14 +339,18 @@ subroutine mpas_allocate_scratch_field1d_real(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1))) - f_cursor % array(:) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1))) - f % array(:) = f % defaultValue + if ( init_array ) then + f % array(:) = f % defaultValue + end if end if end if end if @@ -325,10 +369,11 @@ end subroutine mpas_allocate_scratch_field1d_real!}}} !> This routine allocates a 2D scratch real field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field2d_real(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field2d_real(f, single_block_in, init_array_in)!{{{ type (field2dReal), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field2dReal), pointer :: f_cursor integer :: threadNum @@ -342,6 +387,12 @@ subroutine mpas_allocate_scratch_field2d_real(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -350,14 +401,18 @@ subroutine mpas_allocate_scratch_field2d_real(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2))) - f_cursor % array(:, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2))) - f % array(:, :) = f % defaultValue + if ( init_array ) then + f % array(:, :) = f % defaultValue + end if end if end if end if @@ -376,10 +431,11 @@ end subroutine mpas_allocate_scratch_field2d_real!}}} !> This routine allocates a 3D scratch real field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field3d_real(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field3d_real(f, single_block_in, init_array_in)!{{{ type (field3dReal), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field3dReal), pointer :: f_cursor integer :: threadNum @@ -393,6 +449,12 @@ subroutine mpas_allocate_scratch_field3d_real(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -401,14 +463,18 @@ subroutine mpas_allocate_scratch_field3d_real(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3))) - f_cursor % array(:, :, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3))) - f % array(:, :, :) = f % defaultValue + if ( init_array ) then + f % array(:, :, :) = f % defaultValue + end if end if end if end if @@ -427,10 +493,11 @@ end subroutine mpas_allocate_scratch_field3d_real!}}} !> This routine allocates a 4D scratch real field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field4d_real(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field4d_real(f, single_block_in, init_array_in)!{{{ type (field4dReal), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field4dReal), pointer :: f_cursor integer :: threadNum @@ -444,6 +511,12 @@ subroutine mpas_allocate_scratch_field4d_real(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -452,14 +525,18 @@ subroutine mpas_allocate_scratch_field4d_real(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3), f_cursor % dimSizes(4))) - f_cursor % array(:, :, :, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :, :, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3), f % dimSizes(4))) - f % array(:, :, :, :) = f % defaultValue + if ( init_array ) then + f % array(:, :, :, :) = f % defaultValue + end if end if end if end if @@ -478,10 +555,11 @@ end subroutine mpas_allocate_scratch_field4d_real!}}} !> This routine allocates a 5D scratch real field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field5d_real(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field5d_real(f, single_block_in, init_array_in)!{{{ type (field5dReal), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field5dReal), pointer :: f_cursor integer :: threadNum @@ -495,6 +573,12 @@ subroutine mpas_allocate_scratch_field5d_real(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -503,14 +587,18 @@ subroutine mpas_allocate_scratch_field5d_real(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1), f_cursor % dimSizes(2), f_cursor % dimSizes(3), f_cursor % dimSizes(4), f_cursor % dimSizes(5))) - f_cursor % array(:, :, :, :, :) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:, :, :, :, :) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1), f % dimSizes(2), f % dimSizes(3), f % dimSizes(4), f % dimSizes(5))) - f % array(:, :, :, :, :) = f % defaultValue + if ( init_array ) then + f % array(:, :, :, :, :) = f % defaultValue + end if end if end if end if @@ -529,10 +617,11 @@ end subroutine mpas_allocate_scratch_field5d_real!}}} !> This routine allocates a 1D scratch character field. ! !----------------------------------------------------------------------- - subroutine mpas_allocate_scratch_field1d_char(f, single_block_in)!{{{ + subroutine mpas_allocate_scratch_field1d_char(f, single_block_in, init_array_in)!{{{ type (field1dChar), pointer :: f !< Input: Field to allocate logical, intent(in), optional :: single_block_in !< Input: Logical flag that determines if a single block should be allocated, or all blocks. - logical :: single_block + logical, intent(in), optional :: init_array_in !< Input: Logical flag that determines if allocated arrays are initialized + logical :: single_block, init_array type (field1dChar), pointer :: f_cursor integer :: threadNum @@ -546,6 +635,12 @@ subroutine mpas_allocate_scratch_field1d_char(f, single_block_in)!{{{ single_block = .false. end if + if (present(init_array_in)) then + init_array = init_array_in + else + init_array = .true. + end if + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -554,14 +649,18 @@ subroutine mpas_allocate_scratch_field1d_char(f, single_block_in)!{{{ do while(associated(f_cursor)) if(.not.associated(f_cursor % array)) then allocate(f_cursor % array(f_cursor % dimSizes(1))) - f_cursor % array(:) = f_cursor % defaultValue + if ( init_array ) then + f_cursor % array(:) = f_cursor % defaultValue + end if end if f_cursor => f_cursor % next end do else if(.not.associated(f % array)) then allocate(f % array(f % dimSizes(1))) - f % array(:) = f % defaultValue + if ( init_array ) then + f % array(:) = f % defaultValue + end if end if end if end if