| @@ -151,13 +151,13 @@ jobs: | |||
| strategy: | |||
| fail-fast: false | |||
| matrix: | |||
| msystem: [MINGW64, MINGW32, CLANG64, CLANG32] | |||
| msystem: [UCRT64, MINGW32, CLANG64, CLANG32] | |||
| idx: [int32, int64] | |||
| build-type: [Release] | |||
| include: | |||
| - msystem: MINGW64 | |||
| - msystem: UCRT64 | |||
| idx: int32 | |||
| target-prefix: mingw-w64-x86_64 | |||
| target-prefix: mingw-w64-ucrt-x86_64 | |||
| fc-pkg: fc | |||
| - msystem: MINGW32 | |||
| idx: int32 | |||
| @@ -175,10 +175,10 @@ jobs: | |||
| target-prefix: mingw-w64-clang-i686 | |||
| fc-pkg: cc | |||
| c-lapack-flags: -DC_LAPACK=ON | |||
| - msystem: MINGW64 | |||
| - msystem: UCRT64 | |||
| idx: int64 | |||
| idx64-flags: -DBINARY=64 -DINTERFACE64=1 | |||
| target-prefix: mingw-w64-x86_64 | |||
| target-prefix: mingw-w64-ucrt-x86_64 | |||
| fc-pkg: fc | |||
| - msystem: CLANG64 | |||
| idx: int64 | |||
| @@ -188,9 +188,9 @@ jobs: | |||
| # Compiling with Flang 16 seems to cause test errors on machines | |||
| # with AVX512 instructions. Revisit after MSYS2 distributes Flang 17. | |||
| no-avx512-flags: -DNO_AVX512=1 | |||
| - msystem: MINGW64 | |||
| - msystem: UCRT64 | |||
| idx: int32 | |||
| target-prefix: mingw-w64-x86_64 | |||
| target-prefix: mingw-w64-ucrt-x86_64 | |||
| fc-pkg: fc | |||
| build-type: None | |||
| exclude: | |||
| @@ -23,6 +23,7 @@ permissions: | |||
| jobs: | |||
| build-OpenBLAS-with-Homebrew: | |||
| if: "github.repository == 'OpenMathLib/OpenBLAS'" | |||
| runs-on: macos-latest | |||
| env: | |||
| DEVELOPER_DIR: /Applications/Xcode_11.4.1.app/Contents/Developer | |||
| @@ -35,7 +35,11 @@ export NO_LAPACK | |||
| export C_LAPACK | |||
| endif | |||
| ifeq ($(F_COMPILER),CRAY) | |||
| LAPACK_NOOPT := $(filter-out -O0 -O1 -O2 -O3 -Ofast -Og -Os,$(LAPACK_FFLAGS)) | |||
| else | |||
| LAPACK_NOOPT := $(filter-out -O0 -O1 -O2 -O3 -Ofast -O -Og -Os,$(LAPACK_FFLAGS)) | |||
| endif | |||
| SUBDIRS_ALL = $(SUBDIRS) test ctest utest exports benchmark ../laswp ../bench cpp_thread_test | |||
| @@ -98,6 +98,9 @@ endif | |||
| endif | |||
| endif | |||
| ifeq ($(C_COMPILER), CLANG) | |||
| CCOMMON_OPT += -fno-integrated-as | |||
| endif | |||
| # workaround for C->FORTRAN ABI violation in LAPACKE | |||
| ifeq ($(F_COMPILER), GFORTRAN) | |||
| FCOMMON_OPT += -fno-optimize-sibling-calls | |||
| @@ -133,7 +136,11 @@ ifdef BINARY64 | |||
| ifeq ($(OSNAME), AIX) | |||
| ifeq ($(C_COMPILER), GCC) | |||
| CCOMMON_OPT += -mpowerpc64 -maix64 | |||
| else | |||
| CCOMMON_OPT += -m64 | |||
| endif | |||
| ifeq ($(COMPILER_F77), g77) | |||
| FCOMMON_OPT += -mpowerpc64 -maix64 | |||
| endif | |||
| @@ -277,10 +277,6 @@ endif | |||
| ifndef GOTOBLAS_MAKEFILE | |||
| export GOTOBLAS_MAKEFILE = 1 | |||
| # Determine if the assembler is GNU Assembler | |||
| HAVE_GAS := $(shell $(AS) -v < /dev/null 2>&1 | grep GNU 2>&1 >/dev/null ; echo $$?) | |||
| GETARCH_FLAGS += -DHAVE_GAS=$(HAVE_GAS) | |||
| # Generating Makefile.conf and config.h | |||
| DUMMY := $(shell $(MAKE) -C $(TOPDIR) -f Makefile.prebuild CC="$(CC)" FC="$(FC)" HOSTCC="$(HOSTCC)" HOST_CFLAGS="$(GETARCH_FLAGS)" CFLAGS="$(CFLAGS)" BINARY=$(BINARY) USE_OPENMP=$(USE_OPENMP) DYNAMIC_ARCH=$(DYNAMIC_ARCH) TARGET_CORE=$(TARGET_CORE) ONLY_CBLAS=$(ONLY_CBLAS) TARGET=$(TARGET) all) | |||
| @@ -405,6 +401,13 @@ export MACOSX_DEPLOYMENT_TARGET=10.8 | |||
| endif | |||
| endif | |||
| MD5SUM = md5 -r | |||
| XCVER = $(shell pkgutil --pkg-info=com.apple.pkg.Xcode |awk '/version:/ {print $2}'|cut -d: -f2|cut -f1 -d.) | |||
| ifeq (x$(XCVER)x,xx) | |||
| XCVER = $(shell pkgutil --pkg-info=com.apple.pkg.CLTools_Executables |awk '/version:/ {print $2}'|cut -d: -f2|cut -f1 -d.) | |||
| endif | |||
| ifeq (x$(XCVER), x 15) | |||
| CCOMMON_OPT += -Wl,-ld_classic | |||
| endif | |||
| endif | |||
| ifneq (,$(findstring $(OSNAME), FreeBSD OpenBSD DragonFly)) | |||
| @@ -753,7 +756,11 @@ DYNAMIC_CORE += POWER9 | |||
| else | |||
| $(info, OpenBLAS: Your gcc version is too old to build the POWER9 kernels.) | |||
| endif | |||
| ifeq ($(OSNAME), AIX) | |||
| LDVERSIONGTEQ35 := 1 | |||
| else | |||
| LDVERSIONGTEQ35 := $(shell expr `$(CC) -Wl,--version 2> /dev/null | head -1 | cut -f2 -d "." | cut -f1 -d "-"` \>= 35) | |||
| endif | |||
| ifeq ($(GCCVERSIONGTEQ11)$(LDVERSIONGTEQ35), 11) | |||
| DYNAMIC_CORE += POWER10 | |||
| CCOMMON_OPT += -DHAVE_P10_SUPPORT | |||
| @@ -1635,11 +1642,11 @@ endif | |||
| ifeq ($(F_COMPILER),NAG) | |||
| LAPACK_FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| override FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| endif | |||
| ifeq ($(F_COMPILER),CRAY) | |||
| LAPACK_FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| override FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) | |||
| endif | |||
| LAPACK_CFLAGS = $(CFLAGS) | |||
| @@ -167,11 +167,10 @@ jobs: | |||
| - job: OSX_OpenMP_Clang | |||
| pool: | |||
| vmImage: 'macOS-11' | |||
| vmImage: 'macOS-latest' | |||
| variables: | |||
| LD_LIBRARY_PATH: /usr/local/opt/llvm/lib | |||
| LIBRARY_PATH: /usr/local/opt/llvm/lib | |||
| MACOSX_DEPLOYMENT_TARGET: 11.0 | |||
| steps: | |||
| - script: | | |||
| brew update | |||
| @@ -180,7 +179,7 @@ jobs: | |||
| - job: OSX_OpenMP_Clang_cmake | |||
| pool: | |||
| vmImage: 'macOS-11' | |||
| vmImage: 'macOS-latest' | |||
| variables: | |||
| LD_LIBRARY_PATH: /usr/local/opt/llvm/lib | |||
| LIBRARY_PATH: /usr/local/opt/llvm/lib | |||
| @@ -210,7 +209,7 @@ jobs: | |||
| - job: OSX_Ifort_Clang | |||
| pool: | |||
| vmImage: 'macOS-11' | |||
| vmImage: 'macOS-latest' | |||
| variables: | |||
| LD_LIBRARY_PATH: /usr/local/opt/llvm/lib | |||
| MACOS_HPCKIT_URL: https://registrationcenter-download.intel.com/akdlm/irc_nas/17643/m_HPCKit_p_2021.2.0.2903_offline.dmg | |||
| @@ -96,11 +96,19 @@ esac | |||
| defined=0 | |||
| if [ "$os" = "AIX" ]; then | |||
| case "$BINARY" in | |||
| 32) compiler_name="$compiler_name -maix32" ;; | |||
| 64) compiler_name="$compiler_name -maix64" ;; | |||
| esac | |||
| defined=1 | |||
| if [ "$compiler" = "GCC" ]; then | |||
| case "$BINARY" in | |||
| 32) compiler_name="$compiler_name -maix32" ;; | |||
| 64) compiler_name="$compiler_name -maix64" ;; | |||
| esac | |||
| defined=1 | |||
| else | |||
| case "$BINARY" in | |||
| 32) compiler_name="$compiler_name -m32" ;; | |||
| 64) compiler_name="$compiler_name -m64" ;; | |||
| esac | |||
| defined=1 | |||
| fi | |||
| fi | |||
| case "$architecture" in | |||
| @@ -242,251 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| #if 0 | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| #endif | |||
| /* Common Block Declarations */ | |||
| @@ -503,16 +258,16 @@ static integer c__1 = 1; | |||
| static integer c__5 = 5; | |||
| static real c_b43 = (float)1.; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| static real sfac = (float)9.765625e-4; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ int check1_(), check2_(); | |||
| extern /* Subroutine */ int check1_(real*), check2_(real*); | |||
| static integer ic; | |||
| extern /* Subroutine */ int header_(); | |||
| extern /* Subroutine */ int header_(void); | |||
| /* Test program for the COMPLEX Level 1 CBLAS. */ | |||
| /* Based upon the original CBLAS test routine together with: */ | |||
| @@ -553,7 +308,7 @@ static real c_b43 = (float)1.; | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int header_() | |||
| /* Subroutine */ int header_(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -564,7 +319,7 @@ static real c_b43 = (float)1.; | |||
| /* Format strings */ | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| integer s_wsfe(void), do_fio(void), e_wsfe(void); | |||
| /* .. Parameters .. */ | |||
| /* .. Scalars in Common .. */ | |||
| @@ -577,8 +332,7 @@ static real c_b43 = (float)1.; | |||
| } /* header_ */ | |||
| /* Subroutine */ int check1_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check1_(real* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -683,15 +437,15 @@ real *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern /* Subroutine */ int ctest_(); | |||
| extern /* Subroutine */ int ctest_(integer*, complex*, complex*, complex*, real*); | |||
| static complex mwpcs[5], mwpct[5]; | |||
| extern /* Subroutine */ int itest1_(), stest1_(); | |||
| extern /* Subroutine */ int itest1_(integer*, integer*), stest1_(real*,real*,real*,real*); | |||
| static complex cx[8]; | |||
| extern real scnrm2test_(); | |||
| extern real scnrm2test_(integer*, complex*, integer*); | |||
| static integer np1; | |||
| extern integer icamaxtest_(); | |||
| extern /* Subroutine */ int csscaltest_(); | |||
| extern real scasumtest_(); | |||
| extern integer icamaxtest_(integer*, complex*, integer*); | |||
| extern /* Subroutine */ int csscaltest_(integer*, real*, complex*, integer*); | |||
| extern real scasumtest_(integer*, complex*, integer*); | |||
| static integer len; | |||
| /* .. Parameters .. */ | |||
| @@ -808,8 +562,7 @@ real *sfac; | |||
| return 0; | |||
| } /* check1_ */ | |||
| /* Subroutine */ int check2_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check2_(real* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -981,10 +734,10 @@ real *sfac; | |||
| static complex cdot[1]; | |||
| static integer lenx, leny, i__; | |||
| static complex ctemp; | |||
| extern /* Subroutine */ int ctest_(); | |||
| extern /* Subroutine */ int ctest_(integer*, complex*, complex*, complex*, real*); | |||
| static integer ksize; | |||
| extern /* Subroutine */ int cdotctest_(), ccopytest_(), cdotutest_(), | |||
| cswaptest_(), caxpytest_(); | |||
| extern /* Subroutine */ int cdotctest_(integer*, complex*, integer*, complex*, integer*,complex*), ccopytest_(integer*, complex*, integer*, complex*, integer*), cdotutest_(integer*, complex*, integer*, complex*, integer*, complex*), | |||
| cswaptest_(integer*, complex*, integer*, complex*, integer*), caxpytest_(integer*, complex*, complex*, integer*, complex*, integer*); | |||
| static integer ki, kn; | |||
| static complex cx[7], cy[7]; | |||
| static integer mx, my; | |||
| @@ -1067,9 +820,7 @@ real *sfac; | |||
| return 0; | |||
| } /* check2_ */ | |||
| /* Subroutine */ int stest_(len, scomp, strue, ssize, sfac) | |||
| integer *len; | |||
| real *scomp, *strue, *ssize, *sfac; | |||
| /* Subroutine */ int stest_(integer* len, real* scomp, real* strue, real* ssize,real* sfac) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -1077,7 +828,7 @@ real *scomp, *strue, *ssize, *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(real*, real*); | |||
| static real sd; | |||
| /* ********************************* STEST ************************** */ | |||
| @@ -1133,11 +884,10 @@ L40: | |||
| } /* stest_ */ | |||
| /* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac) | |||
| real *scomp1, *strue1, *ssize, *sfac; | |||
| /* Subroutine */ int stest1_(real* scomp1, real* strue1, real* ssize, real* sfac) | |||
| { | |||
| static real scomp[1], strue[1]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*, real*, real*, real*, real*); | |||
| /* ************************* STEST1 ***************************** */ | |||
| @@ -1164,8 +914,7 @@ real *scomp1, *strue1, *ssize, *sfac; | |||
| return 0; | |||
| } /* stest1_ */ | |||
| doublereal sdiff_(sa, sb) | |||
| real *sa, *sb; | |||
| doublereal sdiff_(real* sa, real* sb) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -1179,10 +928,7 @@ real *sa, *sb; | |||
| return ret_val; | |||
| } /* sdiff_ */ | |||
| /* Subroutine */ int ctest_(len, ccomp, ctrue, csize, sfac) | |||
| integer *len; | |||
| complex *ccomp, *ctrue, *csize; | |||
| real *sfac; | |||
| /* Subroutine */ int ctest_(integer* len, complex* ccomp, complex* ctrue, complex* csize, real* sfac) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1, i__2; | |||
| @@ -1193,7 +939,7 @@ real *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| static real scomp[20], ssize[20], strue[20]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*, real*,real*,real*,real*); | |||
| /* **************************** CTEST ***************************** */ | |||
| @@ -1231,8 +977,7 @@ real *sfac; | |||
| return 0; | |||
| } /* ctest_ */ | |||
| /* Subroutine */ int itest1_(icomp, itrue) | |||
| integer *icomp, *itrue; | |||
| /* Subroutine */ int itest1_(integer* icomp, integer* itrue) | |||
| { | |||
| /* Local variables */ | |||
| static integer id; | |||
| @@ -242,129 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -396,7 +273,7 @@ static integer c_n1 = -1; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -414,17 +291,21 @@ static logical c_false = FALSE_; | |||
| static logical same; | |||
| static integer ninc, nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int cchk1_(), cchk2_(), cchk3_(), cchk4_(), | |||
| cchk5_(), cchk6_(); | |||
| extern /* Subroutine */ int cchk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int cchk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int cchk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int cchk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int cchk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int cchk6_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, complex*, integer*, integer*, integer*, integer*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, complex*, real*, complex*, integer*, ftnlen); | |||
| static complex a[4225] /* was [65][65] */; | |||
| static real g[65]; | |||
| static integer i__, j, n; | |||
| static logical fatal; | |||
| static complex x[65], y[65], z__[130]; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(real*, real*); | |||
| static logical trace; | |||
| static integer nidim; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static char snaps[32], trans[1]; | |||
| static integer isnum; | |||
| static logical ltest[17]; | |||
| @@ -438,11 +319,11 @@ static logical c_false = FALSE_; | |||
| static char snamet[12]; | |||
| static real thresh; | |||
| static logical rorder; | |||
| extern /* Subroutine */ int cc2chke_(); | |||
| extern /* Subroutine */ void cc2chke_(char*, ftnlen); | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| static complex alf[7]; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static integer inc[7], nkb; | |||
| static complex bet[7]; | |||
| static real eps, err; | |||
| @@ -983,22 +864,7 @@ L240: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int cchk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| complex *alf; | |||
| integer *nbet; | |||
| complex *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| real *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, complex* alf, integer* nbet, complex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1015,10 +881,10 @@ ftnlen sname_len; | |||
| static integer incx, incy; | |||
| static logical full, tran, null; | |||
| static integer i__, m, n; | |||
| extern /* Subroutine */ int cmake_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| static complex alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys; | |||
| @@ -1026,14 +892,15 @@ ftnlen sname_len; | |||
| static integer ia, ib, ic; | |||
| static logical banded; | |||
| static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns; | |||
| extern /* Subroutine */ int ccgbmv_(), ccgemv_(); | |||
| extern logical lceres_(); | |||
| extern /* Subroutine */ int ccgbmv_(integer*, char*, integer*, integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ void ccgemv_(integer*, char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| static char ctrans[14]; | |||
| static real errmax; | |||
| static complex transl; | |||
| static char transs[1]; | |||
| static integer laa, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static complex als, bls; | |||
| static real err; | |||
| static integer iku, kls, kus; | |||
| @@ -1448,22 +1315,7 @@ L140: | |||
| } /* cchk1_ */ | |||
| /* Subroutine */ int cchk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| complex *alf; | |||
| integer *nbet; | |||
| complex *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| real *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, complex* alf, integer* nbet, complex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1481,10 +1333,10 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, k, n; | |||
| extern /* Subroutine */ int cmake_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| static complex alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| @@ -1495,13 +1347,14 @@ ftnlen sname_len; | |||
| static integer nc, ik, in; | |||
| static logical packed; | |||
| static integer nk, ks, ix, iy, ns, lx, ly; | |||
| extern /* Subroutine */ int cchbmv_(), cchemv_(); | |||
| extern logical lceres_(); | |||
| extern /* Subroutine */ int cchpmv_(); | |||
| extern /* Subroutine */ void cchbmv_(integer*, char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ void cchemv_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, ftnlen); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cchpmv_(integer*, char*, integer*, complex*, complex*, complex*, integer*, complex*, complex*, integer*, ftnlen); | |||
| static real errmax; | |||
| static complex transl; | |||
| static integer laa, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static complex als, bls; | |||
| static real err; | |||
| @@ -1906,19 +1759,7 @@ L130: | |||
| } /* cchk2_ */ | |||
| /* Subroutine */ int cchk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, xt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *xt; | |||
| real *g; | |||
| complex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* xt, real* g, complex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1937,10 +1778,10 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1], cdiag[14]; | |||
| static integer i__, k, n; | |||
| extern /* Subroutine */ int cmake_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| static char diags[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| @@ -1950,17 +1791,19 @@ ftnlen sname_len; | |||
| static integer nc, ik, in; | |||
| static logical packed; | |||
| static integer nk, ks, ix, ns, lx; | |||
| extern logical lceres_(); | |||
| extern /* Subroutine */ int cctbmv_(), cctbsv_(); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cctbmv_(integer*, char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cctbsv_(integer*, char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char ctrans[14]; | |||
| extern /* Subroutine */ int cctpmv_(); | |||
| extern /* Subroutine */ void cctpmv_(integer*, char*, char*, char*, integer*, complex*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static real errmax; | |||
| extern /* Subroutine */ int cctrmv_(), cctpsv_(); | |||
| extern /* Subroutine */ void cctrmv_(integer*, char*, char*, char*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cctpsv_(integer*, char*, char*, char*, integer*, complex*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static complex transl; | |||
| extern /* Subroutine */ int cctrsv_(); | |||
| extern /* Subroutine */ void cctrsv_(integer*, char*, char*, char*, integer*, complex*, integer*, complex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| static integer laa, icd, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static integer ict, icu; | |||
| static real err; | |||
| @@ -2418,21 +2261,7 @@ L130: | |||
| } /* cchk3_ */ | |||
| /* Subroutine */ int cchk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| complex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| real *g; | |||
| complex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; | |||
| @@ -2444,21 +2273,21 @@ ftnlen sname_len; | |||
| static integer incx, incy; | |||
| static logical null; | |||
| static integer i__, j, m, n; | |||
| extern /* Subroutine */ int cmake_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| static complex alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys, ia, nc, nd, im, in; | |||
| extern /* Subroutine */ int ccgerc_(); | |||
| extern /* Subroutine */ void ccgerc_(integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*); | |||
| static integer ms, ix, iy, ns, lx, ly; | |||
| extern /* Subroutine */ int ccgeru_(); | |||
| extern logical lceres_(); | |||
| extern /* Subroutine */ void ccgeru_(integer*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| static real errmax; | |||
| static complex transl; | |||
| static integer laa, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static complex als; | |||
| static real err; | |||
| @@ -2786,21 +2615,7 @@ L150: | |||
| } /* cchk4_ */ | |||
| /* Subroutine */ int cchk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| complex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| real *g; | |||
| complex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2818,10 +2633,12 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, n; | |||
| extern /* Subroutine */ int cmake_(), ccher_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void ccher_(integer*, char*, integer*, real*, complex*, integer*, complex*, integer*, ftnlen); | |||
| static complex alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cchpr_(), cmvch_(); | |||
| extern /* Subroutine */ void cchpr_(integer*, char*, integer*, real*, complex*, integer*, complex*, ftnlen); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| @@ -2832,11 +2649,11 @@ ftnlen sname_len; | |||
| static logical packed; | |||
| static integer ix, ns, lx; | |||
| static real ralpha; | |||
| extern logical lceres_(); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| static real errmax; | |||
| static complex transl; | |||
| static integer laa, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static real err; | |||
| /* Tests CHER and CHPR. */ | |||
| @@ -3160,21 +2977,7 @@ L130: | |||
| } /* cchk5_ */ | |||
| /* Subroutine */ int cchk6_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| complex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| complex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| real *g; | |||
| complex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int cchk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, complex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, complex* a, complex* aa, complex* as, complex* x, complex* xx, complex* xs, complex* y, complex* yy, complex* ys, complex* yt, real* g, complex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -3192,25 +2995,26 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, n; | |||
| extern /* Subroutine */ int cmake_(); | |||
| extern /* Subroutine */ int cmake_(char*, char*, char*, integer*, integer*, complex*, integer*, complex*, integer*, integer*, integer*, logical*, complex*, ftnlen, ftnlen, ftnlen); | |||
| static complex alpha, w[2]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int cmvch_(); | |||
| extern /* Subroutine */ int cmvch_(char*, integer*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, complex*, integer*, complex*, real*, complex*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ int ccher2_(), cchpr2_(); | |||
| extern /* Subroutine */ void ccher2_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, integer*, ftnlen); | |||
| extern /* Subroutine */ void cchpr2_(integer*, char*, integer*, complex*, complex*, integer*, complex*, integer*, complex*, ftnlen); | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| static logical packed; | |||
| static integer ix, iy, ns, lx, ly; | |||
| extern logical lceres_(); | |||
| extern logical lceres_(char*, char*, integer*, integer*, complex*, complex*, integer*, ftnlen, ftnlen); | |||
| static real errmax; | |||
| static complex transl; | |||
| static integer laa, lda; | |||
| extern logical lce_(); | |||
| extern logical lce_(complex*, complex*, integer*); | |||
| static complex als; | |||
| static real err; | |||
| @@ -3597,24 +3401,7 @@ L170: | |||
| } /* cchk6_ */ | |||
| /* Subroutine */ int cmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y, | |||
| incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len) | |||
| char *trans; | |||
| integer *m, *n; | |||
| complex *alpha, *a; | |||
| integer *nmax; | |||
| complex *x; | |||
| integer *incx; | |||
| complex *beta, *y; | |||
| integer *incy; | |||
| complex *yt; | |||
| real *g; | |||
| complex *yy; | |||
| real *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen trans_len; | |||
| /* Subroutine */ int cmvch_(char* trans, integer* m, integer* n, complex* alpha, complex* a, integer* nmax, complex* x, integer* incx, complex* beta, complex* y, integer* incy, complex* yt, real* g, complex* yy, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len) | |||
| { | |||
| /* System generated locals */ | |||
| @@ -3812,9 +3599,7 @@ L80: | |||
| } /* cmvch_ */ | |||
| logical lce_(ri, rj, lr) | |||
| complex *ri, *rj; | |||
| integer *lr; | |||
| logical lce_(complex* ri, complex* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1, i__2, i__3; | |||
| @@ -3861,13 +3646,7 @@ L30: | |||
| } /* lce_ */ | |||
| logical lceres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| complex *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lceres_(char* type__, char* uplo, integer* m, integer* n, complex* aa, complex* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; | |||
| @@ -3960,9 +3739,7 @@ L80: | |||
| } /* lceres_ */ | |||
| /* Complex */ VOID cbeg_( ret_val, reset) | |||
| complex * ret_val; | |||
| logical *reset; | |||
| /* Complex */ VOID cbeg_(complex* ret_val, logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| real r__1, r__2; | |||
| @@ -4023,8 +3800,7 @@ L10: | |||
| } /* cbeg_ */ | |||
| doublereal sdiff_(x, y) | |||
| real *x, *y; | |||
| doublereal sdiff_(real* x, real* y) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -4044,19 +3820,7 @@ real *x, *y; | |||
| } /* sdiff_ */ | |||
| /* Subroutine */ int cmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl, | |||
| ku, reset, transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| complex *a; | |||
| integer *nmax; | |||
| complex *aa; | |||
| integer *lda, *kl, *ku; | |||
| logical *reset; | |||
| complex *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int cmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, complex* a, integer* nmax, complex* aa, integer* lda, integer* kl, integer* ku, logical* reset, complex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4; | |||
| @@ -4064,7 +3828,7 @@ ftnlen diag_len; | |||
| complex q__1, q__2; | |||
| /* Local variables */ | |||
| extern /* Complex */ VOID cbeg_(); | |||
| extern /* Complex */ VOID cbeg_(complex*, logical*); | |||
| static integer ibeg, iend, ioff; | |||
| static logical unit; | |||
| static integer i__, j; | |||
| @@ -242,130 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -21,19 +21,6 @@ typedef float real; | |||
| typedef double doublereal; | |||
| typedef struct { real r, i; } complex; | |||
| typedef struct { doublereal r, i; } doublecomplex; | |||
| #ifdef _MSC_VER | |||
| static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} | |||
| static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} | |||
| static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} | |||
| static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} | |||
| #else | |||
| static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} | |||
| static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} | |||
| #endif | |||
| #define pCf(z) (*_pCf(z)) | |||
| #define pCd(z) (*_pCd(z)) | |||
| typedef int logical; | |||
| typedef short int shortlogical; | |||
| typedef char logical1; | |||
| @@ -242,124 +229,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* Common Block Declarations */ | |||
| @@ -375,16 +244,16 @@ struct { | |||
| static integer c__1 = 1; | |||
| static doublereal c_b34 = 1.; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| static doublereal sfac = 9.765625e-4; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ int check0_(), check1_(), check2_(), check3_(); | |||
| extern /* Subroutine */ int check0_(doublereal*), check1_(doublereal*), check2_(doublereal*), check3_(doublereal*); | |||
| static integer ic; | |||
| extern /* Subroutine */ int header_(); | |||
| extern /* Subroutine */ int header_(void); | |||
| /* Test program for the DOUBLE PRECISION Level 1 CBLAS. */ | |||
| /* Based upon the original CBLAS test routine together with: */ | |||
| @@ -431,7 +300,7 @@ static doublereal c_b34 = 1.; | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int header_() | |||
| /* Subroutine */ int header_(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -450,8 +319,7 @@ static doublereal c_b34 = 1.; | |||
| } /* header_ */ | |||
| /* Subroutine */ int check0_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check0_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -464,7 +332,7 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static integer k; | |||
| extern /* Subroutine */ int drotgtest_(), stest1_(); | |||
| extern /* Subroutine */ int drotgtest_(doublereal*,doublereal*,doublereal*,doublereal*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*); | |||
| static doublereal sa, sb, sc, ss; | |||
| /* .. Parameters .. */ | |||
| @@ -509,8 +377,7 @@ L40: | |||
| return 0; | |||
| } /* check0_ */ | |||
| /* Subroutine */ int check1_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check1_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -535,14 +402,14 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern doublereal dnrm2test_(); | |||
| extern doublereal dnrm2test_(integer*, doublereal*, integer*); | |||
| static doublereal stemp[1], strue[8]; | |||
| extern /* Subroutine */ int stest_(), dscaltest_(); | |||
| extern doublereal dasumtest_(); | |||
| extern /* Subroutine */ int itest1_(), stest1_(); | |||
| extern /* Subroutine */ int stest_(integer*,doublereal*,doublereal*,doublereal*,doublereal*), dscaltest_(integer*,doublereal*,doublereal*,integer*); | |||
| extern doublereal dasumtest_(integer*,doublereal*,integer*); | |||
| extern /* Subroutine */ int itest1_(integer*,integer*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*); | |||
| static doublereal sx[8]; | |||
| static integer np1; | |||
| extern integer idamaxtest_(); | |||
| extern integer idamaxtest_(integer*,doublereal*,integer*); | |||
| static integer len; | |||
| /* .. Parameters .. */ | |||
| @@ -603,8 +470,7 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* check1_ */ | |||
| /* Subroutine */ int check2_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check2_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -649,10 +515,10 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static integer lenx, leny; | |||
| extern doublereal ddottest_(); | |||
| extern doublereal ddottest_(integer*,doublereal*,integer*,doublereal*,integer*); | |||
| static integer i__, j, ksize; | |||
| extern /* Subroutine */ int stest_(), dcopytest_(), dswaptest_(), | |||
| daxpytest_(), stest1_(); | |||
| extern /* Subroutine */ int stest_(integer*,doublereal*,doublereal*,doublereal*,doublereal*), dcopytest_(integer*,doublereal*,integer*,doublereal*,integer*), dswaptest_(integer*,doublereal*,integer*,doublereal*,integer*), | |||
| daxpytest_(integer*,doublereal*,doublereal*,integer*,doublereal*,integer*), stest1_(doublereal*,doublereal*,doublereal*,doublereal*); | |||
| static integer ki, kn, mx, my; | |||
| static doublereal sx[7], sy[7], stx[7], sty[7]; | |||
| @@ -733,8 +599,7 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* check2_ */ | |||
| /* Subroutine */ int check3_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check3_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -753,9 +618,9 @@ doublereal *sfac; | |||
| ; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ int drottest_(); | |||
| extern /* Subroutine */ int drottest_(integer*,doublereal*,integer*,doublereal*,integer*,doublereal*,doublereal*); | |||
| static integer i__, k, ksize; | |||
| extern /* Subroutine */int stest_(), drotmtest_(); | |||
| extern /* Subroutine */int stest_(integer*,doublereal*,doublereal*,doublereal*,doublereal*), drotmtest_(integer*,doublereal*,integer*,doublereal*,integer*,doublereal*); | |||
| static integer ki, kn; | |||
| static doublereal dparam[5], sx[10], sy[10], stx[10], sty[10]; | |||
| @@ -826,9 +691,7 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* check3_ */ | |||
| /* Subroutine */ int stest_(len, scomp, strue, ssize, sfac) | |||
| integer *len; | |||
| doublereal *scomp, *strue, *ssize, *sfac; | |||
| /* Subroutine */ int stest_(integer* len, doublereal* scomp, doublereal* strue, doublereal* ssize, doublereal* sfac) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -836,7 +699,7 @@ doublereal *scomp, *strue, *ssize, *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(doublereal*,doublereal*); | |||
| static doublereal sd; | |||
| /* ********************************* STEST ************************** */ | |||
| @@ -892,11 +755,10 @@ L40: | |||
| } /* stest_ */ | |||
| /* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac) | |||
| doublereal *scomp1, *strue1, *ssize, *sfac; | |||
| /* Subroutine */ int stest1_(doublereal* scomp1, doublereal* strue1, doublereal* ssize, doublereal* sfac) | |||
| { | |||
| static doublereal scomp[1], strue[1]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*, doublereal*, doublereal*, doublereal*, doublereal*); | |||
| /* ************************* STEST1 ***************************** */ | |||
| @@ -923,8 +785,7 @@ doublereal *scomp1, *strue1, *ssize, *sfac; | |||
| return 0; | |||
| } /* stest1_ */ | |||
| doublereal sdiff_(sa, sb) | |||
| doublereal *sa, *sb; | |||
| doublereal sdiff_(doublereal* sa, doublereal* sb) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -938,8 +799,7 @@ doublereal *sa, *sb; | |||
| return ret_val; | |||
| } /* sdiff_ */ | |||
| /* Subroutine */ int itest1_(icomp, itrue) | |||
| integer *icomp, *itrue; | |||
| /* Subroutine */ int itest1_(integer* icomp, integer* itrue) | |||
| { | |||
| /* Local variables */ | |||
| static integer id; | |||
| @@ -1188,4 +1048,4 @@ doublereal *dparam; | |||
| return 0; | |||
| } /* drotm_ */ | |||
| #endif | |||
| #endif | |||
| @@ -242,129 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -395,7 +272,7 @@ static integer c_n1 = -1; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -413,17 +290,21 @@ static logical c_false = FALSE_; | |||
| static logical same; | |||
| static integer ninc, nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int dchk1_(), dchk2_(), dchk3_(), dchk4_(), | |||
| dchk5_(), dchk6_(); | |||
| extern /* Subroutine */ int dchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk6_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| static doublereal a[4225] /* was [65][65] */, g[65]; | |||
| static integer i__, j; | |||
| extern doublereal ddiff_(); | |||
| extern doublereal ddiff_(doublereal*, doublereal*); | |||
| static integer n; | |||
| static logical fatal; | |||
| static doublereal x[65], y[65], z__[130]; | |||
| static logical trace; | |||
| static integer nidim; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static char snaps[32], trans[1]; | |||
| static integer isnum; | |||
| static logical ltest[16]; | |||
| @@ -437,11 +318,11 @@ static logical c_false = FALSE_; | |||
| static char snamet[12]; | |||
| static doublereal thresh; | |||
| static logical rorder; | |||
| extern /* Subroutine */ int cd2chke_(); | |||
| extern /* Subroutine */ void cd2chke_(char*, ftnlen); | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| static doublereal alf[7]; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static integer inc[7], nkb; | |||
| static doublereal bet[7],eps,err; | |||
| char tmpchar; | |||
| @@ -977,21 +858,7 @@ L240: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int dchk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1007,10 +874,10 @@ ftnlen sname_len; | |||
| static integer incx, incy; | |||
| static logical full, tran, null; | |||
| static integer i__, m, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys; | |||
| @@ -1018,13 +885,14 @@ ftnlen sname_len; | |||
| static integer ia, ib, ic; | |||
| static logical banded; | |||
| static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns; | |||
| extern /* Subroutine */ int cdgbmv_(), cdgemv_(); | |||
| extern logical lderes_(); | |||
| extern /* Subroutine */ void cdgbmv_(integer*, char*, integer*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ void cdgemv_(integer*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static char ctrans[14]; | |||
| static doublereal errmax, transl; | |||
| static char transs[1]; | |||
| static integer laa, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, bls, err; | |||
| static integer iku, kls, kus; | |||
| @@ -1429,21 +1297,7 @@ L140: | |||
| } /* dchk1_ */ | |||
| /* Subroutine */ int dchk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1460,10 +1314,10 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, k, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| @@ -1474,12 +1328,13 @@ ftnlen sname_len; | |||
| static integer nc, ik, in; | |||
| static logical packed; | |||
| static integer nk, ks, ix, iy, ns, lx, ly; | |||
| extern logical lderes_(); | |||
| extern /* Subroutine */ int cdsbmv_(), cdspmv_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdsbmv_(integer*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ void cdspmv_(integer*, char*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen); | |||
| static doublereal errmax, transl; | |||
| extern /* Subroutine */ int cdsymv_(); | |||
| extern /* Subroutine */ void cdsymv_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen); | |||
| static integer laa, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, bls, err; | |||
| @@ -1882,17 +1737,7 @@ L130: | |||
| } /* dchk2_ */ | |||
| /* Subroutine */ int dchk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, xt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *xt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* xt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1911,10 +1756,10 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1], cdiag[14]; | |||
| static integer i__, k, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static char diags[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| @@ -1924,16 +1769,19 @@ ftnlen sname_len; | |||
| static integer nc, ik, in; | |||
| static logical packed; | |||
| static integer nk, ks, ix, ns, lx; | |||
| extern logical lderes_(); | |||
| extern /* Subroutine */ int cdtbmv_(), cdtbsv_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdtbmv_(integer*, char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdtbsv_(integer*, char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char ctrans[14]; | |||
| static doublereal errmax; | |||
| extern /* Subroutine */ int cdtpmv_(), cdtrmv_(); | |||
| extern /* Subroutine */ void cdtpmv_(integer*, char*, char*, char*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdtrmv_(integer*, char*, char*, char*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal transl; | |||
| extern /* Subroutine */ int cdtpsv_(), cdtrsv_(); | |||
| extern /* Subroutine */ void cdtpsv_(integer*, char*, char*, char*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdtrsv_(integer*, char*, char*, char*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| static integer laa, icd, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static integer ict, icu; | |||
| static doublereal err; | |||
| @@ -2388,19 +2236,7 @@ L130: | |||
| } /* dchk3_ */ | |||
| /* Subroutine */ int dchk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; | |||
| @@ -2411,17 +2247,18 @@ ftnlen sname_len; | |||
| static integer incx, incy; | |||
| static logical null; | |||
| static integer i__, j, m, n; | |||
| extern /* Subroutine */ int dmake_(), cdger_(); | |||
| extern /* Subroutine */ void cdger_(integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, integer*); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys, ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax, transl; | |||
| static integer laa, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, err; | |||
| @@ -2727,19 +2564,7 @@ L150: | |||
| } /* dchk4_ */ | |||
| /* Subroutine */ int dchk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2757,25 +2582,25 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int cdspr_(); | |||
| extern /* Subroutine */ void cdspr_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs; | |||
| extern /* Subroutine */ int cdsyr_(); | |||
| extern /* Subroutine */ void cdsyr_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen); | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| static logical packed; | |||
| static integer ix, ns, lx; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax, transl; | |||
| static integer laa, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, err; | |||
| @@ -3096,19 +2921,7 @@ L130: | |||
| } /* dchk5_ */ | |||
| /* Subroutine */ int dchk6_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublereal *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk6_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* x, doublereal* xx, doublereal* xs, doublereal* y, doublereal* yy, doublereal* ys, doublereal* yt, doublereal* g, doublereal* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -3125,24 +2938,25 @@ ftnlen sname_len; | |||
| static logical full, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char* , char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, integer*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha, w[2]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int dmvch_(); | |||
| extern /* Subroutine */ int dmvch_(char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ int cdspr2_(), cdsyr2_(); | |||
| extern /* Subroutine */ void cdspr2_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, ftnlen); | |||
| extern /* Subroutine */ void cdsyr2_(integer*, char*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen); | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| static logical packed; | |||
| static integer ix, iy, ns, lx, ly; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax, transl; | |||
| static integer laa, lda; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, err; | |||
| /* Tests DSYR2 and DSPR2. */ | |||
| @@ -3508,25 +3322,13 @@ L170: | |||
| } /* dchk6_ */ | |||
| /* Subroutine */ int dmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl, | |||
| ku, reset, transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| doublereal *a; | |||
| integer *nmax; | |||
| doublereal *aa; | |||
| integer *lda, *kl, *ku; | |||
| logical *reset; | |||
| doublereal *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int dmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublereal* a, integer* nmax, doublereal* aa, integer* lda, integer* kl, integer* ku, logical* reset, doublereal* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4; | |||
| /* Local variables */ | |||
| extern doublereal dbeg_(); | |||
| extern doublereal dbeg_(logical* ); | |||
| static integer ibeg, iend, ioff; | |||
| static logical unit; | |||
| static integer i__, j; | |||
| @@ -3752,28 +3554,14 @@ ftnlen diag_len; | |||
| } /* dmake_ */ | |||
| /* Subroutine */ int dmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y, | |||
| incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len) | |||
| char *trans; | |||
| integer *m, *n; | |||
| doublereal *alpha, *a; | |||
| integer *nmax; | |||
| doublereal *x; | |||
| integer *incx; | |||
| doublereal *beta, *y; | |||
| integer *incy; | |||
| doublereal *yt, *g, *yy, *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen trans_len; | |||
| /* Subroutine */ int dmvch_(char* trans, integer* m, integer* n, doublereal* alpha, doublereal* a, integer* nmax, doublereal* x, integer* incx, doublereal* beta, doublereal* y, integer* incy, doublereal* yt, doublereal* g, doublereal* yy, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2; | |||
| doublereal d__1; | |||
| /* Builtin functions */ | |||
| double sqrt(); | |||
| double sqrt(double); | |||
| /* Local variables */ | |||
| static doublereal erri; | |||
| @@ -3902,9 +3690,7 @@ L70: | |||
| } /* dmvch_ */ | |||
| logical lde_(ri, rj, lr) | |||
| doublereal *ri, *rj; | |||
| integer *lr; | |||
| logical lde_(doublereal* ri, doublereal* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -3949,13 +3735,7 @@ L30: | |||
| } /* lde_ */ | |||
| logical lderes_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| doublereal *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lderes_(char* type__, char* uplo, integer* m, integer* n, doublereal* aa, doublereal* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2; | |||
| @@ -4042,8 +3822,7 @@ L80: | |||
| } /* lderes_ */ | |||
| doublereal dbeg_(reset) | |||
| logical *reset; | |||
| doublereal dbeg_(logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -4094,8 +3873,7 @@ L10: | |||
| } /* dbeg_ */ | |||
| doublereal ddiff_(x, y) | |||
| doublereal *x, *y; | |||
| doublereal ddiff_(doublereal* x, doublereal* y) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -242,129 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -393,7 +270,7 @@ static logical c_true = TRUE_; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program MAIN__() */ int main() | |||
| /* Main program MAIN__() */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -403,25 +280,24 @@ static logical c_false = FALSE_; | |||
| integer i__1, i__2, i__3; | |||
| doublereal d__1; | |||
| /* Builtin functions */ | |||
| integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(), | |||
| e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe(); | |||
| integer f_clos(); | |||
| /* Local variables */ | |||
| static integer nalf, idim[9]; | |||
| static logical same; | |||
| static integer nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int dchk1_(), dchk2_(), dchk3_(), dchk4_(), | |||
| dchk5_(); | |||
| extern /* Subroutine */ int dchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int dchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, doublereal*, integer*, ftnlen); | |||
| /* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* ab, doublereal* aa, doublereal* as, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, doublereal* w, integer* iorder, ftnlen sname_len); | |||
| static doublereal c__[4225] /* was [65][65] */, g[65]; | |||
| static integer i__, j; | |||
| extern doublereal ddiff_(); | |||
| extern doublereal ddiff_(doublereal*, doublereal*); | |||
| static integer n; | |||
| static logical fatal; | |||
| static doublereal w[130]; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical trace; | |||
| static integer nidim; | |||
| static char snaps[32]; | |||
| @@ -433,11 +309,11 @@ static logical c_false = FALSE_; | |||
| static char snamet[12], transa[1], transb[1]; | |||
| static doublereal thresh; | |||
| static logical rorder; | |||
| extern /* Subroutine */ int cd3chke_(); | |||
| extern /* Subroutine */ void cd3chke_(char*, ftnlen); | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| static doublereal alf[7]; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal bet[7], eps, err; | |||
| char tmpchar; | |||
| @@ -907,21 +783,7 @@ L230: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int dchk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *nmax; | |||
| doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -931,29 +793,27 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5, i__6; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static doublereal beta; | |||
| static integer ldas, ldbs, ldcs; | |||
| static logical same, null; | |||
| static integer i__, k, m, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical isame[13], trana, tranb; | |||
| static integer nargs; | |||
| static logical reset; | |||
| extern /* Subroutine */ void dprcn1_(); | |||
| extern /* Subroutine */ void dprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, ib, ma, mb, na, nb, nc, ik, im, in; | |||
| extern /* Subroutine */ int cdgemm_(); | |||
| extern /* Subroutine */ void cdgemm_(integer*, char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static integer ks, ms, ns; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static char tranas[1], tranbs[1], transa[1], transb[1]; | |||
| static doublereal errmax; | |||
| static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als, bls, err; | |||
| /* Tests DGEMM. */ | |||
| @@ -1283,23 +1143,8 @@ L130: | |||
| } /* dchk1_ */ | |||
| /* Subroutine */ void dprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *transa, *transb; | |||
| integer *m, *n, *k; | |||
| doublereal *alpha; | |||
| integer *lda, *ldb; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ void dprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char crc[14], cta[14], ctb[14]; | |||
| @@ -1328,21 +1173,7 @@ ftnlen transb_len; | |||
| } /* dprcn1_ */ | |||
| /* Subroutine */ int dchk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *nmax; | |||
| doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1353,8 +1184,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static doublereal beta; | |||
| @@ -1364,21 +1193,21 @@ ftnlen sname_len; | |||
| static logical left, null; | |||
| static char uplo[1]; | |||
| static integer i__, m, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical isame[13]; | |||
| static char sides[1]; | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void dprcn2_(); | |||
| extern /* Subroutine */ void dprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, ib, na, nc, im, in, ms, ns; | |||
| extern logical lderes_(); | |||
| extern /* Subroutine */ int cdsymm_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdsymm_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| static integer laa, lbb, lda, lcc, ldb, ldc; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static integer ics; | |||
| static doublereal als, bls; | |||
| static integer icu; | |||
| @@ -1692,23 +1521,8 @@ L120: | |||
| } /* dchk2_ */ | |||
| /* Subroutine */ void dprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha, | |||
| lda, ldb, beta, ldc, sname_len, side_len, uplo_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo; | |||
| integer *m, *n; | |||
| doublereal *alpha; | |||
| integer *lda, *ldb; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| /* Subroutine */ void dprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char cs[14], cu[14], crc[14]; | |||
| @@ -1733,19 +1547,7 @@ ftnlen uplo_len; | |||
| } /* dprcn2_ */ | |||
| /* Subroutine */ int dchk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__, | |||
| iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *nmax; | |||
| doublereal *a, *aa, *as, *b, *bb, *bs, *ct, *g, *c__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* ct, doublereal* g, doublereal* c__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1766,24 +1568,24 @@ ftnlen sname_len; | |||
| static logical left, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, m, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| static char diags[1]; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical isame[13]; | |||
| static char sides[1]; | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void dprcn3_(); | |||
| extern /* Subroutine */ void dprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, na, nc, im, in, ms, ns; | |||
| extern logical lderes_(); | |||
| extern /* Subroutine */ int cdtrmm_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cdtrmm_(integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static char tranas[1], transa[1]; | |||
| extern /* Subroutine */ int cdtrsm_(); | |||
| extern /* Subroutine */ void cdtrsm_(integer*, char*, char*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| static integer laa, icd, lbb, lda, ldb; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static integer ics; | |||
| static doublereal als; | |||
| static integer ict, icu; | |||
| @@ -2165,24 +1967,8 @@ L160: | |||
| } /* dchk3_ */ | |||
| /* Subroutine */ void dprcn3_(nout, nc, sname, iorder, side, uplo, transa, | |||
| diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len, | |||
| transa_len, diag_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo, *transa, *diag; | |||
| integer *m, *n; | |||
| doublereal *alpha; | |||
| integer *lda, *ldb; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ void dprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, doublereal* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cd[14], cs[14], cu[14], crc[14]; | |||
| @@ -2219,21 +2005,7 @@ ftnlen diag_len; | |||
| } /* dprcn3_ */ | |||
| /* Subroutine */ int dchk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *nmax; | |||
| doublereal *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* a, doublereal* aa, doublereal* as, doublereal* b, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2244,8 +2016,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static doublereal beta; | |||
| @@ -2255,23 +2025,23 @@ ftnlen sname_len; | |||
| static logical tran, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, k, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical isame[13]; | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char trans[1]; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void dprcn4_(); | |||
| extern /* Subroutine */ void dprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| extern /* Subroutine */ int cdsyrk_(); | |||
| extern /* Subroutine */ void cdsyrk_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| static integer laa, lda, lcc, ldc; | |||
| extern logical lde_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| static doublereal als; | |||
| static integer ict, icu; | |||
| static doublereal err; | |||
| @@ -2586,23 +2356,8 @@ L130: | |||
| } /* dchk4_ */ | |||
| /* Subroutine */ void dprcn4_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublereal *alpha; | |||
| integer *lda; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ void dprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -2629,21 +2384,7 @@ ftnlen transa_len; | |||
| } /* dprcn4_ */ | |||
| /* Subroutine */ int dchk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs, | |||
| c__, cc, cs, ct, g, w, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublereal *alf; | |||
| integer *nbet; | |||
| doublereal *bet; | |||
| integer *nmax; | |||
| doublereal *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct, *g, *w; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int dchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublereal* alf, integer* nbet, doublereal* bet, integer* nmax, doublereal* ab, doublereal* aa, doublereal* as, doublereal* bb, doublereal* bs, doublereal* c__, doublereal* cc, doublereal* cs, doublereal* ct, doublereal* g, doublereal* w, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2653,8 +2394,6 @@ ftnlen sname_len; | |||
| /* System generated locals */ | |||
| integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static integer jjab; | |||
| @@ -2665,23 +2404,23 @@ ftnlen sname_len; | |||
| static logical tran, null; | |||
| static char uplo[1]; | |||
| static integer i__, j, k, n; | |||
| extern /* Subroutine */ int dmake_(); | |||
| extern /* Subroutine */ int dmake_(char*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, logical*, doublereal*, ftnlen, ftnlen, ftnlen); | |||
| static doublereal alpha; | |||
| extern /* Subroutine */ int dmmch_(); | |||
| extern /* Subroutine */ int dmmch_(char*, char*, integer*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, doublereal*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical isame[13]; | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char trans[1]; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void dprcn5_(); | |||
| extern /* Subroutine */ void dprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; | |||
| extern logical lderes_(); | |||
| extern logical lderes_(char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| static char transs[1]; | |||
| static integer laa, lbb, lda, lcc, ldb, ldc; | |||
| extern logical lde_(); | |||
| extern /* Subroutine */ int cdsyr2k_(); | |||
| extern logical lde_(doublereal*, doublereal*, integer*); | |||
| extern /* Subroutine */ void cdsyr2k_(integer*, char*, char*, integer*, integer*, doublereal*, doublereal*, integer*, doublereal*, integer*, doublereal*, doublereal*, integer*, ftnlen, ftnlen); | |||
| static doublereal als; | |||
| static integer ict, icu; | |||
| static doublereal err; | |||
| @@ -3048,23 +2787,8 @@ L160: | |||
| } /* dchk5_ */ | |||
| /* Subroutine */ void dprcn5_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublereal *alpha; | |||
| integer *lda, *ldb; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ void dprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -3091,25 +2815,13 @@ ftnlen transa_len; | |||
| } /* dprcn5_ */ | |||
| /* Subroutine */ int dmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset, | |||
| transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| doublereal *a; | |||
| integer *nmax; | |||
| doublereal *aa; | |||
| integer *lda; | |||
| logical *reset; | |||
| doublereal *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int dmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublereal* a, integer* nmax, doublereal* aa, integer* lda, logical* reset, doublereal* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2; | |||
| /* Local variables */ | |||
| extern doublereal dbeg_(); | |||
| extern doublereal dbeg_(logical*); | |||
| static integer ibeg, iend; | |||
| static logical unit; | |||
| static integer i__, j; | |||
| @@ -3241,25 +2953,7 @@ ftnlen diag_len; | |||
| } /* dmake_ */ | |||
| /* Subroutine */ int dmmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb, | |||
| beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv, | |||
| transa_len, transb_len) | |||
| char *transa, *transb; | |||
| integer *m, *n, *kk; | |||
| doublereal *alpha, *a; | |||
| integer *lda; | |||
| doublereal *b; | |||
| integer *ldb; | |||
| doublereal *beta, *c__; | |||
| integer *ldc; | |||
| doublereal *ct, *g, *cc; | |||
| integer *ldcc; | |||
| doublereal *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ int dmmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, doublereal* alpha, doublereal* a, integer* lda, doublereal* b, integer* ldb, doublereal* beta, doublereal* c__, integer* ldc, doublereal* ct, doublereal* g, doublereal* cc, integer* ldcc, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1, | |||
| @@ -3267,8 +2961,7 @@ ftnlen transb_len; | |||
| doublereal d__1, d__2; | |||
| /* Builtin functions */ | |||
| double sqrt(); | |||
| integer s_wsfe(), e_wsfe(), do_fio(); | |||
| double sqrt(double); | |||
| /* Local variables */ | |||
| static doublereal erri; | |||
| @@ -3432,9 +3125,7 @@ L150: | |||
| } /* dmmch_ */ | |||
| logical lde_(ri, rj, lr) | |||
| doublereal *ri, *rj; | |||
| integer *lr; | |||
| logical lde_(doublereal* ri, doublereal* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -3481,13 +3172,7 @@ L30: | |||
| } /* lde_ */ | |||
| logical lderes_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| doublereal *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lderes_(char* type__, char* uplo, integer* m, integer* n, doublereal* aa, doublereal* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2; | |||
| @@ -3576,8 +3261,7 @@ L80: | |||
| } /* lderes_ */ | |||
| doublereal dbeg_(reset) | |||
| logical *reset; | |||
| doublereal dbeg_(logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -3629,8 +3313,7 @@ L10: | |||
| } /* dbeg_ */ | |||
| doublereal ddiff_(x, y) | |||
| doublereal *x, *y; | |||
| doublereal ddiff_(doublereal* x, doublereal* y) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -21,19 +21,6 @@ typedef float real; | |||
| typedef double doublereal; | |||
| typedef struct { real r, i; } complex; | |||
| typedef struct { doublereal r, i; } doublecomplex; | |||
| #ifdef _MSC_VER | |||
| static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} | |||
| static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} | |||
| static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} | |||
| static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} | |||
| #else | |||
| static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} | |||
| static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} | |||
| #endif | |||
| #define pCf(z) (*_pCf(z)) | |||
| #define pCd(z) (*_pCd(z)) | |||
| typedef int logical; | |||
| typedef short int shortlogical; | |||
| typedef char logical1; | |||
| @@ -242,250 +229,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| #if 0 | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| #endif | |||
| /* Common Block Declarations */ | |||
| @@ -502,16 +245,16 @@ struct { | |||
| static integer c__1 = 1; | |||
| static real c_b34 = (float)1.; | |||
| /* Main program */ int main () | |||
| /* Main program */ int main (void) | |||
| { | |||
| /* Initialized data */ | |||
| static real sfac = (float)9.765625e-4; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ int check0_(), check1_(), check2_(), check3_(); | |||
| extern /* Subroutine */ int check0_(real*), check1_(real*), check2_(real*), check3_(real*); | |||
| static integer ic; | |||
| extern /* Subroutine */ int header_(); | |||
| extern /* Subroutine */ int header_(void); | |||
| /* Test program for the REAL Level 1 CBLAS. */ | |||
| /* Based upon the original CBLAS test routine together with: */ | |||
| @@ -557,7 +300,7 @@ static real c_b34 = (float)1.; | |||
| exit(0); | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int header_() | |||
| /* Subroutine */ int header_(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -580,8 +323,7 @@ static real c_b34 = (float)1.; | |||
| } /* header_ */ | |||
| /* Subroutine */ int check0_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check0_(real *sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -600,7 +342,7 @@ real *sfac; | |||
| /* Local variables */ | |||
| static integer k; | |||
| extern /* Subroutine */ int srotgtest_(), stest1_(); | |||
| extern /* Subroutine */ int srotgtest_(real*,real*,real*,real*), stest1_(real*,real*,real*,real*); | |||
| static real sa, sb, sc, ss; | |||
| /* .. Parameters .. */ | |||
| @@ -645,8 +387,7 @@ L40: | |||
| return 0; | |||
| } /* check0_ */ | |||
| /* Subroutine */ int check1_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check1_(real* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -692,14 +433,14 @@ real *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern real snrm2test_(); | |||
| extern real snrm2test_(integer*,real*,integer*); | |||
| static real stemp[1], strue[8]; | |||
| extern /* Subroutine */ int stest_(), sscaltest_(); | |||
| extern real sasumtest_(); | |||
| extern /* Subroutine */ int itest1_(), stest1_(); | |||
| extern /* Subroutine */ int stest_(integer*, real*,real*,real*,real*), sscaltest_(integer*,real*,real*,integer*); | |||
| extern real sasumtest_(integer*,real*,integer*); | |||
| extern /* Subroutine */ int itest1_(integer*,integer*), stest1_(real*,real*,real*,real*); | |||
| static real sx[8]; | |||
| static integer np1; | |||
| extern integer isamaxtest_(); | |||
| extern integer isamaxtest_(integer*,real*,integer*); | |||
| static integer len; | |||
| @@ -761,8 +502,7 @@ real *sfac; | |||
| return 0; | |||
| } /* check1_ */ | |||
| /* Subroutine */ int check2_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check2_(real* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -850,12 +590,12 @@ real *sfac; | |||
| /* Local variables */ | |||
| static integer lenx, leny; | |||
| extern real sdottest_(); | |||
| extern real sdottest_(integer*,real*,integer*,real*,integer*); | |||
| static integer i__, j, ksize; | |||
| extern /* Subroutine */ int stest_(), scopytest_(), sswaptest_(), | |||
| saxpytest_(); | |||
| extern /* Subroutine */ int stest_(integer*,real*,real*,real*,real*), scopytest_(integer*,real*,integer*,real*,integer*), sswaptest_(integer*,real*,integer*,real*,integer*), | |||
| saxpytest_(integer*,real*,real*,integer*,real*,integer*); | |||
| static integer ki; | |||
| extern /* Subroutine */ int stest1_(); | |||
| extern /* Subroutine */ int stest1_(real*,real*,real*,real*); | |||
| static integer kn, mx, my; | |||
| static real sx[7], sy[7], stx[7], sty[7]; | |||
| @@ -936,8 +676,7 @@ real *sfac; | |||
| return 0; | |||
| } /* check2_ */ | |||
| /* Subroutine */ int check3_(sfac) | |||
| real *sfac; | |||
| /* Subroutine */ int check3_(real* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -969,9 +708,9 @@ real *sfac; | |||
| 1.17 }; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ void srottest_(); | |||
| extern /* Subroutine */ void srottest_(integer*,real*,integer*,real*,integer*,real*,real*); | |||
| static integer i__, k, ksize; | |||
| extern /* Subroutine */ int stest_(), srotmtest_(); | |||
| extern /* Subroutine */ int stest_(integer*,real*,real*,real*,real*), srotmtest_(integer*,real*,integer*,real*,integer*,real*); | |||
| static integer ki, kn; | |||
| static real sx[19], sy[19], sparam[5], stx[19], sty[19]; | |||
| @@ -1042,16 +781,14 @@ real *sfac; | |||
| return 0; | |||
| } /* check3_ */ | |||
| /* Subroutine */ int stest_(len, scomp, strue, ssize, sfac) | |||
| integer *len; | |||
| real *scomp, *strue, *ssize, *sfac; | |||
| /* Subroutine */ int stest_(integer* len, real* scomp, real* strue, real* ssize, real* sfac) | |||
| { | |||
| integer i__1; | |||
| real r__1, r__2, r__3, r__4, r__5; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(real*,real*); | |||
| static real sd; | |||
| /* ********************************* STEST ************************** */ | |||
| @@ -1107,11 +844,10 @@ L40: | |||
| } /* stest_ */ | |||
| /* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac) | |||
| real *scomp1, *strue1, *ssize, *sfac; | |||
| /* Subroutine */ int stest1_(real* scomp1, real* strue1, real* ssize, real* sfac) | |||
| { | |||
| static real scomp[1], strue[1]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*,real*,real*,real*,real*); | |||
| /* ************************* STEST1 ***************************** */ | |||
| @@ -1138,8 +874,7 @@ real *scomp1, *strue1, *ssize, *sfac; | |||
| return 0; | |||
| } /* stest1_ */ | |||
| doublereal sdiff_(sa, sb) | |||
| real *sa, *sb; | |||
| doublereal sdiff_(real* sa, real* sb) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -1153,8 +888,7 @@ real *sa, *sb; | |||
| return ret_val; | |||
| } /* sdiff_ */ | |||
| /* Subroutine */ int itest1_(icomp, itrue) | |||
| integer *icomp, *itrue; | |||
| /* Subroutine */ int itest1_(integer* icomp, integer* itrue) | |||
| { | |||
| /* Local variables */ | |||
| static integer id; | |||
| @@ -242,255 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| #if 0 | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -521,7 +272,7 @@ static integer c_n1 = -1; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -539,16 +290,20 @@ static logical c_false = FALSE_; | |||
| static logical same; | |||
| static integer ninc, nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int schk1_(), schk2_(), schk3_(), schk4_(), | |||
| schk5_(), schk6_(); | |||
| extern /* Subroutine */ int schk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, integer*, integer*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len); | |||
| static real a[4225] /* was [65][65] */, g[65]; | |||
| static integer i__, j, n; | |||
| static logical fatal; | |||
| static real x[65], y[65], z__[130]; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(real*, real*); | |||
| static logical trace; | |||
| static integer nidim; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static char snaps[32], trans[1]; | |||
| static integer isnum; | |||
| static logical ltest[16]; | |||
| @@ -564,12 +319,12 @@ static logical c_false = FALSE_; | |||
| static logical rorder; | |||
| static integer layout; | |||
| static logical ltestt; | |||
| extern /* Subroutine */ int cs2chke_(); | |||
| extern /* Subroutine */ int cs2chke_(char*, ftnlen); | |||
| static logical tsterr; | |||
| static real alf[7]; | |||
| static integer inc[7], nkb; | |||
| static real bet[7]; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real eps, err; | |||
| char tmpchar; | |||
| @@ -1098,21 +853,7 @@ L240: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int schk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, real* alf, integer* nbet, real* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1130,24 +871,25 @@ ftnlen sname_len; | |||
| static integer i__, m, n; | |||
| static real alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static integer incxs, incys; | |||
| static char trans[1]; | |||
| static integer ia, ib, ic; | |||
| static logical banded; | |||
| static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns; | |||
| extern /* Subroutine */ int csgbmv_(), csgemv_(); | |||
| extern /* Subroutine */ void csgbmv_(integer*, char*, integer*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ void csgemv_(integer*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen); | |||
| static char ctrans[14]; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len); | |||
| static real transl; | |||
| static char transs[1]; | |||
| static integer laa, lda; | |||
| static real als, bls; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| static integer iku, kls, kus; | |||
| @@ -1552,21 +1294,7 @@ L140: | |||
| } /* schk1_ */ | |||
| /* Subroutine */ int schk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, real* alf, integer* nbet, real* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1585,9 +1313,9 @@ ftnlen sname_len; | |||
| static integer i__, k, n; | |||
| static real alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| @@ -1598,13 +1326,14 @@ ftnlen sname_len; | |||
| static logical packed; | |||
| static integer nk, ks, ix, iy, ns, lx, ly; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern /* Subroutine */ int cssbmv_(); | |||
| extern logical lseres_(char* , char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cssbmv_(integer*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen); | |||
| static real transl; | |||
| extern /* Subroutine */ int csspmv_(), cssymv_(); | |||
| extern /* Subroutine */ void csspmv_(integer*, char*, integer*, real*, real*, real*, integer*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ void cssymv_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen); | |||
| static integer laa, lda; | |||
| static real als, bls; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SSYMV, SSBMV and SSPMV. */ | |||
| @@ -2003,17 +1732,7 @@ L130: | |||
| } /* schk2_ */ | |||
| /* Subroutine */ int schk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, xt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *xt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* xt, real* g, real* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2034,9 +1753,9 @@ ftnlen sname_len; | |||
| static integer i__, k, n; | |||
| static char diags[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs; | |||
| @@ -2047,14 +1766,17 @@ ftnlen sname_len; | |||
| static integer nk, ks, ix, ns, lx; | |||
| static char ctrans[14]; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern /* Subroutine */ int cstbmv_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstbmv_(integer*, char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static real transl; | |||
| extern /* Subroutine */ int cstbsv_(); | |||
| extern /* Subroutine */ void cstbsv_(integer*, char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| extern /* Subroutine */ int cstpmv_(), cstrmv_(), cstpsv_(), cstrsv_(); | |||
| extern /* Subroutine */ void cstpmv_(integer*, char*, char*, char*, integer*, real*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstrmv_(integer*, char*, char*, char*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstpsv_(integer*, char*, char*, char*, integer*, real*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstrsv_(integer*, char*, char*, char*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer laa, icd, lda, ict, icu; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests STRMV, STBMV, STPMV, STRSV, STBSV and STPSV. */ | |||
| @@ -2508,19 +2230,7 @@ L130: | |||
| } /* schk3_ */ | |||
| /* Subroutine */ int schk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; | |||
| @@ -2533,17 +2243,18 @@ ftnlen sname_len; | |||
| static integer i__, j, m, n; | |||
| static real alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(), csger_(); | |||
| /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void csger_(integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, integer*); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static integer incxs, incys, ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lseres_(char* , char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| static real transl; | |||
| static integer laa, lda; | |||
| static real als; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SGER. */ | |||
| @@ -2848,19 +2559,7 @@ L150: | |||
| } /* schk4_ */ | |||
| /* Subroutine */ int schk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2880,25 +2579,25 @@ ftnlen sname_len; | |||
| static integer i__, j, n; | |||
| static real alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs; | |||
| extern /* Subroutine */ int csspr_(); | |||
| extern /* Subroutine */ void csspr_(integer*, char*, integer*, real*, real*, integer*, real*, ftnlen); | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ int cssyr_(); | |||
| extern /* Subroutine */ void cssyr_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, ftnlen); | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| static logical packed; | |||
| static integer ix, ns, lx; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| static real transl; | |||
| static integer laa, lda; | |||
| static real als; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SSYR and SSPR. */ | |||
| @@ -3218,19 +2917,7 @@ L130: | |||
| } /* schk5_ */ | |||
| /* Subroutine */ int schk6_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| real *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt, *g, *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk6_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, real* a, real* aa, real* as, real* x, real* xx, real* xs, real* y, real* yy, real* ys, real* yt, real* g, real* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -3249,26 +2936,26 @@ ftnlen sname_len; | |||
| static integer i__, j, n; | |||
| static real alpha, w[2]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, integer*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int smvch_(); | |||
| extern /* Subroutine */ int smvch_(char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, real*, real*, logical*, integer*, logical*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ja, ic; | |||
| extern /* Subroutine */ int csspr2_(); | |||
| extern /* Subroutine */ void csspr2_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, ftnlen); | |||
| static integer nc, jj, lj, in; | |||
| static logical packed; | |||
| extern /* Subroutine */ int cssyr2_(); | |||
| extern /* Subroutine */ void cssyr2_(integer*, char*, integer*, real*, real*, integer*, real*, integer*, real*, integer*, ftnlen); | |||
| static integer ix, iy, ns, lx, ly; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len); | |||
| static real transl; | |||
| static integer laa, lda; | |||
| static real als; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SSYR2 and SSPR2. */ | |||
| @@ -3634,26 +3321,14 @@ L170: | |||
| } /* schk6_ */ | |||
| /* Subroutine */ int smake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl, | |||
| ku, reset, transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| real *a; | |||
| integer *nmax; | |||
| real *aa; | |||
| integer *lda, *kl, *ku; | |||
| logical *reset; | |||
| real *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| { | |||
| /* Subroutine */ int smake_(char* type__, char* uplo, char* diag, integer* m, integer* n, real* a, integer* nmax, real* aa, integer* lda, integer* kl, integer* ku, logical* reset, real* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4; | |||
| /* Local variables */ | |||
| static integer ibeg, iend; | |||
| extern doublereal sbeg_(); | |||
| extern doublereal sbeg_(logical*); | |||
| static integer ioff; | |||
| static logical unit; | |||
| static integer i__, j; | |||
| @@ -3879,28 +3554,14 @@ ftnlen diag_len; | |||
| } /* smake_ */ | |||
| /* Subroutine */ int smvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y, | |||
| incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len) | |||
| char *trans; | |||
| integer *m, *n; | |||
| real *alpha, *a; | |||
| integer *nmax; | |||
| real *x; | |||
| integer *incx; | |||
| real *beta, *y; | |||
| integer *incy; | |||
| real *yt, *g, *yy, *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen trans_len; | |||
| /* Subroutine */ int smvch_(char* trans, integer* m, integer* n, real* alpha, real* a, integer* nmax, real* x, integer* incx, real* beta, real* y, integer* incy, real* yt, real* g, real* yy, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2; | |||
| real r__1; | |||
| /* Builtin functions */ | |||
| double sqrt(); | |||
| double sqrt(double); | |||
| /* Local variables */ | |||
| static real erri; | |||
| @@ -4029,9 +3690,7 @@ L70: | |||
| } /* smvch_ */ | |||
| logical lse_(ri, rj, lr) | |||
| real *ri, *rj; | |||
| integer *lr; | |||
| logical lse_(real* ri, real* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -4076,13 +3735,7 @@ L30: | |||
| } /* lse_ */ | |||
| logical lseres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| real *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen ltype_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2; | |||
| @@ -4169,8 +3822,7 @@ L80: | |||
| } /* lseres_ */ | |||
| doublereal sbeg_(reset) | |||
| logical *reset; | |||
| doublereal sbeg_(logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -4221,8 +3873,7 @@ L10: | |||
| } /* sbeg_ */ | |||
| doublereal sdiff_(x, y) | |||
| real *x, *y; | |||
| doublereal sdiff_(real* x, real* y) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -242,129 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -393,7 +270,7 @@ static logical c_true = TRUE_; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program MAIN__() */ int main() | |||
| /* Main program MAIN__() */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -402,26 +279,25 @@ static logical c_false = FALSE_; | |||
| /* System generated locals */ | |||
| integer i__1, i__2, i__3; | |||
| real r__1; | |||
| /* Builtin functions */ | |||
| integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(), | |||
| e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe(); | |||
| integer f_clos(); | |||
| /* Local variables */ | |||
| static integer nalf, idim[9]; | |||
| static logical same; | |||
| static integer nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int schk1_(), schk2_(), schk3_(), schk4_(), | |||
| schk5_(); | |||
| extern /* Subroutine */ int schk1_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk2_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk3_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk4_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| extern /* Subroutine */ int schk5_(char*, real*, real*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, real*, integer*, real*, integer*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, real*, integer*, ftnlen); | |||
| static real c__[4225] /* was [65][65] */, g[65]; | |||
| static integer i__, j, n; | |||
| static logical fatal; | |||
| static real w[130]; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(real*, real*); | |||
| static logical trace; | |||
| static integer nidim; | |||
| extern /* Subroutine */ int smmch_(); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static char snaps[32]; | |||
| static integer isnum; | |||
| static logical ltest[6]; | |||
| @@ -433,9 +309,9 @@ static logical c_false = FALSE_; | |||
| static logical rorder; | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| extern /* Subroutine */ int cs3chke_(); | |||
| extern /* Subroutine */ void cs3chke_(char*, ftnlen); | |||
| static real alf[7], bet[7]; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real eps, err; | |||
| char tmpchar; | |||
| @@ -899,21 +775,7 @@ L230: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int schk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *nmax; | |||
| real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk1_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -923,8 +785,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5, i__6; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static real beta; | |||
| @@ -936,18 +796,17 @@ ftnlen sname_len; | |||
| static logical trana, tranb; | |||
| static integer nargs; | |||
| static logical reset; | |||
| extern /* Subroutine */ void sprcn1_(); | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smmch_(); | |||
| extern /* Subroutine */ void sprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static integer ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; | |||
| extern /* Subroutine */ int csgemm_(); | |||
| extern /* Subroutine */ void csgemm_(integer*, char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| static char tranas[1], tranbs[1], transa[1], transb[1]; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lse_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; | |||
| static real als, bls; | |||
| extern logical lse_(); | |||
| static real err; | |||
| /* Tests SGEMM. */ | |||
| @@ -1278,23 +1137,8 @@ L130: | |||
| /* Subroutine */ void sprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *transa, *transb; | |||
| integer *m, *n, *k; | |||
| real *alpha; | |||
| integer *lda, *ldb; | |||
| real *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ void sprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char crc[14], cta[14], ctb[14]; | |||
| @@ -1324,21 +1168,7 @@ ftnlen transb_len; | |||
| } /* sprcn1_ */ | |||
| /* Subroutine */ int schk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *nmax; | |||
| real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk2_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1349,8 +1179,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static real beta; | |||
| @@ -1368,15 +1196,15 @@ ftnlen sname_len; | |||
| static char uplos[1]; | |||
| static integer ia, ib, na, nc, im, in, ms, ns; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern /* Subroutine */ int cssymm_(); | |||
| extern void sprcn2_(); | |||
| extern int smake_(); | |||
| extern int smmch_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cssymm_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern void sprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static integer laa, lbb, lda, lcc, ldb, ldc, ics; | |||
| static real als, bls; | |||
| static integer icu; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SSYMM. */ | |||
| @@ -1685,23 +1513,8 @@ L120: | |||
| } /* schk2_ */ | |||
| /* Subroutine */ void sprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha, | |||
| lda, ldb, beta, ldc, sname_len, side_len, uplo_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo; | |||
| integer *m, *n; | |||
| real *alpha; | |||
| integer *lda, *ldb; | |||
| real *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| /* Subroutine */ void sprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char cs[14], cu[14], crc[14]; | |||
| @@ -1726,19 +1539,7 @@ ftnlen uplo_len; | |||
| } /* sprcn2_ */ | |||
| /* Subroutine */ int schk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__, | |||
| iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *nmax; | |||
| real *a, *aa, *as, *b, *bb, *bs, *ct, *g, *c__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk3_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* ct, real* g, real* c__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1751,8 +1552,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static char diag[1]; | |||
| @@ -1769,18 +1568,19 @@ ftnlen sname_len; | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void sprcn3_(); | |||
| extern /* Subroutine */ void sprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, real*, integer*, integer*, ftnlen , ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static integer ia, na, nc, im, in, ms, ns; | |||
| static char tranas[1], transa[1]; | |||
| static real errmax; | |||
| extern int smake_(); | |||
| extern int smmch_(); | |||
| extern logical lseres_(); | |||
| extern /* Subroutine */ int cstrmm_(), cstrsm_(); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstrmm_(integer*, char*, char*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cstrsm_(integer*, char*, char*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static integer laa, icd, lbb, lda, ldb, ics; | |||
| static real als; | |||
| static integer ict, icu; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests STRMM and STRSM. */ | |||
| @@ -2155,24 +1955,8 @@ L160: | |||
| } /* schk3_ */ | |||
| /* Subroutine */ void sprcn3_(nout, nc, sname, iorder, side, uplo, transa, | |||
| diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len, | |||
| transa_len, diag_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo, *transa, *diag; | |||
| integer *m, *n; | |||
| real *alpha; | |||
| integer *lda, *ldb; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ void sprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, real* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cd[14], cs[14], cu[14], crc[14]; | |||
| @@ -2210,21 +1994,7 @@ ftnlen diag_len; | |||
| } /* sprcn3_ */ | |||
| /* Subroutine */ int schk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *nmax; | |||
| real *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct, *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk4_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* a, real* aa, real* as, real* b, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2235,8 +2005,6 @@ ftnlen sname_len; | |||
| integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, | |||
| i__3, i__4, i__5; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static real beta; | |||
| @@ -2253,18 +2021,18 @@ ftnlen sname_len; | |||
| static char trans[1]; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ void sprcn4_(); | |||
| extern /* Subroutine */ int smake_(); | |||
| extern /* Subroutine */ int smmch_(); | |||
| extern /* Subroutine */ void sprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| extern /* Subroutine */ int cssyrk_(); | |||
| extern /* Subroutine */ void cssyrk_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lda, lcc, ldc; | |||
| static real als; | |||
| static integer ict, icu; | |||
| extern logical lse_(); | |||
| extern logical lse_(real*, real*, integer*); | |||
| static real err; | |||
| /* Tests SSYRK. */ | |||
| @@ -2575,23 +2343,8 @@ L130: | |||
| } /* schk4_ */ | |||
| /* Subroutine */ void sprcn4_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| real *alpha; | |||
| integer *lda; | |||
| real *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ void sprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, real* alpha, integer* lda, real* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -2619,21 +2372,7 @@ ftnlen transa_len; | |||
| } /* sprcn4_ */ | |||
| /* Subroutine */ int schk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs, | |||
| c__, cc, cs, ct, g, w, iorder, sname_len) | |||
| char *sname; | |||
| real *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| real *alf; | |||
| integer *nbet; | |||
| real *bet; | |||
| integer *nmax; | |||
| real *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct, *g, *w; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int schk5_(char* sname, real* eps, real* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, real* alf, integer* nbet, real* bet, integer* nmax, real* ab, real* aa, real* as, real* bb, real* bs, real* c__, real* cc, real* cs, real* ct, real* g, real* w, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2643,8 +2382,6 @@ ftnlen sname_len; | |||
| /* System generated locals */ | |||
| integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; | |||
| /* Builtin functions */ | |||
| integer f_rew(), s_wsfe(), e_wsfe(), do_fio(); | |||
| /* Local variables */ | |||
| static integer jjab; | |||
| @@ -2663,18 +2400,18 @@ ftnlen sname_len; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ib; | |||
| extern /* Subroutine */ void sprcn5_(); | |||
| extern /* Subroutine */ void sprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, real*, integer*, integer*, real*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer jc, ma, na, nc, ik, in, jj, lj, ks, ns; | |||
| static real errmax; | |||
| extern logical lseres_(); | |||
| extern int smake_(); | |||
| extern logical lseres_(char*, char*, integer*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int smake_(char*, char*, char*, integer*, integer*, real*, integer*, real*, integer*, logical*, real*, ftnlen, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| static integer laa, lbb, lda, lcc, ldb, ldc; | |||
| static real als; | |||
| static integer ict, icu; | |||
| extern /* Subroutine */ int cssyr2k_(); | |||
| extern logical lse_(); | |||
| extern int smmch_(); | |||
| extern /* Subroutine */ void cssyr2k_(integer*, char*, char*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, ftnlen, ftnlen); | |||
| extern logical lse_(real*, real*, integer*); | |||
| extern /* Subroutine */ int smmch_(char*, char*, integer*, integer*, integer*, real*, real*, integer*, real*, integer*, real*, real*, integer*, real*, real*, real*, integer*, real*, real*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static real err; | |||
| /* Tests SSYR2K. */ | |||
| @@ -3037,23 +2774,8 @@ L160: | |||
| } /* schk5_ */ | |||
| /* Subroutine */ void sprcn5_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| real *alpha; | |||
| integer *lda, *ldb; | |||
| real *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ void sprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, real* alpha, integer* lda, integer* ldb, real* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), do_fio(), e_wsfe(); | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -3081,19 +2803,7 @@ ftnlen transa_len; | |||
| } /* sprcn5_ */ | |||
| /* Subroutine */ int smake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset, | |||
| transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| real *a; | |||
| integer *nmax; | |||
| real *aa; | |||
| integer *lda; | |||
| logical *reset; | |||
| real *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int smake_(char* type__, char* uplo, char* diag, integer* m, integer* n, real* a, integer* nmax, real* aa, integer* lda, logical* reset, real* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2; | |||
| @@ -3102,7 +2812,7 @@ ftnlen diag_len; | |||
| /* Local variables */ | |||
| static integer ibeg, iend; | |||
| extern doublereal sbeg_(); | |||
| extern doublereal sbeg_(logical*); | |||
| static logical unit; | |||
| static integer i__, j; | |||
| static logical lower, upper, gen, tri, sym; | |||
| @@ -3233,25 +2943,7 @@ ftnlen diag_len; | |||
| } /* smake_ */ | |||
| /* Subroutine */ int smmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb, | |||
| beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv, | |||
| transa_len, transb_len) | |||
| char *transa, *transb; | |||
| integer *m, *n, *kk; | |||
| real *alpha, *a; | |||
| integer *lda; | |||
| real *b; | |||
| integer *ldb; | |||
| real *beta, *c__; | |||
| integer *ldc; | |||
| real *ct, *g, *cc; | |||
| integer *ldcc; | |||
| real *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ int smmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, real* alpha, real* a, integer* lda, real* b, integer* ldb, real* beta, real* c__, integer* ldc, real* ct, real* g, real* cc, integer* ldcc, real* eps, real* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* System generated locals */ | |||
| @@ -3260,8 +2952,7 @@ ftnlen transb_len; | |||
| real r__1, r__2; | |||
| /* Builtin functions */ | |||
| double sqrt(); | |||
| integer s_wsfe(), e_wsfe(), do_fio(); | |||
| double sqrt(double); | |||
| /* Local variables */ | |||
| static real erri; | |||
| @@ -3426,9 +3117,7 @@ L150: | |||
| } /* smmch_ */ | |||
| logical lse_(ri, rj, lr) | |||
| real *ri, *rj; | |||
| integer *lr; | |||
| logical lse_(real* ri, real* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| @@ -3475,13 +3164,7 @@ L30: | |||
| } /* lse_ */ | |||
| logical lseres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| real *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lseres_(char* type__, char* uplo, integer* m, integer* n, real* aa, real* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2; | |||
| @@ -3572,8 +3255,7 @@ L80: | |||
| } /* lseres_ */ | |||
| doublereal sbeg_(reset) | |||
| logical *reset; | |||
| doublereal sbeg_(logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -3625,8 +3307,7 @@ L10: | |||
| } /* sbeg_ */ | |||
| doublereal sdiff_(x, y) | |||
| real *x, *y; | |||
| doublereal sdiff_(real* x, real* y) | |||
| { | |||
| /* System generated locals */ | |||
| real ret_val; | |||
| @@ -242,250 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| #if 0 | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| #endif | |||
| /* Common Block Declarations */ | |||
| @@ -502,16 +258,16 @@ static integer c__1 = 1; | |||
| static integer c__5 = 5; | |||
| static doublereal c_b43 = 1.; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| static doublereal sfac = 9.765625e-4; | |||
| /* Local variables */ | |||
| extern /* Subroutine */ int check1_(), check2_(); | |||
| extern /* Subroutine */ int check1_(doublereal*), check2_(doublereal*); | |||
| static integer ic; | |||
| extern /* Subroutine */ int header_(); | |||
| extern /* Subroutine */ int header_(void); | |||
| /* Test program for the COMPLEX*16 Level 1 CBLAS. */ | |||
| /* Based upon the original CBLAS test routine together with: */ | |||
| @@ -551,7 +307,7 @@ static doublereal c_b43 = 1.; | |||
| exit(0); | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int header_() | |||
| /* Subroutine */ int header_(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -570,8 +326,7 @@ static doublereal c_b43 = 1.; | |||
| } /* header_ */ | |||
| /* Subroutine */ int check1_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check1_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -623,15 +378,15 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern /* Subroutine */ int ctest_(); | |||
| extern /* Subroutine */ int ctest_(integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*); | |||
| static doublecomplex mwpcs[5], mwpct[5]; | |||
| extern /* Subroutine */ int zscaltest_(), itest1_(), stest1_(); | |||
| extern /* Subroutine */ int zscaltest_(integer*, doublereal*, doublecomplex*, integer*), itest1_(integer*, integer*), stest1_(doublereal*, doublereal*, doublereal*, doublereal*); | |||
| static doublecomplex cx[8]; | |||
| extern doublereal dznrm2test_(); | |||
| extern doublereal dznrm2test_(integer*, doublecomplex*, integer*); | |||
| static integer np1; | |||
| extern /* Subroutine */ int zdscaltest_(); | |||
| extern integer izamaxtest_(); | |||
| extern doublereal dzasumtest_(); | |||
| extern /* Subroutine */ int zdscaltest_(integer*, doublereal*, doublecomplex*, integer*); | |||
| extern integer izamaxtest_(integer*, doublecomplex*, integer*); | |||
| extern doublereal dzasumtest_(integer*, doublecomplex*, integer*); | |||
| static integer len; | |||
| /* .. Parameters .. */ | |||
| @@ -748,8 +503,7 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* check1_ */ | |||
| /* Subroutine */ int check2_(sfac) | |||
| doublereal *sfac; | |||
| /* Subroutine */ int check2_(doublereal* sfac) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -834,14 +588,14 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static doublecomplex cdot[1]; | |||
| static integer lenx, leny, i__; | |||
| extern /* Subroutine */ int ctest_(); | |||
| extern /* Subroutine */ int ctest_(integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*); | |||
| static integer ksize; | |||
| static doublecomplex ztemp; | |||
| extern /* Subroutine */ int zdotctest_(), zcopytest_(); | |||
| extern /* Subroutine */ int zdotctest_(integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*), zcopytest_(integer*, doublecomplex*, integer*, doublecomplex*, integer*); | |||
| static integer ki; | |||
| extern /* Subroutine */ int zdotutest_(), zswaptest_(); | |||
| extern /* Subroutine */ int zdotutest_(integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*), zswaptest_(integer*, doublecomplex*, integer*, doublecomplex*, integer*); | |||
| static integer kn; | |||
| extern /* Subroutine */ int zaxpytest_(); | |||
| extern /* Subroutine */ int zaxpytest_(integer*, doublereal*, doublecomplex*, integer*, doublecomplex*, integer*); | |||
| static doublecomplex cx[7], cy[7]; | |||
| static integer mx, my; | |||
| @@ -923,20 +677,18 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* check2_ */ | |||
| /* Subroutine */ int stest_(len, scomp, strue, ssize, sfac) | |||
| integer *len; | |||
| doublereal *scomp, *strue, *ssize, *sfac; | |||
| /* Subroutine */ int stest_(integer* len, doublereal* scomp, doublereal* strue, doublereal* ssize, doublereal* sfac) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1; | |||
| doublereal d__1, d__2, d__3, d__4, d__5; | |||
| /* Builtin functions */ | |||
| integer s_wsfe(), e_wsfe(), do_fio(); | |||
| integer s_wsfe(void), e_wsfe(void), do_fio(void); | |||
| /* Local variables */ | |||
| static integer i__; | |||
| extern doublereal sdiff_(); | |||
| extern doublereal sdiff_(doublereal*, doublereal*); | |||
| static doublereal sd; | |||
| /* ********************************* STEST ************************** */ | |||
| @@ -992,11 +744,10 @@ L40: | |||
| } /* stest_ */ | |||
| /* Subroutine */ int stest1_(scomp1, strue1, ssize, sfac) | |||
| doublereal *scomp1, *strue1, *ssize, *sfac; | |||
| /* Subroutine */ int stest1_(doublereal* scomp1, doublereal* strue1, doublereal* ssize, doublereal* sfac) | |||
| { | |||
| static doublereal scomp[1], strue[1]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*,doublereal*, doublereal*, doublereal*, doublereal*); | |||
| /* ************************* STEST1 ***************************** */ | |||
| @@ -1023,8 +774,7 @@ doublereal *scomp1, *strue1, *ssize, *sfac; | |||
| return 0; | |||
| } /* stest1_ */ | |||
| doublereal sdiff_(sa, sb) | |||
| doublereal *sa, *sb; | |||
| doublereal sdiff_(doublereal* sa, doublereal* sb) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -1038,10 +788,7 @@ doublereal *sa, *sb; | |||
| return ret_val; | |||
| } /* sdiff_ */ | |||
| /* Subroutine */ int ctest_(len, ccomp, ctrue, csize, sfac) | |||
| integer *len; | |||
| doublecomplex *ccomp, *ctrue, *csize; | |||
| doublereal *sfac; | |||
| /* Subroutine */ int ctest_(integer* len, doublecomplex* ccomp, doublecomplex* ctrue, doublecomplex* csize, doublereal* sfac) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1, i__2; | |||
| @@ -1049,7 +796,7 @@ doublereal *sfac; | |||
| /* Local variables */ | |||
| static integer i__; | |||
| static doublereal scomp[20], ssize[20], strue[20]; | |||
| extern /* Subroutine */ int stest_(); | |||
| extern /* Subroutine */ int stest_(integer*, doublereal*, doublereal*, doublereal*, doublereal*); | |||
| /* **************************** CTEST ***************************** */ | |||
| @@ -1087,8 +834,7 @@ doublereal *sfac; | |||
| return 0; | |||
| } /* ctest_ */ | |||
| /* Subroutine */ int itest1_(icomp, itrue) | |||
| integer *icomp, *itrue; | |||
| /* Subroutine */ int itest1_(integer* icomp, integer* itrue) | |||
| { | |||
| static integer id; | |||
| @@ -242,129 +242,6 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Common Block Declarations */ | |||
| @@ -396,7 +273,7 @@ static integer c_n1 = -1; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program */ int main() | |||
| /* Main program */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -414,19 +291,23 @@ static logical c_false = FALSE_; | |||
| static logical same; | |||
| static integer ninc, nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int zchk1_(), zchk2_(), zchk3_(), zchk4_(), | |||
| zchk5_(), zchk6_(); | |||
| extern /* Subroutine */ int zchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk6_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| static doublecomplex a[4225] /* was [65][65] */; | |||
| static doublereal g[65]; | |||
| static integer i__, j; | |||
| extern doublereal ddiff_(); | |||
| extern doublereal ddiff_(doublereal*, doublereal*); | |||
| static integer n; | |||
| static logical fatal; | |||
| static doublecomplex x[65], y[65], z__[130]; | |||
| static logical trace; | |||
| static integer nidim; | |||
| static char snaps[32], trans[1]; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer isnum; | |||
| static logical ltest[17]; | |||
| static doublecomplex aa[4225]; | |||
| @@ -441,12 +322,12 @@ static logical c_false = FALSE_; | |||
| static logical rorder; | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| extern /* Subroutine */ int cz2chke_(); | |||
| extern /* Subroutine */ void cz2chke_(char*, ftnlen); | |||
| static doublecomplex alf[7]; | |||
| static integer inc[7], nkb; | |||
| static doublecomplex bet[7]; | |||
| static doublereal eps, err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| char tmpchar; | |||
| /* Test program for the DOUBLE PRECISION COMPLEX Level 2 Blas. */ | |||
| @@ -984,22 +865,7 @@ L240: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int zchk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| doublereal *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1018,27 +884,27 @@ ftnlen sname_len; | |||
| static integer i__, m, n; | |||
| static doublecomplex alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys; | |||
| static char trans[1]; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer ia, ib, ic; | |||
| static logical banded; | |||
| static integer nc, nd, im, in, kl, ml, nk, nl, ku, ix, iy, ms, lx, ly, ns; | |||
| extern /* Subroutine */ int czgbmv_(); | |||
| extern /* Subroutine */ void czgbmv_(integer*, char*, integer*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen); | |||
| static char ctrans[14]; | |||
| extern /* Subroutine */ int czgemv_(); | |||
| extern /* Subroutine */ void czgemv_(integer*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen); | |||
| static doublereal errmax; | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| static integer laa, lda; | |||
| static doublecomplex als, bls; | |||
| static doublereal err; | |||
| static integer iku, kls; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| static integer kus; | |||
| @@ -1451,22 +1317,7 @@ L140: | |||
| } /* zchk1_ */ | |||
| /* Subroutine */ int zchk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, nalf, alf, nbet, bet, ninc, inc, nmax, | |||
| incmax, a, aa, as, x, xx, xs, y, yy, ys, yt, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| doublereal *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1486,27 +1337,28 @@ ftnlen sname_len; | |||
| static integer i__, k, n; | |||
| static doublecomplex alpha; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static char uplos[1]; | |||
| static integer ia, ib, ic; | |||
| static logical banded; | |||
| static integer nc, ik, in; | |||
| static logical packed; | |||
| static integer nk, ks, ix, iy, ns, lx, ly; | |||
| extern /* Subroutine */ int czhbmv_(), czhemv_(); | |||
| extern /* Subroutine */ void czhbmv_(integer*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ void czhemv_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen); | |||
| static doublereal errmax; | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern /* Subroutine */ int czhpmv_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void czhpmv_(integer*, char*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen); | |||
| static integer laa, lda; | |||
| static doublecomplex als, bls; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests CHEMV, CHBMV and CHPMV. */ | |||
| @@ -1909,19 +1761,7 @@ L130: | |||
| } /* zchk2_ */ | |||
| /* Subroutine */ int zchk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nkb, kb, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, xt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nkb, *kb, *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *xt; | |||
| doublereal *g; | |||
| doublecomplex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nkb, integer* kb, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* xt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1942,13 +1782,13 @@ ftnlen sname_len; | |||
| static integer i__, k, n; | |||
| static char diags[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs; | |||
| static char trans[1]; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static char uplos[1]; | |||
| static logical banded; | |||
| static integer nc, ik, in; | |||
| @@ -1957,14 +1797,17 @@ ftnlen sname_len; | |||
| static char ctrans[14]; | |||
| static doublereal errmax; | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern /* Subroutine */ int cztbmv_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztbmv_(integer*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static char transs[1]; | |||
| extern /* Subroutine */ int cztbsv_(), cztpmv_(), cztrmv_(), cztpsv_(), | |||
| cztrsv_(); | |||
| extern /* Subroutine */ void cztbsv_(integer*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztpmv_(integer*, char*, char*, char*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztpsv_(integer*, char*, char*, char*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztrmv_(integer*, char*, char*, char*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztrsv_(integer*, char*, char*, char*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer laa, icd, lda, ict, icu; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| @@ -2422,21 +2265,7 @@ L130: | |||
| } /* zchk3_ */ | |||
| /* Subroutine */ int zchk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| doublereal *g; | |||
| doublecomplex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; | |||
| @@ -2450,21 +2279,21 @@ ftnlen sname_len; | |||
| static integer i__, j, m, n; | |||
| static doublecomplex alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static integer incxs, incys; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static integer ia, nc, nd, im, in, ms, ix, iy, ns, lx, ly; | |||
| extern /* Subroutine */ int czgerc_(); | |||
| extern /* Subroutine */ void czgerc_(integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*); | |||
| static doublereal errmax; | |||
| extern /* Subroutine */ int czgeru_(); | |||
| extern /* Subroutine */ void czgeru_(integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*); | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lda; | |||
| static doublecomplex als; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| @@ -2793,21 +2622,7 @@ L150: | |||
| } /* zchk4_ */ | |||
| /* Subroutine */ int zchk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| doublereal *g; | |||
| doublecomplex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2827,13 +2642,14 @@ ftnlen sname_len; | |||
| static integer i__, j, n; | |||
| static doublecomplex alpha, w[1]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int czher_(); | |||
| extern /* Subroutine */ void czher_(integer*, char*, integer*, doublereal*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen); | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs; | |||
| extern /* Subroutine */ int czhpr_(), zmvch_(); | |||
| extern /* Subroutine */ void czhpr_(integer*, char*, integer*, doublereal*, doublecomplex*, integer*, doublecomplex*, ftnlen); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| @@ -2841,10 +2657,10 @@ ftnlen sname_len; | |||
| static integer ix, ns, lx; | |||
| static doublereal ralpha, errmax; | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lda; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZHER and ZHPR. */ | |||
| @@ -3167,21 +2983,7 @@ L130: | |||
| } /* zchk5_ */ | |||
| /* Subroutine */ int zchk6_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, ninc, inc, nmax, incmax, a, aa, as, x, | |||
| xx, xs, y, yy, ys, yt, g, z__, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *ninc, *inc, *nmax, *incmax; | |||
| doublecomplex *a, *aa, *as, *x, *xx, *xs, *y, *yy, *ys, *yt; | |||
| doublereal *g; | |||
| doublecomplex *z__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk6_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* ninc, integer* inc, integer* nmax, integer* incmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* x, doublecomplex* xx, doublecomplex* xs, doublecomplex* y, doublecomplex* yy, doublecomplex* ys, doublecomplex* yt, doublereal* g, doublecomplex* z__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -3201,25 +3003,26 @@ ftnlen sname_len; | |||
| static integer i__, j, n; | |||
| static doublecomplex alpha, w[2]; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, integer*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| static logical reset; | |||
| static char cuplo[14]; | |||
| static integer incxs, incys; | |||
| extern /* Subroutine */ int zmvch_(); | |||
| extern /* Subroutine */ int zmvch_(char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen); | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| extern /* Subroutine */ int czher2_(), czhpr2_(); | |||
| extern /* Subroutine */ void czher2_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ void czhpr2_(integer*, char*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, ftnlen); | |||
| static integer ia, ja, ic, nc, jj, lj, in; | |||
| static logical packed; | |||
| static integer ix, iy, ns, lx, ly; | |||
| static doublereal errmax; | |||
| static doublecomplex transl; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lda; | |||
| static doublecomplex als; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZHER2 and ZHPR2. */ | |||
| @@ -3604,24 +3407,7 @@ L170: | |||
| } /* zchk6_ */ | |||
| /* Subroutine */ int zmvch_(trans, m, n, alpha, a, nmax, x, incx, beta, y, | |||
| incy, yt, g, yy, eps, err, fatal, nout, mv, trans_len) | |||
| char *trans; | |||
| integer *m, *n; | |||
| doublecomplex *alpha, *a; | |||
| integer *nmax; | |||
| doublecomplex *x; | |||
| integer *incx; | |||
| doublecomplex *beta, *y; | |||
| integer *incy; | |||
| doublecomplex *yt; | |||
| doublereal *g; | |||
| doublecomplex *yy; | |||
| doublereal *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen trans_len; | |||
| /* Subroutine */ int zmvch_(char* trans, integer* m, integer* n, doublecomplex* alpha, doublecomplex* a, integer* nmax, doublecomplex* x, integer* incx, doublecomplex* beta, doublecomplex* y, integer* incy, doublecomplex* yt, doublereal* g, doublecomplex* yy, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen trans_len) | |||
| { | |||
| /* System generated locals */ | |||
| @@ -3819,9 +3605,7 @@ L80: | |||
| } /* zmvch_ */ | |||
| logical lze_(ri, rj, lr) | |||
| doublecomplex *ri, *rj; | |||
| integer *lr; | |||
| logical lze_(doublecomplex* ri, doublecomplex* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1, i__2, i__3; | |||
| @@ -3868,13 +3652,7 @@ L30: | |||
| } /* lze_ */ | |||
| logical lzeres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| doublecomplex *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lzeres_(char* type__, char* uplo, integer* m, integer* n, doublecomplex* aa, doublecomplex* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; | |||
| @@ -3967,9 +3745,7 @@ L80: | |||
| } /* lzeres_ */ | |||
| /* Double Complex */ VOID zbeg_( ret_val, reset) | |||
| doublecomplex * ret_val; | |||
| logical *reset; | |||
| /* Double Complex */ VOID zbeg_( doublecomplex* ret_val, logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal d__1, d__2; | |||
| @@ -4030,8 +3806,7 @@ L10: | |||
| } /* zbeg_ */ | |||
| doublereal ddiff_(x, y) | |||
| doublereal *x, *y; | |||
| doublereal ddiff_(doublereal* x, doublereal* y) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -4051,19 +3826,7 @@ doublereal *x, *y; | |||
| } /* ddiff_ */ | |||
| /* Subroutine */ int zmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, kl, | |||
| ku, reset, transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| doublecomplex *a; | |||
| integer *nmax; | |||
| doublecomplex *aa; | |||
| integer *lda, *kl, *ku; | |||
| logical *reset; | |||
| doublecomplex *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int zmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublecomplex* a, integer* nmax, doublecomplex* aa, integer* lda, integer* kl, integer* ku, logical* reset, doublecomplex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4; | |||
| @@ -4072,7 +3835,7 @@ ftnlen diag_len; | |||
| /* Local variables */ | |||
| static integer ibeg, iend, ioff; | |||
| extern /* Double Complex */ VOID zbeg_(); | |||
| extern /* Double Complex */ VOID zbeg_(doublecomplex*, logical*); | |||
| static logical unit; | |||
| static integer i__, j; | |||
| static logical lower; | |||
| @@ -22,14 +22,11 @@ typedef double doublereal; | |||
| typedef struct { real r, i; } complex; | |||
| typedef struct { doublereal r, i; } doublecomplex; | |||
| #ifdef _MSC_VER | |||
| static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} | |||
| static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} | |||
| static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} | |||
| static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} | |||
| #else | |||
| static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} | |||
| static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} | |||
| static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} | |||
| #endif | |||
| #define pCf(z) (*_pCf(z)) | |||
| @@ -242,124 +239,7 @@ typedef struct Namelist Namelist; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| #if 0 | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| #endif | |||
| /* Common Block Declarations */ | |||
| @@ -388,7 +268,7 @@ static logical c_true = TRUE_; | |||
| static integer c__0 = 0; | |||
| static logical c_false = FALSE_; | |||
| /* Main program MAIN__() */ int main() | |||
| /* Main program MAIN__() */ int main(void) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -400,26 +280,29 @@ static logical c_false = FALSE_; | |||
| doublereal d__1; | |||
| /* Builtin functions */ | |||
| integer s_rsle(), do_lio(), e_rsle(), f_open(), s_wsfe(), do_fio(), | |||
| e_wsfe(), s_wsle(), e_wsle(), s_rsfe(), e_rsfe(); | |||
| integer s_rsle(void), do_lio(void), e_rsle(void), f_open(void), s_wsfe(void), do_fio(void), | |||
| e_wsfe(void), s_wsle(void), e_wsle(void), s_rsfe(void), e_rsfe(void); | |||
| /* Local variables */ | |||
| static integer nalf, idim[9]; | |||
| static logical same; | |||
| static integer nbet, ntra; | |||
| static logical rewi; | |||
| extern /* Subroutine */ int zchk1_(), zchk2_(), zchk3_(), zchk4_(), | |||
| zchk5_(); | |||
| extern /* Subroutine */ int zchk1_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk2_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk3_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk4_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, integer*, ftnlen); | |||
| extern /* Subroutine */ int zchk5_(char*, doublereal*, doublereal*, integer*, integer*, logical*, logical*, logical*, integer*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublecomplex*, doublereal*, doublecomplex*, integer*, ftnlen); | |||
| static doublecomplex c__[4225] /* was [65][65] */; | |||
| static doublereal g[65]; | |||
| static integer i__, j; | |||
| extern doublereal ddiff_(); | |||
| extern doublereal ddiff_(doublereal*, doublereal*); | |||
| static integer n; | |||
| static logical fatal; | |||
| static doublecomplex w[130]; | |||
| static logical trace; | |||
| static integer nidim; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static char snaps[32]; | |||
| static integer isnum; | |||
| static logical ltest[9]; | |||
| @@ -431,10 +314,10 @@ static logical c_false = FALSE_; | |||
| static logical rorder; | |||
| static integer layout; | |||
| static logical ltestt, tsterr; | |||
| extern /* Subroutine */ int cz3chke_(); | |||
| extern /* Subroutine */ int cz3chke_(char*, ftnlen); | |||
| static doublecomplex alf[7], bet[7]; | |||
| static doublereal eps, err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| char tmpchar; | |||
| /* Test program for the COMPLEX*16 Level 3 Blas. */ | |||
| @@ -924,22 +807,7 @@ L230: | |||
| } /* MAIN__ */ | |||
| /* Subroutine */ int zchk1_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *nmax; | |||
| doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct; | |||
| doublereal *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -956,21 +824,21 @@ ftnlen sname_len; | |||
| static integer i__, k, m, n; | |||
| static doublecomplex alpha; | |||
| static logical isame[13], trana, tranb; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical reset; | |||
| static integer ia, ib; | |||
| extern /* Subroutine */ int zprcn1_(); | |||
| extern /* Subroutine */ int zprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; | |||
| extern /* Subroutine */ int czgemm_(); | |||
| extern /* Subroutine */ void czgemm_(integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static char tranas[1], tranbs[1], transa[1], transb[1]; | |||
| static doublereal errmax; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; | |||
| static doublecomplex als, bls; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZGEMM. */ | |||
| @@ -1313,20 +1181,7 @@ L130: | |||
| } /* zchk1_ */ | |||
| /* Subroutine */ int zprcn1_(nout, nc, sname, iorder, transa, transb, m, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, transa_len, transb_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *transa, *transb; | |||
| integer *m, *n, *k; | |||
| doublecomplex *alpha; | |||
| integer *lda, *ldb; | |||
| doublecomplex *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ int zprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* Local variables */ | |||
| static char crc[14], cta[14], ctb[14]; | |||
| @@ -1357,22 +1212,7 @@ return 0; | |||
| } /* zprcn1_ */ | |||
| /* Subroutine */ int zchk2_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *nmax; | |||
| doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct; | |||
| doublereal *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1394,23 +1234,23 @@ ftnlen sname_len; | |||
| static doublecomplex alpha; | |||
| static logical isame[13]; | |||
| static char sides[1]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical reset; | |||
| static char uplos[1]; | |||
| static integer ia, ib; | |||
| extern /* Subroutine */ int zprcn2_(); | |||
| extern /* Subroutine */ int zprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer na, nc, im, in, ms, ns; | |||
| extern /* Subroutine */ int czhemm_(); | |||
| extern /* Subroutine */ void czhemm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| extern logical lzeres_(); | |||
| extern /* Subroutine */ int czsymm_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void czsymm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lbb, lda, lcc, ldb, ldc, ics; | |||
| static doublecomplex als, bls; | |||
| static integer icu; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZHEMM and ZSYMM. */ | |||
| @@ -1737,20 +1577,7 @@ L120: | |||
| } /* zchk2_ */ | |||
| /* Subroutine */ int zprcn2_(nout, nc, sname, iorder, side, uplo, m, n, alpha, | |||
| lda, ldb, beta, ldc, sname_len, side_len, uplo_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo; | |||
| integer *m, *n; | |||
| doublecomplex *alpha; | |||
| integer *lda, *ldb; | |||
| doublecomplex *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| /* Subroutine */ int zprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len) | |||
| { | |||
| /* Local variables */ | |||
| static char cs[14], cu[14], crc[14]; | |||
| @@ -1777,21 +1604,7 @@ return 0; | |||
| } /* zprcn2_ */ | |||
| /* Subroutine */ int zchk3_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c__, | |||
| iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nmax; | |||
| doublecomplex *a, *aa, *as, *b, *bb, *bs, *ct; | |||
| doublereal *g; | |||
| doublecomplex *c__; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* ct, doublereal* g, doublecomplex* c__, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -1817,23 +1630,24 @@ ftnlen sname_len; | |||
| static char diags[1]; | |||
| static logical isame[13]; | |||
| static char sides[1]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static logical reset; | |||
| static char uplos[1]; | |||
| static integer ia, na; | |||
| extern /* Subroutine */ int zprcn3_(); | |||
| extern /* Subroutine */ int zprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static integer nc, im, in, ms, ns; | |||
| static char tranas[1], transa[1]; | |||
| static doublereal errmax; | |||
| extern logical lzeres_(); | |||
| extern /* Subroutine */ int cztrmm_(), cztrsm_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztrmm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ void cztrsm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); | |||
| static integer laa, icd, lbb, lda, ldb, ics; | |||
| static doublecomplex als; | |||
| static integer ict, icu; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZTRMM and ZTRSM. */ | |||
| @@ -2227,21 +2041,7 @@ L160: | |||
| } /* zchk3_ */ | |||
| /* Subroutine */ int zprcn3_(nout, nc, sname, iorder, side, uplo, transa, | |||
| diag, m, n, alpha, lda, ldb, sname_len, side_len, uplo_len, | |||
| transa_len, diag_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *side, *uplo, *transa, *diag; | |||
| integer *m, *n; | |||
| doublecomplex *alpha; | |||
| integer *lda, *ldb; | |||
| ftnlen sname_len; | |||
| ftnlen side_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int zprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len) | |||
| { | |||
| /* Local variables */ | |||
| @@ -2281,22 +2081,7 @@ return 0; | |||
| } /* zprcn3_ */ | |||
| /* Subroutine */ int zchk4_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, | |||
| c__, cc, cs, ct, g, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *nmax; | |||
| doublecomplex *a, *aa, *as, *b, *bb, *bs, *c__, *cc, *cs, *ct; | |||
| doublereal *g; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2320,30 +2105,30 @@ ftnlen sname_len; | |||
| static doublecomplex alpha; | |||
| static doublereal rbeta; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static doublereal rbets; | |||
| static logical reset; | |||
| static char trans[1]; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ib, jc, ma, na; | |||
| extern /* Subroutine */ int zprcn4_(); | |||
| extern /* Subroutine */ int zprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer nc; | |||
| extern /* Subroutine */ int zprcn6_(); | |||
| extern /* Subroutine */ int zprcn6_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ik, in, jj, lj, ks, ns; | |||
| static doublereal ralpha; | |||
| extern /* Subroutine */ int czherk_(); | |||
| extern /* Subroutine */ int czherk_(integer*, char*, char*, integer*, integer*, doublereal*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static doublereal errmax; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static char transs[1], transt[1]; | |||
| extern /* Subroutine */ int czsyrk_(); | |||
| extern /* Subroutine */ int czsyrk_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lda, lcc, ldc; | |||
| static doublecomplex als; | |||
| static integer ict, icu; | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZHERK and ZSYRK. */ | |||
| @@ -2732,20 +2517,7 @@ L130: | |||
| } /* zchk4_ */ | |||
| /* Subroutine */ int zprcn4_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublecomplex *alpha; | |||
| integer *lda; | |||
| doublecomplex *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ int zprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -2775,20 +2547,7 @@ return 0; | |||
| /* Subroutine */ int zprcn6_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublereal *alpha; | |||
| integer *lda; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ int zprcn6_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Local variables */ | |||
| @@ -2818,23 +2577,7 @@ return 0; | |||
| } /* zprcn6_ */ | |||
| /* Subroutine */ int zchk5_(sname, eps, thresh, nout, ntra, trace, rewi, | |||
| fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs, | |||
| c__, cc, cs, ct, g, w, iorder, sname_len) | |||
| char *sname; | |||
| doublereal *eps, *thresh; | |||
| integer *nout, *ntra; | |||
| logical *trace, *rewi, *fatal; | |||
| integer *nidim, *idim, *nalf; | |||
| doublecomplex *alf; | |||
| integer *nbet; | |||
| doublecomplex *bet; | |||
| integer *nmax; | |||
| doublecomplex *ab, *aa, *as, *bb, *bs, *c__, *cc, *cs, *ct; | |||
| doublereal *g; | |||
| doublecomplex *w; | |||
| integer *iorder; | |||
| ftnlen sname_len; | |||
| /* Subroutine */ int zchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* ab, doublecomplex* aa, doublecomplex* as, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, doublecomplex* w, integer* iorder, ftnlen sname_len) | |||
| { | |||
| /* Initialized data */ | |||
| @@ -2857,27 +2600,28 @@ ftnlen sname_len; | |||
| static doublecomplex alpha; | |||
| static doublereal rbeta; | |||
| static logical isame[13]; | |||
| extern /* Subroutine */ int zmake_(); | |||
| extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); | |||
| static integer nargs; | |||
| extern /* Subroutine */ int zmmch_(); | |||
| extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); | |||
| static doublereal rbets; | |||
| static logical reset; | |||
| static char trans[1]; | |||
| static logical upper; | |||
| static char uplos[1]; | |||
| static integer ia, ib, jc, ma, na, nc; | |||
| extern /* Subroutine */ int zprcn5_(), zprcn7_(); | |||
| extern /* Subroutine */ int zprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); | |||
| extern /* Subroutine */ int zprcn7_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); | |||
| static integer ik, in, jj, lj, ks, ns; | |||
| static doublereal errmax; | |||
| extern logical lzeres_(); | |||
| extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static char transs[1], transt[1]; | |||
| extern /* Subroutine */ int czher2k_(); | |||
| extern /* Subroutine */ int czher2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static integer laa, lbb, lda, lcc, ldb, ldc; | |||
| static doublecomplex als; | |||
| static integer ict, icu; | |||
| extern /* Subroutine */ int czsyr2k_(); | |||
| extern /* Subroutine */ int czsyr2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); | |||
| static doublereal err; | |||
| extern logical lze_(); | |||
| extern logical lze_(doublecomplex*, doublecomplex*, integer*); | |||
| /* Tests ZHER2K and ZSYR2K. */ | |||
| @@ -3349,20 +3093,7 @@ L160: | |||
| } /* zchk5_ */ | |||
| /* Subroutine */ int zprcn5_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublecomplex *alpha; | |||
| integer *lda, *ldb; | |||
| doublecomplex *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ int zprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Local variables */ | |||
| static char ca[14], cu[14], crc[14]; | |||
| @@ -3392,20 +3123,7 @@ return 0; | |||
| /* Subroutine */ int zprcn7_(nout, nc, sname, iorder, uplo, transa, n, k, | |||
| alpha, lda, ldb, beta, ldc, sname_len, uplo_len, transa_len) | |||
| integer *nout, *nc; | |||
| char *sname; | |||
| integer *iorder; | |||
| char *uplo, *transa; | |||
| integer *n, *k; | |||
| doublecomplex *alpha; | |||
| integer *lda, *ldb; | |||
| doublereal *beta; | |||
| integer *ldc; | |||
| ftnlen sname_len; | |||
| ftnlen uplo_len; | |||
| ftnlen transa_len; | |||
| /* Subroutine */ int zprcn7_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) | |||
| { | |||
| /* Local variables */ | |||
| @@ -3435,19 +3153,7 @@ return 0; | |||
| } /* zprcn7_ */ | |||
| /* Subroutine */ int zmake_(type__, uplo, diag, m, n, a, nmax, aa, lda, reset, | |||
| transl, type_len, uplo_len, diag_len) | |||
| char *type__, *uplo, *diag; | |||
| integer *m, *n; | |||
| doublecomplex *a; | |||
| integer *nmax; | |||
| doublecomplex *aa; | |||
| integer *lda; | |||
| logical *reset; | |||
| doublecomplex *transl; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| ftnlen diag_len; | |||
| /* Subroutine */ int zmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublecomplex* a, integer* nmax, doublecomplex* aa, integer* lda, logical* reset, doublecomplex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer a_dim1, a_offset, i__1, i__2, i__3, i__4; | |||
| @@ -3456,7 +3162,7 @@ ftnlen diag_len; | |||
| /* Local variables */ | |||
| static integer ibeg, iend; | |||
| extern /* Double Complex */ VOID zbeg_(); | |||
| extern /* Double Complex */ VOID zbeg_(doublecomplex*, logical*); | |||
| static logical unit; | |||
| static integer i__, j; | |||
| static logical lower, upper; | |||
| @@ -3629,27 +3335,7 @@ ftnlen diag_len; | |||
| } /* zmake_ */ | |||
| /* Subroutine */ int zmmch_(transa, transb, m, n, kk, alpha, a, lda, b, ldb, | |||
| beta, c__, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv, | |||
| transa_len, transb_len) | |||
| char *transa, *transb; | |||
| integer *m, *n, *kk; | |||
| doublecomplex *alpha, *a; | |||
| integer *lda; | |||
| doublecomplex *b; | |||
| integer *ldb; | |||
| doublecomplex *beta, *c__; | |||
| integer *ldc; | |||
| doublecomplex *ct; | |||
| doublereal *g; | |||
| doublecomplex *cc; | |||
| integer *ldcc; | |||
| doublereal *eps, *err; | |||
| logical *fatal; | |||
| integer *nout; | |||
| logical *mv; | |||
| ftnlen transa_len; | |||
| ftnlen transb_len; | |||
| /* Subroutine */ int zmmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, doublecomplex* alpha, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* beta, doublecomplex* c__, integer* ldc, doublecomplex* ct, doublereal* g, doublecomplex* cc, integer* ldcc, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len) | |||
| { | |||
| /* System generated locals */ | |||
| @@ -3658,7 +3344,7 @@ ftnlen transb_len; | |||
| doublereal d__1, d__2, d__3, d__4, d__5, d__6; | |||
| doublecomplex z__1, z__2, z__3, z__4; | |||
| double sqrt(); | |||
| double sqrt(double); | |||
| /* Local variables */ | |||
| static doublereal erri; | |||
| static integer i__, j, k; | |||
| @@ -4031,9 +3717,7 @@ L250: | |||
| } /* zmmch_ */ | |||
| logical lze_(ri, rj, lr) | |||
| doublecomplex *ri, *rj; | |||
| integer *lr; | |||
| logical lze_(doublecomplex* ri, doublecomplex* rj, integer* lr) | |||
| { | |||
| /* System generated locals */ | |||
| integer i__1, i__2, i__3; | |||
| @@ -4082,13 +3766,7 @@ L30: | |||
| } /* lze_ */ | |||
| logical lzeres_(type__, uplo, m, n, aa, as, lda, type_len, uplo_len) | |||
| char *type__, *uplo; | |||
| integer *m, *n; | |||
| doublecomplex *aa, *as; | |||
| integer *lda; | |||
| ftnlen type_len; | |||
| ftnlen uplo_len; | |||
| logical lzeres_(char* type__, char* uplo, integer* m, integer* n, doublecomplex *aa, doublecomplex* as, integer* lda, ftnlen type_len, ftnlen uplo_len) | |||
| { | |||
| /* System generated locals */ | |||
| integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; | |||
| @@ -4184,9 +3862,7 @@ L80: | |||
| } /* lzeres_ */ | |||
| /* Double Complex */ VOID zbeg_( ret_val, reset) | |||
| doublecomplex * ret_val; | |||
| logical *reset; | |||
| /* Double Complex */ VOID zbeg_(doublecomplex* ret_val, logical* reset) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal d__1, d__2; | |||
| @@ -4249,8 +3925,7 @@ L10: | |||
| } /* zbeg_ */ | |||
| doublereal ddiff_(x, y) | |||
| doublereal *x, *y; | |||
| doublereal ddiff_(doublereal* x, doublereal* y) | |||
| { | |||
| /* System generated locals */ | |||
| doublereal ret_val; | |||
| @@ -805,7 +805,8 @@ static gotoblas_t *get_coretype(void){ | |||
| } | |||
| return NULL; | |||
| } | |||
| case 0xf: | |||
| break; | |||
| case 0xf: | |||
| if (model <= 0x2) return &gotoblas_NORTHWOOD; | |||
| return &gotoblas_PRESCOTT; | |||
| } | |||
| @@ -66,13 +66,8 @@ void CNAME(FLOAT *DA, FLOAT *DB, FLOAT *C, FLOAT *S){ | |||
| c = da / r; | |||
| s = db / r; | |||
| z = ONE; | |||
| if (da != ZERO) { | |||
| if (ada > adb){ | |||
| z = s; | |||
| } else { | |||
| z = ONE / c; | |||
| } | |||
| } | |||
| if (ada > adb) z = s; | |||
| if ((ada <= adb) && (c != ZERO)) z = ONE / c; | |||
| *C = c; | |||
| *S = s; | |||
| @@ -61,16 +61,16 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) { | |||
| *(S1 + 0) = *(DB + 0); | |||
| *(S1 + 1) = *(DB + 1) *-1; | |||
| if (da_r == ZERO && da_i == ZERO) { | |||
| *C = ZERO; | |||
| *C = ZERO; | |||
| if (db_r == ZERO) { | |||
| (*DA) = fabsl(db_i); | |||
| *S = *S1 /da_r; | |||
| *(S+1) = *(S1+1) /da_r; | |||
| *S = *S1 /(*DA); | |||
| *(S+1) = *(S1+1) /(*DA); | |||
| return; | |||
| } else if ( db_i == ZERO) { | |||
| *DA = fabsl(db_r); | |||
| *S = *S1 /da_r; | |||
| *(S+1) = *(S1+1) /da_r; | |||
| *S = *S1 /(*DA); | |||
| *(S+1) = *(S1+1) /(*DA); | |||
| return; | |||
| } else { | |||
| long double g1 = MAX( fabsl(db_r), fabsl(db_i)); | |||
| @@ -5,12 +5,6 @@ endif | |||
| TOPDIR = .. | |||
| include $(TOPDIR)/Makefile.system | |||
| ifeq ($(ARCH), power) | |||
| ifeq ($(C_COMPILER), CLANG) | |||
| override CFLAGS += -fno-integrated-as | |||
| endif | |||
| endif | |||
| AVX2OPT = | |||
| ifeq ($(C_COMPILER), GCC) | |||
| # AVX2 support was added in 4.7.0 | |||
| @@ -61,6 +61,15 @@ ifeq ($(CORE), ZEN) | |||
| USE_TRMM = 1 | |||
| endif | |||
| ifeq ($(OS), AIX) | |||
| M4VERSION := $(shell m4 --version < /dev/null 2>&1 | grep GNU 2>&1 >/dev/null ; echo $$?) | |||
| ifeq ($(M4VERSION), 0) | |||
| M4_AIX := m4 -l16384 | |||
| else | |||
| M4_AIX := m4 -B16384 | |||
| endif | |||
| $(info $$var is [${$(M4_AIX)}]) | |||
| endif | |||
| ifeq ($(CORE), POWER8) | |||
| ifeq ($(BINARY64),1) | |||
| USE_TRMM = 1 | |||
| @@ -634,15 +643,7 @@ $(KDIR)$(SBGEMMONCOPYOBJ) : $(KERNELDIR)/$(SBGEMMONCOPY) | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o $@ | |||
| $(KDIR)$(SBGEMMOTCOPYOBJ) : $(KERNELDIR)/$(SBGEMMOTCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o - > sbgemmotcopy.s | |||
| m4 sbgemmotcopy.s > sbgemmotcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX sbgemmotcopy_nomacros.s -o $@ | |||
| rm sbgemmotcopy.s sbgemmotcopy_nomacros.s | |||
| else | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o $@ | |||
| endif | |||
| ifneq ($(SBGEMM_UNROLL_M), $(SBGEMM_UNROLL_N)) | |||
| @@ -650,14 +651,7 @@ $(KDIR)$(SBGEMMINCOPYOBJ) : $(KERNELDIR)/$(SBGEMMINCOPY) | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o $@ | |||
| $(KDIR)$(SBGEMMITCOPYOBJ) : $(KERNELDIR)/$(SBGEMMITCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o - > sbgemmitcopy.s | |||
| m4 sbgemmitcopy.s > sbgemmitcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX sbgemmitcopy_nomacros.s -o $@ | |||
| rm sbgemmitcopy.s sbgemmitcopy_nomacros.s | |||
| else | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o $@ | |||
| endif | |||
| endif | |||
| endif | |||
| @@ -668,7 +662,7 @@ $(KDIR)$(SGEMMONCOPYOBJ) : $(KERNELDIR)/$(SGEMMONCOPY) | |||
| $(KDIR)$(SGEMMOTCOPYOBJ) : $(KERNELDIR)/$(SGEMMOTCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -UCOMPLEX $< -o - > sgemmotcopy.s | |||
| m4 sgemmotcopy.s > sgemmotcopy_nomacros.s | |||
| $(M4_AIX) sgemmotcopy.s > sgemmotcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -UCOMPLEX sgemmotcopy_nomacros.s -o $@ | |||
| rm sgemmotcopy.s sgemmotcopy_nomacros.s | |||
| else | |||
| @@ -684,7 +678,7 @@ $(KDIR)$(SGEMMINCOPYOBJ) : $(KERNELDIR)/$(SGEMMINCOPY) | |||
| $(KDIR)$(SGEMMITCOPYOBJ) : $(KERNELDIR)/$(SGEMMITCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -UCOMPLEX $< -o - > sgemmitcopy.s | |||
| m4 sgemmitcopy.s > sgemmitcopy_nomacros.s | |||
| $(M4_AIX) sgemmitcopy.s > sgemmitcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -UCOMPLEX sgemmitcopy_nomacros.s -o $@ | |||
| rm sgemmitcopy.s sgemmitcopy_nomacros.s | |||
| else | |||
| @@ -696,7 +690,7 @@ endif | |||
| $(KDIR)$(DGEMMONCOPYOBJ) : $(KERNELDIR)/$(DGEMMONCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -UCOMPLEX $< -o - > dgemm_ncopy.s | |||
| m4 dgemm_ncopy.s > dgemm_ncopy_nomacros.s | |||
| $(M4_AIX) dgemm_ncopy.s > dgemm_ncopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -UCOMPLEX dgemm_ncopy_nomacros.s -o $@ | |||
| rm dgemm_ncopy.s dgemm_ncopy_nomacros.s | |||
| else | |||
| @@ -714,7 +708,7 @@ $(KDIR)$(DGEMMINCOPYOBJ) : $(KERNELDIR)/$(DGEMMINCOPY) | |||
| $(KDIR)$(DGEMMITCOPYOBJ) : $(KERNELDIR)/$(DGEMMITCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -UCOMPLEX $< -o - > dgemm_itcopy.s | |||
| m4 dgemm_itcopy.s > dgemm_itcopy_nomacros.s | |||
| $(M4_AIX) dgemm_itcopy.s > dgemm_itcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -UCOMPLEX dgemm_itcopy_nomacros.s -o $@ | |||
| rm dgemm_itcopy.s dgemm_itcopy_nomacros.s | |||
| else | |||
| @@ -757,7 +751,7 @@ $(KDIR)$(CGEMMINCOPYOBJ) : $(KERNELDIR)/$(CGEMMINCOPY) | |||
| $(KDIR)$(CGEMMITCOPYOBJ) : $(KERNELDIR)/$(CGEMMITCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -UDOUBLE -UCOMPLEX -S $< -o - > cgemm_itcopy.s | |||
| m4 cgemm_itcopy.s > cgemm_itcopy_nomacros.s | |||
| $(M4_AIX) cgemm_itcopy.s > cgemm_itcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -UCOMPLEX cgemm_itcopy_nomacros.s -o $@ | |||
| rm cgemm_itcopy.s cgemm_itcopy_nomacros.s | |||
| else | |||
| @@ -780,7 +774,7 @@ $(KDIR)$(ZGEMMINCOPYOBJ) : $(KERNELDIR)/$(ZGEMMINCOPY) | |||
| $(KDIR)$(ZGEMMITCOPYOBJ) : $(KERNELDIR)/$(ZGEMMITCOPY) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -UCOMPLEX $< -o - > zgemm_itcopy.s | |||
| m4 zgemm_itcopy.s > zgemm_itcopy_nomacros.s | |||
| $(M4_AIX) zgemm_itcopy.s > zgemm_itcopy_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -UCOMPLEX zgemm_itcopy_nomacros.s -o $@ | |||
| rm zgemm_itcopy.s zgemm_itcopy_nomacros.s | |||
| else | |||
| @@ -812,7 +806,7 @@ endif | |||
| $(KDIR)sgemm_kernel$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(SGEMMKERNEL) $(SGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -UCOMPLEX $< -o - > sgemm_kernel$(TSUFFIX).s | |||
| m4 sgemm_kernel$(TSUFFIX).s > sgemm_kernel$(TSUFFIX)_nomacros.s | |||
| $(M4_AIX) sgemm_kernel$(TSUFFIX).s > sgemm_kernel$(TSUFFIX)_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -UCOMPLEX sgemm_kernel$(TSUFFIX)_nomacros.s -o $@ | |||
| rm sgemm_kernel$(TSUFFIX).s sgemm_kernel$(TSUFFIX)_nomacros.s | |||
| else | |||
| @@ -829,20 +823,13 @@ endif | |||
| ifeq ($(BUILD_BFLOAT16), 1) | |||
| $(KDIR)sbgemm_kernel$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(SBGEMMKERNEL) $(SBGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o - > sbgemm_kernel$(TSUFFIX).s | |||
| m4 sbgemm_kernel$(TSUFFIX).s > sbgemm_kernel$(TSUFFIX)_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX sbgemm_kernel$(TSUFFIX)_nomacros.s -o $@ | |||
| rm sbgemm_kernel$(TSUFFIX).s sbgemm_kernel$(TSUFFIX)_nomacros.s | |||
| else | |||
| $(CC) $(CFLAGS) -c -DBFLOAT16 -UDOUBLE -UCOMPLEX $< -o $@ | |||
| endif | |||
| endif | |||
| $(KDIR)dgemm_kernel$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DGEMMKERNEL) $(DGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -UCOMPLEX $< -o - > dgemm_kernel$(TSUFFIX).s | |||
| m4 dgemm_kernel$(TSUFFIX).s > dgemm_kernel$(TSUFFIX)_nomacros.s | |||
| $(M4_AIX) dgemm_kernel$(TSUFFIX).s > dgemm_kernel$(TSUFFIX)_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -UCOMPLEX dgemm_kernel$(TSUFFIX)_nomacros.s -o $@ | |||
| rm dgemm_kernel$(TSUFFIX).s dgemm_kernel$(TSUFFIX)_nomacros.s | |||
| else | |||
| @@ -855,7 +842,7 @@ $(KDIR)qgemm_kernel$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(QGEMMKERNEL) $(QGEMMDEP | |||
| $(KDIR)cgemm_kernel_n$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -DCOMPLEX -DNN $< -o - > cgemm_kernel_n.s | |||
| m4 cgemm_kernel_n.s > cgemm_kernel_n_nomacros.s | |||
| $(M4_AIX) cgemm_kernel_n.s > cgemm_kernel_n_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -DCOMPLEX -DNN cgemm_kernel_n_nomacros.s -o $@ | |||
| rm cgemm_kernel_n.s cgemm_kernel_n_nomacros.s | |||
| else | |||
| @@ -865,7 +852,7 @@ endif | |||
| $(KDIR)cgemm_kernel_l$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -DCOMPLEX -DCN $< -o - > cgemm_kernel_l.s | |||
| m4 cgemm_kernel_l.s > cgemm_kernel_l_nomacros.s | |||
| $(M4_AIX) cgemm_kernel_l.s > cgemm_kernel_l_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -DCOMPLEX -DCN cgemm_kernel_l_nomacros.s -o $@ | |||
| rm cgemm_kernel_l.s cgemm_kernel_l_nomacros.s | |||
| else | |||
| @@ -875,7 +862,7 @@ endif | |||
| $(KDIR)cgemm_kernel_r$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -DCOMPLEX -DNC $< -o - > cgemm_kernel_r.s | |||
| m4 cgemm_kernel_r.s > cgemm_kernel_r_nomacros.s | |||
| $(M4_AIX) cgemm_kernel_r.s > cgemm_kernel_r_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -DCOMPLEX -DNC cgemm_kernel_r_nomacros.s -o $@ | |||
| rm cgemm_kernel_r.s cgemm_kernel_r_nomacros.s | |||
| else | |||
| @@ -885,7 +872,7 @@ endif | |||
| $(KDIR)cgemm_kernel_b$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -UDOUBLE -DCOMPLEX -DCC $< -o - > cgemm_kernel_b.s | |||
| m4 cgemm_kernel_b.s > cgemm_kernel_b_nomacros.s | |||
| $(M4_AIX) cgemm_kernel_b.s > cgemm_kernel_b_nomacros.s | |||
| $(CC) $(CFLAGS) -c -UDOUBLE -DCOMPLEX -DCC cgemm_kernel_b_nomacros.s -o $@ | |||
| rm cgemm_kernel_b.s cgemm_kernel_b_nomacros.s | |||
| else | |||
| @@ -895,7 +882,7 @@ endif | |||
| $(KDIR)zgemm_kernel_n$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZGEMMKERNEL) $(ZGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -DCOMPLEX -DNN $< -o - > zgemm_kernel_n.s | |||
| m4 zgemm_kernel_n.s > zgemm_kernel_n_nomacros.s | |||
| $(M4_AIX) zgemm_kernel_n.s > zgemm_kernel_n_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -DCOMPLEX -DNN zgemm_kernel_n_nomacros.s -o $@ | |||
| rm zgemm_kernel_n.s zgemm_kernel_n_nomacros.s | |||
| else ifeq ($(CORE),SANDYBRIDGE) | |||
| @@ -907,7 +894,7 @@ endif | |||
| $(KDIR)zgemm_kernel_l$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZGEMMKERNEL) $(ZGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -DCOMPLEX -DCN $< -o - > zgemm_kernel_l.s | |||
| m4 zgemm_kernel_l.s > zgemm_kernel_l_nomacros.s | |||
| $(M4_AIX) zgemm_kernel_l.s > zgemm_kernel_l_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -DCOMPLEX -DCN zgemm_kernel_l_nomacros.s -o $@ | |||
| rm zgemm_kernel_l.s zgemm_kernel_l_nomacros.s | |||
| else ifeq ($(CORE),SANDYBRIDGE) | |||
| @@ -919,7 +906,7 @@ endif | |||
| $(KDIR)zgemm_kernel_r$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZGEMMKERNEL) $(ZGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -DCOMPLEX -DNC $< -o - > zgemm_kernel_r.s | |||
| m4 zgemm_kernel_r.s > zgemm_kernel_r_nomacros.s | |||
| $(M4_AIX) zgemm_kernel_r.s > zgemm_kernel_r_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -DCOMPLEX -DNC zgemm_kernel_r_nomacros.s -o $@ | |||
| rm zgemm_kernel_r.s zgemm_kernel_r_nomacros.s | |||
| else ifeq ($(CORE),SANDYBRIDGE) | |||
| @@ -931,7 +918,7 @@ endif | |||
| $(KDIR)zgemm_kernel_b$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZGEMMKERNEL) $(ZGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DDOUBLE -DCOMPLEX -DCC $< -o - > zgemm_kernel_b.s | |||
| m4 zgemm_kernel_b.s > zgemm_kernel_b_nomacros.s | |||
| $(M4_AIX) zgemm_kernel_b.s > zgemm_kernel_b_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DDOUBLE -DCOMPLEX -DCC zgemm_kernel_b_nomacros.s -o $@ | |||
| rm zgemm_kernel_b.s zgemm_kernel_b_nomacros.s | |||
| else ifeq ($(CORE),SANDYBRIDGE) | |||
| @@ -957,7 +944,7 @@ ifdef USE_TRMM | |||
| $(KDIR)strmm_kernel_LN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(STRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -DLEFT -UTRANSA $< -o - > strmmkernel_ln.s | |||
| m4 strmmkernel_ln.s > strmmkernel_ln_nomacros.s | |||
| $(M4_AIX) strmmkernel_ln.s > strmmkernel_ln_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -DLEFT -UTRANSA strmmkernel_ln_nomacros.s -o $@ | |||
| rm strmmkernel_ln.s strmmkernel_ln_nomacros.s | |||
| else | |||
| @@ -967,7 +954,7 @@ endif | |||
| $(KDIR)strmm_kernel_LT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(STRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -DLEFT -DTRANSA $< -o - > strmmkernel_lt.s | |||
| m4 strmmkernel_lt.s > strmmkernel_lt_nomacros.s | |||
| $(M4_AIX) strmmkernel_lt.s > strmmkernel_lt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -DLEFT -DTRANSA strmmkernel_lt_nomacros.s -o $@ | |||
| rm strmmkernel_lt.s strmmkernel_lt_nomacros.s | |||
| else | |||
| @@ -977,7 +964,7 @@ endif | |||
| $(KDIR)strmm_kernel_RN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(STRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -UTRANSA $< -o - > strmmkernel_rn.s | |||
| m4 strmmkernel_rn.s > strmmkernel_rn_nomacros.s | |||
| $(M4_AIX) strmmkernel_rn.s > strmmkernel_rn_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -UTRANSA strmmkernel_rn_nomacros.s -o $@ | |||
| rm strmmkernel_rn.s strmmkernel_rn_nomacros.s | |||
| else | |||
| @@ -987,7 +974,7 @@ endif | |||
| $(KDIR)strmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(STRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA $< -o - > strmm_kernel_rt.s | |||
| m4 strmm_kernel_rt.s > strmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) strmm_kernel_rt.s > strmm_kernel_rt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA strmm_kernel_rt_nomacros.s -o $@ | |||
| rm strmm_kernel_rt.s strmm_kernel_rt_nomacros.s | |||
| else | |||
| @@ -997,7 +984,7 @@ endif | |||
| $(KDIR)dtrmm_kernel_LN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -UCOMPLEX -DLEFT -UTRANSA $< -o - > dtrmm_kernel_ln.s | |||
| m4 dtrmm_kernel_ln.s > dtrmm_kernel_ln_nomacros.s | |||
| $(M4_AIX) dtrmm_kernel_ln.s > dtrmm_kernel_ln_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -UCOMPLEX -DLEFT -UTRANSA dtrmm_kernel_ln_nomacros.s -o $@ | |||
| rm dtrmm_kernel_ln.s dtrmm_kernel_ln_nomacros.s | |||
| else | |||
| @@ -1007,7 +994,7 @@ endif | |||
| $(KDIR)dtrmm_kernel_LT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -UCOMPLEX -DLEFT -DTRANSA $< -o - > dtrmm_kernel_lt.s | |||
| m4 dtrmm_kernel_lt.s > dtrmm_kernel_lt_nomacros.s | |||
| $(M4_AIX) dtrmm_kernel_lt.s > dtrmm_kernel_lt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -UCOMPLEX -DLEFT -DTRANSA dtrmm_kernel_lt_nomacros.s -o $@ | |||
| rm dtrmm_kernel_lt.s dtrmm_kernel_lt_nomacros.s | |||
| else | |||
| @@ -1017,7 +1004,7 @@ endif | |||
| $(KDIR)dtrmm_kernel_RN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -UCOMPLEX -ULEFT -UTRANSA $< -o - > dtrmm_kernel_rn.s | |||
| m4 dtrmm_kernel_rn.s > dtrmm_kernel_rn_nomacros.s | |||
| $(M4_AIX) dtrmm_kernel_rn.s > dtrmm_kernel_rn_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -UCOMPLEX -ULEFT -UTRANSA dtrmm_kernel_rn_nomacros.s -o $@ | |||
| rm dtrmm_kernel_rn.s dtrmm_kernel_rn_nomacros.s | |||
| else | |||
| @@ -1027,7 +1014,7 @@ endif | |||
| $(KDIR)dtrmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -UCOMPLEX -ULEFT -DTRANSA $< -o - > dtrmm_kernel_rt.s | |||
| m4 dtrmm_kernel_rt.s > dtrmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) dtrmm_kernel_rt.s > dtrmm_kernel_rt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -UCOMPLEX -ULEFT -DTRANSA dtrmm_kernel_rt_nomacros.s -o $@ | |||
| rm dtrmm_kernel_rt.s dtrmm_kernel_rt_nomacros.s | |||
| else | |||
| @@ -1049,7 +1036,7 @@ $(KDIR)qtrmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(QGEMMKERNEL) | |||
| $(KDIR)ctrmm_kernel_LN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -UTRANSA -UCONJ -DNN $< -o - > ctrmm_kernel_ln.s | |||
| m4 ctrmm_kernel_ln.s > ctrmm_kernel_ln_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_ln.s > ctrmm_kernel_ln_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -UTRANSA -UCONJ -DNN ctrmm_kernel_ln_nomacros.s -o $@ | |||
| rm ctrmm_kernel_ln.s ctrmm_kernel_ln_nomacros.s | |||
| else | |||
| @@ -1059,7 +1046,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_LT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -DTRANSA -UCONJ -DNN $< -o - > ctrmm_kernel_lt.s | |||
| m4 ctrmm_kernel_lt.s > ctrmm_kernel_lt_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_lt.s > ctrmm_kernel_lt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -DTRANSA -UCONJ -DNN ctrmm_kernel_lt_nomacros.s -o $@ | |||
| rm ctrmm_kernel_lt.s ctrmm_kernel_lt_nomacros.s | |||
| else | |||
| @@ -1069,7 +1056,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_LR$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -UTRANSA -DCONJ -DCN $< -o - > ctrmm_kernel_lr.s | |||
| m4 ctrmm_kernel_lr.s > ctrmm_kernel_lr_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_lr.s > ctrmm_kernel_lr_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -UTRANSA -DCONJ -DCN ctrmm_kernel_lr_nomacros.s -o $@ | |||
| rm ctrmm_kernel_lr.s ctrmm_kernel_lr_nomacros.s | |||
| else | |||
| @@ -1079,7 +1066,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_LC$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -DTRANSA -DCONJ -DCN $< -o - > ctrmm_kernel_lc.s | |||
| m4 ctrmm_kernel_lc.s > ctrmm_kernel_lc_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_lc.s > ctrmm_kernel_lc_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -DLEFT -DTRANSA -DCONJ -DCN ctrmm_kernel_lc_nomacros.s -o $@ | |||
| rm ctrmm_kernel_lc_nomacros.s ctrmm_kernel_lc.s | |||
| else | |||
| @@ -1089,7 +1076,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_RN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -UTRANSA -UCONJ -DNN $< -o - > ctrmm_kernel_rn.s | |||
| m4 ctrmm_kernel_rn.s > ctrmm_kernel_rn_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_rn.s > ctrmm_kernel_rn_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -UTRANSA -UCONJ -DNN ctrmm_kernel_rn_nomacros.s -o $@ | |||
| rm ctrmm_kernel_rn.s ctrmm_kernel_rn_nomacros.s | |||
| else | |||
| @@ -1099,7 +1086,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -DTRANSA -UCONJ -DNN $< -o - > ctrmm_kernel_rt.s | |||
| m4 ctrmm_kernel_rt.s > ctrmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_rt.s > ctrmm_kernel_rt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -DTRANSA -UCONJ -DNN ctrmm_kernel_rt_nomacros.s -o $@ | |||
| rm ctrmm_kernel_rt.s ctrmm_kernel_rt_nomacros.s | |||
| else | |||
| @@ -1109,7 +1096,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_RR$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -UTRANSA -DCONJ -DNC $< -o - > ctrmm_kernel_rr.s | |||
| m4 ctrmm_kernel_rr.s > ctrmm_kernel_rr_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_rr.s > ctrmm_kernel_rr_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -UTRANSA -DCONJ -DNC ctrmm_kernel_rr_nomacros.s -o $@ | |||
| rm ctrmm_kernel_rr.s ctrmm_kernel_rr_nomacros.s | |||
| else | |||
| @@ -1119,7 +1106,7 @@ endif | |||
| $(KDIR)ctrmm_kernel_RC$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(CTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -DTRANSA -DCONJ -DNC $< -o - > ctrmm_kernel_RC.s | |||
| m4 ctrmm_kernel_RC.s > ctrmm_kernel_RC_nomacros.s | |||
| $(M4_AIX) ctrmm_kernel_RC.s > ctrmm_kernel_RC_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -DCOMPLEX -ULEFT -DTRANSA -DCONJ -DNC ctrmm_kernel_RC_nomacros.s -o $@ | |||
| rm ctrmm_kernel_RC.s ctrmm_kernel_RC_nomacros.s | |||
| else | |||
| @@ -1129,7 +1116,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_LN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -UTRANSA -UCONJ -DNN $< -o - > ztrmm_kernel_ln.s | |||
| m4 ztrmm_kernel_ln.s > ztrmm_kernel_ln_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_ln.s > ztrmm_kernel_ln_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -UTRANSA -UCONJ -DNN ztrmm_kernel_ln_nomacros.s -o $@ | |||
| rm ztrmm_kernel_ln.s ztrmm_kernel_ln_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1141,7 +1128,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_LT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -DTRANSA -UCONJ -DNN $< -o - > ztrmm_kernel_lt.s | |||
| m4 ztrmm_kernel_lt.s > ztrmm_kernel_lt_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_lt.s > ztrmm_kernel_lt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -DTRANSA -UCONJ -DNN ztrmm_kernel_lt_nomacros.s -o $@ | |||
| rm ztrmm_kernel_lt.s ztrmm_kernel_lt_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1153,7 +1140,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_LR$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -UTRANSA -DCONJ -DCN $< -o - > ztrmm_kernel_lr.s | |||
| m4 ztrmm_kernel_lr.s > ztrmm_kernel_lr_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_lr.s > ztrmm_kernel_lr_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -UTRANSA -DCONJ -DCN ztrmm_kernel_lr_nomacros.s -o $@ | |||
| rm ztrmm_kernel_lr.s ztrmm_kernel_lr_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1165,7 +1152,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_LC$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -DTRANSA -DCONJ -DCN $< -o - > ztrmm_kernel_lc.s | |||
| m4 ztrmm_kernel_lc.s >ztrmm_kernel_lc_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_lc.s >ztrmm_kernel_lc_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -DLEFT -DTRANSA -DCONJ -DCN ztrmm_kernel_lc_nomacros.s -o $@ | |||
| rm ztrmm_kernel_lc.s ztrmm_kernel_lc_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1177,7 +1164,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_RN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -UTRANSA -UCONJ -DNN $< -o - > ztrmm_kernel_rn.s | |||
| m4 ztrmm_kernel_rn.s > ztrmm_kernel_rn_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_rn.s > ztrmm_kernel_rn_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -UTRANSA -UCONJ -DNN ztrmm_kernel_rn_nomacros.s -o $@ | |||
| rm ztrmm_kernel_rn.s ztrmm_kernel_rn_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1189,7 +1176,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -DTRANSA -UCONJ -DNN $< -o - > ztrmm_kernel_rt.s | |||
| m4 ztrmm_kernel_rt.s > ztrmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_rt.s > ztrmm_kernel_rt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -DTRANSA -UCONJ -DNN ztrmm_kernel_rt_nomacros.s -o $@ | |||
| rm ztrmm_kernel_rt.s ztrmm_kernel_rt_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1201,7 +1188,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_RR$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -UTRANSA -DCONJ -DNC $< -o - > ztrmm_kernel_rr.s | |||
| m4 ztrmm_kernel_rr.s > ztrmm_kernel_rr_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_rr.s > ztrmm_kernel_rr_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -UTRANSA -DCONJ -DNC ztrmm_kernel_rr_nomacros.s -o $@ | |||
| rm ztrmm_kernel_rr.s ztrmm_kernel_rr_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1213,7 +1200,7 @@ endif | |||
| $(KDIR)ztrmm_kernel_RC$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(ZTRMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -DTRANSA -DCONJ -DNC $< -o - > ztrmm_kernel_rc.s | |||
| m4 ztrmm_kernel_rc.s > ztrmm_kernel_rc_nomacros.s | |||
| $(M4_AIX) ztrmm_kernel_rc.s > ztrmm_kernel_rc_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -DDOUBLE -DCOMPLEX -ULEFT -DTRANSA -DCONJ -DNC ztrmm_kernel_rc_nomacros.s -o $@ | |||
| rm ztrmm_kernel_rc.s ztrmm_kernel_rc_nomacros.s | |||
| else ifeq ($(CORE), SANDYBRIDGE) | |||
| @@ -1235,7 +1222,7 @@ $(KDIR)strmm_kernel_RN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(SGEMMKERNEL) | |||
| $(KDIR)strmm_kernel_RT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(SGEMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA $< -o - > strmm_kernel_rt.s | |||
| m4 strmm_kernel_rt.s > strmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) strmm_kernel_rt.s > strmm_kernel_rt_nomacros.s | |||
| $(CC) $(CFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA strmm_kernel_rt_nomacros.s -o $@ | |||
| rm strmm_kernel_rt.s strmm_kernel_rt_nomacros.s | |||
| else | |||
| @@ -1395,7 +1382,7 @@ $(KDIR)dtrsm_kernel_LN$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRSMKERNEL_LN) $(DT | |||
| $(KDIR)dtrsm_kernel_LT$(TSUFFIX).$(SUFFIX) : $(KERNELDIR)/$(DTRSMKERNEL_LT) $(DTRSMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRSMKERNEL -UCOMPLEX -DDOUBLE -UUPPER -DLT -UCONJ $< -o - > dtrsm_kernel_lt.s | |||
| m4 dtrsm_kernel_lt.s > dtrsm_kernel_lt_nomacros.s | |||
| $(M4_AIX) dtrsm_kernel_lt.s > dtrsm_kernel_lt_nomacros.s | |||
| $(CC) -c $(CFLAGS) -DTRSMKERNEL -UCOMPLEX -DDOUBLE -UUPPER -DLT -UCONJ dtrsm_kernel_lt_nomacros.s -o $@ | |||
| rm dtrsm_kernel_lt.s dtrsm_kernel_lt_nomacros.s | |||
| else | |||
| @@ -2987,7 +2974,7 @@ $(KDIR)cgemm_kernel_l$(TSUFFIX).$(PSUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMM | |||
| $(KDIR)cgemm_kernel_r$(TSUFFIX).$(PSUFFIX) : $(KERNELDIR)/$(CGEMMKERNEL) $(CGEMMDEPEND) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(PFLAGS) -S -UDOUBLE -DCOMPLEX -DNC $< -o - > cgemm_kernel_r.s | |||
| m4 cgemm_kernel_r.s > cgemm_kernel_r_nomacros.s | |||
| $(M4_AIX) cgemm_kernel_r.s > cgemm_kernel_r_nomacros.s | |||
| $(CC) $(PFLAGS) -c -UDOUBLE -DCOMPLEX -DNC cgemm_kernel_r_nomacros.s -o $@ | |||
| rm cgemm_kernel_r.s cgemm_kernel_r_nomacros.s | |||
| else | |||
| @@ -3033,7 +3020,7 @@ $(KDIR)strmm_kernel_RN$(TSUFFIX).$(PSUFFIX) : $(KERNELDIR)/$(SGEMMKERNEL) | |||
| $(KDIR)strmm_kernel_RT$(TSUFFIX).$(PSUFFIX) : $(KERNELDIR)/$(SGEMMKERNEL) | |||
| ifeq ($(OS), AIX) | |||
| $(CC) $(CFLAGS) -S -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA $< -o - > strmm_kernel_rt.s | |||
| m4 strmmkernel_rn.s > strmm_kernel_rt_nomacros.s | |||
| $(M4_AIX) strmmkernel_rn.s > strmm_kernel_rt_nomacros.s | |||
| $(CC) $(PFLAGS) -c -DTRMMKERNEL -UDOUBLE -UCOMPLEX -ULEFT -DTRANSA strmm_kernel_rt_nomacros.s -o $@ | |||
| rm strmm_kernel_rt.s strmm_kernel_rt_nomacros.s | |||
| else | |||
| @@ -57,7 +57,7 @@ CAMAXKERNEL = zamax.S | |||
| ZAMAXKERNEL = zamax.S | |||
| SAXPYKERNEL = axpy.S | |||
| DAXPYKERNEL = axpy.S | |||
| DAXPYKERNEL = daxpy_thunderx2t99.S | |||
| CAXPYKERNEL = zaxpy.S | |||
| ZAXPYKERNEL = zaxpy.S | |||
| @@ -81,45 +81,35 @@ DGEMVTKERNEL = gemv_t.S | |||
| CGEMVTKERNEL = zgemv_t.S | |||
| ZGEMVTKERNEL = zgemv_t.S | |||
| SASUMKERNEL = asum.S | |||
| DASUMKERNEL = asum.S | |||
| CASUMKERNEL = casum.S | |||
| ZASUMKERNEL = zasum.S | |||
| SCOPYKERNEL = copy.S | |||
| DCOPYKERNEL = copy.S | |||
| CCOPYKERNEL = copy.S | |||
| ZCOPYKERNEL = copy.S | |||
| SSWAPKERNEL = swap.S | |||
| DSWAPKERNEL = swap.S | |||
| CSWAPKERNEL = swap.S | |||
| ZSWAPKERNEL = swap.S | |||
| ISAMAXKERNEL = iamax.S | |||
| IDAMAXKERNEL = iamax.S | |||
| ICAMAXKERNEL = izamax.S | |||
| IZAMAXKERNEL = izamax.S | |||
| SNRM2KERNEL = nrm2.S | |||
| DNRM2KERNEL = nrm2.S | |||
| CNRM2KERNEL = znrm2.S | |||
| ZNRM2KERNEL = znrm2.S | |||
| DDOTKERNEL = dot.S | |||
| ifneq ($(C_COMPILER), PGI) | |||
| SDOTKERNEL = ../generic/dot.c | |||
| else | |||
| SDOTKERNEL = dot.S | |||
| endif | |||
| ifneq ($(C_COMPILER), PGI) | |||
| CDOTKERNEL = zdot.S | |||
| ZDOTKERNEL = zdot.S | |||
| else | |||
| CDOTKERNEL = ../arm/zdot.c | |||
| ZDOTKERNEL = ../arm/zdot.c | |||
| endif | |||
| SASUMKERNEL = sasum_thunderx2t99.c | |||
| DASUMKERNEL = dasum_thunderx2t99.c | |||
| CASUMKERNEL = casum_thunderx2t99.c | |||
| ZASUMKERNEL = zasum_thunderx2t99.c | |||
| SCOPYKERNEL = copy_thunderx2t99.c | |||
| DCOPYKERNEL = copy_thunderx2t99.c | |||
| CCOPYKERNEL = copy_thunderx2t99.c | |||
| ZCOPYKERNEL = copy_thunderx2t99.c | |||
| SSWAPKERNEL = swap_thunderx2t99.S | |||
| DSWAPKERNEL = swap_thunderx2t99.S | |||
| CSWAPKERNEL = swap_thunderx2t99.S | |||
| ZSWAPKERNEL = swap_thunderx2t99.S | |||
| ISAMAXKERNEL = iamax_thunderx2t99.c | |||
| IDAMAXKERNEL = iamax_thunderx2t99.c | |||
| ICAMAXKERNEL = izamax_thunderx2t99.c | |||
| IZAMAXKERNEL = izamax_thunderx2t99.c | |||
| SNRM2KERNEL = scnrm2_thunderx2t99.c | |||
| DNRM2KERNEL = dznrm2_thunderx2t99.c | |||
| CNRM2KERNEL = scnrm2_thunderx2t99.c | |||
| ZNRM2KERNEL = dznrm2_thunderx2t99.c | |||
| DDOTKERNEL = dot.c | |||
| SDOTKERNEL = dot.c | |||
| CDOTKERNEL = zdot_thunderx2t99.c | |||
| ZDOTKERNEL = zdot_thunderx2t99.c | |||
| DSDOTKERNEL = dot.S | |||
| DGEMM_BETA = dgemm_beta.S | |||
| @@ -128,10 +118,10 @@ SGEMM_BETA = sgemm_beta.S | |||
| SGEMMKERNEL = sgemm_kernel_sve_v2x$(SGEMM_UNROLL_N).S | |||
| STRMMKERNEL = strmm_kernel_sve_v1x$(SGEMM_UNROLL_N).S | |||
| SGEMMINCOPY = sgemm_ncopy_sve_v1.c | |||
| SGEMMITCOPY = sgemm_tcopy_sve_v1.c | |||
| SGEMMONCOPY = sgemm_ncopy_$(DGEMM_UNROLL_N).S | |||
| SGEMMOTCOPY = sgemm_tcopy_$(DGEMM_UNROLL_N).S | |||
| SGEMMINCOPY = gemm_ncopy_sve_v1x$(SGEMM_UNROLL_N).c | |||
| SGEMMITCOPY = gemm_tcopy_sve_v1x$(SGEMM_UNROLL_N).c | |||
| SGEMMONCOPY = sgemm_ncopy_$(SGEMM_UNROLL_N).S | |||
| SGEMMOTCOPY = sgemm_tcopy_$(SGEMM_UNROLL_N).S | |||
| SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) | |||
| SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) | |||
| @@ -149,8 +139,8 @@ SSYMMLCOPY_M = symm_lcopy_sve.c | |||
| DGEMMKERNEL = dgemm_kernel_sve_v2x$(DGEMM_UNROLL_N).S | |||
| DTRMMKERNEL = dtrmm_kernel_sve_v1x$(DGEMM_UNROLL_N).S | |||
| DGEMMINCOPY = dgemm_ncopy_sve_v1.c | |||
| DGEMMITCOPY = dgemm_tcopy_sve_v1.c | |||
| DGEMMINCOPY = gemm_ncopy_sve_v1x$(DGEMM_UNROLL_N).c | |||
| DGEMMITCOPY = gemm_tcopy_sve_v1x$(DGEMM_UNROLL_N).c | |||
| DGEMMONCOPY = dgemm_ncopy_$(DGEMM_UNROLL_N).S | |||
| DGEMMOTCOPY = dgemm_tcopy_$(DGEMM_UNROLL_N).S | |||
| @@ -170,8 +160,8 @@ DSYMMLCOPY_M = symm_lcopy_sve.c | |||
| CGEMMKERNEL = cgemm_kernel_sve_v1x$(ZGEMM_UNROLL_N).S | |||
| CTRMMKERNEL = ctrmm_kernel_sve_v1x$(ZGEMM_UNROLL_N).S | |||
| CGEMMINCOPY = cgemm_ncopy_sve_v1.c | |||
| CGEMMITCOPY = cgemm_tcopy_sve_v1.c | |||
| CGEMMINCOPY = gemm_ncopy_complex_sve_v1x$(ZGEMM_UNROLL_N).c | |||
| CGEMMITCOPY = gemm_tcopy_complex_sve_v1x$(ZGEMM_UNROLL_N).c | |||
| CGEMMONCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_N).c | |||
| CGEMMOTCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_N).c | |||
| @@ -194,8 +184,8 @@ CSYMMLCOPY_M = zsymm_lcopy_sve.c | |||
| ZGEMMKERNEL = zgemm_kernel_sve_v1x$(ZGEMM_UNROLL_N).S | |||
| ZTRMMKERNEL = ztrmm_kernel_sve_v1x$(ZGEMM_UNROLL_N).S | |||
| ZGEMMINCOPY = zgemm_ncopy_sve_v1.c | |||
| ZGEMMITCOPY = zgemm_tcopy_sve_v1.c | |||
| ZGEMMINCOPY = gemm_ncopy_complex_sve_v1x$(ZGEMM_UNROLL_N).c | |||
| ZGEMMITCOPY = gemm_tcopy_complex_sve_v1x$(ZGEMM_UNROLL_N).c | |||
| ZGEMMONCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_N).c | |||
| ZGEMMOTCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_N).c | |||
| @@ -1,6 +1,3 @@ | |||
| ifeq ($(HAVE_GAS), 1) | |||
| include $(KERNELDIR)/KERNEL.POWER8 | |||
| else | |||
| #SGEMM_BETA = ../generic/gemm_beta.c | |||
| #DGEMM_BETA = ../generic/gemm_beta.c | |||
| #CGEMM_BETA = ../generic/zgemm_beta.c | |||
| @@ -19,8 +16,13 @@ SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) | |||
| STRMMKERNEL = sgemm_kernel_power10.c | |||
| DTRMMKERNEL = dgemm_kernel_power10.c | |||
| ifeq ($(OSNAME), AIX) | |||
| CTRMMKERNEL = ctrmm_kernel_8x4_power8.S | |||
| ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S | |||
| else | |||
| CTRMMKERNEL = cgemm_kernel_power10.S | |||
| ZTRMMKERNEL = zgemm_kernel_power10.S | |||
| endif | |||
| SGEMMKERNEL = sgemm_kernel_power10.c | |||
| SGEMMINCOPY = ../generic/gemm_ncopy_16.c | |||
| @@ -62,10 +64,18 @@ DGEMM_SMALL_K_B0_TT = dgemm_small_kernel_tt_power10.c | |||
| DGEMM_SMALL_K_TN = dgemm_small_kernel_tn_power10.c | |||
| DGEMM_SMALL_K_B0_TN = dgemm_small_kernel_tn_power10.c | |||
| ifeq ($(OSNAME), AIX) | |||
| CGEMMKERNEL = cgemm_kernel_8x4_power8.S | |||
| else | |||
| CGEMMKERNEL = cgemm_kernel_power10.S | |||
| endif | |||
| #CGEMMKERNEL = cgemm_kernel_8x4_power8.S | |||
| CGEMMINCOPY = ../generic/zgemm_ncopy_8.c | |||
| ifeq ($(OSNAME), AIX) | |||
| CGEMMITCOPY = cgemm_tcopy_8_power8.S | |||
| else | |||
| CGEMMITCOPY = ../generic/zgemm_tcopy_8.c | |||
| endif | |||
| CGEMMONCOPY = ../generic/zgemm_ncopy_4.c | |||
| CGEMMOTCOPY = ../generic/zgemm_tcopy_4.c | |||
| CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) | |||
| @@ -73,7 +83,11 @@ CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) | |||
| CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) | |||
| CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) | |||
| ifeq ($(OSNAME), AIX) | |||
| ZGEMMKERNEL = zgemm_kernel_8x2_power8.S | |||
| else | |||
| ZGEMMKERNEL = zgemm_kernel_power10.S | |||
| endif | |||
| ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c | |||
| ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c | |||
| ZGEMMINCOPY = ../generic/zgemm_ncopy_8.c | |||
| @@ -124,6 +138,7 @@ ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c | |||
| #SMINKERNEL = ../arm/min.c | |||
| #DMINKERNEL = ../arm/min.c | |||
| # | |||
| ifeq ($(C_COMPILER), GCC) | |||
| ifneq ($(GCCVERSIONGTEQ9),1) | |||
| ISAMAXKERNEL = isamax_power9.S | |||
| else | |||
| @@ -148,6 +163,15 @@ ICAMINKERNEL = icamin_power9.S | |||
| else | |||
| ICAMINKERNEL = icamin.c | |||
| endif | |||
| else | |||
| ISAMAXKERNEL = isamax.c | |||
| IDAMAXKERNEL = idamax.c | |||
| ICAMAXKERNEL = icamax.c | |||
| IZAMAXKERNEL = izamax.c | |||
| ISAMINKERNEL = isamin.c | |||
| IDAMINKERNEL = idamin.c | |||
| ICAMINKERNEL = icamin.c | |||
| endif | |||
| IZAMINKERNEL = izamin.c | |||
| # | |||
| #ISMAXKERNEL = ../arm/imax.c | |||
| @@ -238,4 +262,3 @@ QCABS_KERNEL = ../generic/cabs.c | |||
| #Dump kernel | |||
| CGEMM3MKERNEL = ../generic/zgemm3mkernel_dump.c | |||
| ZGEMM3MKERNEL = ../generic/zgemm3mkernel_dump.c | |||
| endif | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,24 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| @@ -291,217 +273,7 @@ static double dpow_ui(double x, integer n) { | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -223,7 +223,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -237,145 +236,5 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| @@ -223,7 +223,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -237,149 +236,10 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -223,7 +223,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -237,149 +236,10 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,11 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| @@ -279,229 +273,6 @@ static float spow_ui(float x, integer n) { | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -223,7 +223,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -237,145 +236,5 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,252 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,251 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,252 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,252 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,247 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,8 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,248 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| /* | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b CLARND */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,11 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| @@ -279,235 +273,6 @@ static float spow_ui(float x, integer n) { | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b CLATM2 */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b CLATM3 */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b DLARAN */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b DLARND */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,24 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| @@ -291,223 +273,6 @@ static double dpow_ui(double x, integer n) { | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b DLATM1 */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b DLATM2 */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* > \brief \b DLATM3 */ | |||
| @@ -247,7 +247,6 @@ typedef struct Namelist Namelist; | |||
| #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } | |||
| #define sig_die(s, kill) { exit(1); } | |||
| #define s_stop(s, n) {exit(0);} | |||
| static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| #define z_abs(z) (cabs(Cd(z))) | |||
| #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} | |||
| #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} | |||
| @@ -261,253 +260,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; | |||
| /* procedure parameter types for -A and -C++ */ | |||
| #define F2C_proc_par_types 1 | |||
| #ifdef __cplusplus | |||
| typedef logical (*L_fp)(...); | |||
| #else | |||
| typedef logical (*L_fp)(); | |||
| #endif | |||
| static float spow_ui(float x, integer n) { | |||
| float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static double dpow_ui(double x, integer n) { | |||
| double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #ifdef _MSC_VER | |||
| static _Fcomplex cpow_ui(complex x, integer n) { | |||
| complex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow.r *= x.r, pow.i *= x.i; | |||
| if(u >>= 1) x.r *= x.r, x.i *= x.i; | |||
| else break; | |||
| } | |||
| } | |||
| _Fcomplex p={pow.r, pow.i}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex float cpow_ui(_Complex float x, integer n) { | |||
| _Complex float pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| #ifdef _MSC_VER | |||
| static _Dcomplex zpow_ui(_Dcomplex x, integer n) { | |||
| _Dcomplex pow={1.0,0.0}; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; | |||
| if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; | |||
| else break; | |||
| } | |||
| } | |||
| _Dcomplex p = {pow._Val[0], pow._Val[1]}; | |||
| return p; | |||
| } | |||
| #else | |||
| static _Complex double zpow_ui(_Complex double x, integer n) { | |||
| _Complex double pow=1.0; unsigned long int u; | |||
| if(n != 0) { | |||
| if(n < 0) n = -n, x = 1/x; | |||
| for(u = n; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| #endif | |||
| static integer pow_ii(integer x, integer n) { | |||
| integer pow; unsigned long int u; | |||
| if (n <= 0) { | |||
| if (n == 0 || x == 1) pow = 1; | |||
| else if (x != -1) pow = x == 0 ? 1/x : 0; | |||
| else n = -n; | |||
| } | |||
| if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { | |||
| u = n; | |||
| for(pow = 1; ; ) { | |||
| if(u & 01) pow *= x; | |||
| if(u >>= 1) x *= x; | |||
| else break; | |||
| } | |||
| } | |||
| return pow; | |||
| } | |||
| static integer dmaxloc_(double *w, integer s, integer e, integer *n) | |||
| { | |||
| double m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static integer smaxloc_(float *w, integer s, integer e, integer *n) | |||
| { | |||
| float m; integer i, mi; | |||
| for(m=w[s-1], mi=s, i=s+1; i<=e; i++) | |||
| if (w[i-1]>m) mi=i ,m=w[i-1]; | |||
| return mi-s+1; | |||
| } | |||
| static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i])) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i])) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Fcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex float zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i]) * Cf(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]); | |||
| } | |||
| } | |||
| pCf(z) = zdotc; | |||
| } | |||
| #endif | |||
| static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) { | |||
| integer n = *n_, incx = *incx_, incy = *incy_, i; | |||
| #ifdef _MSC_VER | |||
| _Dcomplex zdotc = {0.0, 0.0}; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1]; | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0]; | |||
| zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1]; | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #else | |||
| _Complex double zdotc = 0.0; | |||
| if (incx == 1 && incy == 1) { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i]) * Cd(&y[i]); | |||
| } | |||
| } else { | |||
| for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */ | |||
| zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]); | |||
| } | |||
| } | |||
| pCd(z) = zdotc; | |||
| } | |||
| #endif | |||
| /* -- translated by f2c (version 20000121). | |||
| You must link the resulting object file with the libraries: | |||
| -lf2c -lm (in that order) | |||
| */ | |||
| /* Table of constant values */ | |||