mirror of
https://github.com/autc04/Retro68.git
synced 2024-12-13 03:29:50 +00:00
30 lines
890 B
Fortran
30 lines
890 B
Fortran
|
! { dg-do run }
|
||
|
|
SUBROUTINE SUBDOMAIN(X, ISTART, IPOINTS)
|
||
|
|
INTEGER ISTART, IPOINTS
|
||
|
|
REAL X(*)
|
||
|
|
INTEGER I
|
||
|
|
DO 100 I=1,IPOINTS
|
||
|
|
X(ISTART+I) = 123.456
|
||
|
|
100 CONTINUE
|
||
|
|
END SUBROUTINE SUBDOMAIN
|
||
|
|
SUBROUTINE SUB(X, NPOINTS)
|
||
|
|
INCLUDE "omp_lib.h" ! or USE OMP_LIB
|
||
|
|
REAL X(*)
|
||
|
|
INTEGER NPOINTS
|
||
|
|
INTEGER IAM, NT, IPOINTS, ISTART
|
||
|
|
!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(X,NPOINTS)
|
||
|
|
IAM = OMP_GET_THREAD_NUM()
|
||
|
|
NT = OMP_GET_NUM_THREADS()
|
||
|
|
IPOINTS = NPOINTS/NT
|
||
|
|
ISTART = IAM * IPOINTS
|
||
|
|
IF (IAM .EQ. NT-1) THEN
|
||
|
|
IPOINTS = NPOINTS - ISTART
|
||
|
|
ENDIF
|
||
|
|
CALL SUBDOMAIN(X,ISTART,IPOINTS)
|
||
|
|
!$OMP END PARALLEL
|
||
|
|
END SUBROUTINE SUB
|
||
|
|
PROGRAM A4
|
||
|
|
REAL ARRAY(10000)
|
||
|
|
CALL SUB(ARRAY, 10000)
|
||
|
|
END PROGRAM A4
|