00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int cg_(integer *nm, integer *n, doublereal *ar, doublereal *
00009 ai, doublereal *wr, doublereal *wi, integer *matz, doublereal *zr,
00010 doublereal *zi, doublereal *fv1, doublereal *fv2, doublereal *fv3,
00011 integer *ierr)
00012 {
00013
00014 integer ar_dim1, ar_offset, ai_dim1, ai_offset, zr_dim1, zr_offset,
00015 zi_dim1, zi_offset;
00016
00017
00018 extern int cbal_(integer *, integer *, doublereal *,
00019 doublereal *, integer *, integer *, doublereal *), corth_(integer
00020 *, integer *, integer *, integer *, doublereal *, doublereal *,
00021 doublereal *, doublereal *), comqr_(integer *, integer *, integer
00022 *, integer *, doublereal *, doublereal *, doublereal *,
00023 doublereal *, integer *), cbabk2_(integer *, integer *, integer *,
00024 integer *, doublereal *, integer *, doublereal *, doublereal *),
00025 comqr2_(integer *, integer *, integer *, integer *, doublereal *,
00026 doublereal *, doublereal *, doublereal *, doublereal *,
00027 doublereal *, doublereal *, doublereal *, integer *);
00028 static integer is1, is2;
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076 --fv3;
00077 --fv2;
00078 --fv1;
00079 zi_dim1 = *nm;
00080 zi_offset = zi_dim1 + 1;
00081 zi -= zi_offset;
00082 zr_dim1 = *nm;
00083 zr_offset = zr_dim1 + 1;
00084 zr -= zr_offset;
00085 --wi;
00086 --wr;
00087 ai_dim1 = *nm;
00088 ai_offset = ai_dim1 + 1;
00089 ai -= ai_offset;
00090 ar_dim1 = *nm;
00091 ar_offset = ar_dim1 + 1;
00092 ar -= ar_offset;
00093
00094
00095 if (*n <= *nm) {
00096 goto L10;
00097 }
00098 *ierr = *n * 10;
00099 goto L50;
00100
00101 L10:
00102 cbal_(nm, n, &ar[ar_offset], &ai[ai_offset], &is1, &is2, &fv1[1]);
00103 corth_(nm, n, &is1, &is2, &ar[ar_offset], &ai[ai_offset], &fv2[1], &fv3[1]
00104 );
00105 if (*matz != 0) {
00106 goto L20;
00107 }
00108
00109 comqr_(nm, n, &is1, &is2, &ar[ar_offset], &ai[ai_offset], &wr[1], &wi[1],
00110 ierr);
00111 goto L50;
00112
00113 L20:
00114 comqr2_(nm, n, &is1, &is2, &fv2[1], &fv3[1], &ar[ar_offset], &ai[
00115 ai_offset], &wr[1], &wi[1], &zr[zr_offset], &zi[zi_offset], ierr);
00116 if (*ierr != 0) {
00117 goto L50;
00118 }
00119 cbabk2_(nm, n, &is1, &is2, &fv1[1], n, &zr[zr_offset], &zi[zi_offset]);
00120 L50:
00121 return 0;
00122 }
00123