00001 SUBROUTINE ZERRPS( PATH, NUNIT )
00002
00003
00004
00005
00006
00007
00008 INTEGER NUNIT
00009 CHARACTER*3 PATH
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030 INTEGER NMAX
00031 PARAMETER ( NMAX = 4 )
00032
00033
00034 INTEGER I, INFO, J
00035
00036
00037 COMPLEX*16 A( NMAX, NMAX )
00038 DOUBLE PRECISION RWORK( 2*NMAX )
00039 INTEGER PIV( NMAX )
00040
00041
00042 EXTERNAL ALAESM, CHKXER, ZPSTF2, ZPSTRF
00043
00044
00045 INTEGER INFOT, NOUT
00046 LOGICAL LERR, OK
00047 CHARACTER*32 SRNAMT
00048
00049
00050 COMMON / INFOC / INFOT, NOUT, OK, LERR
00051 COMMON / SRNAMC / SRNAMT
00052
00053
00054 INTRINSIC DBLE
00055
00056
00057
00058 NOUT = NUNIT
00059 WRITE( NOUT, FMT = * )
00060
00061
00062
00063 DO 110 J = 1, NMAX
00064 DO 100 I = 1, NMAX
00065 A( I, J ) = 1.D0 / DBLE( I+J )
00066
00067 100 CONTINUE
00068 PIV( J ) = J
00069 RWORK( J ) = 0.D0
00070 RWORK( NMAX+J ) = 0.D0
00071
00072 110 CONTINUE
00073 OK = .TRUE.
00074
00075
00076
00077
00078
00079
00080
00081 SRNAMT = 'ZPSTRF'
00082 INFOT = 1
00083 CALL ZPSTRF( '/', 0, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00084 CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
00085 INFOT = 2
00086 CALL ZPSTRF( 'U', -1, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00087 CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
00088 INFOT = 4
00089 CALL ZPSTRF( 'U', 2, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00090 CALL CHKXER( 'ZPSTRF', INFOT, NOUT, LERR, OK )
00091
00092
00093
00094 SRNAMT = 'ZPSTF2'
00095 INFOT = 1
00096 CALL ZPSTF2( '/', 0, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00097 CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
00098 INFOT = 2
00099 CALL ZPSTF2( 'U', -1, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00100 CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
00101 INFOT = 4
00102 CALL ZPSTF2( 'U', 2, A, 1, PIV, 1, -1.D0, RWORK, INFO )
00103 CALL CHKXER( 'ZPSTF2', INFOT, NOUT, LERR, OK )
00104
00105
00106
00107
00108 CALL ALAESM( PATH, OK, NOUT )
00109
00110 RETURN
00111
00112
00113
00114 END