OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zmumps_iXamax.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 INTEGER FUNCTION zmumps_ixamax(N,X,INCX,GRAIN)
15!$ USE omp_lib
16 IMPLICIT NONE
17 COMPLEX(kind=8), intent(in) :: x(*)
18 INTEGER, intent(in) :: incx,n
19 INTEGER, intent(in) :: grain
20 DOUBLE PRECISION absmax
21 INTEGER :: i
22 INTEGER(8) :: ix
23!$ INTEGER :: NOMP, CHUNK
24!$ INTEGER :: IMAX
25!$ DOUBLE PRECISION :: XMAX, VALABS
26!$ DOUBLE PRECISION, PARAMETER :: RZERO = 0.0D0
27!$ NOMP = OMP_GET_MAX_THREADS()
29 IF ( n.LT.1 ) RETURN
31 IF ( n.EQ.1 .OR. incx.LE.0 ) RETURN
32!$ IF (NOMP.GT.1 .AND. N.GE.GRAIN*2) THEN
33!$ IF ( INCX.EQ.1 ) THEN
34!$ CHUNK = max(GRAIN,(N+NOMP-1)/NOMP)
35!$ ABSMAX = RZERO
36!$OMP PARALLEL PRIVATE(I, VALABS, XMAX, IMAX)
37!$OMP& FIRSTPRIVATE(N, CHUNK)
38!$ XMAX = RZERO
39!$OMP DO SCHEDULE(static, CHUNK)
40!$ DO I = 1, N
41!$ VALABS = abs(X(I))
42!$ IF ( VALABS .GT. XMAX ) THEN
43!$ XMAX = VALABS
44!$ IMAX = I
45!$ ENDIF
46!$ ENDDO
47!$OMP END DO
48!$ IF (XMAX .GT. RZERO) THEN
49!$OMP CRITICAL
50!$ IF (XMAX .GT. ABSMAX) THEN
51!$ ZMUMPS_IXAMAX = IMAX
52!$ ABSMAX = XMAX
53!$ ENDIF
54!$omp END critical
55!$ ENDIF
56!$OMP END PARALLEL
57!$ ELSE
58!$ chunk = max(grain,(n+nomp-1)/nomp)
59!$ ABSMAX = RZERO
60!$OMP PARALLEL PRIVATE(I, VALABS, XMAX, IMAX, IX)
61!$OMP& FIRSTPRIVATE(N, CHUNK, INCX)
62!$ XMAX = RZERO
63!$OMP DO SCHEDULE(static, CHUNK)
64!$ DO I = 1, N
65!$ IX = 1 + int((I-1),8)*int(INCX,8)
66!$ VALABS = abs(X(IX))
67!$ IF ( VALABS .GT. XMAX ) THEN
68!$ XMAX = VALABS
69!$ IMAX = I
70!$ ENDIF
71!$ ENDDO
72!$OMP END DO
73!$ IF (XMAX .GT. RZERO) THEN
74!$OMP CRITICAL
75!$ IF (XMAX .GT. ABSMAX) THEN
76!$ ZMUMPS_IXAMAX = IMAX
77!$ ABSMAX = XMAX
78!$ ENDIF
79!$OMP END CRITICAL
80!$ ENDIF
81!$OMP END PARALLEL
82!$ ENDIF
83!$ ELSE
84 IF ( incx.EQ.1 ) THEN
85 absmax = abs(x(1))
86 DO i = 2, n
87 IF ( abs(x(i)) .LE. absmax ) cycle
89 absmax = abs(x(i))
90 ENDDO
91 ELSE
92 ix = 1
93 absmax = abs(x(1))
94 ix = ix + incx
95 DO i = 2, n
96 IF ( abs(x(ix)).LE.absmax ) GOTO 5
98 absmax = abs(x(ix))
99 5 ix = ix + incx
100 ENDDO
101 ENDIF
102!$ ENDIF
103 RETURN
104 END FUNCTION zmumps_ixamax
#define max(a, b)
Definition macros.h:21
integer function zmumps_ixamax(n, x, incx, grain)