C******************************************************************************
C FILE: omp_bug3.f
C DESCRIPTION:
C   Run time bug
C AUTHOR: Blaise Barney  01/09/04
C LAST REVISED: 06/28/05
C******************************************************************************

      PROGRAM BUG3

      INTEGER N, I, NTHREADS, TID, SECTION, OMP_GET_NUM_THREADS,
     +        OMP_GET_THREAD_NUM
      PARAMETER (N=50)
      REAL A(N), B(N), C(N)

C     Some initializations
      DO I = 1, N
        A(I) = I * 1.0
        B(I) = A(I)
      ENDDO

!$OMP PARALLEL PRIVATE(C,I,TID,SECTION)
      TID = OMP_GET_THREAD_NUM()
      IF (TID .EQ. 0) THEN
        NTHREADS = OMP_GET_NUM_THREADS()
        PRINT *, 'Number of threads = ', NTHREADS
      END IF

C     Use barriers for clean output
!$OMP BARRIER
      PRINT *, 'Thread ', TID, ' starting...'
!$OMP BARRIER

!$OMP SECTIONS
!$OMP SECTION
      SECTION = 1
      DO I = 1, N
         C(I) = A(I) * B(I)
      ENDDO
      CALL PRINT_RESULTS(C, TID, SECTION)

!$OMP SECTION
      SECTION = 2
      DO I = 1, N
         C(I) = A(I) + B(I)
      ENDDO
      CALL PRINT_RESULTS(C, TID, SECTION)

!$OMP END SECTIONS

C     Use barrier for clean output
!$OMP BARRIER
      PRINT *, 'Thread', tid, ' exiting...'

!$OMP END PARALLEL

      END



      SUBROUTINE PRINT_RESULTS(C, TID, SECTION)
      INTEGER TID, SECTION, N, I, J
      PARAMETER (N=50)
      REAL C(N)

      J = 1
C     Use critical for clean output
!$OMP CRITICAL
      PRINT *, ' '
      PRINT *, 'Thread', TID, ' did section', SECTION
      DO I=1, N
        WRITE(*,100) C(I)
 100    FORMAT(E12.6,$)
        J = J + 1
        IF (J .EQ. 6) THEN
          PRINT *, ' '
          J = 1
        END IF
      END DO
      PRINT *, ' '
!$OMP END CRITICAL

!$OMP BARRIER
      PRINT *,'Thread', TID, ' done and synchronized'

      END SUBROUTINE PRINT_RESULTS
