Hello,
I can’t compile the following program. The compiling error quoted in the subject occurs
only when I use the command: pgf95 -mp -g omp_support.f90
Forgive me lengthy code.
Regards,
James
MODULE lib_aux
IMPLICIT NONE
INTEGER, PRIVATE :: i
! number of threads
INTEGER, PARAMETER :: n = 3
! sleep time
INTEGER, PARAMETER :: nsleep = 5
TYPE :: history
INTEGER :: idh = -1
DOUBLE PRECISION :: htime
CHARACTER :: descr*20
END TYPE history
TYPE (history), DIMENSION(0:(n-1)), SAVE :: histA,histB
INTEGER, SAVE :: iA = 0
INTEGER, SAVE :: iB = 0
CONTAINS
SUBROUTINE print_history()
DO i=0, n-1
IF (histA(i)%idh /= -1) THEN
PRINT *, histA(i)%idh, histA(i)%htime,' ', histA(i)%descr
END IF
END DO
DO i=0, n-1
IF (histB(i)%idh /= -1) THEN
PRINT *, histB(i)%idh, histB(i)%htime,' ', histB(i)%descr
END IF
END DO
END SUBROUTINE print_history
END MODULE lib_aux
MODULE lib
USE lib_aux
USE omp_lib
IMPLICIT NONE
INTEGER (omp_lock_kind), SAVE :: rlck
TYPE :: struct
REAL, DIMENSION(:), POINTER :: r_ptr => null()
END TYPE struct
TYPE (struct), SAVE :: structA
CONTAINS
SUBROUTINE write_struct (DATA)
REAL, INTENT(in) :: DATA(:)
IF (.NOT. ASSOCIATED(structA%r_ptr)) THEN
ALLOCATE (structA%r_ptr(SIZE(DATA)) )
END IF
!$OMP CRITICAL (WR)
histA(iA)%idh = omp_get_thread_num()
histA(iA)%htime = omp_get_wtime()
histA(iA)%descr = 'write_struct_r'
iA = iA + 1
CALL sleep(2)
DO WHILE (.NOT. omp_test_lock(rlck))
PRINT *, 'waiting', omp_get_thread_num(), omp_test_lock(rlck)
END DO
CALL omp_unset_lock(rlck)
structA%r_ptr = DATA
!$OMP END CRITICAL (WR)
END SUBROUTINE write_struct
SUBROUTINE read_struct(DATA)
REAL, INTENT(out) :: DATA(:)
!$OMP CRITICAL (RS)
histB(iB)%idh = omp_get_thread_num()
histB(iB)%htime = omp_get_wtime()
histB(iB)%descr = 'read_struct'
iB = iB + 1
CALL omp_set_lock(rlck)
!$OMP FLUSH
DATA = structA%r_ptr
CALL sleep(nsleep)
CALL omp_unset_lock(rlck)
!$OMP END CRITICAL (RS)
END SUBROUTINE read_struct
END MODULE lib
PROGRAM test
USE lib
IMPLICIT NONE
INTEGER :: i
REAL :: wr_data1(10), wr_data2(10), rr_data(10)
wr_data1 = (/(REAL(i),i=1,10)/)
wr_data2 = -wr_data1
CALL omp_set_dynamic(.false.)
CALL omp_set_num_threads(n)
CALL omp_init_lock(rlck)
!$OMP PARALLEL DEFAULT(SHARED)
!$OMP SECTIONS
!$OMP SECTION
CALL write_struct(wr_data1)
!$OMP SECTION
CALL write_struct(wr_data2)
!$OMP SECTION
CALL read_struct(rr_data)
!$OMP END SECTIONS
!$OMP END PARALLEL
CALL omp_destroy_lock(rlck)
CALL print_history()
END PROGRAM test