https://github.com/cran/fields
Raw File
Tip revision: 6769ffc81115fbf0bf7d9c566cf7ac81be0049dc authored by Doug Nychka on 25 July 2005, 00:00:00 UTC
version 3.04
Tip revision: 6769ffc
mltdrb.f
       

C** evaluates radial basis functions 
c**** K_ij= radfun( distance( x1_i, x2_j))
c
       subroutine mltdrb( nd,x1,n1, x2,n2, par, c,h,work)
       implicit double precision (a-h,o-z)
       integer nd,n1,n2,ic, ivar
       
       double precision par(1),x1(n1,nd)
       double precision  x2(n2,nd), c(n2), h(n1, nd),sum
       double precision work( n1), ddot
       do 1000 ivar=1, nd
c****** work aray must be dimensioned to size n2
c **** loop through columns of output matrix K
c*** outer most loop over columns of x1 and x2 should reduce paging 

       do 5 ir= 1, n1

c
 
c evaluate all basis functions at  x1(j,.)       
       do 10 j =1,n2
c
c  zero out sum accumulator
c
         sum=0.0
      do 15  ic=1,nd
c
c** accumulate squared differences
c 

            sum= sum+ (x1(ir,ic)- x2(j,ic))**2

 15             continue
        work(j)=sum
 10    continue

C**** evaluate squared distances  with basis functions. 

          call drdfun( n2,work(1),par)
          do 11 j= 1, n2
               work( j)= 2.0*work(j)*(x1(ir,ivar)- x2(j,ivar))
 11            continue
c
c***** now the dot product you have all been waiting for!
c
          h(ir,ivar)= ddot( n2, work(1), 1, c(1),1)
 5      continue
 1000   continue
       return
       end
back to top