Skip to content

Commit 34a2a59

Browse files
joseeromanjoseeroman
committed
Avoid calling CLADIV, ZLADIV
These LAPACK functions return a complex number (as ZDOTC and friends) and hence do not work in MacOS, so it is better not to call them
1 parent e829503 commit 34a2a59

File tree

6 files changed

+132
-64
lines changed

6 files changed

+132
-64
lines changed

‎SRC/clanv2.f

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -55,13 +55,10 @@ SUBROUTINE CLANV2( A, B, C, D, RT1, RT2, CS, SN )
5555
* ..
5656
* .. Local Scalars ..
5757
COMPLEX AA, BB, DD, T, TEMP, TEMP2, U, X, Y
58-
* ..
59-
* .. External Functions ..
60-
COMPLEX CLADIV
61-
EXTERNAL CLADIV
58+
REAL CR, CI
6259
* ..
6360
* .. External Subroutines ..
64-
EXTERNAL CLARTG
61+
EXTERNAL CLARTG, SLADIV
6562
* ..
6663
* .. Intrinsic Functions ..
6764
INTRINSIC REAL, CMPLX, CONJG, AIMAG, SQRT
@@ -97,9 +94,13 @@ SUBROUTINE CLANV2( A, B, C, D, RT1, RT2, CS, SN )
9794
SN = CMPLX( RZERO, RONE )*CS
9895
ELSE
9996
TEMP = SQRT( B+C )
100-
TEMP2 = CLADIV( SQRT( B ), TEMP )
97+
CALL SLADIV( REAL( SQRT( B ) ), AIMAG( SQRT( B ) ),
98+
$ REAL( TEMP ), AIMAG( TEMP ), CR, CI )
99+
TEMP2 = CMPLX( CR, CI )
101100
CS = REAL( TEMP2 )
102-
SN = CLADIV( SQRT( C ), TEMP )
101+
CALL SLADIV( REAL( SQRT( C ) ), AIMAG( SQRT( C ) ),
102+
$ REAL( TEMP ), AIMAG( TEMP ), CR, CI )
103+
SN = CMPLX( CR, CI )
103104
END IF
104105
B = B - C
105106
C = ZERO
@@ -114,7 +115,9 @@ SUBROUTINE CLANV2( A, B, C, D, RT1, RT2, CS, SN )
114115
Y = SQRT( X*X+U )
115116
IF( REAL( X )*REAL( Y )+AIMAG( X )*AIMAG( Y ).LT.RZERO )
116117
$ Y = -Y
117-
T = T - CLADIV( U, ( X+Y ) )
118+
CALL SLADIV( REAL( U ), AIMAG( U ),
119+
$ REAL( X+Y ), AIMAG( X+Y ), CR, CI )
120+
T = T - CMPLX( CR, CI )
118121
*
119122
* Do one QR step with exact shift T - resulting 2 x 2 in
120123
* triangular form.

‎SRC/pclarfg.f

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -153,16 +153,16 @@ SUBROUTINE PCLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
153153
* .. Local Scalars ..
154154
INTEGER ICTXT, IIAX, INDXTAU, IXCOL, IXROW, J, JJAX,
155155
$ KNT, MYCOL, MYROW, NPCOL, NPROW
156-
REAL ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
156+
REAL ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM, CR,
157+
$ CI
157158
* ..
158159
* .. External Subroutines ..
159160
EXTERNAL BLACS_GRIDINFO, CGEBR2D, CGEBS2D, PCSCAL,
160-
$ PCSSCAL, INFOG2L, PSCNRM2
161+
$ PCSSCAL, INFOG2L, PSCNRM2, SLADIV
161162
* ..
162163
* .. External Functions ..
163164
REAL SLAMCH, SLAPY3
164-
COMPLEX CLADIV
165-
EXTERNAL CLADIV, SLAPY3, SLAMCH
165+
EXTERNAL SLAPY3, SLAMCH
166166
* ..
167167
* .. Intrinsic Functions ..
168168
INTRINSIC ABS, AIMAG, CMPLX, REAL, SIGN
@@ -265,7 +265,9 @@ SUBROUTINE PCLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
265265
BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
266266
TAU( INDXTAU ) = CMPLX( ( BETA-ALPHR ) / BETA,
267267
$ -ALPHI / BETA )
268-
ALPHA = CLADIV( CMPLX( ONE ), ALPHA-BETA )
268+
CALL SLADIV( ONE, ZERO, REAL( ALPHA-BETA ),
269+
$ AIMAG( ALPHA-BETA ), CR, CI )
270+
ALPHA = CMPLX( CR, CI )
269271
CALL PCSCAL( N-1, ALPHA, X, IX, JX, DESCX, INCX )
270272
*
271273
* If ALPHA is subnormal, it may lose relative accuracy
@@ -277,7 +279,9 @@ SUBROUTINE PCLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
277279
ELSE
278280
TAU( INDXTAU ) = CMPLX( ( BETA-ALPHR ) / BETA,
279281
$ -ALPHI / BETA )
280-
ALPHA = CLADIV( CMPLX( ONE ), ALPHA-BETA )
282+
CALL SLADIV( ONE, ZERO, REAL( ALPHA-BETA ),
283+
$ AIMAG( ALPHA-BETA ), CR, CI )
284+
ALPHA = CMPLX( CR, CI )
281285
CALL PCSCAL( N-1, ALPHA, X, IX, JX, DESCX, INCX )
282286
ALPHA = BETA
283287
END IF

‎SRC/pclattrs.f

Lines changed: 45 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -271,22 +271,21 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
271271
$ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB,
272272
$ NPCOL, NPROW, RSRC
273273
REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
274-
$ XBND, XJ
274+
$ XBND, XJ, CR, CI
275275
REAL XMAX( 1 )
276276
COMPLEX CSUMJ, TJJS, USCAL, XJTMP, ZDUM
277277
* ..
278278
* .. External Functions ..
279279
LOGICAL LSAME
280280
INTEGER ISAMAX
281281
REAL PSLAMCH
282-
COMPLEX CLADIV
283-
EXTERNAL LSAME, ISAMAX, PSLAMCH, CLADIV
282+
EXTERNAL LSAME, ISAMAX, PSLAMCH
284283
* ..
285284
* .. External Subroutines ..
286285
EXTERNAL BLACS_GRIDINFO, SGSUM2D, SSCAL, INFOG2L,
287286
$ PSCASUM, PSLABAD, PXERBLA, PCAMAX, PCAXPY,
288287
$ PCDOTC, PCDOTU, PCSSCAL, PCLASET, PCSCAL,
289-
$ PCTRSV, CGEBR2D, CGEBS2D
288+
$ PCTRSV, CGEBR2D, CGEBS2D, SLADIV
290289
* ..
291290
* .. Intrinsic Functions ..
292291
INTRINSIC ABS, REAL, CMPLX, CONJG, AIMAG, MAX, MIN
@@ -657,7 +656,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
657656
END IF
658657
* X( J ) = CLADIV( X( J ), TJJS )
659658
* XJ = CABS1( X( J ) )
660-
XJTMP = CLADIV( XJTMP, TJJS )
659+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
660+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
661+
XJTMP = CMPLX( CR, CI )
661662
XJ = CABS1( XJTMP )
662663
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
663664
$ THEN
@@ -687,7 +688,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
687688
END IF
688689
* X( J ) = CLADIV( X( J ), TJJS )
689690
* XJ = CABS1( X( J ) )
690-
XJTMP = CLADIV( XJTMP, TJJS )
691+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
692+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
693+
XJTMP = CMPLX( CR, CI )
691694
XJ = CABS1( XJTMP )
692695
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
693696
$ THEN
@@ -815,7 +818,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
815818
* Divide by A(j,j) when scaling x if A(j,j) > 1.
816819
*
817820
REC = MIN( ONE, REC*TJJ )
818-
USCAL = CLADIV( USCAL, TJJS )
821+
CALL SLADIV( REAL( USCAL ), AIMAG( USCAL ),
822+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
823+
USCAL = CMPLX( CR, CI )
819824
END IF
820825
IF( REC.LT.ONE ) THEN
821826
CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
@@ -857,7 +862,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
857862
CALL PCSCAL( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1 )
858863
CALL PCDOTU( J-1, CSUMJ, A, IA, JA+J-1, DESCA, 1,
859864
$ X, IX, JX, DESCX, 1 )
860-
ZDUM = CLADIV( ZDUM, USCAL )
865+
CALL SLADIV( REAL( ZDUM ), AIMAG( ZDUM ),
866+
$ REAL( USCAL ), AIMAG( USCAL ), CR, CI)
867+
ZDUM = CMPLX( CR, CI )
861868
CALL PCSCAL( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1 )
862869
ELSE IF( J.LT.N ) THEN
863870
* DO 140 I = J + 1, N
@@ -867,7 +874,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
867874
CALL PCSCAL( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1 )
868875
CALL PCDOTU( N-J, CSUMJ, A, IA+J, JA+J-1, DESCA, 1,
869876
$ X, IX+J, JX, DESCX, 1 )
870-
ZDUM = CLADIV( ZDUM, USCAL )
877+
CALL SLADIV( REAL( ZDUM ), AIMAG( ZDUM ),
878+
$ REAL( USCAL ), AIMAG( USCAL ), CR, CI)
879+
ZDUM = CMPLX( CR, CI )
871880
CALL PCSCAL( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1 )
872881
END IF
873882
IF( MYCOL.EQ.ITMP2X ) THEN
@@ -929,7 +938,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
929938
END IF
930939
END IF
931940
* X( J ) = CLADIV( X( J ), TJJS )
932-
XJTMP = CLADIV( XJTMP, TJJS )
941+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
942+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
943+
XJTMP = CMPLX( CR, CI )
933944
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
934945
$ THEN
935946
X( IROWX ) = XJTMP
@@ -949,7 +960,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
949960
XMAX( 1 ) = XMAX( 1 )*REC
950961
END IF
951962
* X( J ) = CLADIV( X( J ), TJJS )
952-
XJTMP = CLADIV( XJTMP, TJJS )
963+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
964+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
965+
XJTMP = CMPLX( CR, CI )
953966
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
954967
$ THEN
955968
X( IROWX ) = XJTMP
@@ -976,7 +989,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
976989
* product has already been divided by 1/A(j,j).
977990
*
978991
* X( J ) = CLADIV( X( J ), TJJS ) - CSUMJ
979-
XJTMP = CLADIV( XJTMP, TJJS ) - CSUMJ
992+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
993+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
994+
XJTMP = CMPLX( CR, CI )
980995
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
981996
$ THEN
982997
X( IROWX ) = XJTMP
@@ -1034,7 +1049,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
10341049
* Divide by A(j,j) when scaling x if A(j,j) > 1.
10351050
*
10361051
REC = MIN( ONE, REC*TJJ )
1037-
USCAL = CLADIV( USCAL, TJJS )
1052+
CALL SLADIV( REAL( USCAL ), AIMAG( USCAL ),
1053+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
1054+
USCAL = CMPLX( CR, CI )
10381055
END IF
10391056
IF( REC.LT.ONE ) THEN
10401057
CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
@@ -1077,7 +1094,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
10771094
CALL PCSCAL( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1 )
10781095
CALL PCDOTC( J-1, CSUMJ, A, IA, JA+J-1, DESCA, 1,
10791096
$ X, IX, JX, DESCX, 1 )
1080-
ZDUM = CLADIV( CONE, ZDUM )
1097+
CALL SLADIV( ONE, ZERO,
1098+
$ REAL( ZDUM ), AIMAG( ZDUM ), CR, CI )
1099+
ZDUM = CMPLX( CR, CI )
10811100
CALL PCSCAL( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1 )
10821101
ELSE IF( J.LT.N ) THEN
10831102
* DO 190 I = J + 1, N
@@ -1088,7 +1107,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
10881107
CALL PCSCAL( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1 )
10891108
CALL PCDOTC( N-J, CSUMJ, A, IA+J, JA+J-1, DESCA, 1,
10901109
$ X, IX+J, JX, DESCX, 1 )
1091-
ZDUM = CLADIV( CONE, ZDUM )
1110+
CALL SLADIV( ONE, ZERO,
1111+
$ REAL( ZDUM ), AIMAG( ZDUM ), CR, CI )
1112+
ZDUM = CMPLX( CR, CI )
10921113
CALL PCSCAL( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1 )
10931114
END IF
10941115
IF( MYCOL.EQ.ITMP2X ) THEN
@@ -1150,7 +1171,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
11501171
END IF
11511172
END IF
11521173
* X( J ) = CLADIV( X( J ), TJJS )
1153-
XJTMP = CLADIV( XJTMP, TJJS )
1174+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
1175+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
1176+
XJTMP = CMPLX( CR, CI )
11541177
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
11551178
$ X( IROWX ) = XJTMP
11561179
ELSE IF( TJJ.GT.ZERO ) THEN
@@ -1168,7 +1191,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
11681191
XMAX( 1 ) = XMAX( 1 )*REC
11691192
END IF
11701193
* X( J ) = CLADIV( X( J ), TJJS )
1171-
XJTMP = CLADIV( XJTMP, TJJS )
1194+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
1195+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
1196+
XJTMP = CMPLX( CR, CI )
11721197
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
11731198
$ X( IROWX ) = XJTMP
11741199
ELSE
@@ -1191,7 +1216,9 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
11911216
* product has already been divided by 1/A(j,j).
11921217
*
11931218
* X( J ) = CLADIV( X( J ), TJJS ) - CSUMJ
1194-
XJTMP = CLADIV( XJTMP, TJJS ) - CSUMJ
1219+
CALL SLADIV( REAL( XJTMP ), AIMAG( XJTMP ),
1220+
$ REAL( TJJS ), AIMAG( TJJS ), CR, CI )
1221+
XJTMP = CMPLX( CR, CI )
11951222
IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
11961223
$ X( IROWX ) = XJTMP
11971224
END IF

‎SRC/pzlarfg.f

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -153,17 +153,17 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
153153
* .. Local Scalars ..
154154
INTEGER ICTXT, IIAX, INDXTAU, IXCOL, IXROW, J, JJAX,
155155
$ KNT, MYCOL, MYROW, NPCOL, NPROW
156-
DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
156+
DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM, ZR,
157+
$ ZI
157158
* ..
158159
* .. External Subroutines ..
159160
EXTERNAL BLACS_GRIDINFO, INFOG2L, PDZNRM2,
160161
$ ZGEBR2D, ZGEBS2D, PZSCAL,
161-
$ PZDSCAL
162+
$ PZDSCAL, DLADIV
162163
* ..
163164
* .. External Functions ..
164165
DOUBLE PRECISION DLAMCH, DLAPY3
165-
COMPLEX*16 ZLADIV
166-
EXTERNAL DLAMCH, DLAPY3, ZLADIV
166+
EXTERNAL DLAMCH, DLAPY3
167167
* ..
168168
* .. Intrinsic Functions ..
169169
INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN
@@ -266,7 +266,9 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
266266
BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
267267
TAU( INDXTAU ) = DCMPLX( ( BETA-ALPHR ) / BETA,
268268
$ -ALPHI / BETA )
269-
ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
269+
CALL DLADIV( ONE, ZERO, DBLE( ALPHA-BETA ),
270+
$ DIMAG( ALPHA-BETA ), ZR, ZI )
271+
ALPHA = DCMPLX( ZR, ZI )
270272
CALL PZSCAL( N-1, ALPHA, X, IX, JX, DESCX, INCX )
271273
*
272274
* If ALPHA is subnormal, it may lose relative accuracy
@@ -278,7 +280,9 @@ SUBROUTINE PZLARFG( N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX,
278280
ELSE
279281
TAU( INDXTAU ) = DCMPLX( ( BETA-ALPHR ) / BETA,
280282
$ -ALPHI / BETA )
281-
ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
283+
CALL DLADIV( ONE, ZERO, DBLE( ALPHA-BETA ),
284+
$ DIMAG( ALPHA-BETA ), ZR, ZI )
285+
ALPHA = DCMPLX( ZR, ZI )
282286
CALL PZSCAL( N-1, ALPHA, X, IX, JX, DESCX, INCX )
283287
ALPHA = BETA
284288
END IF

0 commit comments

Comments
 (0)