D.2.13 Scatter Procedure

The main documentation of the Scatter Procedure contains additional explanation of this code listing.

  define([SCATTER_ROUTINE],[
    pushdef([TYPE], [$1])
    pushdef([DIM], [$2])
    pushdef([OP], [$3])
    pushdef([Scatter_OP_TYPE_DIM], expand(Scatter_OP_TYPE_DIM))
    pushdef([PGSLib_Scatter_OP], expand(PGSLib_Scatter_OP))

    subroutine Scatter_OP_TYPE_DIM (Output, Input, Index, Trace)

      ! Input variables.

      ! Distributed vector (bare naked vector) to be scattered.
      type(TYPE,DIM,np), intent(in) :: Input 
      type(integer,DIM,np), intent(in), optional :: Index ! Indirect reference 
                                                          ! indices.

      ! Input/Output variable.

      type(Trace_type), intent(inout), optional :: Trace   ! Setup information.

      ! Output variable.

      type(TYPE,1,np), intent(out) :: Output     ! Scattered variable.
  
      ! Internal variables.

      ifdef([USE_PGSLIB],[
        type(integer,DIM) :: Index_tmp           ! Index temporary.
        type(logical,DIM) :: Mask_tmp            ! Index mask temporary.
      ],[
        ifelse(DIM, [1], [], [  
          type(integer) :: column                ! Loop parameter.
        ])
        type(integer) :: row                     ! Loop parameter.
      ])

      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

      ! Verify requirements.
  
      ! Either the Trace or the Index, or both, must be present.
      VERIFY(PRESENT(Index) .or. PRESENT(Trace),1)
  
      ! Initialize the Trace.

      if (PRESENT(Trace)) then
        if (.not. Initialized(Trace)) then
          VERIFY(PRESENT(Index),5)
          call Initialize (Trace, Index, SIZE(Input))
        end if
      end if

      ! Do the global scatter.

      ifdef([USE_PGSLIB],[
    
        ! PGSLib parallel scatter.

        if (PRESENT(Trace)) then
          call PGSLib_Scatter_OP (Output, Input, Trace%Index[]DIM, &
                                  Trace%Trace, Trace%Mask[]DIM)
        else
          ifelse(DIM, [1], [
            call Initialize (Index_tmp, SIZE(Index))
            call Initialize (Mask_tmp,  SIZE(Index))
          ], [
            call Initialize (Index_tmp, SIZE(Index,1), SIZE(Index,2))
            call Initialize (Mask_tmp,  SIZE(Index,1), SIZE(Index,2))
          ])
          Index_tmp = Index
          Mask_tmp = Index_tmp /= 0
          call PGSLib_Scatter_OP (Output, Input, Index_tmp, Mask=Mask_tmp)
          call Finalize (Index_tmp)
          call Finalize (Mask_tmp)
        end if
  
      ],[

        ! Serial scatter.

        if (PRESENT(Trace)) then
          ifelse(DIM, [1], [
            do row = 1, SIZE(Input, 1)
              if (Trace%Index1(row) /= 0) then
                Output(Trace%Index1(row)) = &
                  OPERATION(Output(Trace%Index1(row)), Input(row))
              end if
            end do
          ],[
            do column = 1, SIZE(Input, 2)
              do row = 1, SIZE(Input, 1)
                if (Trace%Index2(row,column) /= 0) then
                  Output(Trace%Index2(row,column)) = &
                    OPERATION(Output(Trace%Index2(row,column)), &
                              Input(row,column))
                end if
              end do
            end do
          ])
        else
          ifelse(DIM, [1], [
            do row = 1, SIZE(Input, 1)
              if (Index(row) /= 0) then
                Output(Index(row)) = OPERATION(Output(Index(row)), Input(row))
              end if
            end do
          ],[
            do column = 1, SIZE(Input, 2)
              do row = 1, SIZE(Input, 1)
                if (Index(row,column) /= 0) then
                  Output(Index(row,column)) = &
                    OPERATION(Output(Index(row,column)), Input(row,column))
                end if
              end do
            end do
          ])
        end if

      ])

      ! Verify guarantees - none.
  
      return
    end subroutine Scatter_OP_TYPE_DIM
  
    popdef([TYPE])
    popdef([DIM])
    popdef([OP])
    popdef([Scatter_OP_TYPE_DIM])
    popdef([PGSLib_Scatter_OP])
  ])

  forloop([Dim],[1],[2],[
    fortext([Op],[SUM MAX MIN],[
      ifelse(Op, [SUM], [
        pushdef([OPERATION], [$1 + $2])
      ], [
        pushdef([OPERATION], [Op[]($1, $2)])
      ]) 
      fortext([Type],[real integer],[
        SCATTER_ROUTINE(Type, Dim, Op)
      ])
    ])
    fortext([Op],[AND OR],[
      pushdef([OPERATION], [$1 .Op. $2]) 
      SCATTER_ROUTINE(logical, Dim, Op)
    ])
  ])
  popdef([OPERATION])