download bsplvd.f
Language: Fortran
LOC: 61
Project Info
Scientific Data Tools(sds)
Server: BerliOS
Type: cvs
...\sdsfortranlibs‑1.0\approx\
   bndacc.f
   bndsol.f
   bsplvd.f
   bsplvn.f
   chkder.f
   d1mach.f
   dasum.f
   daxpy.f
   dbndac.f
   dbndsl.f
   dbocls.f
   dbols.f
   dbolsm.f
   dckder.f
   dcopy.f
   dcov.f
   ddot.f
   defc.f
   defcmn.f
   denorm.f
   dfc.f
   dfcmn.f
   dfdjc3.f
   dfspvd.f
   dfspvn.f
   dh12.f
   dhfti.f
   dlpdp.f
   dlsei.f
   dlsi.f
   dmout.f
   dmpar.f
   dnls1.f
   dnls1e.f
   dnrm2.f
   dp1vlu.f
   dpcoef.f
   dpolft.f
   dqrfac.f
   dqrslv.f
   drot.f
   drotg.f
   drotm.f
   drotmg.f
   dscal.f
   dsort.f
   dswap.f
   dvout.f
   dwnlit.f
   dwnlsm.f
   dwnlt1.f
   dwnlt2.f
   dwnlt3.f
   dwnnls.f
   dwupdt.f
   efc.f
   efcmn.f
   enorm.f
   fc.f
   fcmn.f
   fdjac3.f
   fdump.f
   h12.f
   hfti.f
   i1mach.f
   idamax.f
   isamax.f
   ivout.f
   j4save.f
   lmpar.f
   lpdp.f
   lsei.f
   lsi.f
   pcoef.f
   polfit.f
   pvalue.f
   qrfac.f
   qrsolv.f
   r1mach.f
   rwupdt.f
   sasum.f
   saxpy.f
   sbocls.f
   sbols.f
   sbolsm.f
   scopy.f
   scov.f
   sdot.f
   smout.f
   snls1.f
   snls1e.f
   snrm2.f
   srot.f
   srotg.f
   srotm.f
   srotmg.f
   sscal.f
   ssort.f
   sswap.f
   svout.f
   wnlit.f
   wnlsm.f
   wnlt1.f
   wnlt2.f
   wnlt3.f
   wnnls.f
   xerclr.f
   xercnt.f
   xerhlt.f
   xermsg.f
   xerprn.f
   xersve.f
   xgetf.f
   xgetua.f
   xsetf.f

*DECK BSPLVD
      SUBROUTINE BSPLVD (T, K, X, ILEFT, VNIKX, NDERIV)
C***BEGIN PROLOGUE  BSPLVD
C***SUBSIDIARY
C***PURPOSE  Subsidiary to FC
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (BSPLVD-S, DFSPVD-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C Calculates value and deriv.s of all B-splines which do not vanish at X
C
C  Fill VNIKX(J,IDERIV), J=IDERIV, ... ,K  with nonzero values of
C  B-splines of order K+1-IDERIV , IDERIV=NDERIV, ... ,1, by repeated
C  calls to BSPLVN
C
C***SEE ALSO  FC
C***ROUTINES CALLED  BSPLVN
C***REVISION HISTORY  (YYMMDD)
C   780801  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890831  Modified array declarations.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  BSPLVD
      DIMENSION T(*),VNIKX(K,*)
      DIMENSION A(20,20)
C***FIRST EXECUTABLE STATEMENT  BSPLVD
      CALL BSPLVN(T,K+1-NDERIV,1,X,ILEFT,VNIKX(NDERIV,NDERIV))
      IF (NDERIV .LE. 1)               GO TO 99
      IDERIV = NDERIV
      DO 15 I=2,NDERIV
         IDERVM = IDERIV-1
         DO 11 J=IDERIV,K
   11       VNIKX(J-1,IDERVM) = VNIKX(J,IDERIV)
         IDERIV = IDERVM
         CALL BSPLVN(T,0,2,X,ILEFT,VNIKX(IDERIV,IDERIV))
   15    CONTINUE
C
      DO 20 I=1,K
         DO 19 J=1,K
   19       A(I,J) = 0.
   20    A(I,I) = 1.
      KMD = K
      DO 40 M=2,NDERIV
         KMD = KMD-1
         FKMD = KMD
         I = ILEFT
         J = K
   21       JM1 = J-1
            IPKMD = I + KMD
            DIFF = T(IPKMD) - T(I)
            IF (JM1 .EQ. 0)            GO TO 26
            IF (DIFF .EQ. 0.)          GO TO 25
            DO 24 L=1,J
   24          A(L,J) = (A(L,J) - A(L,J-1))/DIFF*FKMD
   25       J = JM1
            I = I - 1
                                       GO TO 21
   26    IF (DIFF .EQ. 0.)             GO TO 30
         A(1,1) = A(1,1)/DIFF*FKMD
C
   30    DO 40 I=1,K
            V = 0.
            JLOW = MAX(I,M)
            DO 35 J=JLOW,K
   35          V = A(I,J)*VNIKX(J,M) + V
   40       VNIKX(I,M) = V
   99                                  RETURN
      END

About Koders | Resources | Downloads | Support | Black Duck | Submit Project | Terms of Service | DMCA | Privacy Policy | Site Map| Contact Us