(defun gamma (a) (declare (type double-float a))
 (prog
  ((d 0.0d0) (g 0.0d0) (z 0.0d0) (lnx 0.0d0) (glog 0.0d0)
   (p (make-array '(7) :element-type 'float))
   (q (make-array '(7) :element-type 'float)) (gamma 0.0d0) (w 0.0d0)
   (r1 0.0d0) (pi_ 0.0d0) (s 0.0d0) (n 0) (i 0) (bot 0.0d0) (top 0.0d0) (j 0)
   (m 0) (t_ 0.0d0) (x 0.0d0)
  )
  (declare (type double-float d)) (declare (type double-float g))
  (declare (type double-float z)) (declare (type double-float lnx))
  (declare (type double-float glog))
  (declare (type (simple-array float (*)) p))
  (declare (type (simple-array float (*)) q)) (declare (type real gamma))
  (declare (type double-float w)) (declare (type double-float r1))
  (declare (type double-float pi_)) (declare (type double-float s))
  (declare (type fixnum n)) (declare (type fixnum i))
  (declare (type double-float bot)) (declare (type double-float top))
  (declare (type fixnum j)) (declare (type fixnum m))
  (declare (type double-float t_)) (declare (type double-float x))
  (setq pi 3.1415927) (setq d 0.4189385332046727d0) (replace p '(1.0) :end 0)
  (replace p '(0.55341387) :end 0) (replace p '(0.27964863) :end 0)
  (replace p '(0.07309811) :end 0) (replace p '(0.020449366) :end 0)
  (replace p '(0.0026193927) :end 0) (replace p '(5.396373E-4) :end 0)
  (replace q '(1.0) :end 0) (replace q '(1.1306295) :end 0)
  (replace q '((- 0.056790277)) :end 0) (replace q '((- 0.17045897)) :end 0)
  (replace q '(0.022521114) :end 0) (replace q '(0.004700595) :end 0)
  (replace q '((- 8.329792E-4)) :end 0) (setq r5 0.083333336)
  (setq r4 (- 0.0027777778)) (setq r3 7.936507E-4) (setq r2 (- 5.9515634E-4))
  (setq r1 8.2075637E-4) (setf gamma 0.0) (setf x a)
  (if (>= (abs a) 15.0) (go label60)) (setf t_ 1.0) (setf m (+ (int a) (- 1)))
  (arithmetic-if m (go label20) (go label12) (go label10)) label10
  (fdo ((j 1 (+ j 1))) ((> j m) nil)
   (tagbody (setf x (+ x (- 1.0))) (setf t_ (* x t_)))
  )
  label12 (setf x (+ x (- 1.0))) (go label40) label20 (setf t_ a)
  (if (> a 0.0) (go label30)) (setf m (+ (- m) (- 1)))
  (if (= m 0) (go label22))
  (fdo ((j 1 (+ j 1))) ((> j m) nil)
   (tagbody (setf x (+ x 1.0)) (setf t_ (* x t_)))
  )
  label22 (setf x (+ (+ x 0.5) 0.5)) (setf t_ (* x t_))
  (if (= t_ 0.0) (go end_label)) label30
  (if (>= (abs t_) 1.0E-30) (go label40))
  (if (<= (* (abs t_) (spmpar 3)) 1.0001) (go end_label))
  (setf gamma (/ 1.0 t_)) (go end_label) label40 (setf top (fref p 1))
  (setf bot (fref q 1))
  (fdo ((i 2 (+ i 1))) ((> i 7) nil)
   (tagbody (setf top (+ (fref p i) (* x top)))
    (setf bot (+ (fref q i) (* x bot)))
  ))
  (setf gamma (/ top bot)) (if (< a 1.0) (go label50))
  (setf gamma (* gamma t_)) (go end_label) label50 (setf gamma (/ gamma t_))
  (go end_label) label60 (if (>= (abs a) 1000.0) (go end_label))
  (if (> a 0.0) (go label70)) (setf x (- a)) (setf n x) (setf t_ (+ x (- n)))
  (if (> t_ 0.9) (setf t_ (+ 1.0 (- t_)))) (setf s (/ (sin (* pi_ t_)) pi_))
  (if (= (mod n 2) 0) (setf s (- s))) (if (= s 0.0) (go end_label)) label70
  (setf t_ (/ 1.0 (* x x)))
  (setf g (/ (+ (* (+ (* (+ (* (+ (* r1 t_) r2) t_) r3) t_) r4) t_) r5) x))
  (setf lnx (glog x)) (setf z x)
  (setf g (+ (+ d g) (* (+ z (- 0.5d0)) (+ lnx (- 1.0d0))))) (setf w g)
  (setf t_ (+ g (- (dble w)))) (if (> w (* 0.99999 (exparg 0))) (go end_label))
  (setf gamma (* (exp w) (+ 1.0 t_)))
  (if (< a 0.0) (setf gamma (/ (/ 1.0 (* gamma s)) x))) (go end_label)
  end_label (return gamma)
))