xtrnlt.f

Go to the documentation of this file.

      SUBROUTINE xtrnlt(XI,XIDOT,FREG,FDR)
*
*
*       Galactic force & first derivative.
*       ----------------------------------
*
      include 'common6.h'
      common/galaxy/ gmg,rg(3),vg(3),fg(3),fgd(3),tg,
     &               omega,disk,a,b,v02,rl2,gmb,ar,gam,zdum(7)
      REAL*8  xi(3),xidot(3),freg(3),fdr(3),fm(3),fmd(3)
*
*
*       Consider point-mass, disk and/or logarithmic halo model.
      IF (kz(14).EQ.3) THEN
*       Employ global instead of linearized forms for better accuracy.
          IF (gmg.GT.0.0d0) THEN
              CALL fnuc(xi,xidot,fm,fmd)
              DO 10 k = 1,3
                  freg(k) = freg(k) + fm(k)
                  fdr(k) = fdr(k) + fmd(k)
   10         CONTINUE
          END IF
*
*       Check bulge force.
      IF (gmb.GT.0.0d0) THEN
          CALL fbulge(xi,xidot,fm,fmd)
          DO 15 k = 1,3
              freg(k) = freg(k) + fm(k)
              fdr(k) = fdr(k) + fmd(k)
   15     CONTINUE
      END IF
*
*       Include Miyamoto disk for positive disk mass.
          IF (disk.GT.0.0d0) THEN
              CALL fdisk(xi,xidot,fm,fmd)
              DO 20 k = 1,3
                  freg(k) = freg(k) + fm(k)
                  fdr(k) = fdr(k) + fmd(k)
   20         CONTINUE
          END IF
*
*       Check addition of logarithmic halo potential to regular force.
          IF (v02.GT.0.0d0) THEN
              CALL fhalo(xi,xidot,fm,fmd)
              DO 30 k = 1,3
                  freg(k) = freg(k) + fm(k)
                  fdr(k) = fdr(k) + fmd(k)
   30         CONTINUE
          END IF
      END IF
*
      RETURN
*
      END