      SUBROUTINE Deriv
C COMPUTES PARTIAL DERIVATIVES OF RECIPROCAL OF D SQUARED
      common/qmod/qj(3),mmin,mmax,qmodul,qrefin,nq,iqtyp,iq(3)
      COMMON/RECP/Z(10),Q,AR(3),X(4),VR,U(3),W(3),VRO
      COMMON/REAL/AO(3),ALO(3),VCO,AD(3),ALS(3),VC,CSA(3),SNA(3)
      COMMON/SCRT/E(9),ee(9,9),NH(4),qh(3),f(9),ff(9,10)
      COMMON/BLKA/A(54),UO(3),B(9),bb(9,9)
      COMMON/IO/NTOUT,NTIN,NEXTN
      character*4 d(9)
      data d/'da* ','db* ','dc* ','dalp','dbet','dgam','dr  ','ds  ',
     * 'dt  '/
*
* set values of indicies including modulation effects
*
      do j = 1,3
        qh(j) = nh(j) + nh(4)*qj(j)
      enddo
*
* calculate first partials of d star squared
*
      do j=1,3
        k=mod(j,3) + 1
        l=mod(k,3) + 1
        b(j)=2*qh(j)**2*x(j) + 2*qh(j)*qh(k)*x(k)*u(l)
     *     + 2*qh(l)*qh(j)*x(l)*u(k)
        b(j+3) = 2*qh(k)*qh(l)*x(k)*x(l)
        b(j+6) = 2*nh(4)*( qh(j)*z(j) + qh(k)*x(j)*x(k)*u(l)
     *  + qh(l)*x(l)*x(j)*u(k) )
      enddo
*
* Calculate the second partials of d star squared
*
      do i=1,3
        do j=1,3
          k = mod(j,3) + 1
          l = mod(k,3) + 1
          if(i.eq.j)then
            bb(i,j) = 2*qh(j)**2
            bb(i,j+3) = 0.0
            bb(i,j+6) = 2*nh(4)*(2*qh(j)*x(j) + qh(k)*x(k)*u(l) 
     *        + qh(l)*x(l)*u(k))
            bb(i+3,j) = 0.0
            bb(i+3,j+3) = 0.0
            bb(i+3,j+6) = 0.0
            bb(i+6,j) = 2*nh(4)*(2*qh(j)*x(j) + qh(k)*x(k)*u(l)
     *        + qh(l)*x(l)*u(k))
            bb(i+6,j+3) = 0.0
            bb(i+6,j+6) = 2*nh(4)**2*z(j)
          endif
          if(i.eq.l)then
            bb(i,j) = 2*qh(l)*qh(j)*u(k)
            bb(i,j+3) = 2*qh(k)*qh(l)*x(k)
            bb(i,j+6) = 2*nh(4)*qh(l)*x(j)*u(k)
            bb(i+3,j) = 2*qh(j)*qh(k)*x(k)
            bb(i+3,j+3) = 0.0
            bb(i+3,j+6) = 2*nh(4)*qh(k)*x(j)*x(k)
            bb(i+6,j) = 2*nh(4)*qh(j)*x(l)*u(k)
            bb(i+6,j+3) = 2*nh(4)*qh(k)*x(k)*x(l)
            bb(i+6,j+6) = 2*nh(4)**2*x(l)*x(j)*u(k)
          endif
          if(i.eq.k)then
            bb(i,j) = 2*qh(j)*qh(k)*u(l)
            bb(i,j+3) = 2*qh(k)*qh(l)*x(l)
            bb(i,j+6) = 2*nh(4)*qh(k)*x(j)*u(l)
            bb(i+3,j) = 2*qh(l)*qh(j)*x(l)
            bb(i+3,j+3) = 0.0
            bb(i+3,j+6) = 2*nh(4)*qh(l)*x(l)*x(j)
            bb(i+6,j) = 2*nh(4)*qh(j)*x(k)*u(l)
            bb(i+6,j+3) = 2*nh(4)*qh(l)*x(k)*x(l)
            bb(i+6,j+6) = 2*nh(4)**2*x(j)*x(k)*u(l)
          endif
        enddo
      enddo
*      if(nh(1).eq.1.and.nh(2).eq.-1.and.nh(3).eq.1.and.nh(4).eq.1)then
*        write(ntout,1)(nh(j),j=1,4)
* 1        format(' h k l & m are: ',4(2x,i2))
*        write(ntout,2)(b(j),j=1,9)
* 2        format(' the first partials are:'/ 
*     *  12x,'da*',5x,'db*',5x,'dc*',5x,'dalp',4x,'dbet',4x,'dgam',
*     *  4x,'dr',6x,'ds',6x,'dt'/  9x,9f8.4)
*        write(ntout,3)
* 3        format(' the second partials are:'/
*     *  12x,'da*',5x,'db*',5x,'dc*',5x,'dalp',4x,'dbet',4x,'dgam',
*     *  4x,'dr',6x,'ds',6x,'dt')
*        do i=1,9
*          write(ntout,4)d(i),(bb(i,j),j=1,9)
*        enddo
*      endif
* 4      format(1x,a4,4x,9f8.4)
      return
      end
