find_proper_position Subroutine

private pure subroutine find_proper_position(pos, row, maxpos, maxrows, blk_p, row_p, tdist, tid, local2global)

Finds the next proper position accounting for threads First time: pos and row are set to 0. If there is no valid block, pos is set to 0

Arguments

Type IntentOptional Attributes Name
integer, intent(inout) :: pos

current position and updated position input: current row; output: the row corresponding to the next proper position
integer, intent(inout) :: row

current position and updated position input: current row; output: the row corresponding to the next proper position
integer, intent(in) :: maxpos

maximum allowable position maxmimum row
integer, intent(in) :: maxrows

maximum allowable position maxmimum row
integer, intent(in), DIMENSION(:) :: blk_p

block pointercs row pointers
integer, intent(in), DIMENSION(:) :: row_p

block pointercs row pointers
integer, intent(in), optional, DIMENSION(1:maxrows) :: tdist

thread distribution
integer, intent(in), optional :: tid

my thread number
integer, intent(in), optional, DIMENSION(1:*) :: local2global

Source Code

   PURE SUBROUTINE find_proper_position(pos, row, maxpos, maxrows, &
                                        blk_p, row_p, tdist, tid, local2global)
      !! Finds the next proper position accounting for threads
      !! First time: pos and row are set to 0.
      !! If there is no valid block, pos is set to 0

      INTEGER, INTENT(INOUT)                             :: pos, row
         !! current position and updated position
         !! input: current row; output: the row corresponding to the next proper position
      INTEGER, INTENT(IN)                                :: maxpos, maxrows
         !! maximum allowable position
         !! maxmimum row
      INTEGER, DIMENSION(:), INTENT(IN)                  :: blk_p, row_p
         !! block pointercs
         !! row pointers
      INTEGER, DIMENSION(1:maxrows), INTENT(IN), &
         OPTIONAL                                        :: tdist
         !! thread distribution
      INTEGER, INTENT(IN), OPTIONAL                      :: tid
         !! my thread number
      INTEGER, DIMENSION(1:*), INTENT(IN), OPTIONAL      :: local2global

      LOGICAL                                            :: local, row_inrange, row_ok

!   ---------------------------------------------------------------------------

      MARK_USED(tdist) ! only used with OMP
      MARK_USED(tid) ! only used with OMP

      local = PRESENT(local2global)
      IF (maxpos .GE. 1) THEN
         !IF (pos.EQ.0) pos = 1
         CALL find_first_valid_block(pos, maxpos, blk_p)
         CALL find_proper_row(pos, row, maxrows, row_p)
         row_inrange = row .NE. 0 .AND. row .LE. maxrows
         row_ok = row_inrange
!$       IF (present(tdist) .AND. PRESENT(tid) .AND. row_inrange) THEN
!$          IF (.NOT. local) THEN
!$             row_ok = tdist(row) .EQ. tid
!$          ELSE
!$             row_ok = tdist(local2global(row)) .EQ. tid
!$          END IF
!$       END IF
         DO WHILE (row_inrange .AND. .NOT. row_ok)
            row = row + 1
            pos = row_p(row) + 1
            IF (row .GT. maxrows) THEN
               row = 0
               EXIT
            END IF
            CALL find_first_valid_block(pos, maxpos, blk_p)
            CALL find_proper_row(pos, row, maxrows, row_p)
            row_inrange = row .NE. 0
            row_ok = row_inrange
!$          IF (present(tdist) .AND. PRESENT(tid) .AND. row_inrange) THEN
!$             IF (.NOT. local) THEN
!$                row_ok = tdist(row) .EQ. tid
!$             ELSE
!$                row_ok = tdist(local2global(row)) .EQ. tid
!$             END IF
!$          END IF
         END DO
         IF (row .EQ. 0) pos = 0
      ELSE
         pos = 0
         row = 0
      END IF
   END SUBROUTINE find_proper_position