GSP
Quick Navigator

Search Site

Unix VPS
A - Starter
B - Basic
C - Preferred
D - Commercial
MPS - Dedicated
Previous VPSs
* Sign Up! *

Support
Contact Us
Online Help
Handbooks
Domain Status
Man Pages

FAQ
Virtual Servers
Pricing
Billing
Technical

Network
Facilities
Connectivity
Topology Map

Miscellaneous
Server Agreement
Year 2038
Credits
 

USA Flag

 

 

Man Pages
PCHENGST(l) ) PCHENGST(l)

SUBROUTINE PCHENGST(
IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, DESCB, SCALE, WORK, LWORK, INFO )
CHARACTER UPLO INTEGER IA, IB, IBTYPE, INFO, JA, JB, LWORK, N REAL SCALE INTEGER DESCA( * ), DESCB( * ) COMPLEX A( * ), B( * ), WORK( * ) COMPLEX ONEHALF, ONE, MONE REAL RONE PARAMETER ( ONEHALF = ( 0.5E0, 0.0E0 ), ONE = ( 1.0E0, 0.0E0 ), MONE = ( -1.0E0, 0.0E0 ), RONE = 1.0E0 ) INTEGER DLEN_, CTXT_, MB_, NB_, RSRC_, CSRC_, LLD_ PARAMETER ( DLEN_ = 9, CTXT_ = 2, MB_ = 5, NB_ = 6, RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) LOGICAL LQUERY, UPPER INTEGER I, IACOL, IAROW, IBCOL, IBROW, ICOFFA, ICOFFB, ICTXT, INDAA, INDG, INDR, INDRT, IROFFA, IROFFB, J, K, KB, LWMIN, LWOPT, MYCOL, MYROW, NB, NP0, NPCOL, NPK, NPROW, NQ0, POSTK INTEGER DESCAA( DLEN_ ), DESCG( DLEN_ ), DESCR( DLEN_ ), DESCRT( DLEN_ ), IDUM1( 2 ), IDUM2( 2 ) LOGICAL LSAME INTEGER INDXG2P, NUMROC EXTERNAL LSAME, INDXG2P, NUMROC EXTERNAL BLACS_GRIDINFO, CHK1MAT, DESCSET, PCGEMM, PCHEGST, PCHEMM, PCHER2K, PCHK2MAT, PCLACPY, PCTRSM, PXERBLA INTRINSIC CMPLX, CONJG, ICHAR, MAX, MIN, MOD, REAL ICTXT = DESCA( CTXT_ ) CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) SCALE = 1.0E0 NB = DESCA( MB_ ) INFO = 0 IF( NPROW.EQ.-1 ) THEN INFO = -( 700+CTXT_ ) ELSE UPPER = LSAME( UPLO, 'U' ) CALL CHK1MAT( N, 3, N, 3, IA, JA, DESCA, 7, INFO ) CALL CHK1MAT( N, 3, N, 3, IB, JB, DESCB, 11, INFO ) IF( INFO.EQ.0 ) THEN IAROW = INDXG2P( IA, DESCA( MB_ ), MYROW, DESCA( RSRC_ ), NPROW ) IBROW = INDXG2P( IB, DESCB( MB_ ), MYROW, DESCB( RSRC_ ), NPROW ) IACOL = INDXG2P( JA, DESCA( NB_ ), MYCOL, DESCA( CSRC_ ), NPCOL ) IBCOL = INDXG2P( JB, DESCB( NB_ ), MYCOL, DESCB( CSRC_ ), NPCOL ) IROFFA = MOD( IA-1, DESCA( MB_ ) ) ICOFFA = MOD( JA-1, DESCA( NB_ ) ) IROFFB = MOD( IB-1, DESCB( MB_ ) ) ICOFFB = MOD( JB-1, DESCB( NB_ ) ) NP0 = NUMROC( N, NB, 0, 0, NPROW ) NQ0 = NUMROC( N, NB, 0, 0, NPCOL ) LWMIN = MAX( NB*( NP0+1 ), 3*NB ) IF( IBTYPE.EQ.1 .AND. .NOT.UPPER ) THEN LWOPT = 2*NP0*NB + NQ0*NB + NB*NB ELSE LWOPT = LWMIN END IF WORK( 1 ) = CMPLX( REAL( LWOPT ) ) LQUERY = ( LWORK.EQ.-1 ) IF( IBTYPE.LT.1 .OR. IBTYPE.GT.3 ) THEN INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 ELSE IF( IROFFA.NE.0 ) THEN INFO = -5 ELSE IF( ICOFFA.NE.0 ) THEN INFO = -6 ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN INFO = -( 700+NB_ ) ELSE IF( IROFFB.NE.0 .OR. IBROW.NE.IAROW ) THEN INFO = -9 ELSE IF( ICOFFB.NE.0 .OR. IBCOL.NE.IACOL ) THEN INFO = -10 ELSE IF( DESCB( MB_ ).NE.DESCA( MB_ ) ) THEN INFO = -( 1100+MB_ ) ELSE IF( DESCB( NB_ ).NE.DESCA( NB_ ) ) THEN INFO = -( 1100+NB_ ) ELSE IF( ICTXT.NE.DESCB( CTXT_ ) ) THEN INFO = -( 1100+CTXT_ ) ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF END IF IDUM1( 1 ) = IBTYPE IDUM2( 1 ) = 1 IF( UPPER ) THEN IDUM1( 2 ) = ICHAR( 'U' ) ELSE IDUM1( 2 ) = ICHAR( 'L' ) END IF IDUM2( 2 ) = 2 CALL PCHK2MAT( N, 3, N, 3, IA, JA, DESCA, 7, N, 3, N, 3, IB, JB, DESCB, 11, 2, IDUM1, IDUM2, INFO ) END IF IF( INFO.NE.0 ) THEN CALL PXERBLA( ICTXT, 'PCHENGST', -INFO ) RETURN ELSE IF( LQUERY ) THEN RETURN END IF IF( N.EQ.0 ) RETURN IF( IBTYPE.NE.1 .OR. UPPER .OR. LWORK.LT.LWOPT ) THEN CALL PCHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, DESCB, SCALE, INFO ) RETURN END IF CALL DESCSET( DESCG, N, NB, NB, NB, IAROW, IACOL, ICTXT, NP0 ) CALL DESCSET( DESCR, N, NB, NB, NB, IAROW, IACOL, ICTXT, NP0 ) CALL DESCSET( DESCRT, NB, N, NB, NB, IAROW, IACOL, ICTXT, NB ) CALL DESCSET( DESCAA, NB, NB, NB, NB, IAROW, IACOL, ICTXT, NB ) INDG = 1 INDR = INDG + DESCG( LLD_ )*NB INDAA = INDR + DESCR( LLD_ )*NB INDRT = INDAA + DESCAA( LLD_ )*NB DO 30 K = 1, N, NB KB = MIN( N-K+1, NB ) POSTK = K + KB NPK = N - POSTK + 1 CALL PCLACPY( 'A', N-POSTK+1, KB, B, POSTK+IB-1, K+JB-1, DESCB, WORK( INDG ), POSTK, 1, DESCG ) CALL PCLACPY( 'A', N-POSTK+1, KB, A, POSTK+IA-1, K+JA-1, DESCA, WORK( INDR ), POSTK, 1, DESCR ) CALL PCLACPY( 'A', KB, K-1, A, K+IA-1, JA, DESCA, WORK( INDRT ), 1, 1, DESCRT ) CALL PCLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDR ), K, 1, DESCR ) CALL PCTRSM( 'Right', 'L', 'N', 'N', NPK, KB, MONE, B, K+IB-1, K+JB-1, DESCB, WORK( INDG ), POSTK, 1, DESCG ) CALL PCHEMM( 'Right', 'L', NPK, KB, ONEHALF, A, K+IA-1, K+JA-1, DESCA, WORK( INDG ), POSTK, 1, DESCG, ONE, WORK( INDR ), POSTK, 1, DESCR ) CALL PCHER2K( 'Lower', 'No T', NPK, KB, ONE, WORK( INDG ), POSTK, 1, DESCG, WORK( INDR ), POSTK, 1, DESCR, RONE, A, POSTK+IA-1, POSTK+JA-1, DESCA ) CALL PCGEMM( 'No T', 'No Conj', NPK, K-1, KB, ONE, WORK( INDG ), POSTK, 1, DESCG, WORK( INDRT ), 1, 1, DESCRT, ONE, A, POSTK+IA-1, JA, DESCA ) CALL PCHEMM( 'Right', 'L', NPK, KB, ONE, WORK( INDR ), K, 1, DESCR, WORK( INDG ), POSTK, 1, DESCG, ONE, A, POSTK+IA-1, K+JA-1, DESCA ) CALL PCTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, K-1, ONE, B, K+IB-1, K+JB-1, DESCB, A, K+IA-1, JA, DESCA ) CALL PCLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDAA ), 1, 1, DESCAA ) IF( MYROW.EQ.DESCAA( RSRC_ ) .AND. MYCOL.EQ.DESCAA( CSRC_ ) ) THEN DO 20 I = 1, KB DO 10 J = 1, I WORK( INDAA+J-1+( I-1 )*DESCAA( LLD_ ) ) = CONJG( WORK( INDAA+I-1+( J-1 )*DESCAA( LLD_ ) ) ) 10 CONTINUE 20 CONTINUE END IF CALL PCTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, KB, ONE, B, K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA ) CALL PCTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', KB, KB, ONE, B, K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA ) CALL PCLACPY( 'L', KB, KB, WORK( INDAA ), 1, 1, DESCAA, A, K+IA-1, K+JA-1, DESCA ) CALL PCTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', NPK, KB, ONE, B, K+IB-1, K+JB-1, DESCB, A, POSTK+IA-1, K+JA-1, DESCA ) DESCR( CSRC_ ) = MOD( DESCR( CSRC_ )+1, NPCOL ) DESCG( CSRC_ ) = MOD( DESCG( CSRC_ )+1, NPCOL ) DESCRT( RSRC_ ) = MOD( DESCRT( RSRC_ )+1, NPROW ) DESCAA( RSRC_ ) = MOD( DESCAA( RSRC_ )+1, NPROW ) DESCAA( CSRC_ ) = MOD( DESCAA( CSRC_ )+1, NPCOL ) 30 CONTINUE WORK( 1 ) = CMPLX( REAL( LWOPT ) ) RETURN END

13 August 2001 ScaLAPACK version 1.7

Search for    or go to Top of page |  Section l |  Main Index

Powered by GSP Visit the GSP FreeBSD Man Page Interface.
Output converted with ManDoc.