Mercurial > hg > octave-lyh

view libcruft/odepack/ewset.f @ 13754:e652ff4d1522

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
don't crash when concatenating structs with no fields * oct-map.cc (octave_map::cat (int, octave_idx_type, const octave_scalar_map*)): Quick return for N == 1. (octave_map::cat (int, octave_idx_type, const octave_map*)): Quick return for N == 1. Only call permute_to_correct_order if there are fields. Use dim_vector::concat to compute result dimensions if there are no fields. New tests for concatentation of structs with no fields. * pt-mat.cc (tm_const::init (const tree_matrix&)): Initialize all_1x1 to true if tree_matrix argument is not empty.
author John W. Eaton <jwe@octave.org>
date Wed, 26 Oct 2011 00:50:39 -0400
parents d20a2f261306
children
line wrap: on
line source

      SUBROUTINE EWSET (N, ITOL, RTOL, ATOL, YCUR, EWT)
CLLL. OPTIMIZE
C-----------------------------------------------------------------------
C THIS SUBROUTINE SETS THE ERROR WEIGHT VECTOR EWT ACCORDING TO
C     EWT(I) = RTOL(I)*ABS(YCUR(I)) + ATOL(I),  I = 1,...,N,
C WITH THE SUBSCRIPT ON RTOL AND/OR ATOL POSSIBLY REPLACED BY 1 ABOVE,
C DEPENDING ON THE VALUE OF ITOL.
C-----------------------------------------------------------------------
      INTEGER N, ITOL
      INTEGER I
      DOUBLE PRECISION RTOL, ATOL, YCUR, EWT
      DIMENSION RTOL(*), ATOL(*), YCUR(N), EWT(N) 
C
      GO TO (10, 20, 30, 40), ITOL
 10   CONTINUE
      DO 15 I = 1,N 
 15     EWT(I) = RTOL(1)*DABS(YCUR(I)) + ATOL(1)
      RETURN
 20   CONTINUE
      DO 25 I = 1,N 
 25     EWT(I) = RTOL(1)*DABS(YCUR(I)) + ATOL(I)
      RETURN
 30   CONTINUE
      DO 35 I = 1,N 
 35     EWT(I) = RTOL(I)*DABS(YCUR(I)) + ATOL(1)
      RETURN
 40   CONTINUE
      DO 45 I = 1,N 
 45     EWT(I) = RTOL(I)*DABS(YCUR(I)) + ATOL(I)
      RETURN
C----------------------- END OF SUBROUTINE EWSET -----------------------
      END