/* volume in half dB
* don't check input values */
static void set_hp_vol(int vol_l, int vol_r)
{
/* minimum is -57.5dB and max is 6dB in DAC mode
* and -51.5dB / 12dB in Line1 mode */
int min = input_line1 ? -103 : -115;
int max = input_line1 ? 24 : 12;
vol_l = MAX(min, MIN(vol_l, max));
vol_r = MAX(min, MIN(vol_r, max));
/* unmute, enable zero cross and set volume.*/
#if IMX233_SUBTARGET >= 3700
unsigned mstr_zcd = BM_AUDIOOUT_HPVOL_EN_MSTR_ZCD;
#else
unsigned mstr_zcd = 0;
#endif
HW_AUDIOOUT_HPVOL = mstr_zcd | BF_OR3(AUDIOOUT_HPVOL, SELECT(input_line1),
VOL_LEFT(max - vol_l), VOL_RIGHT(max - vol_r));
}
DSTATUS disk_initialize (void)
{
BYTE n, cmd, ty, ocr[4];
UINT tmr;
#if _USE_WRITE
if (CardType && MMC_SEL) disk_writep(0, 0); /* Finalize write process if it is in progress */
#endif
spi_card_init(); /* Initialize ports to control MMC */
DESELECT();
for (n = 10; n; n--) spi_card_rcv(); /* 80 dummy clocks with CS=H */
SELECT();
for (n = 2; n; n--) spi_card_rcv();
ty = 0;
if (send_cmd(CMD0, 0) == 0x01) { /* Enter Idle state */
if (send_cmd(CMD8, 0x1AA) == 1) { /* SDv2 */
for (n = 0; n < 4; n++) ocr[n] = spi_card_rcv(); /* Get trailing return value of R7 resp */
if (ocr[2] == 0x01 && ocr[3] == 0xAA) { /* The card can work at vdd range of 2.7-3.6V */
for (tmr = 10000; tmr && send_cmd(ACMD41, 1UL << 30); tmr--) _delay_us(100); /* Wait for leaving idle state (ACMD41 with HCS bit) */
if (tmr && send_cmd(CMD58, 0) == 0) { /* Check CCS bit in the OCR */
for (n = 0; n < 4; n++) ocr[n] = spi_card_rcv();
ty = (ocr[0] & 0x40) ? CT_SD2 | CT_BLOCK : CT_SD2; /* SDv2 (HC or SC) */
}
}
} else { /* SDv1 or MMCv3 */
for (tmr = 2000; tmr && (send_cmd(ACMD41, 0)>1); tmr--) _delay_us(100);
if (tmr) {
ty = CT_SD1; cmd = ACMD41; /* SDv1 */
} else {
ty = CT_MMC; cmd = CMD1; /* MMCv3 */
}
for (tmr = 1000; tmr && send_cmd(cmd, 0); tmr--) _delay_us(1000); /* Wait for leaving idle state */
if (!tmr || send_cmd(CMD16, 512) != 0) /* Set R/W block length to 512 */
ty = 0;
}
}
CardType = ty;
DESELECT();
spi_card_rcv();
spi_card_vollgas();
return ty ? 0 : STA_NOINIT;
}
int
heapsort(void *vbase, size_t nmemb, size_t size,
int (*compar)(const void *, const void *))
#endif
{
size_t cnt, i, j, l;
char tmp, *tmp1, *tmp2;
char *base, *k, *p, *t;
if (nmemb <= 1)
return (0);
if (!size) {
errno = EINVAL;
return (-1);
}
if ((k = malloc(size)) == NULL)
return (-1);
/*
* Items are numbered from 1 to nmemb, so offset from size bytes
* below the starting address.
*/
base = (char *)vbase - size;
for (l = nmemb / 2 + 1; --l;)
CREATE(l, nmemb, i, j, t, p, size, cnt, tmp);
/*
* For each element of the heap, save the largest element into its
* final slot, save the displaced element (k), then recreate the
* heap.
*/
while (nmemb > 1) {
COPY(k, base + nmemb * size, cnt, size, tmp1, tmp2);
COPY(base + nmemb * size, base + size, cnt, size, tmp1, tmp2);
--nmemb;
SELECT(i, j, nmemb, t, p, size, k, cnt, tmp1, tmp2);
}
free(k);
return (0);
}
TEST(select_outputs, order)
{
tools::wallet2 w;
// check that most unrelated heights are picked in order
tools::wallet2::transfer_container transfers = make_transfers_container(5);
transfers[0].m_block_height = 700;
transfers[1].m_block_height = 700;
transfers[2].m_block_height = 704;
transfers[3].m_block_height = 716;
transfers[4].m_block_height = 701;
std::vector<size_t> unused_indices({0, 1, 2, 3, 4});
std::vector<size_t> selected;
SELECT(0);
PICK(3); // first the one that's far away
PICK(2); // then the one that's close
PICK(4); // then the one that's adjacent
PICK(1); // then the one that's on the same height
}
//------------------------------------------------------------------------------------
// Записывает блок данных в SRAM-буффер dataflash
// Параметры: BufferNo -> Номер буффера (1 или 2)
// Addr -> Адрес в буффере с которого начинать чтение
// Count -> Количество байт, которое необходимо записать
// *BufferPtr -> Буффер, данные из которого нужно записать
//------------------------------------------------------------------------------------
void df_WriteStr( uint8 BufferNo, uint16 Addr, uint16 Count, uint8 *BufferPtr )
{
SELECT();
if ( BufferNo == 1 ) { DF_SPI_RW(Buf1Write); } // буффер 1
else if ( BufferNo == 2 ) { DF_SPI_RW(Buf2Write); } // буффер 2
else { DESELECT(); return; } // ошиблись с номером буффера
DF_SPI_RW(0x00);
DF_SPI_RW((unsigned char)(Addr>>8));
DF_SPI_RW((unsigned char)(Addr));
for( uint16 i=0; i<Count; i++)
{
DF_SPI_RW(*(BufferPtr));
BufferPtr++;
}
DESELECT();
}
//------------------------------------------------------------------------------------
// Читает один байт из SRAM-буффера dataflash
// Параметры: BufferNo -> Номер буффера (1 или 2)
// Addr -> Адрес в буффере
//------------------------------------------------------------------------------------
uint8 df_GetChar(uint8 BufferNo, uint16 Addr )
{
uint8 data;
SELECT();
if ( BufferNo == 1 ) { DF_SPI_RW(Buf1Read); } // буффер 1
else if ( BufferNo == 2 ) { DF_SPI_RW(Buf2Read); } // буффер 2
else { DESELECT(); return 0; } // ошиблись с номером буффера
DF_SPI_RW(0x00); // цикл чтения описан в даташите
DF_SPI_RW((uint8)(Addr>>8));
DF_SPI_RW((uint8)(Addr));
DF_SPI_RW(0x00);
data = DF_SPI_RW(0x00);
DESELECT();
return data;
}
//------------------------------------------------------------------------------------
// Прочитать блок данных непосредственно из Flash - памяти
// Параметры: PageAdr -> Номер страницы, с которой начинать чтение
// Addr -> Адрес в странице, с которого начинать чтение
// Count -> Количество байт, которое необходимо прочитать
// *BufferPtr -> Адрес буффера в который заносить данные
//------------------------------------------------------------------------------------
void df_FlashRead( uint16 PageAdr, uint16 Addr, uint16 Count, uint8 *BufferPtr )
{
SELECT();
DF_SPI_RW(ContArrayRead);
DF_SPI_RW((unsigned char)(PageAdr >> (16 - df_Info.page_bit)));
DF_SPI_RW((unsigned char)((PageAdr << (df_Info.page_bit - 8))+ (Addr>>8)));
DF_SPI_RW((unsigned char)(Addr));
DF_SPI_RW(0x00);
DF_SPI_RW(0x00);
DF_SPI_RW(0x00);
DF_SPI_RW(0x00);
for( uint16 i=0; i < Count; i++ )
{
*(BufferPtr) = DF_SPI_RW(0x00);
BufferPtr++;
}
DESELECT();
}
bool SimpleSocket::isReadyReceive(int timeout)
{
timeval time;
fd_set read, write, except;
int rc = this->SOCKET_FAIL;
bool rtn = false;
// The select function uses the timeval data structure
time.tv_sec = timeout/1000;
time.tv_usec = (timeout%1000)*1000;
FD_ZERO(&read);
FD_ZERO(&write);
FD_ZERO(&except);
FD_SET(this->getSockHandle(), &read);
rc = SELECT(this->getSockHandle() + 1, &read, &write, &except, &time);
if (this->SOCKET_FAIL != rc)
{
if (0==rc)
{
LOG_DEBUG("Socket select timed out");
rtn = false;
}
else
{
LOG_DEBUG("Data is ready for reading");
rtn = true;
}
}
else
{
this->logSocketError("Socket select function failed", rc);
rtn = false;
}
return rtn;
}
//-----------------------------------------------------------------------
// Send a command packet to MMC
//-----------------------------------------------------------------------
static
BYTE send_cmd (
BYTE cmd, // Command byte
DWORD arg // Argument
)
{
BYTE n, res;
if (cmd & 0x80) { // ACMD<n> is the command sequense of CMD55-CMD<n>
cmd &= 0x7F;
res = send_cmd(CMD55, 0);
if (res > 1) return res;
}
// Select the card
DESELECT();
rcv_spi();
SELECT();
rcv_spi();
// Send a command packet
xmit_spi(cmd); // Start + Command index
xmit_spi((BYTE)(arg >> 24)); // Argument[31..24]
xmit_spi((BYTE)(arg >> 16)); // Argument[23..16]
xmit_spi((BYTE)(arg >> 8)); // Argument[15..8]
xmit_spi((BYTE)arg); // Argument[7..0]
n = 0x01; // Dummy CRC + Stop
if (cmd == CMD0) n = 0x95; // Valid CRC for CMD0(0)
if (cmd == CMD8) n = 0x87; // Valid CRC for CMD8(0x1AA)
xmit_spi(n);
// Receive a command response
n = 10; // Wait for a valid response in timeout of 10 attempts
do {
res = rcv_spi();
} while ((res & 0x80) && --n);
return res; // Return with the response value
}
static
BYTE send_cmd (
BYTE cmd, /* 1st byte (Start + Index) */
DWORD arg /* Argument (32 bits) */
)
{
BYTE n, res;
if (cmd & 0x80) { /* ACMD<n> is the command sequense of CMD55-CMD<n> */
cmd &= 0x7F;
res = send_cmd(CMD55, 0);
if (res > 1) return res;
}
/* Select the card */
DESELECT();
SPI_RECEIVE();
SELECT();
SPI_RECEIVE();
/* Send a command packet */
SPI_SEND((BYTE)cmd); /* Start + Command index */
SPI_SEND((BYTE)(arg >> 24)); /* Argument[31..24] */
SPI_SEND((BYTE)(arg >> 16)); /* Argument[23..16] */
SPI_SEND((BYTE)(arg >> 8)); /* Argument[15..8] */
SPI_SEND((BYTE)arg); /* Argument[7..0] */
n = 0x01; /* Dummy CRC + Stop */
if (cmd == CMD0) n = 0x95; /* Valid CRC for CMD0(0) */
if (cmd == CMD8) n = 0x87; /* Valid CRC for CMD8(0x1AA) */
SPI_SEND(n);
/* Receive a command response */
n = 10; /* Wait for a valid response in timeout of 10 attempts */
do {
res = SPI_RECEIVE();
} while ((res & 0x80) && --n);
return res; /* Return with the response value */
}
int vfc_pcf8584_init(struct vfc_dev *dev)
{
/* This will also choose register S0_OWN so we can set it. */
WRITE_S1(RESET);
/* The pcf8584 shifts this value left one bit and uses
* it as its i2c bus address.
*/
WRITE_REG(0x55000000);
/* This will set the i2c bus at the same speed sun uses,
* and set another magic bit.
*/
WRITE_S1(SELECT(S2));
WRITE_REG(0x14000000);
/* Enable the serial port, idle the i2c bus and set
* the data reg to s0.
*/
WRITE_S1(CLEAR_I2C_BUS);
udelay(100);
return 0;
}
int main()
{
char cmd[CMDLEN]; //command string
printf("Welcome to pSQL by 20061201 Kim Dong-Gyu\n");
while(1){
__fpurge(stdin); //keep buffer out
printf("pSQL>>"); //prompt
scanf("%s", cmd); //take a command
if(strcmp(cmd, "CREATE") == 0){
CREATE();
}
else if(strcmp(cmd, "INFO") == 0){
INFO();
}
else if(strcmp(cmd, "DROP") == 0){
DROP();
}
else if(strcmp(cmd, "QUIT") == 0){
QUIT();
return 0;
}
else if(strcmp(cmd, "SELECT") == 0){
SELECT();
}
//when a command is fault
else{
printf("Please give me a correct command!!\n");
}
}
return 0;
}
QList<T *> DataMapper<Subclass, T, I>::find(const QString & whereClause)
{
return basicFind(SELECT("*").FROM(table()).WHERE(whereClause));
}
DSTATUS disk_initialize(void)
{
u8 n, cmd, ty, ocr[4], rep, timeout;
u16 tmr;
power_on(); /* Force socket power on */
for (n = 10; n; n--) xmit_spi(0xFF); /* Dummy clocks */
ty = 0;
timeout=100;
// Trying to enter Idle state
do {
DESELECT();
xmit_spi(0xFF);
SELECT();
rep = send_cmd(CMD0,0);
} while ((rep != 1) && (--timeout));
if(timeout == 0)
{
DESELECT();
xmit_spi(0xFF);
SELECT();
rep = send_cmd(CMD12,0);
rep = send_cmd(CMD0,0);
if (rep != 1)
{
return STA_NOINIT;
}
}
rep = send_cmd(CMD8, 0x1AA);
// SDHC
if ( rep == 1)
{
for (n = 0; n < 4; n++) ocr[n] = rcvr_spi(); /* Get trailing return value of R7 resp */
if (ocr[2] == 0x01 && ocr[3] == 0xAA) { /* The card can work at vdd range of 2.7-3.6V */
for (tmr = 25000; tmr && send_cmd(ACMD41, 1UL << 30); tmr--) ; /* Wait for leaving idle state (ACMD41 with HCS bit) */
if (tmr && send_cmd(CMD58, 0) == 0) { /* Check CCS bit in the OCR */
for (n = 0; n < 4; n++) ocr[n] = rcvr_spi();
ty = (ocr[0] & 0x40) ? CT_SD2 | CT_BLOCK : CT_SD2; /* SDv2 */
}
}
}
// SDSC or MMC
else
{
if (send_cmd(ACMD41, 0) <= 1) {
ty = CT_SD1; cmd = ACMD41; /* SDv1 */
} else {
ty = CT_MMC; cmd = CMD1; /* MMCv3 */
}
for (tmr = 25000; tmr && send_cmd(cmd, 0); tmr--) ; /* Wait for leaving idle state */
if (!tmr || send_cmd(CMD16, 512) != 0) /* Set R/W block length to 512 */
ty = 0;
}
CardType = ty;
release_spi();
// Initialization succeded
if (ty)
{
FCLK_FAST();
return RES_OK;
}
// Initialization failed
else
{
power_off();
return STA_NOINIT;
}
}
int testAMMI(int argc,char** argv ) {
int j,i=0;
unsigned char test1[] = { 1,25,50,75,100,125,128,150,175,200,225,250,254} ;
unsigned char test2[] = { 0x55,0x55,0xAA,0xAA,0x55,0x55,0xAA,0xAA} ;
unsigned char test3[] = { 0x00,0x00,0xFF,0xFF,0x00,0x00,0xFF,0xFF} ;
unsigned char atr[] = { 0x3b ,0x7e ,0x13 ,0x0 ,0x0 ,0x80 ,0x53 ,0xff ,0xff ,0xff ,0x62 ,0x0 ,0xff ,0x71 ,0xbf ,0x83 ,0x7 ,0x90 ,0x0 ,0x90,0};
int res;
data = alloca(300);
buffer = alloca(300);
//checkATR(atr);
/* Try to set T=0 protocol */
printit("Try to set protocol T1");
data[0]=0x00;
data[1]=0x07;
dwSendLength= 7;
SELECT(02,data,buffer,dwSendLength);
DO_TRANSMIT(SCARD_PCI_T1,1);
myprintf("Set protocol T0 \n");
myprintf("Test No. 1 \n");
/* Test1 */
data[0]=0x00;
data[1]=0x10;
dwSendLength= 7;
SELECT(02,data,buffer,dwSendLength);
printit("SELECT FILE EFptsDataCheck");
DO_TRANSMIT(SCARD_PCI_T0,0);
dwSendLength=5;
printit("READ BINARY 256 Byte(s)");
READBIN(0,0,0,data,buffer,dwSendLength);
DO_TRANSMIT(SCARD_PCI_T0,0);
myprintf("Test No. 2\n");
data[0]=0x00;
data[1]=0x10;
dwSendLength= 7;
SELECT(02,data,buffer,dwSendLength);
printit("SELECT FILE EFptsDataCheck");
DO_TRANSMIT(SCARD_PCI_T0,0);
for(j=0;j<255;j++)
data[j]=j;
printit("WRITE BINARY 255 Byte(s)");
dwSendLength=255+5;
UPDATEBIN(0,0,255,data,buffer,dwSendLength);
DO_TRANSMIT(SCARD_PCI_T0,0);
myprintf("Test No. 3 \n");
data[0]=0xA0;
data[1]=0x00;
dwSendLength= 7;
SELECT(02,data,buffer,dwSendLength);
printit("SELECT FILE EFresult");
DO_TRANSMIT(SCARD_PCI_T0,0);
printit("READ BINARY FILE EFResult");
dwSendLength=5;
READBIN(0,0,04,data,buffer,dwSendLength);
DO_TRANSMIT(SCARD_PCI_T0,0) ;
res=r[1];
dwSendLength=5;
printit("READ BINARY FILE EFresult");
READBIN(0,0x0A,0x0E,data,buffer,dwSendLength);
DO_TRANSMIT(SCARD_PCI_T0,0) ;
printit("\'PTS\'");
if( r[11] == res )
myprintf("Passed \n");
else {
myprintf("Failed \n");
fails++;
}
printit("\'PTS data check\'");
if( r[13] == res )
myprintf("Passed \n");
else {
myprintf("Failed \n");
fails++;
}
return fails;
}
int main(int argc,char *argv[])
{
struct timeval currTime;
int sockfd;
int port;
//check arguments here
if (argc != 3) {
printf("usage: %s <port#> <logFile>\n", argv[0]);
return 0;
}
// set port number var
port = atoi(argv[1]);
// copy log file name into log_filename
memcpy(log_filename,argv[2],strlen(argv[2]));
// log the start of the server
gettimeofday(&currTime,NULL);
_log(log_filename,"Server started");
/*
* Open a TCP socket (an Internet stream socket).
*/
sockfd = setup_socket(port);
/*
* here you should listen() on your TCP socket
*/
listen(sockfd,5);
SELECT_INIT();
for ( ; ; ) //endless loop
{
SELECT();
if(s == 0) {
// timeout, do nothing
}
if (s > 0) { // something ready for read, probably a client connection request
int n, r;
socklen_t clilen;
int newsockfd;
struct sockaddr_in cli_addr;
char buffer[100];
char welcome_msg[100];
pthread_t th;
clilen = sizeof(cli_addr);
// accept connection
newsockfd = accept(sockfd, (struct sockaddr *) &cli_addr, &clilen);
if (newsockfd < 0) error("ERROR on accept");
FD_SET(newsockfd, &rdset);
max_fd = newsockfd + 1;
// check select to see if client is sending their username
s = select(max_fd, &rdset, &wrset, NULL, &selectTimeout);
if (s == -1) { printf("ERROR: Socket error. Exiting.\n"); exit(1); }
if (s > 0) {
bzero(buffer,100);
n = recv(newsockfd,buffer,100,0);
if (n < 0) error("ERROR reading from socket");
// since a new user connected, let's review the current file list
char *filelist_buf = malloc(sizeof(struct UserFile)*FILELIST_LEN);
build_file_list(filelist_buf);
printf("%s just started connecting. This is the updated file list from all clients:\n%s\n",buffer,filelist_buf);
// add user to users hash
pthread_mutex_lock(&mutex);
struct User *user = malloc(sizeof(struct User));
strcpy(user->name,buffer);
memcpy(&(user->addr),&cli_addr,sizeof(struct sockaddr_in));
user->sockfd = newsockfd;
add_user(user);
pthread_mutex_unlock(&mutex);
// send welcome message
strcpy(welcome_msg,"Welcome, ");
strcat(welcome_msg, buffer);
strcat(welcome_msg,". You are now connected.");
n = send(newsockfd,welcome_msg,strlen(welcome_msg),0);
// notify other users that a new user has joined
/*
struct User *u;
char *new_user_msg = malloc(128);
strcpy(new_user_msg,"New user connected: ");
for(u = users; u != NULL; u = u->hh.next) {
if (strcmp(u->name,buffer) != 0) {
sprintf(new_user_msg,"A new user has joined: %s\n",buffer);
n = send(u->sockfd,new_user_msg,strlen(new_user_msg),0);
}
}
*/
r = pthread_create(&th, 0, connection, (void *)user);
if (r != 0) { fprintf(stderr, "thread create failed\n"); }
}
if (s == 0) {
printf("Client did not send username\n");
}
}
}
//if you've accepted the connection, you'll probably want to
//check "select()" to see if they're trying to send data,
//like their name, and if so
//recv() whatever they're trying to send
//since you're talking nicely now.. probably a good idea send them
//a message to welcome them to the new client.
//if there are others connected to the server, probably good to notify them
//that someone else has joined.
//pthread_mutex_lock(&mutex);
//now add your new user to your global list of users
//pthread_mutex_unlock(&mutex);
//now you need to start a thread to take care of the
//rest of the messages for that client
//r = pthread_create(&th, 0, connection, (void *)newsockfd);
//if (r != 0) { fprintf(stderr, "thread create failed\n"); }
//A requirement for 5273 students:
//at this point...
//whether or not someone connected, you should probably
//look for clients that should be timed out
//and kick them out
//oh, and notify everyone that they're gone.
}
void DAC7512_chip_select(uint16_t cs_arg) {
SELECT(BIT3);
}
int sdc_init(void) {
int i;
uint8 n, ty = 0, ocr[4];
if(initted)
return 0;
if(spi_init(0)) {
return -1;
}
timer_spin_sleep(20);
SELECT();
/* 80 dummy clocks */
for (n = 10; n; n--)
(void)spi_slow_sr_byte(0xff);
if (send_slow_cmd(CMD0, 0) == 1) { /* Enter Idle state */
#ifdef SD_DEBUG
dbglog(DBG_DEBUG, "%s: Enter Idle state\n", __func__);
#endif
timer_spin_sleep(20);
// thd_sleep(100);
i = 0;
if (send_slow_cmd(CMD8, 0x1AA) == 1) { /* SDC Ver2+ */
for (n = 0; n < 4; n++)
ocr[n] = spi_slow_sr_byte(0xff);
if (ocr[2] == 0x01 && ocr[3] == 0xAA) { /* The card can work at vdd range of 2.7-3.6V */
do {
/* ACMD41 with HCS bit */
if (send_slow_cmd(CMD55, 0) <= 1 && send_slow_cmd(CMD41, 1UL << 30) == 0)
break;
++i;
} while (i < 300000);
if (i < 300000 && send_slow_cmd(CMD58, 0) == 0) { /* Check CCS bit */
for (n = 0; n < 4; n++)
ocr[n] = spi_slow_sr_byte(0xff);
ty = (ocr[0] & 0x40) ? 6 : 2;
}
}
} else { /* SDC Ver1 or MMC */
ty = (send_slow_cmd(CMD55, 0) <= 1 && send_slow_cmd(CMD41, 0) <= 1) ? 2 : 1; /* SDC : MMC */
do {
if (ty == 2) {
if (send_slow_cmd(CMD55, 0) <= 1 && send_slow_cmd(CMD41, 0) == 0) /* ACMD41 */
break;
} else {
if (send_slow_cmd(CMD1, 0) == 0) { /* CMD1 */
is_mmc = 1;
break;
}
}
++i;
} while (i < 300000);
if (!(i < 300000) || send_slow_cmd(CMD16, 512) != 0) /* Select R/W block length */
ty = 0;
}
}
send_slow_cmd(CMD59, 1); // crc check
#ifdef SD_DEBUG
dbglog(DBG_DEBUG, "%s: card type = 0x%02x\n", __func__, ty & 0xff);
#endif
if(!(ty & 4)) {
byte_mode = 1;
}
DESELECT();
(void)spi_slow_sr_byte(0xff); /* Idle (Release DO) */
if (ty) { /* Initialization succeded */
// sdc_print_ident();
initted = 1;
return 0;
}
/* Initialization failed */
sdc_shutdown();
return -1;
}
void pci_init_board(void)
{
int mem_target, mem_attr, i;
int bus = 0;
u32 reg;
u32 soc_ctrl = readl(MVEBU_SYSTEM_REG_BASE + 0x4);
/* Check SoC Control Power State */
debug("%s: SoC Control %08x, 0en %01lx, 1en %01lx, 2en %01lx\n",
__func__, soc_ctrl, SELECT(soc_ctrl, 0), SELECT(soc_ctrl, 1),
SELECT(soc_ctrl, 2));
for (i = 0; i < MAX_PEX; i++) {
struct mvebu_pcie *pcie = &pcie_bus[i];
struct pci_controller *hose = &pcie->hose;
/* Get port number, lane number and memory target / attr */
mvebu_get_port_lane(pcie, i, &mem_target, &mem_attr);
/* Don't read at all from pci registers if port power is down */
if (pcie->lane == 0 && SELECT(soc_ctrl, pcie->port) == 0) {
i += 3;
debug("%s: skipping port %d\n", __func__, pcie->port);
continue;
}
pcie->base = (void __iomem *)PCIE_BASE(i);
/* Check link and skip ports that have no link */
if (!mvebu_pcie_link_up(pcie)) {
debug("%s: PCIe %d.%d - down\n", __func__,
pcie->port, pcie->lane);
continue;
}
debug("%s: PCIe %d.%d - up, base %08x\n", __func__,
pcie->port, pcie->lane, (u32)pcie->base);
/* Read Id info and local bus/dev */
debug("direct conf read %08x, local bus %d, local dev %d\n",
readl(pcie->base), mvebu_pcie_get_local_bus_nr(pcie),
mvebu_pcie_get_local_dev_nr(pcie));
mvebu_pcie_set_local_bus_nr(pcie, bus);
mvebu_pcie_set_local_dev_nr(pcie, 0);
pcie->dev = PCI_BDF(bus, 0, 0);
pcie->mem.start = (u32)mvebu_pcie_membase;
pcie->mem.end = pcie->mem.start + PCIE_MEM_SIZE - 1;
mvebu_pcie_membase += PCIE_MEM_SIZE;
if (mvebu_mbus_add_window_by_id(mem_target, mem_attr,
(phys_addr_t)pcie->mem.start,
PCIE_MEM_SIZE)) {
printf("PCIe unable to add mbus window for mem at %08x+%08x\n",
(u32)pcie->mem.start, PCIE_MEM_SIZE);
}
/* Setup windows and configure host bridge */
mvebu_pcie_setup_wins(pcie);
/* Master + slave enable. */
reg = readl(pcie->base + PCIE_CMD_OFF);
reg |= PCI_COMMAND_MEMORY;
reg |= PCI_COMMAND_MASTER;
reg |= BIT(10); /* disable interrupts */
writel(reg, pcie->base + PCIE_CMD_OFF);
/* Setup U-Boot PCI Controller */
hose->first_busno = 0;
hose->current_busno = bus;
/* PCI memory space */
pci_set_region(hose->regions + 0, pcie->mem.start,
pcie->mem.start, PCIE_MEM_SIZE, PCI_REGION_MEM);
pci_set_region(hose->regions + 1,
0, 0,
gd->ram_size,
PCI_REGION_MEM | PCI_REGION_SYS_MEMORY);
hose->region_count = 2;
pci_set_ops(hose,
pci_hose_read_config_byte_via_dword,
pci_hose_read_config_word_via_dword,
mvebu_pcie_read_config_dword,
pci_hose_write_config_byte_via_dword,
pci_hose_write_config_word_via_dword,
mvebu_pcie_write_config_dword);
pci_register_hose(hose);
hose->last_busno = pci_hose_scan(hose);
/* Set BAR0 to internal registers */
writel(SOC_REGS_PHY_BASE, pcie->base + PCIE_BAR_LO_OFF(0));
writel(0, pcie->base + PCIE_BAR_HI_OFF(0));
bus = hose->last_busno + 1;
}
}
/**
* Select chip.
*/
void AD5504_chip_select(uint16_t cs_arg) {
SELECT(PIN_CS1);
}
/* Subroutine */ int ztgevc_(char *side, char *howmny, logical *select,
integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer
*ldb, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *
ldvr, integer *mm, integer *m, doublecomplex *work, doublereal *rwork,
integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
ZTGEVC computes some or all of the right and/or left generalized
eigenvectors of a pair of complex upper triangular matrices (A,B).
The right generalized eigenvector x and the left generalized
eigenvector y of (A,B) corresponding to a generalized eigenvalue
w are defined by:
(A - wB) * x = 0 and y**H * (A - wB) = 0
where y**H denotes the conjugate tranpose of y.
If an eigenvalue w is determined by zero diagonal elements of both A
and B, a unit vector is returned as the corresponding eigenvector.
If all eigenvectors are requested, the routine may either return
the matrices X and/or Y of right or left eigenvectors of (A,B), or
the products Z*X and/or Q*Y, where Z and Q are input unitary
matrices. If (A,B) was obtained from the generalized Schur
factorization of an original pair of matrices
(A0,B0) = (Q*A*Z**H,Q*B*Z**H),
then Z*X and Q*Y are the matrices of right or left eigenvectors of
A.
Arguments
=========
SIDE (input) CHARACTER*1
= 'R': compute right eigenvectors only;
= 'L': compute left eigenvectors only;
= 'B': compute both right and left eigenvectors.
HOWMNY (input) CHARACTER*1
= 'A': compute all right and/or left eigenvectors;
= 'B': compute all right and/or left eigenvectors, and
backtransform them using the input matrices supplied
in VR and/or VL;
= 'S': compute selected right and/or left eigenvectors,
specified by the logical array SELECT.
SELECT (input) LOGICAL array, dimension (N)
If HOWMNY='S', SELECT specifies the eigenvectors to be
computed.
If HOWMNY='A' or 'B', SELECT is not referenced.
To select the eigenvector corresponding to the j-th
eigenvalue, SELECT(j) must be set to .TRUE..
N (input) INTEGER
The order of the matrices A and B. N >= 0.
A (input) COMPLEX*16 array, dimension (LDA,N)
The upper triangular matrix A.
LDA (input) INTEGER
The leading dimension of array A. LDA >= max(1,N).
B (input) COMPLEX*16 array, dimension (LDB,N)
The upper triangular matrix B. B must have real diagonal
elements.
LDB (input) INTEGER
The leading dimension of array B. LDB >= max(1,N).
VL (input/output) COMPLEX*16 array, dimension (LDVL,MM)
On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
contain an N-by-N matrix Q (usually the unitary matrix Q
of left Schur vectors returned by ZHGEQZ).
On exit, if SIDE = 'L' or 'B', VL contains:
if HOWMNY = 'A', the matrix Y of left eigenvectors of (A,B);
if HOWMNY = 'B', the matrix Q*Y;
if HOWMNY = 'S', the left eigenvectors of (A,B) specified by
SELECT, stored consecutively in the columns of
VL, in the same order as their eigenvalues.
If SIDE = 'R', VL is not referenced.
LDVL (input) INTEGER
The leading dimension of array VL.
LDVL >= max(1,N) if SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
contain an N-by-N matrix Q (usually the unitary matrix Z
of right Schur vectors returned by ZHGEQZ).
On exit, if SIDE = 'R' or 'B', VR contains:
if HOWMNY = 'A', the matrix X of right eigenvectors of (A,B);
if HOWMNY = 'B', the matrix Z*X;
if HOWMNY = 'S', the right eigenvectors of (A,B) specified by
SELECT, stored consecutively in the columns of
VR, in the same order as their eigenvalues.
If SIDE = 'L', VR is not referenced.
LDVR (input) INTEGER
The leading dimension of the array VR.
LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
MM (input) INTEGER
The leading dimension of the array VR.
LDVR >= max(1,N) if SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
MM (input) INTEGER
The number of columns in the arrays VL and/or VR. MM >= M.
M (output) INTEGER
The number of columns in the arrays VL and/or VR actually
used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
is set to N. Each selected eigenvector occupies one column.
WORK (workspace) COMPLEX*16 array, dimension (2*N)
RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
=====================================================================
Decode and Test the input parameters
Parameter adjustments
Function Body */
/* Table of constant values */
static doublecomplex c_b1 = {0.,0.};
static doublecomplex c_b2 = {1.,0.};
static integer c__1 = 1;
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1,
vr_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1, d__2, d__3, d__4, d__5, d__6;
doublecomplex z__1, z__2, z__3, z__4;
/* Builtin functions */
double d_imag(doublecomplex *);
void d_cnjg(doublecomplex *, doublecomplex *), z_div(doublecomplex *,
doublecomplex *, doublecomplex *);
/* Local variables */
static integer ibeg, ieig, iend;
static doublereal dmin__;
static integer isrc;
static doublereal temp;
static doublecomplex suma, sumb;
static doublereal xmax;
static doublecomplex d;
static integer i, j;
static doublereal scale;
static logical ilall;
static integer iside;
static doublereal sbeta;
extern logical lsame_(char *, char *);
static doublereal small;
static logical compl;
static doublereal anorm, bnorm;
static logical compr;
extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *);
static doublecomplex ca, cb;
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
static logical ilbbad;
static doublereal acoefa;
static integer je;
static doublereal bcoefa, acoeff;
static doublecomplex bcoeff;
static logical ilback;
static integer im;
static doublereal ascale, bscale;
extern doublereal dlamch_(char *);
static integer jr;
static doublecomplex salpha;
static doublereal safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
static doublereal bignum;
static logical ilcomp;
static integer ihwmny;
static doublereal big;
static logical lsa, lsb;
static doublereal ulp;
static doublecomplex sum;
#define SELECT(I) select[(I)-1]
#define WORK(I) work[(I)-1]
#define RWORK(I) rwork[(I)-1]
#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
#define B(I,J) b[(I)-1 + ((J)-1)* ( *ldb)]
#define VL(I,J) vl[(I)-1 + ((J)-1)* ( *ldvl)]
#define VR(I,J) vr[(I)-1 + ((J)-1)* ( *ldvr)]
if (lsame_(howmny, "A")) {
ihwmny = 1;
ilall = TRUE_;
ilback = FALSE_;
} else if (lsame_(howmny, "S")) {
ihwmny = 2;
ilall = FALSE_;
ilback = FALSE_;
} else if (lsame_(howmny, "B") || lsame_(howmny, "T")) {
ihwmny = 3;
ilall = TRUE_;
ilback = TRUE_;
} else {
ihwmny = -1;
}
if (lsame_(side, "R")) {
iside = 1;
compl = FALSE_;
compr = TRUE_;
} else if (lsame_(side, "L")) {
iside = 2;
compl = TRUE_;
compr = FALSE_;
} else if (lsame_(side, "B")) {
iside = 3;
compl = TRUE_;
compr = TRUE_;
} else {
iside = -1;
}
/* Count the number of eigenvectors */
if (! ilall) {
im = 0;
i__1 = *n;
for (j = 1; j <= *n; ++j) {
if (SELECT(j)) {
++im;
}
/* L10: */
}
} else {
im = *n;
}
/* Check diagonal of B */
ilbbad = FALSE_;
i__1 = *n;
for (j = 1; j <= *n; ++j) {
if (d_imag(&B(j,j)) != 0.) {
ilbbad = TRUE_;
}
/* L20: */
}
*info = 0;
if (iside < 0) {
*info = -1;
} else if (ihwmny < 0) {
*info = -2;
} else if (*n < 0) {
*info = -4;
} else if (*lda < max(1,*n)) {
*info = -6;
} else if (ilbbad) {
*info = -7;
} else if (*ldb < max(1,*n)) {
*info = -8;
} else if (compl && *ldvl < *n || *ldvl < 1) {
*info = -10;
} else if (compr && *ldvr < *n || *ldvr < 1) {
*info = -12;
} else if (*mm < im) {
*info = -13;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZTGEVC", &i__1);
return 0;
}
/* Quick return if possible */
*m = im;
if (*n == 0) {
return 0;
}
/* Machine Constants */
safmin = dlamch_("Safe minimum");
big = 1. / safmin;
dlabad_(&safmin, &big);
ulp = dlamch_("Epsilon") * dlamch_("Base");
small = safmin * *n / ulp;
big = 1. / small;
bignum = 1. / (safmin * *n);
/* Compute the 1-norm of each column of the strictly upper triangular
part of A and B to check for possible overflow in the triangular
solver. */
i__1 = a_dim1 + 1;
anorm = (d__1 = A(1,1).r, abs(d__1)) + (d__2 = d_imag(&A(1,1)),
abs(d__2));
i__1 = b_dim1 + 1;
bnorm = (d__1 = B(1,1).r, abs(d__1)) + (d__2 = d_imag(&B(1,1)),
abs(d__2));
RWORK(1) = 0.;
RWORK(*n + 1) = 0.;
i__1 = *n;
for (j = 2; j <= *n; ++j) {
RWORK(j) = 0.;
RWORK(*n + j) = 0.;
i__2 = j - 1;
for (i = 1; i <= j-1; ++i) {
i__3 = i + j * a_dim1;
RWORK(j) += (d__1 = A(i,j).r, abs(d__1)) + (d__2 = d_imag(&A(i,j)), abs(d__2));
i__3 = i + j * b_dim1;
RWORK(*n + j) += (d__1 = B(i,j).r, abs(d__1)) + (d__2 = d_imag(&
B(i,j)), abs(d__2));
/* L30: */
}
/* Computing MAX */
i__2 = j + j * a_dim1;
d__3 = anorm, d__4 = RWORK(j) + ((d__1 = A(j,j).r, abs(d__1)) + (
d__2 = d_imag(&A(j,j)), abs(d__2)));
anorm = max(d__3,d__4);
/* Computing MAX */
i__2 = j + j * b_dim1;
d__3 = bnorm, d__4 = RWORK(*n + j) + ((d__1 = B(j,j).r, abs(d__1)) +
(d__2 = d_imag(&B(j,j)), abs(d__2)));
bnorm = max(d__3,d__4);
/* L40: */
}
ascale = 1. / max(anorm,safmin);
bscale = 1. / max(bnorm,safmin);
/* Left eigenvectors */
if (compl) {
ieig = 0;
/* Main loop over eigenvalues */
i__1 = *n;
for (je = 1; je <= *n; ++je) {
if (ilall) {
ilcomp = TRUE_;
} else {
ilcomp = SELECT(je);
}
if (ilcomp) {
++ieig;
i__2 = je + je * a_dim1;
i__3 = je + je * b_dim1;
if ((d__1 = A(je,je).r, abs(d__1)) + (d__2 = d_imag(&A(je,je)), abs(d__2)) <= safmin && (d__3 = B(je,je).r,
abs(d__3)) <= safmin) {
/* Singular matrix pencil -- return unit e
igenvector */
i__2 = *n;
for (jr = 1; jr <= *n; ++jr) {
i__3 = jr + ieig * vl_dim1;
VL(jr,ieig).r = 0., VL(jr,ieig).i = 0.;
/* L50: */
}
i__2 = ieig + ieig * vl_dim1;
VL(ieig,ieig).r = 1., VL(ieig,ieig).i = 0.;
goto L140;
}
/* Non-singular eigenvalue:
Compute coefficients a and b in
H
y ( a A - b B ) = 0
Computing MAX */
i__2 = je + je * a_dim1;
i__3 = je + je * b_dim1;
d__4 = ((d__1 = A(je,je).r, abs(d__1)) + (d__2 = d_imag(&A(je,je)), abs(d__2))) * ascale, d__5 = (d__3 =
B(je,je).r, abs(d__3)) * bscale, d__4 = max(d__4,d__5);
temp = 1. / max(d__4,safmin);
i__2 = je + je * a_dim1;
z__2.r = temp * A(je,je).r, z__2.i = temp * A(je,je).i;
z__1.r = ascale * z__2.r, z__1.i = ascale * z__2.i;
salpha.r = z__1.r, salpha.i = z__1.i;
i__2 = je + je * b_dim1;
sbeta = temp * B(je,je).r * bscale;
acoeff = sbeta * ascale;
z__1.r = bscale * salpha.r, z__1.i = bscale * salpha.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
/* Scale to avoid underflow */
lsa = abs(sbeta) >= safmin && abs(acoeff) < small;
lsb = (d__1 = salpha.r, abs(d__1)) + (d__2 = d_imag(&salpha),
abs(d__2)) >= safmin && (d__3 = bcoeff.r, abs(d__3))
+ (d__4 = d_imag(&bcoeff), abs(d__4)) < small;
scale = 1.;
if (lsa) {
scale = small / abs(sbeta) * min(anorm,big);
}
if (lsb) {
/* Computing MAX */
d__3 = scale, d__4 = small / ((d__1 = salpha.r, abs(d__1))
+ (d__2 = d_imag(&salpha), abs(d__2))) * min(
bnorm,big);
scale = max(d__3,d__4);
}
if (lsa || lsb) {
/* Computing MIN
Computing MAX */
d__5 = 1., d__6 = abs(acoeff), d__5 = max(d__5,d__6),
d__6 = (d__1 = bcoeff.r, abs(d__1)) + (d__2 =
d_imag(&bcoeff), abs(d__2));
d__3 = scale, d__4 = 1. / (safmin * max(d__5,d__6));
scale = min(d__3,d__4);
if (lsa) {
acoeff = ascale * (scale * sbeta);
} else {
acoeff = scale * acoeff;
}
if (lsb) {
z__2.r = scale * salpha.r, z__2.i = scale * salpha.i;
z__1.r = bscale * z__2.r, z__1.i = bscale * z__2.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
} else {
z__1.r = scale * bcoeff.r, z__1.i = scale * bcoeff.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
}
}
acoefa = abs(acoeff);
bcoefa = (d__1 = bcoeff.r, abs(d__1)) + (d__2 = d_imag(&
bcoeff), abs(d__2));
xmax = 1.;
i__2 = *n;
for (jr = 1; jr <= *n; ++jr) {
i__3 = jr;
WORK(jr).r = 0., WORK(jr).i = 0.;
/* L60: */
}
i__2 = je;
WORK(je).r = 1., WORK(je).i = 0.;
/* Computing MAX */
d__1 = ulp * acoefa * anorm, d__2 = ulp * bcoefa * bnorm,
d__1 = max(d__1,d__2);
dmin__ = max(d__1,safmin);
/* H
Triangular solve of (a A - b B) y = 0
H
(rowwise in (a A - b B) , or columnwise in a
A - b B) */
i__2 = *n;
for (j = je + 1; j <= *n; ++j) {
/* Compute
j-1
SUM = sum conjg( a*A(k,j) - b*B(k,j) )
*x(k)
k=je
(Scale if necessary) */
temp = 1. / xmax;
if (acoefa * RWORK(j) + bcoefa * RWORK(*n + j) > bignum *
temp) {
i__3 = j - 1;
for (jr = je; jr <= j-1; ++jr) {
i__4 = jr;
i__5 = jr;
z__1.r = temp * WORK(jr).r, z__1.i = temp *
WORK(jr).i;
WORK(jr).r = z__1.r, WORK(jr).i = z__1.i;
/* L70: */
}
xmax = 1.;
}
suma.r = 0., suma.i = 0.;
sumb.r = 0., sumb.i = 0.;
i__3 = j - 1;
for (jr = je; jr <= j-1; ++jr) {
d_cnjg(&z__3, &A(jr,j));
i__4 = jr;
z__2.r = z__3.r * WORK(jr).r - z__3.i * WORK(jr)
.i, z__2.i = z__3.r * WORK(jr).i + z__3.i *
WORK(jr).r;
z__1.r = suma.r + z__2.r, z__1.i = suma.i + z__2.i;
suma.r = z__1.r, suma.i = z__1.i;
d_cnjg(&z__3, &B(jr,j));
i__4 = jr;
z__2.r = z__3.r * WORK(jr).r - z__3.i * WORK(jr)
.i, z__2.i = z__3.r * WORK(jr).i + z__3.i *
WORK(jr).r;
z__1.r = sumb.r + z__2.r, z__1.i = sumb.i + z__2.i;
sumb.r = z__1.r, sumb.i = z__1.i;
/* L80: */
}
z__2.r = acoeff * suma.r, z__2.i = acoeff * suma.i;
d_cnjg(&z__4, &bcoeff);
z__3.r = z__4.r * sumb.r - z__4.i * sumb.i, z__3.i =
z__4.r * sumb.i + z__4.i * sumb.r;
z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
sum.r = z__1.r, sum.i = z__1.i;
/* Form x(j) = - SUM / conjg( a*A(j,j) - b
*B(j,j) )
with scaling and perturbation of the de
nominator */
i__3 = j + j * a_dim1;
z__3.r = acoeff * A(j,j).r, z__3.i = acoeff * A(j,j).i;
i__4 = j + j * b_dim1;
z__4.r = bcoeff.r * B(j,j).r - bcoeff.i * B(j,j).i,
z__4.i = bcoeff.r * B(j,j).i + bcoeff.i * B(j,j)
.r;
z__2.r = z__3.r - z__4.r, z__2.i = z__3.i - z__4.i;
d_cnjg(&z__1, &z__2);
d.r = z__1.r, d.i = z__1.i;
if ((d__1 = d.r, abs(d__1)) + (d__2 = d_imag(&d), abs(
d__2)) <= dmin__) {
z__1.r = dmin__, z__1.i = 0.;
d.r = z__1.r, d.i = z__1.i;
}
if ((d__1 = d.r, abs(d__1)) + (d__2 = d_imag(&d), abs(
d__2)) < 1.) {
if ((d__1 = sum.r, abs(d__1)) + (d__2 = d_imag(&sum),
abs(d__2)) >= bignum * ((d__3 = d.r, abs(d__3)
) + (d__4 = d_imag(&d), abs(d__4)))) {
temp = 1. / ((d__1 = sum.r, abs(d__1)) + (d__2 =
d_imag(&sum), abs(d__2)));
i__3 = j - 1;
for (jr = je; jr <= j-1; ++jr) {
i__4 = jr;
i__5 = jr;
z__1.r = temp * WORK(jr).r, z__1.i = temp *
WORK(jr).i;
WORK(jr).r = z__1.r, WORK(jr).i = z__1.i;
/* L90: */
}
xmax = temp * xmax;
z__1.r = temp * sum.r, z__1.i = temp * sum.i;
sum.r = z__1.r, sum.i = z__1.i;
}
}
i__3 = j;
z__2.r = -sum.r, z__2.i = -sum.i;
z_div(&z__1, &z__2, &d);
WORK(j).r = z__1.r, WORK(j).i = z__1.i;
/* Computing MAX */
i__3 = j;
d__3 = xmax, d__4 = (d__1 = WORK(j).r, abs(d__1)) + (
d__2 = d_imag(&WORK(j)), abs(d__2));
xmax = max(d__3,d__4);
/* L100: */
}
/* Back transform eigenvector if HOWMNY='B'. */
if (ilback) {
i__2 = *n + 1 - je;
zgemv_("N", n, &i__2, &c_b2, &VL(1,je), ldvl,
&WORK(je), &c__1, &c_b1, &WORK(*n + 1), &c__1)
;
isrc = 2;
ibeg = 1;
} else {
isrc = 1;
ibeg = je;
}
/* Copy and scale eigenvector into column of VL
*/
xmax = 0.;
i__2 = *n;
for (jr = ibeg; jr <= *n; ++jr) {
/* Computing MAX */
i__3 = (isrc - 1) * *n + jr;
d__3 = xmax, d__4 = (d__1 = WORK((isrc-1)**n+jr).r, abs(d__1)) + (
d__2 = d_imag(&WORK((isrc - 1) * *n + jr)), abs(
d__2));
xmax = max(d__3,d__4);
/* L110: */
}
if (xmax > safmin) {
temp = 1. / xmax;
i__2 = *n;
for (jr = ibeg; jr <= *n; ++jr) {
i__3 = jr + ieig * vl_dim1;
i__4 = (isrc - 1) * *n + jr;
z__1.r = temp * WORK((isrc-1)**n+jr).r, z__1.i = temp * WORK(
(isrc-1)**n+jr).i;
VL(jr,ieig).r = z__1.r, VL(jr,ieig).i = z__1.i;
/* L120: */
}
} else {
ibeg = *n + 1;
}
i__2 = ibeg - 1;
for (jr = 1; jr <= ibeg-1; ++jr) {
i__3 = jr + ieig * vl_dim1;
VL(jr,ieig).r = 0., VL(jr,ieig).i = 0.;
/* L130: */
}
}
L140:
;
}
}
/* Right eigenvectors */
if (compr) {
ieig = im + 1;
/* Main loop over eigenvalues */
for (je = *n; je >= 1; --je) {
if (ilall) {
ilcomp = TRUE_;
} else {
ilcomp = SELECT(je);
}
if (ilcomp) {
--ieig;
i__1 = je + je * a_dim1;
i__2 = je + je * b_dim1;
if ((d__1 = A(je,je).r, abs(d__1)) + (d__2 = d_imag(&A(je,je)), abs(d__2)) <= safmin && (d__3 = B(je,je).r,
abs(d__3)) <= safmin) {
/* Singular matrix pencil -- return unit e
igenvector */
i__1 = *n;
for (jr = 1; jr <= *n; ++jr) {
i__2 = jr + ieig * vr_dim1;
VR(jr,ieig).r = 0., VR(jr,ieig).i = 0.;
/* L150: */
}
i__1 = ieig + ieig * vr_dim1;
VR(ieig,ieig).r = 1., VR(ieig,ieig).i = 0.;
goto L250;
}
/* Non-singular eigenvalue:
Compute coefficients a and b in
( a A - b B ) x = 0
Computing MAX */
i__1 = je + je * a_dim1;
i__2 = je + je * b_dim1;
d__4 = ((d__1 = A(je,je).r, abs(d__1)) + (d__2 = d_imag(&A(je,je)), abs(d__2))) * ascale, d__5 = (d__3 =
B(je,je).r, abs(d__3)) * bscale, d__4 = max(d__4,d__5);
temp = 1. / max(d__4,safmin);
i__1 = je + je * a_dim1;
z__2.r = temp * A(je,je).r, z__2.i = temp * A(je,je).i;
z__1.r = ascale * z__2.r, z__1.i = ascale * z__2.i;
salpha.r = z__1.r, salpha.i = z__1.i;
i__1 = je + je * b_dim1;
sbeta = temp * B(je,je).r * bscale;
acoeff = sbeta * ascale;
z__1.r = bscale * salpha.r, z__1.i = bscale * salpha.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
/* Scale to avoid underflow */
lsa = abs(sbeta) >= safmin && abs(acoeff) < small;
lsb = (d__1 = salpha.r, abs(d__1)) + (d__2 = d_imag(&salpha),
abs(d__2)) >= safmin && (d__3 = bcoeff.r, abs(d__3))
+ (d__4 = d_imag(&bcoeff), abs(d__4)) < small;
scale = 1.;
if (lsa) {
scale = small / abs(sbeta) * min(anorm,big);
}
if (lsb) {
/* Computing MAX */
d__3 = scale, d__4 = small / ((d__1 = salpha.r, abs(d__1))
+ (d__2 = d_imag(&salpha), abs(d__2))) * min(
bnorm,big);
scale = max(d__3,d__4);
}
if (lsa || lsb) {
/* Computing MIN
Computing MAX */
d__5 = 1., d__6 = abs(acoeff), d__5 = max(d__5,d__6),
d__6 = (d__1 = bcoeff.r, abs(d__1)) + (d__2 =
d_imag(&bcoeff), abs(d__2));
d__3 = scale, d__4 = 1. / (safmin * max(d__5,d__6));
scale = min(d__3,d__4);
if (lsa) {
acoeff = ascale * (scale * sbeta);
} else {
acoeff = scale * acoeff;
}
if (lsb) {
z__2.r = scale * salpha.r, z__2.i = scale * salpha.i;
z__1.r = bscale * z__2.r, z__1.i = bscale * z__2.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
} else {
z__1.r = scale * bcoeff.r, z__1.i = scale * bcoeff.i;
bcoeff.r = z__1.r, bcoeff.i = z__1.i;
}
}
acoefa = abs(acoeff);
bcoefa = (d__1 = bcoeff.r, abs(d__1)) + (d__2 = d_imag(&
bcoeff), abs(d__2));
xmax = 1.;
i__1 = *n;
for (jr = 1; jr <= *n; ++jr) {
i__2 = jr;
WORK(jr).r = 0., WORK(jr).i = 0.;
/* L160: */
}
i__1 = je;
WORK(je).r = 1., WORK(je).i = 0.;
/* Computing MAX */
d__1 = ulp * acoefa * anorm, d__2 = ulp * bcoefa * bnorm,
d__1 = max(d__1,d__2);
dmin__ = max(d__1,safmin);
/* Triangular solve of (a A - b B) x = 0 (colum
nwise)
WORK(1:j-1) contains sums w,
WORK(j+1:JE) contains x */
i__1 = je - 1;
for (jr = 1; jr <= je-1; ++jr) {
i__2 = jr;
i__3 = jr + je * a_dim1;
z__2.r = acoeff * A(jr,je).r, z__2.i = acoeff * A(jr,je).i;
i__4 = jr + je * b_dim1;
z__3.r = bcoeff.r * B(jr,je).r - bcoeff.i * B(jr,je).i,
z__3.i = bcoeff.r * B(jr,je).i + bcoeff.i * B(jr,je)
.r;
z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
WORK(jr).r = z__1.r, WORK(jr).i = z__1.i;
/* L170: */
}
i__1 = je;
WORK(je).r = 1., WORK(je).i = 0.;
for (j = je - 1; j >= 1; --j) {
/* Form x(j) := - w(j) / d
with scaling and perturbation of the de
nominator */
i__1 = j + j * a_dim1;
z__2.r = acoeff * A(j,j).r, z__2.i = acoeff * A(j,j).i;
i__2 = j + j * b_dim1;
z__3.r = bcoeff.r * B(j,j).r - bcoeff.i * B(j,j).i,
z__3.i = bcoeff.r * B(j,j).i + bcoeff.i * B(j,j)
.r;
z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
d.r = z__1.r, d.i = z__1.i;
if ((d__1 = d.r, abs(d__1)) + (d__2 = d_imag(&d), abs(
d__2)) <= dmin__) {
z__1.r = dmin__, z__1.i = 0.;
d.r = z__1.r, d.i = z__1.i;
}
if ((d__1 = d.r, abs(d__1)) + (d__2 = d_imag(&d), abs(
d__2)) < 1.) {
i__1 = j;
if ((d__1 = WORK(j).r, abs(d__1)) + (d__2 = d_imag(
&WORK(j)), abs(d__2)) >= bignum * ((d__3 =
d.r, abs(d__3)) + (d__4 = d_imag(&d), abs(
d__4)))) {
i__1 = j;
temp = 1. / ((d__1 = WORK(j).r, abs(d__1)) + (
d__2 = d_imag(&WORK(j)), abs(d__2)));
i__1 = je;
for (jr = 1; jr <= je; ++jr) {
i__2 = jr;
i__3 = jr;
z__1.r = temp * WORK(jr).r, z__1.i = temp *
WORK(jr).i;
WORK(jr).r = z__1.r, WORK(jr).i = z__1.i;
/* L180: */
}
}
}
i__1 = j;
i__2 = j;
z__2.r = -WORK(j).r, z__2.i = -WORK(j).i;
z_div(&z__1, &z__2, &d);
WORK(j).r = z__1.r, WORK(j).i = z__1.i;
if (j > 1) {
/* w = w + x(j)*(a A(*,j) - b B(*,j
) ) with scaling */
i__1 = j;
if ((d__1 = WORK(j).r, abs(d__1)) + (d__2 = d_imag(
&WORK(j)), abs(d__2)) > 1.) {
i__1 = j;
temp = 1. / ((d__1 = WORK(j).r, abs(d__1)) + (
d__2 = d_imag(&WORK(j)), abs(d__2)));
if (acoefa * RWORK(j) + bcoefa * RWORK(*n + j) >=
bignum * temp) {
i__1 = je;
for (jr = 1; jr <= je; ++jr) {
i__2 = jr;
i__3 = jr;
z__1.r = temp * WORK(jr).r, z__1.i =
temp * WORK(jr).i;
WORK(jr).r = z__1.r, WORK(jr).i =
z__1.i;
/* L190: */
}
}
}
i__1 = j;
z__1.r = acoeff * WORK(j).r, z__1.i = acoeff *
WORK(j).i;
ca.r = z__1.r, ca.i = z__1.i;
i__1 = j;
z__1.r = bcoeff.r * WORK(j).r - bcoeff.i * WORK(
j).i, z__1.i = bcoeff.r * WORK(j).i +
bcoeff.i * WORK(j).r;
cb.r = z__1.r, cb.i = z__1.i;
i__1 = j - 1;
for (jr = 1; jr <= j-1; ++jr) {
i__2 = jr;
i__3 = jr;
i__4 = jr + j * a_dim1;
z__3.r = ca.r * A(jr,j).r - ca.i * A(jr,j).i,
z__3.i = ca.r * A(jr,j).i + ca.i * A(jr,j)
.r;
z__2.r = WORK(jr).r + z__3.r, z__2.i = WORK(
jr).i + z__3.i;
i__5 = jr + j * b_dim1;
z__4.r = cb.r * B(jr,j).r - cb.i * B(jr,j).i,
z__4.i = cb.r * B(jr,j).i + cb.i * B(jr,j)
.r;
z__1.r = z__2.r - z__4.r, z__1.i = z__2.i -
z__4.i;
WORK(jr).r = z__1.r, WORK(jr).i = z__1.i;
/* L200: */
}
}
/* L210: */
}
/* Back transform eigenvector if HOWMNY='B'. */
if (ilback) {
zgemv_("N", n, &je, &c_b2, &VR(1,1), ldvr, &WORK(1),
&c__1, &c_b1, &WORK(*n + 1), &c__1);
isrc = 2;
iend = *n;
} else {
isrc = 1;
iend = je;
}
/* Copy and scale eigenvector into column of VR
*/
xmax = 0.;
i__1 = iend;
for (jr = 1; jr <= iend; ++jr) {
/* Computing MAX */
i__2 = (isrc - 1) * *n + jr;
d__3 = xmax, d__4 = (d__1 = WORK((isrc-1)**n+jr).r, abs(d__1)) + (
d__2 = d_imag(&WORK((isrc - 1) * *n + jr)), abs(
d__2));
xmax = max(d__3,d__4);
/* L220: */
}
if (xmax > safmin) {
temp = 1. / xmax;
i__1 = iend;
for (jr = 1; jr <= iend; ++jr) {
i__2 = jr + ieig * vr_dim1;
i__3 = (isrc - 1) * *n + jr;
z__1.r = temp * WORK((isrc-1)**n+jr).r, z__1.i = temp * WORK(
(isrc-1)**n+jr).i;
VR(jr,ieig).r = z__1.r, VR(jr,ieig).i = z__1.i;
/* L230: */
}
} else {
iend = 0;
}
i__1 = *n;
for (jr = iend + 1; jr <= *n; ++jr) {
i__2 = jr + ieig * vr_dim1;
VR(jr,ieig).r = 0., VR(jr,ieig).i = 0.;
/* L240: */
}
}
L250:
;
}
}
return 0;
/* End of ZTGEVC */
} /* ztgevc_ */
/* Subroutine */ int ztrsna_(char *job, char *howmny, logical *select,
integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
integer *ldvl, doublecomplex *vr, integer *ldvr, doublereal *s,
doublereal *sep, integer *mm, integer *m, doublecomplex *work,
integer *ldwork, doublereal *rwork, integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
ZTRSNA estimates reciprocal condition numbers for specified
eigenvalues and/or right eigenvectors of a complex upper triangular
matrix T (or of any matrix Q*T*Q**H with Q unitary).
Arguments
=========
JOB (input) CHARACTER*1
Specifies whether condition numbers are required for
eigenvalues (S) or eigenvectors (SEP):
= 'E': for eigenvalues only (S);
= 'V': for eigenvectors only (SEP);
= 'B': for both eigenvalues and eigenvectors (S and SEP).
HOWMNY (input) CHARACTER*1
= 'A': compute condition numbers for all eigenpairs;
= 'S': compute condition numbers for selected eigenpairs
specified by the array SELECT.
SELECT (input) LOGICAL array, dimension (N)
If HOWMNY = 'S', SELECT specifies the eigenpairs for which
condition numbers are required. To select condition numbers
for the j-th eigenpair, SELECT(j) must be set to .TRUE..
If HOWMNY = 'A', SELECT is not referenced.
N (input) INTEGER
The order of the matrix T. N >= 0.
T (input) COMPLEX*16 array, dimension (LDT,N)
The upper triangular matrix T.
LDT (input) INTEGER
The leading dimension of the array T. LDT >= max(1,N).
VL (input) COMPLEX*16 array, dimension (LDVL,M)
If JOB = 'E' or 'B', VL must contain left eigenvectors of T
(or of any Q*T*Q**H with Q unitary), corresponding to the
eigenpairs specified by HOWMNY and SELECT. The eigenvectors
must be stored in consecutive columns of VL, as returned by
ZHSEIN or ZTREVC.
If JOB = 'V', VL is not referenced.
LDVL (input) INTEGER
The leading dimension of the array VL.
LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
VR (input) COMPLEX*16 array, dimension (LDVR,M)
If JOB = 'E' or 'B', VR must contain right eigenvectors of T
(or of any Q*T*Q**H with Q unitary), corresponding to the
eigenpairs specified by HOWMNY and SELECT. The eigenvectors
must be stored in consecutive columns of VR, as returned by
ZHSEIN or ZTREVC.
If JOB = 'V', VR is not referenced.
LDVR (input) INTEGER
The leading dimension of the array VR.
LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
S (output) DOUBLE PRECISION array, dimension (MM)
If JOB = 'E' or 'B', the reciprocal condition numbers of the
selected eigenvalues, stored in consecutive elements of the
array. Thus S(j), SEP(j), and the j-th columns of VL and VR
all correspond to the same eigenpair (but not in general the
j-th eigenpair, unless all eigenpairs are selected).
If JOB = 'V', S is not referenced.
SEP (output) DOUBLE PRECISION array, dimension (MM)
If JOB = 'V' or 'B', the estimated reciprocal condition
numbers of the selected eigenvectors, stored in consecutive
elements of the array.
If JOB = 'E', SEP is not referenced.
MM (input) INTEGER
The number of elements in the arrays S (if JOB = 'E' or 'B')
and/or SEP (if JOB = 'V' or 'B'). MM >= M.
M (output) INTEGER
The number of elements of the arrays S and/or SEP actually
used to store the estimated condition numbers.
If HOWMNY = 'A', M is set to N.
WORK (workspace) COMPLEX*16 array, dimension (LDWORK,N+1)
If JOB = 'E', WORK is not referenced.
LDWORK (input) INTEGER
The leading dimension of the array WORK.
LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
RWORK (workspace) DOUBLE PRECISION array, dimension (N)
If JOB = 'E', RWORK is not referenced.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
Further Details
===============
The reciprocal of the condition number of an eigenvalue lambda is
defined as
S(lambda) = |v'*u| / (norm(u)*norm(v))
where u and v are the right and left eigenvectors of T corresponding
to lambda; v' denotes the conjugate transpose of v, and norm(u)
denotes the Euclidean norm. These reciprocal condition numbers always
lie between zero (very badly conditioned) and one (very well
conditioned). If n = 1, S(lambda) is defined to be 1.
An approximate error bound for a computed eigenvalue W(i) is given by
EPS * norm(T) / S(i)
where EPS is the machine precision.
The reciprocal of the condition number of the right eigenvector u
corresponding to lambda is defined as follows. Suppose
T = ( lambda c )
( 0 T22 )
Then the reciprocal condition number is
SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
where sigma-min denotes the smallest singular value. We approximate
the smallest singular value by the reciprocal of an estimate of the
one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
defined to be abs(T(1,1)).
An approximate error bound for a computed right eigenvector VR(i)
is given by
EPS * norm(T) / SEP(i)
=====================================================================
Decode and test the input parameters
Parameter adjustments
Function Body */
/* Table of constant values */
static integer c__1 = 1;
/* System generated locals */
integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset,
work_dim1, work_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1, d__2;
doublecomplex z__1;
/* Builtin functions */
double z_abs(doublecomplex *), d_imag(doublecomplex *);
/* Local variables */
static integer kase, ierr;
static doublecomplex prod;
static doublereal lnrm, rnrm;
static integer i, j, k;
static doublereal scale;
extern logical lsame_(char *, char *);
extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
static doublecomplex dummy[1];
static logical wants;
static doublereal xnorm;
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
extern doublereal dznrm2_(integer *, doublecomplex *, integer *), dlamch_(
char *);
static integer ks, ix;
extern /* Subroutine */ int xerbla_(char *, integer *);
static doublereal bignum;
static logical wantbh;
extern /* Subroutine */ int zlacon_(integer *, doublecomplex *,
doublecomplex *, doublereal *, integer *);
extern integer izamax_(integer *, doublecomplex *, integer *);
static logical somcon;
extern /* Subroutine */ int zdrscl_(integer *, doublereal *,
doublecomplex *, integer *);
static char normin[1];
extern /* Subroutine */ int zlacpy_(char *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
static doublereal smlnum;
static logical wantsp;
extern /* Subroutine */ int zlatrs_(char *, char *, char *, char *,
integer *, doublecomplex *, integer *, doublecomplex *,
doublereal *, doublereal *, integer *), ztrexc_(char *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, integer *, integer *, integer *);
static doublereal eps, est;
#define DUMMY(I) dummy[(I)]
#define SELECT(I) select[(I)-1]
#define S(I) s[(I)-1]
#define SEP(I) sep[(I)-1]
#define RWORK(I) rwork[(I)-1]
#define T(I,J) t[(I)-1 + ((J)-1)* ( *ldt)]
#define VL(I,J) vl[(I)-1 + ((J)-1)* ( *ldvl)]
#define VR(I,J) vr[(I)-1 + ((J)-1)* ( *ldvr)]
#define WORK(I,J) work[(I)-1 + ((J)-1)* ( *ldwork)]
wantbh = lsame_(job, "B");
wants = lsame_(job, "E") || wantbh;
wantsp = lsame_(job, "V") || wantbh;
somcon = lsame_(howmny, "S");
/* Set M to the number of eigenpairs for which condition numbers are
to be computed. */
if (somcon) {
*m = 0;
i__1 = *n;
for (j = 1; j <= *n; ++j) {
if (SELECT(j)) {
++(*m);
}
/* L10: */
}
} else {
*m = *n;
}
*info = 0;
if (! wants && ! wantsp) {
*info = -1;
} else if (! lsame_(howmny, "A") && ! somcon) {
*info = -2;
} else if (*n < 0) {
*info = -4;
} else if (*ldt < max(1,*n)) {
*info = -6;
} else if (*ldvl < 1 || wants && *ldvl < *n) {
*info = -8;
} else if (*ldvr < 1 || wants && *ldvr < *n) {
*info = -10;
} else if (*mm < *m) {
*info = -13;
} else if (*ldwork < 1 || wantsp && *ldwork < *n) {
*info = -16;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("ZTRSNA", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
if (*n == 1) {
if (somcon) {
if (! SELECT(1)) {
return 0;
}
}
if (wants) {
S(1) = 1.;
}
if (wantsp) {
SEP(1) = z_abs(&T(1,1));
}
return 0;
}
/* Get machine constants */
eps = dlamch_("P");
smlnum = dlamch_("S") / eps;
bignum = 1. / smlnum;
dlabad_(&smlnum, &bignum);
ks = 1;
i__1 = *n;
for (k = 1; k <= *n; ++k) {
if (somcon) {
if (! SELECT(k)) {
goto L50;
}
}
if (wants) {
/* Compute the reciprocal condition number of the k-th
eigenvalue. */
zdotc_(&z__1, n, &VR(1,ks), &c__1, &VL(1,ks), &c__1);
prod.r = z__1.r, prod.i = z__1.i;
rnrm = dznrm2_(n, &VR(1,ks), &c__1);
lnrm = dznrm2_(n, &VL(1,ks), &c__1);
S(ks) = z_abs(&prod) / (rnrm * lnrm);
}
if (wantsp) {
/* Estimate the reciprocal condition number of the k-th
eigenvector.
Copy the matrix T to the array WORK and swap the k-th
diagonal element to the (1,1) position. */
zlacpy_("Full", n, n, &T(1,1), ldt, &WORK(1,1),
ldwork);
ztrexc_("No Q", n, &WORK(1,1), ldwork, dummy, &c__1, &k, &
c__1, &ierr);
/* Form C = T22 - lambda*I in WORK(2:N,2:N). */
i__2 = *n;
for (i = 2; i <= *n; ++i) {
i__3 = i + i * work_dim1;
i__4 = i + i * work_dim1;
i__5 = work_dim1 + 1;
z__1.r = WORK(i,i).r - WORK(1,1).r, z__1.i = WORK(i,i).i -
WORK(1,1).i;
WORK(i,i).r = z__1.r, WORK(i,i).i = z__1.i;
/* L20: */
}
/* Estimate a lower bound for the 1-norm of inv(C'). The
1st
and (N+1)th columns of WORK are used to store work ve
ctors. */
SEP(ks) = 0.;
est = 0.;
kase = 0;
*(unsigned char *)normin = 'N';
L30:
i__2 = *n - 1;
zlacon_(&i__2, &WORK(1,*n+1), &WORK(1,1)
, &est, &kase);
if (kase != 0) {
if (kase == 1) {
/* Solve C'*x = scale*b */
i__2 = *n - 1;
zlatrs_("Upper", "Conjugate transpose", "Nonunit", normin,
&i__2, &WORK(2,2), ldwork, &
WORK(1,1), &scale, &RWORK(1), &ierr);
} else {
/* Solve C*x = scale*b */
i__2 = *n - 1;
zlatrs_("Upper", "No transpose", "Nonunit", normin, &i__2,
&WORK(2,2), ldwork, &WORK(1,1), &scale, &RWORK(1), &ierr);
}
*(unsigned char *)normin = 'Y';
if (scale != 1.) {
/* Multiply by 1/SCALE if doing so will no
t cause
overflow. */
i__2 = *n - 1;
ix = izamax_(&i__2, &WORK(1,1), &c__1);
i__2 = ix + work_dim1;
xnorm = (d__1 = WORK(ix,1).r, abs(d__1)) + (d__2 = d_imag(
&WORK(ix,1)), abs(d__2));
if (scale < xnorm * smlnum || scale == 0.) {
goto L40;
}
zdrscl_(n, &scale, &WORK(1,1), &c__1);
}
goto L30;
}
SEP(ks) = 1. / max(est,smlnum);
}
L40:
++ks;
L50:
;
}
return 0;
/* End of ZTRSNA */
} /* ztrsna_ */
/*>BOOL blFitCaPDB(PDB *ref_pdb, PDB *fit_pdb, REAL rm[3][3])
--------------------------------------------------------
*//**
\param[in] *ref_pdb Reference PDB linked list
\param[in,out] *fit_pdb Mobile PDB linked list
\param[out] rm Rotation matrix (May be input as NULL).
\return Success
Fits two PDB linked lists using only the CA atoms.
Actually fits fit_pdb onto ref_pdb and also returns the rotation
matrix. This may be NULL if these data are not required.
- 14.03.96 Original based on FitPDB() By: ACRM
- 28.01.09 Initialize RetVal to TRUE!
- 07.07.14 Use bl prefix for functions By: CTP
- 19.08.14 Added AsCopy suffix to calls to blSelectAtomsPDB() By: CTP
*/
BOOL blFitCaPDB(PDB *ref_pdb, PDB *fit_pdb, REAL rm[3][3])
{
REAL RotMat[3][3];
COOR *ref_coor = NULL,
*fit_coor = NULL;
VEC3F ref_ca_CofG,
fit_ca_CofG,
tvect;
int NCoor = 0,
i, j,
natoms;
BOOL RetVal = TRUE;
PDB *ref_ca_pdb = NULL,
*fit_ca_pdb = NULL;
char *sel[2];
/* First extract only the CA atoms */
SELECT(sel[0], "CA ");
if(sel[0]==NULL)
return(FALSE);
if( (ref_ca_pdb = blSelectAtomsPDBAsCopy(ref_pdb, 1, sel, &natoms))
== NULL )
RetVal = FALSE;
if( (fit_ca_pdb = blSelectAtomsPDBAsCopy(fit_pdb, 1, sel, &natoms))
== NULL )
RetVal = FALSE;
free(sel[0]);
/* If we succeeded in building our CA PDB linked lists... */
if(RetVal)
{
/* Get the CofG of the CA structures and the original mobile */
blGetCofGPDB(ref_ca_pdb, &ref_ca_CofG);
blGetCofGPDB(fit_ca_pdb, &fit_ca_CofG);
/* Move them both to the origin */
blOriginPDB(ref_ca_pdb);
blOriginPDB(fit_ca_pdb);
/* Create coordinate arrays, checking numbers match */
NCoor = blGetPDBCoor(ref_ca_pdb, &ref_coor);
if(blGetPDBCoor(fit_ca_pdb, &fit_coor) != NCoor)
{
RetVal = FALSE;
}
else
{
/* Can't fit with fewer than 3 coordinates */
if(NCoor < 3)
{
RetVal = FALSE;
}
else
{
/* Everything OK, go ahead with the fitting */
if(!blMatfit(ref_coor,fit_coor,RotMat,NCoor,NULL,FALSE))
{
RetVal = FALSE;
}
else
{
/* Apply the operations to the true coordinates */
tvect.x = (-fit_ca_CofG.x);
tvect.y = (-fit_ca_CofG.y);
tvect.z = (-fit_ca_CofG.z);
blTranslatePDB(fit_pdb, tvect);
blApplyMatrixPDB(fit_pdb, RotMat);
blTranslatePDB(fit_pdb, ref_ca_CofG);
}
}
}
}
/* Free the coordinate arrays and CA PDB linked lists */
if(ref_coor) free(ref_coor);
if(fit_coor) free(fit_coor);
if(ref_ca_pdb) FREELIST(ref_ca_pdb, PDB);
if(fit_ca_pdb) FREELIST(fit_ca_pdb, PDB);
/* Fill in the rotation matrix for output, if required */
if(RetVal && (rm!=NULL))
{
for(i=0; i<3; i++)
for(j=0; j<3; j++)
rm[i][j] = RotMat[i][j];
}
return(RetVal);
}
void start_timer(unsigned r0, unsigned r1, unsigned r2, unsigned r3)
{
int val;
int i;
#define BIT(n) (1<<n)
#define BITTST(val, n) ((val) & BIT(n))
#define TST(val, b) ((val) & (b))
hw_timer_rotary[0] = (void *)(0x80068000); /* have ROTCTRL */
hw_timer_rotary[1] = (void *)(0x80068050);
hw_timer_rotary[2] = (void *)(0x80068080);
hw_timer_rotary[3] = (void *)(0x800680C0);
val = hw_timer_rotary[0]->HW_TIMROT_ROTCTRL[0];
printk("This SoC has:\n");
if(BITTST(val,25)) printk("timer 0\n");
if(BITTST(val,26)) printk("timer 1\n");
if(BITTST(val,27)) printk("timer 2\n");
if(BITTST(val,28)) printk("timer 3\n");
#define IRQ (1<<15)
#define IRQ_EN (1<<14)
#define MATCH_MODE (1<<11)
#define POLARITY (1<<8)
#define UPDATE (1<<7)
#define RELOAD (1<<6)
#define PRESCALE(n) ((n)<<4)
#define DIV_BY_8 (0x3)
#define SELECT(n) ((n)<<0)
#define TICK_ALWAYS (0XF)
#define SET 1
#define CLR 2
#define TOG 3
hw_timer_rotary[1]->HW_TIMROT_FIXED_COUNT[0] = 0x00011000;
val = IRQ_EN | UPDATE | RELOAD | PRESCALE(TICK_ALWAYS) | SELECT(0xB);
out_w(HW_TIMROT_TIMCTRL1, val);
while(1){
static int random = 0;
random++;
printk("[%04d]wait timer1 irq\n", random);
waitMsec(100);
val = hw_timer_rotary[1]->HW_TIMROT_TIMCTRL[0];
printk("%016b\n", val);
val = in_w(HW_TIMROT_RUNNING_COUNT1);
printk("timer running @[0x%x]\n", val);
val = in_w(HW_TIMROT_VERSION);
printk("timer version @[%X]\n", val);
if(random>300) break;
}
printk("Goodbye TIMER!\n");
}
getname(char *defname, char *defpasswd)
/* Let person identify themselves from w */
{
register char ch;
int secondsLeft = 199, laststate;
char tempstr[40];
LONG lasttime;
char *namptr, *passptr;
register int j;
struct timeval timeout;
fd_set readfds;
autolog = (*defpasswd && *defname) ? 1 : 0;
MZERO(mystats, sizeof(struct stats));
mystats->st_tticks = 1;
for (j = 0; j < 95; j++)
{
mystats->st_keymap[j] = j + 32;
mystats->st_keymap[j + 96] = j + 32 + 96;
#ifdef MOUSE_AS_SHIFT
mystats->st_keymap[j + 192] = j + 32;
mystats->st_keymap[j + 288] = j + 32;
mystats->st_keymap[j + 384] = j + 32;
#endif
}
mystats->st_keymap[95] = 0;
mystats->st_flags = ST_MAPMODE + ST_NAMEMODE + ST_SHOWSHIELDS +
ST_KEEPPEACE + ST_SHOWLOCAL * 2 + ST_SHOWGLOBAL * 2;
lasttime = time(NULL);
if (ghoststart)
return;
tempname[0] = '\0';
password1[0] = '\0';
password2[0] = '\0';
laststate = state = ST_GETNAME;
displayStartup(defname);
while (1)
{
handleWEvents(defname);
if (!autolog)
{
#ifndef HAVE_WIN32
W_FullScreen(baseWin);
timeout.tv_sec = 1;
timeout.tv_usec = 0;
#else
/* Since we don't have a socket to check on Win32 for windowing *
* system events, we set the timeout to zero and effectively poll.
* * Yes, I could do the correct thing and call *
* WaitForMultipleObjects() etc. but I don't feel like it */
timeout.tv_sec = 0;
timeout.tv_usec = 100000;
#endif
FD_ZERO(&readfds);
FD_SET(sock, &readfds);
if (udpSock >= 0)
FD_SET(udpSock, &readfds);
#ifndef HAVE_WIN32
FD_SET(W_Socket(), &readfds);
#endif
if (SELECT(32, &readfds, 0, 0, &timeout) < 0)
{
perror("select");
continue;
}
if (FD_ISSET(sock, &readfds)
|| (udpSock >= 0 && FD_ISSET(udpSock, &readfds)))
readFromServer(&readfds);
#ifndef HAVE_WIN32
if (FD_ISSET(W_Socket(), &readfds))
#else
if (W_EventsPending())
#endif
handleWEvents(defname);
}
else
{
readFromServer(&readfds);
}
if (isServerDead())
{
printf("Shit, we were ghostbusted\n");
#ifdef HAVE_XPM
W_GalacticBgd(GHOST_PIX);
#endif
#ifdef AUTOKEY
if (autoKey)
W_AutoRepeatOn();
#endif
terminate(0);
}
if (time(0) != lasttime)
{
lasttime++;
secondsLeft--;
showreadme();
if (!autolog)
{
sprintf(tempstr, "Seconds to go: %d ", secondsLeft);
W_WriteText(w, 100, 400, textColor, tempstr, strlen(tempstr),
W_RegularFont);
}
if (secondsLeft == 0)
{
me->p_status = PFREE;
printf("Timed Out.\n");
#ifdef AUTOKEY
if (autoKey)
W_AutoRepeatOn();
#endif
terminate(0);
}
}
if (state == ST_DONE)
{
W_ClearWindow(w);
W_ClearWindow(mapw);
return;
}
if (autolog)
{
switch (state)
{
case ST_GETNAME:
tempname[0] = '\0';
ch = 13;
j = 0;
break;
case ST_GETPASS:
case ST_MAKEPASS1:
case ST_MAKEPASS2:
ch = defpasswd[j++];
if (ch == '\0')
{
j = 0;
ch = 13;
}
break;
default:
break;
}
loginproced(ch, defname);
}
laststate = state;
}
}
scandir(const char *dirname, struct dirent ***namelist,
int (*select)(const struct dirent *), int (*dcomp)(const struct dirent **,
const struct dirent **))
#endif
{
struct dirent *d, *p, **names = NULL;
size_t arraysz, numitems;
DIR *dirp;
if ((dirp = opendir(dirname)) == NULL)
return(-1);
numitems = 0;
arraysz = 32; /* initial estimate of the array size */
names = (struct dirent **)malloc(arraysz * sizeof(struct dirent *));
if (names == NULL)
goto fail;
while ((d = readdir(dirp)) != NULL) {
if (select != NULL && !SELECT(d))
continue; /* just selected names */
/*
* Make a minimum size copy of the data
*/
p = (struct dirent *)malloc(_GENERIC_DIRSIZ(d));
if (p == NULL)
goto fail;
p->d_fileno = d->d_fileno;
p->d_type = d->d_type;
p->d_reclen = d->d_reclen;
p->d_namlen = d->d_namlen;
bcopy(d->d_name, p->d_name, p->d_namlen + 1);
/*
* Check to make sure the array has space left and
* realloc the maximum size.
*/
if (numitems >= arraysz) {
struct dirent **names2;
names2 = reallocarray(names, arraysz,
2 * sizeof(struct dirent *));
if (names2 == NULL) {
free(p);
goto fail;
}
names = names2;
arraysz *= 2;
}
names[numitems++] = p;
}
closedir(dirp);
if (numitems && dcomp != NULL)
#ifdef I_AM_SCANDIR_B
qsort_b(names, numitems, sizeof(struct dirent *), (void*)dcomp);
#else
qsort_r(names, numitems, sizeof(struct dirent *),
&dcomp, alphasort_thunk);
#endif
*namelist = names;
return (numitems);
fail:
while (numitems > 0)
free(names[--numitems]);
free(names);
closedir(dirp);
return (-1);
}
/* Subroutine */ int dtrsna_(char *job, char *howmny, logical *select,
integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *
ldvl, doublereal *vr, integer *ldvr, doublereal *s, doublereal *sep,
integer *mm, integer *m, doublereal *work, integer *ldwork, integer *
iwork, integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
DTRSNA estimates reciprocal condition numbers for specified
eigenvalues and/or right eigenvectors of a real upper
quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q
orthogonal).
T must be in Schur canonical form (as returned by DHSEQR), that is,
block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
2-by-2 diagonal block has its diagonal elements equal and its
off-diagonal elements of opposite sign.
Arguments
=========
JOB (input) CHARACTER*1
Specifies whether condition numbers are required for
eigenvalues (S) or eigenvectors (SEP):
= 'E': for eigenvalues only (S);
= 'V': for eigenvectors only (SEP);
= 'B': for both eigenvalues and eigenvectors (S and SEP).
HOWMNY (input) CHARACTER*1
= 'A': compute condition numbers for all eigenpairs;
= 'S': compute condition numbers for selected eigenpairs
specified by the array SELECT.
SELECT (input) LOGICAL array, dimension (N)
If HOWMNY = 'S', SELECT specifies the eigenpairs for which
condition numbers are required. To select condition numbers
for the eigenpair corresponding to a real eigenvalue w(j),
SELECT(j) must be set to .TRUE.. To select condition numbers
corresponding to a complex conjugate pair of eigenvalues w(j)
and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be
set to .TRUE..
If HOWMNY = 'A', SELECT is not referenced.
N (input) INTEGER
The order of the matrix T. N >= 0.
T (input) DOUBLE PRECISION array, dimension (LDT,N)
The upper quasi-triangular matrix T, in Schur canonical form.
LDT (input) INTEGER
The leading dimension of the array T. LDT >= max(1,N).
VL (input) DOUBLE PRECISION array, dimension (LDVL,M)
If JOB = 'E' or 'B', VL must contain left eigenvectors of T
(or of any Q*T*Q**T with Q orthogonal), corresponding to the
eigenpairs specified by HOWMNY and SELECT. The eigenvectors
must be stored in consecutive columns of VL, as returned by
DHSEIN or DTREVC.
If JOB = 'V', VL is not referenced.
LDVL (input) INTEGER
The leading dimension of the array VL.
LDVL >= 1; and if JOB = 'E' or 'B', LDVL >= N.
VR (input) DOUBLE PRECISION array, dimension (LDVR,M)
If JOB = 'E' or 'B', VR must contain right eigenvectors of T
(or of any Q*T*Q**T with Q orthogonal), corresponding to the
eigenpairs specified by HOWMNY and SELECT. The eigenvectors
must be stored in consecutive columns of VR, as returned by
DHSEIN or DTREVC.
If JOB = 'V', VR is not referenced.
LDVR (input) INTEGER
The leading dimension of the array VR.
LDVR >= 1; and if JOB = 'E' or 'B', LDVR >= N.
S (output) DOUBLE PRECISION array, dimension (MM)
If JOB = 'E' or 'B', the reciprocal condition numbers of the
selected eigenvalues, stored in consecutive elements of the
array. For a complex conjugate pair of eigenvalues two
consecutive elements of S are set to the same value. Thus
S(j), SEP(j), and the j-th columns of VL and VR all
correspond to the same eigenpair (but not in general the
j-th eigenpair, unless all eigenpairs are selected).
If JOB = 'V', S is not referenced.
SEP (output) DOUBLE PRECISION array, dimension (MM)
If JOB = 'V' or 'B', the estimated reciprocal condition
numbers of the selected eigenvectors, stored in consecutive
elements of the array. For a complex eigenvector two
consecutive elements of SEP are set to the same value. If
the eigenvalues cannot be reordered to compute SEP(j), SEP(j)
is set to 0; this can only occur when the true value would be
very small anyway.
If JOB = 'E', SEP is not referenced.
MM (input) INTEGER
The number of elements in the arrays S (if JOB = 'E' or 'B')
and/or SEP (if JOB = 'V' or 'B'). MM >= M.
M (output) INTEGER
The number of elements of the arrays S and/or SEP actually
used to store the estimated condition numbers.
If HOWMNY = 'A', M is set to N.
WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N+1)
If JOB = 'E', WORK is not referenced.
LDWORK (input) INTEGER
The leading dimension of the array WORK.
LDWORK >= 1; and if JOB = 'V' or 'B', LDWORK >= N.
IWORK (workspace) INTEGER array, dimension (N)
If JOB = 'E', IWORK is not referenced.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
Further Details
===============
The reciprocal of the condition number of an eigenvalue lambda is
defined as
S(lambda) = |v'*u| / (norm(u)*norm(v))
where u and v are the right and left eigenvectors of T corresponding
to lambda; v' denotes the conjugate-transpose of v, and norm(u)
denotes the Euclidean norm. These reciprocal condition numbers always
lie between zero (very badly conditioned) and one (very well
conditioned). If n = 1, S(lambda) is defined to be 1.
An approximate error bound for a computed eigenvalue W(i) is given by
EPS * norm(T) / S(i)
where EPS is the machine precision.
The reciprocal of the condition number of the right eigenvector u
corresponding to lambda is defined as follows. Suppose
T = ( lambda c )
( 0 T22 )
Then the reciprocal condition number is
SEP( lambda, T22 ) = sigma-min( T22 - lambda*I )
where sigma-min denotes the smallest singular value. We approximate
the smallest singular value by the reciprocal of an estimate of the
one-norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is
defined to be abs(T(1,1)).
An approximate error bound for a computed right eigenvector VR(i)
is given by
EPS * norm(T) / SEP(i)
=====================================================================
Decode and test the input parameters
Parameter adjustments
Function Body */
/* Table of constant values */
static integer c__1 = 1;
static logical c_true = TRUE_;
static logical c_false = FALSE_;
/* System generated locals */
integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset,
work_dim1, work_offset, i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer kase;
static doublereal cond;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
static logical pair;
static integer ierr;
static doublereal dumm, prod;
static integer ifst;
static doublereal lnrm;
static integer ilst;
static doublereal rnrm;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
static doublereal prod1, prod2;
static integer i, j, k;
static doublereal scale, delta;
extern logical lsame_(char *, char *);
static logical wants;
static doublereal dummy[1];
static integer n2;
extern doublereal dlapy2_(doublereal *, doublereal *);
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
static doublereal cs;
extern doublereal dlamch_(char *);
static integer nn, ks;
extern /* Subroutine */ int dlacon_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
static doublereal sn, mu;
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
xerbla_(char *, integer *);
static doublereal bignum;
static logical wantbh;
extern /* Subroutine */ int dlaqtr_(logical *, logical *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, integer *), dtrexc_(char *, integer *
, doublereal *, integer *, doublereal *, integer *, integer *,
integer *, doublereal *, integer *);
static logical somcon;
static doublereal smlnum;
static logical wantsp;
static doublereal eps, est;
#define DUMMY(I) dummy[(I)]
#define SELECT(I) select[(I)-1]
#define S(I) s[(I)-1]
#define SEP(I) sep[(I)-1]
#define IWORK(I) iwork[(I)-1]
#define T(I,J) t[(I)-1 + ((J)-1)* ( *ldt)]
#define VL(I,J) vl[(I)-1 + ((J)-1)* ( *ldvl)]
#define VR(I,J) vr[(I)-1 + ((J)-1)* ( *ldvr)]
#define WORK(I,J) work[(I)-1 + ((J)-1)* ( *ldwork)]
wantbh = lsame_(job, "B");
wants = lsame_(job, "E") || wantbh;
wantsp = lsame_(job, "V") || wantbh;
somcon = lsame_(howmny, "S");
*info = 0;
if (! wants && ! wantsp) {
*info = -1;
} else if (! lsame_(howmny, "A") && ! somcon) {
*info = -2;
} else if (*n < 0) {
*info = -4;
} else if (*ldt < max(1,*n)) {
*info = -6;
} else if (*ldvl < 1 || wants && *ldvl < *n) {
*info = -8;
} else if (*ldvr < 1 || wants && *ldvr < *n) {
*info = -10;
} else {
/* Set M to the number of eigenpairs for which condition number
s
are required, and test MM. */
if (somcon) {
*m = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= *n; ++k) {
if (pair) {
pair = FALSE_;
} else {
if (k < *n) {
if (T(k+1,k) == 0.) {
if (SELECT(k)) {
++(*m);
}
} else {
pair = TRUE_;
if (SELECT(k) || SELECT(k + 1)) {
*m += 2;
}
}
} else {
if (SELECT(*n)) {
++(*m);
}
}
}
/* L10: */
}
} else {
*m = *n;
}
if (*mm < *m) {
*info = -13;
} else if (*ldwork < 1 || wantsp && *ldwork < *n) {
*info = -16;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DTRSNA", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
if (*n == 1) {
if (somcon) {
if (! SELECT(1)) {
return 0;
}
}
if (wants) {
S(1) = 1.;
}
if (wantsp) {
SEP(1) = (d__1 = T(1,1), abs(d__1));
}
return 0;
}
/* Get machine constants */
eps = dlamch_("P");
smlnum = dlamch_("S") / eps;
bignum = 1. / smlnum;
dlabad_(&smlnum, &bignum);
ks = 0;
pair = FALSE_;
i__1 = *n;
for (k = 1; k <= *n; ++k) {
/* Determine whether T(k,k) begins a 1-by-1 or 2-by-2 block. */
if (pair) {
pair = FALSE_;
goto L60;
} else {
if (k < *n) {
pair = T(k+1,k) != 0.;
}
}
/* Determine whether condition numbers are required for the k-t
h
eigenpair. */
if (somcon) {
if (pair) {
if (! SELECT(k) && ! SELECT(k + 1)) {
goto L60;
}
} else {
if (! SELECT(k)) {
goto L60;
}
}
}
++ks;
if (wants) {
/* Compute the reciprocal condition number of the k-th
eigenvalue. */
if (! pair) {
/* Real eigenvalue. */
prod = ddot_(n, &VR(1,ks), &c__1, &VL(1,ks), &c__1);
rnrm = dnrm2_(n, &VR(1,ks), &c__1);
lnrm = dnrm2_(n, &VL(1,ks), &c__1);
S(ks) = abs(prod) / (rnrm * lnrm);
} else {
/* Complex eigenvalue. */
prod1 = ddot_(n, &VR(1,ks), &c__1, &VL(1,ks), &c__1);
prod1 += ddot_(n, &VR(1,ks+1), &c__1, &VL(1,ks+1), &c__1);
prod2 = ddot_(n, &VL(1,ks), &c__1, &VR(1,ks+1), &c__1);
prod2 -= ddot_(n, &VL(1,ks+1), &c__1, &VR(1,ks), &c__1);
d__1 = dnrm2_(n, &VR(1,ks), &c__1);
d__2 = dnrm2_(n, &VR(1,ks+1), &c__1);
rnrm = dlapy2_(&d__1, &d__2);
d__1 = dnrm2_(n, &VL(1,ks), &c__1);
d__2 = dnrm2_(n, &VL(1,ks+1), &c__1);
lnrm = dlapy2_(&d__1, &d__2);
cond = dlapy2_(&prod1, &prod2) / (rnrm * lnrm);
S(ks) = cond;
S(ks + 1) = cond;
}
}
if (wantsp) {
/* Estimate the reciprocal condition number of the k-th
eigenvector.
Copy the matrix T to the array WORK and swap the diag
onal
block beginning at T(k,k) to the (1,1) position. */
dlacpy_("Full", n, n, &T(1,1), ldt, &WORK(1,1),
ldwork);
ifst = k;
ilst = 1;
dtrexc_("No Q", n, &WORK(1,1), ldwork, dummy, &c__1, &
ifst, &ilst, &WORK(1,*n+1), &ierr);
if (ierr == 1 || ierr == 2) {
/* Could not swap because blocks not well separat
ed */
scale = 1.;
est = bignum;
} else {
/* Reordering successful */
if (WORK(2,1) == 0.) {
/* Form C = T22 - lambda*I in WORK(2:N,2:N
). */
i__2 = *n;
for (i = 2; i <= *n; ++i) {
WORK(i,i) -= WORK(1,1);
/* L20: */
}
n2 = 1;
nn = *n - 1;
} else {
/* Triangularize the 2 by 2 block by unita
ry
transformation U = [ cs i*ss ]
[ i*ss cs ].
such that the (1,1) position of WORK is
complex
eigenvalue lambda with positive imagina
ry part. (2,2)
position of WORK is the complex eigenva
lue lambda
with negative imaginary part. */
mu = sqrt((d__1 = WORK(1,2), abs(d__1)))
* sqrt((d__2 = WORK(2,1), abs(d__2)));
delta = dlapy2_(&mu, &WORK(2,1));
cs = mu / delta;
sn = -WORK(2,1) / delta;
/* Form
C' = WORK(2:N,2:N) + i*[rwork(1) .....
rwork(n-1) ]
[ mu
]
[ ..
]
[ ..
]
[
mu ]
where C' is conjugate transpose of comp
lex matrix C,
and RWORK is stored starting in the N+1
-st column of
WORK. */
i__2 = *n;
for (j = 3; j <= *n; ++j) {
WORK(2,j) = cs * WORK(2,j)
;
WORK(j,j) -= WORK(1,1);
/* L30: */
}
WORK(2,2) = 0.;
WORK(1,*n+1) = mu * 2.;
i__2 = *n - 1;
for (i = 2; i <= *n-1; ++i) {
WORK(i,*n+1) = sn * WORK(1,i+1);
/* L40: */
}
n2 = 2;
nn = *n - 1 << 1;
}
/* Estimate norm(inv(C')) */
est = 0.;
kase = 0;
L50:
dlacon_(&nn, &WORK(1,*n+2), &WORK(1,*n+4), &IWORK(1), &est, &kase);
if (kase != 0) {
if (kase == 1) {
if (n2 == 1) {
/* Real eigenvalue: solve C'
*x = scale*c. */
i__2 = *n - 1;
dlaqtr_(&c_true, &c_true, &i__2, &WORK(2,2), ldwork, dummy, &dumm, &scale,
&WORK(1,*n+4), &WORK(1,*n+6), &ierr);
} else {
/* Complex eigenvalue: solve
C'*(p+iq) = scale*(c+id)
in real arithmetic. */
i__2 = *n - 1;
dlaqtr_(&c_true, &c_false, &i__2, &WORK(2,2), ldwork, &WORK(1,*n+1), &mu, &scale, &WORK(1,*n+4), &WORK(1,*n+6), &ierr);
}
} else {
if (n2 == 1) {
/* Real eigenvalue: solve C*
x = scale*c. */
i__2 = *n - 1;
dlaqtr_(&c_false, &c_true, &i__2, &WORK(2,2), ldwork, dummy, &
dumm, &scale, &WORK(1,*n+4), &WORK(1,*n+6), &
ierr);
} else {
/* Complex eigenvalue: solve
C*(p+iq) = scale*(c+id) i
n real arithmetic. */
i__2 = *n - 1;
dlaqtr_(&c_false, &c_false, &i__2, &WORK(2,2), ldwork, &WORK(1,*n+1), &mu, &scale, &WORK(1,*n+4), &WORK(1,*n+6), &ierr);
}
}
goto L50;
}
}
SEP(ks) = scale / max(est,smlnum);
if (pair) {
SEP(ks + 1) = SEP(ks);
}
}
if (pair) {
++ks;
}
L60:
;
}
return 0;
/* End of DTRSNA */
} /* dtrsna_ */
int vfc_init_i2c_bus(struct vfc_dev *dev)
{
WRITE_S1(ENABLE_SERIAL | SELECT(S0) | ACK);
vfc_i2c_reset_bus(dev);
return 0;
}