Numérotation des lignes :

C DSGETS    SOURCE    GF238795  18/02/01    21:15:21     9724           c-----------------------------------------------------------------------c\BeginDoccc\Name: dsgetscc\Description:c  Given the eigenvalues of the symmetric tridiagonal matrix H,c  computes the NP shifts AMU that are zeros of the polynomial ofc  degree NP which filters out components of the unwanted eigenvectorsc  corresponding to the AMU's based on some given criteria.cc  NOTE: This is called even in the case of user specified shifts inc  order to sort the eigenvalues, and error bounds of H for later use.cc\Usage:c  call dsgetsc     ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )cc\Argumentsc  ISHIFT  Integer.  (INPUT)c          Method for selecting the implicit shifts at each iteration.c          ISHIFT = 0: user specified shiftsc          ISHIFT = 1: exact shift with respect to the matrix H.cc  WHICH   Character*2.  (INPUT)c          Shift selection criteria.c          'LM' -> KEV eigenvalues of largest magnitude are retained.c          'SM' -> KEV eigenvalues of smallest magnitude are retained.c          'LA' -> KEV eigenvalues of largest value are retained.c          'SA' -> KEV eigenvalues of smallest value are retained.c          'BE' -> KEV eigenvalues, half from each end of the spectrum.c                  If KEV is odd, compute one more from the high end.cc  KEV      Integer.  (INPUT)c          KEV+NP is the size of the matrix H.cc  NP      Integer.  (INPUT)c          Number of implicit shifts to be computed.cc  RITZ    Double precision array of length KEV+NP.  (INPUT/OUTPUT)c          On INPUT, RITZ contains the eigenvalues of H.c          On OUTPUT, RITZ are sorted so that the unwanted eigenvaluesc          are in the first NP locations and the wanted part is inc          the last KEV locations.  When exact shifts are selected, thec          unwanted part corresponds to the shifts to be applied.cc  BOUNDS  Double precision array of length KEV+NP.  (INPUT/OUTPUT)c          Error bounds corresponding to the ordering in RITZ.cc  SHIFTS  Double precision array of length NP.  (INPUT/OUTPUT)c          On INPUT:  contains the user specified shifts if ISHIFT = 0.c          On OUTPUT: contains the shifts sorted into decreasing orderc          of magnitude with respect to the Ritz estimates contained inc          BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.cc\EndDoccc-----------------------------------------------------------------------cc\BeginLibcc\Local variables:c     xxxxxx  realcc\Routines called:c     dsortr  ARPACK utility sorting routine.c     ivout   ARPACK utility routine that prints integers.c     arscnd  ARPACK utility routine for timing.c     dvout   ARPACK utility routine that prints vectors.c     dcopy   Level 1 BLAS that copies one vector to another.c     dswap   Level 1 BLAS that swaps the contents of two vectors.cc\Authorc     Danny Sorensen               Phuong Vuc     Richard Lehoucq              CRPC / Rice Universityc     Dept. of Computational &     Houston, Texasc     Applied Mathematicsc     Rice Universityc     Houston, Texascc\Revision history:c     xx/xx/93: Version ' 2.1'cc\SCCS Information: @(#)c FILE: sgets.F   SID: 2.4   DATE OF SID: 4/19/96   RELEASE: 2cc\Remarkscc\EndLibcc-----------------------------------------------------------------------c      subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts )cc     %----------------------------------------------------%c     | Include files for debugging and timing information |-INC TARTRAKc     %----------------------------------------------------%ccc     %------------------%c     | Scalar Arguments |c     %------------------%c      character*2 which      integer    ishift, kev, np      real*8     T0,T1cc     %-----------------%c     | Array Arguments |c     %-----------------%c      REAL*8     &           bounds(kev+np), ritz(kev+np), shifts(np)cc     %------------%c     | Parameters |c     %------------%c      REAL*8     &           one, zero      parameter (one = 1.0D+0, zero = 0.0D+0)cc     %---------------%c     | Local Scalars |c     %---------------%c      integer    kevd2, msglvlcc     %----------------------%c     | External Subroutines |c     %----------------------%c      external   dswap, dcopy, dsortr, arscndcc     %---------------------%**c     | Intrinsic Functions |**c     %---------------------%**c**      intrinsic    max, min**c**c     %-----------------------%**c     | Executable Statements |c     %-----------------------%      T0=0.D0      T1=0.D0cc     %-------------------------------%c     | Initialize timing statistics  |c     | & message level for debugging |c     %-------------------------------%c*      call arscnd (t0)      msglvl = msgetsc      if (which .eq. 'BE') thencc        %-----------------------------------------------------%c        | Both ends of the spectrum are requested.            |c        | Sort the eigenvalues into algebraically increasing  |c        | order first then swap high end of the spectrum next |c        | to low end in appropriate locations.                |c        | NOTE: when np &lt; floor(kev/2) be careful not to swap |c        | overlapping locations.                              |c        %-----------------------------------------------------%c         call dsortr ('LA', .true., kev+np, ritz, bounds)         kevd2 = kev / 2         if ( kev .gt. 1 ) then            call dswap ( min(kevd2,np), ritz, 1,     &                   ritz( max(kevd2,np)+1 ), 1)            call dswap ( min(kevd2,np), bounds, 1,     &                   bounds( max(kevd2,np)+1 ), 1)         end ifc      elsecc        %----------------------------------------------------%c        | LM, SM, LA, SA case.                               |c        | Sort the eigenvalues of H into the desired order   |c        | and apply the resulting order to BOUNDS.           |c        | The eigenvalues are sorted so that the wanted part |c        | are always in the last KEV locations.               |c        %----------------------------------------------------%c         call dsortr (which, .true., kev+np, ritz, bounds)      end ifc      if (ishift .eq. 1 .and. np .gt. 0) thencc        %-------------------------------------------------------%c        | Sort the unwanted Ritz values used as shifts so that  |c        | the ones with largest Ritz estimates are first.       |c        | This will tend to minimize the effects of the         |c        | forward instability of the iteration when the shifts  |c        | are applied in subroutine dsapps.                     |c        %-------------------------------------------------------%c         call dsortr ('SM', .true., np, bounds, ritz)         call dcopy (np, ritz, 1, shifts, 1)      end ifc*      call arscnd (t1)      tsgets = tsgets + (t1 - t0)c      if (msglvl .gt. 0) then         call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is')         call ivout (logfil, 1, np, ndigit, '_sgets: NP is')         call dvout (logfil, kev+np, ritz, ndigit,     &        '_sgets: Eigenvalues of current H matrix')         call dvout (logfil, kev+np, bounds, ndigit,     &        '_sgets: Associated Ritz estimates')      end ifc      returncc     %---------------%c     | End of dsgets |c     %---------------%c      end

© Cast3M 2003 - Tous droits réservés.
Mentions légales