;;; Compiled by f2cl version 2.0 beta Date: 2007/05/04 17:29:50 ;;; Using Lisp CMU Common Lisp Snapshot 2007-05 (19D) ;;; ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t) ;;; (:coerce-assigns :as-needed) (:array-type ':simple-array) ;;; (:array-slicing nil) (:declare-common nil) ;;; (:float-format double-float)) (in-package :slatec) (let ((nam20 0) (nath0 0) (nam21 0) (nath1 0) (nam22 0) (nath2 0) (xsml 0.0) (am20cs (make-array 57 :element-type 'double-float :initial-contents '(0.010871674908656186 3.6948922898266353e-4 4.4068010048468954e-6 1.4368676236191115e-7 8.242755523900783e-9 6.844267588936616e-10 7.395666972827393e-11 9.74595633696825e-12 1.5007688582940578e-12 2.6214791022152763e-13 5.083541113764872e-14 1.0768475335881144e-14 2.460912866184334e-15 6.007863803586564e-16 1.5544915610238807e-16 4.235351250355766e-17 1.2086216628929984e-17 3.596096512146583e-18 1.1113421838639565e-18 3.555595324323666e-19 1.174330216001393e-19 3.993974546610776e-20 1.395766715289163e-20 5.0024005530923605e-21 1.8355276095813267e-21 6.884909981792028e-22 2.63631035611417e-22 1.0292489023733836e-22 4.0924696667159487e-23 1.6555857340673466e-23 6.807974670630334e-24 2.8432655993407982e-24 1.2050739834896525e-24 5.179612432875052e-25 2.256226134275628e-25 9.954188011477451e-26 4.445516963973424e-26 2.008651954615011e-26 9.177863441517751e-27 4.238729581055893e-27 1.9778927200784608e-27 9.321163512846207e-28 4.434821332499181e-28 2.129456723655739e-28 1.0315856965107598e-28 5.040237730225912e-29 2.4830130457015594e-29 1.2330178312856219e-29 6.1703344992052174e-30 3.110926174159189e-30 1.5798308520170617e-30 8.079319875382835e-31 4.159973941386676e-31 2.156109340977169e-31 1.1246885726586918e-31 5.90331560632838e-32 3.1173566769292857e-32))) (ath0cs (make-array 53 :element-type 'double-float :initial-contents '(-0.08172601764161634 -8.004012824788273e-4 -3.186525268782113e-6 -6.68838826647751e-8 -2.9317592849945644e-9 -2.0112637608836216e-10 -1.8775226780559733e-11 -2.1996371377046013e-12 -3.0716166825922727e-13 -4.9361405536734185e-14 -8.902833722583661e-15 -1.7689877646152725e-15 -3.817868689032277e-16 -8.851159014819948e-17 -2.184818181414366e-17 -5.700849046986453e-18 -1.5631211221778754e-18 -4.481437996768995e-19 -1.337794883736188e-19 -4.1433400368741143e-20 -1.327263385718805e-20 -4.385728589128441e-21 -1.4913606959528181e-21 -5.2081047386307115e-22 -1.864382222390499e-22 -6.830263751167969e-23 -2.5571170580293295e-23 -9.7701586402543e-24 -3.805161433416679e-24 -1.5090227507370542e-24 -6.087551341242425e-25 -2.4958795138097113e-25 -1.0391576545819209e-25 -4.3902359139768467e-26 -1.8807906784479903e-26 -8.165070764199463e-27 -3.589944503749751e-27 -1.5976581266321329e-27 -7.193250175703824e-28 -3.2749430127278565e-28 -1.5070424457836906e-28 -7.006624198319905e-29 -3.289907402983718e-29 -1.5595180843651466e-29 -7.460690508208254e-30 -3.600877034824662e-30 -1.7528514374737722e-30 -8.603275775188512e-31 -4.256432603226946e-31 -2.1221618650442627e-31 -1.065996156704879e-31 -5.393568608816949e-32 -2.748174851043955e-32))) (am21cs (make-array 60 :element-type 'double-float :initial-contents '(0.005927902667213096 0.002005694053931652 9.110818502622758e-5 8.498943063720471e-6 1.1329790897691307e-6 1.875179461006665e-7 3.593065190182458e-8 7.657577140716838e-9 1.7699996716803918e-9 4.362595556545989e-10 1.1329164133785322e-10 3.072576909824192e-11 8.64482416482201e-12 2.510152500609244e-12 7.491024967644404e-13 2.289969284879941e-13 7.151136589279877e-14 2.2760792495956686e-14 7.369421427608866e-15 2.423286752678275e-15 8.081537745482399e-16 2.730080798043561e-16 9.332360708913853e-17 3.2250809968108464e-17 1.1258193234644454e-17 3.966994639869388e-18 1.410065679443195e-18 5.053020865378512e-19 1.8246152321594515e-19 6.635845682621305e-20 2.4296373163127618e-20 8.952389151236878e-21 3.318452893500508e-21 1.2370619618865832e-21 4.636366770123908e-22 1.7465313594776447e-22 6.611168102349912e-23 2.514099189940725e-23 9.602749955717325e-24 3.683249522892964e-24 1.4184313826915914e-24 5.483426742769359e-25 2.127610546231188e-25 8.284437008494186e-26 3.23670563926127e-26 1.2686888296328606e-26 4.988438189921216e-27 1.967345844676494e-27 7.781359710203269e-28 3.0863394149891115e-28 1.227446470454531e-28 4.894312791342922e-29 1.9564687980290983e-29 7.839889529224262e-30 3.1489691400248424e-30 1.2676976313725068e-30 5.114706919069002e-31 2.0680170979553875e-31 8.37891344768519e-32 3.401689919714898e-32))) (ath1cs (make-array 58 :element-type 'double-float :initial-contents '(-0.06972849916208884 -0.005108722790650045 -8.644335996989756e-5 -5.604720044235264e-6 -6.045735125623897e-7 -8.639802632488334e-8 -1.4808094843099271e-8 -2.885809334577236e-9 -6.191631975665699e-10 -1.4319928088609578e-10 -3.5181411021372145e-11 -9.084761919955078e-12 -2.4461716726885985e-12 -6.826083203213446e-13 -1.9645799311949403e-13 -5.808933227139693e-14 -1.759042249527442e-14 -5.440902932714896e-15 -1.7152474074868068e-15 -5.500929233576992e-16 -1.7918782877393173e-16 -5.920372520086694e-17 -1.981713027876484e-17 -6.713232347016352e-18 -2.299450243658281e-18 -7.957300928236376e-19 -2.779994027291784e-19 -9.798924361326986e-20 -3.4827170060615747e-20 -1.2474891225585991e-20 -4.501210041478228e-21 -1.6353462440133521e-21 -5.980102897780336e-22 -2.2002462862861235e-22 -8.142463073515086e-23 -3.0299247736600425e-23 -1.1333900985746235e-23 -4.260766024749296e-24 -1.6093633962781897e-24 -6.106377190825026e-25 -2.326954318021694e-25 -8.903987877472253e-26 -3.420558530005675e-26 -1.3190267152572728e-26 -5.104899493612043e-27 -1.9825994784745476e-27 -7.7257023568808305e-28 -3.02023473366468e-28 -1.18437973907417e-28 -4.6584302279223085e-29 -1.8375541881003845e-29 -7.26856689442799e-30 -2.882863120391468e-30 -1.1463746294599063e-30 -4.570031437748533e-31 -1.826276602045346e-31 -7.315349993385251e-32 -2.9369255999714296e-32))) (am22cs (make-array 74 :element-type 'double-float :initial-contents '(-0.015628444806253413 0.007783364452396813 8.670577704771895e-4 1.5696627315611372e-4 3.563962571432865e-5 9.245983354250432e-6 2.621101618504224e-6 7.918822165160125e-7 2.5104152792101184e-7 8.265223206654078e-8 2.8057116628130525e-8 9.768210904846808e-9 3.4740792322771035e-9 1.2582813216983691e-9 4.629882606418953e-10 1.7272825881360407e-10 6.523192001311541e-11 2.4904716852098205e-11 9.601568205537659e-12 3.734480020677269e-12 1.464175650320534e-12 5.782654711685129e-13 2.299154072447061e-13 9.197807112319973e-14 3.700600688130901e-14 1.49675761698673e-14 6.083611949384611e-15 2.4840408711512138e-15 1.0186247652676908e-15 4.19383856352754e-16 1.7331890176293075e-16 7.188219023885086e-17 2.991236335984036e-17 1.2486899043323863e-17 5.2282934460948366e-18 2.195329617247134e-18 9.242983252297773e-19 3.901577082360914e-19 1.6509389269386372e-19 7.002218157159944e-20 2.976518336167869e-20 1.2679653908690207e-20 5.412434006970776e-21 2.3148735021815524e-21 9.919202883865666e-22 4.258030153237324e-22 1.831018429730245e-22 7.886787123110753e-23 3.402546073862299e-23 1.4702088140571253e-23 6.36211018324917e-24 2.7570705068098073e-24 1.1964585809010406e-24 5.199125457292422e-25 2.2621767484710446e-25 9.855261137544318e-26 4.2987063033250873e-26 1.8772364166158064e-26 8.207219417728422e-27 3.592146656046155e-27 1.5739059461277332e-27 6.903297810393338e-28 3.030920790789685e-28 1.3320493416048123e-28 5.859788368515235e-29 2.580168684894878e-29 1.1371243363728367e-29 5.015925572260685e-30 2.214458293955094e-30 9.784702838865072e-31 4.326954149341802e-31 1.9149728819399457e-31 8.481646224023924e-32 3.759470651739559e-32))) (ath2cs (make-array 72 :element-type 'double-float :initial-contents '(0.004405273458718779 -0.030429194523184547 -0.0013856532837717938 -1.8044439089549524e-4 -3.3808471083273084e-5 -7.678183535229024e-6 -1.967839443716035e-6 -5.4837271158777e-7 -1.6254615505326126e-7 -5.053049981268895e-8 -1.631580701124067e-8 -5.4342041123485176e-9 -1.8573985564099003e-9 -6.489512033326109e-10 -2.3105948858009446e-10 -8.363282183204412e-11 -3.071196844890191e-11 -1.1423671424327168e-11 -4.2981160663458034e-12 -1.6338986995967155e-12 -6.269328620016619e-13 -2.4260526948162576e-13 -9.46119832162404e-14 -3.7160603134115045e-14 -1.4691556840975268e-14 -5.843694726140912e-15 -2.337502595591951e-15 -9.399231371171434e-16 -3.7980146693728945e-16 -1.5417310439849726e-16 -6.285287079535307e-17 -2.5727318128114555e-17 -1.0570981193540178e-17 -4.359080267402697e-18 -1.803634315959978e-18 -7.486838064380537e-19 -3.117261367347605e-19 -1.3016879809277009e-19 -5.450527587519523e-20 -2.288293490114232e-20 -9.631059503829539e-21 -4.063281001524614e-21 -1.718203980908027e-21 -7.281574619892536e-22 -3.092352652680643e-22 -1.3159178559654404e-22 -5.610606786087056e-23 -2.396621894086355e-23 -1.0255743323905812e-23 -4.3962641381436564e-24 -1.8876529983725773e-24 -8.118140359576808e-25 -3.496734274366287e-25 -1.5084029251568733e-25 -6.516268284778671e-26 -2.8189457975292075e-26 -1.2211275965122627e-26 -5.2966743411698674e-27 -2.3003592707736733e-27 -1.0002794823553675e-27 -4.354760404180879e-28 -1.8980561347414776e-28 -8.282111868712974e-29 -3.617815493066569e-29 -1.5820188961780036e-29 -6.92506859780227e-30 -3.0343902397786293e-30 -1.3308895681667253e-30 -5.84284852217309e-31 -2.5674884232383028e-31 -1.1292323222688822e-31 -4.970947029753337e-32))) (pi4 0.7853981633974483) (first$ nil)) (declare (type f2cl-lib:logical first$) (type (simple-array double-float (72)) ath2cs) (type (simple-array double-float (74)) am22cs) (type (simple-array double-float (58)) ath1cs) (type (simple-array double-float (60)) am21cs) (type (simple-array double-float (53)) ath0cs) (type (simple-array double-float (57)) am20cs) (type (double-float) pi4 xsml) (type (integer) nath2 nam22 nath1 nam21 nath0 nam20)) (setq first$ f2cl-lib:%true%) (defun d9aimp (x ampl theta) (declare (type (double-float) theta ampl x)) (prog ((sqrtx 0.0) (z 0.0) (eta 0.0f0)) (declare (type (single-float) eta) (type (double-float) z sqrtx)) (cond (first$ (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3)))) (setf nam20 (initds am20cs 57 eta)) (setf nath0 (initds ath0cs 53 eta)) (setf nam21 (initds am21cs 60 eta)) (setf nath1 (initds ath1cs 58 eta)) (setf nam22 (initds am22cs 74 eta)) (setf nath2 (initds ath2cs 72 eta)) (setf xsml (/ -1.0 (expt (f2cl-lib:d1mach 3) 0.3333))))) (setf first$ f2cl-lib:%false%) (if (>= x -4.0) (go label20)) (setf z 1.0) (if (> x xsml) (setf z (+ (/ 128.0 (expt x 3)) 1.0))) (setf ampl (+ 0.3125 (dcsevl z am20cs nam20))) (setf theta (- (dcsevl z ath0cs nath0) 0.625)) (go label40) label20 (if (>= x -2.0) (go label30)) (setf z (/ (+ (/ 128.0 (expt x 3)) 9.0) 7.0)) (setf ampl (+ 0.3125 (dcsevl z am21cs nam21))) (setf theta (- (dcsevl z ath1cs nath1) 0.625)) (go label40) label30 (if (>= x -1.0) (xermsg "SLATEC" "D9AIMP" "X MUST BE LE -1.0" 1 2)) (setf z (/ (+ (/ 16.0 (expt x 3)) 9.0) 7.0)) (setf ampl (+ 0.3125 (dcsevl z am22cs nam22))) (setf theta (- (dcsevl z ath2cs nath2) 0.625)) label40 (setf sqrtx (f2cl-lib:fsqrt (- x))) (setf ampl (f2cl-lib:fsqrt (/ ampl sqrtx))) (setf theta (+ pi4 (* (- x) sqrtx theta))) (go end_label) end_label (return (values nil ampl theta))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) (eval-when (:load-toplevel :compile-toplevel :execute) (setf (gethash 'fortran-to-lisp::d9aimp fortran-to-lisp::*f2cl-function-info*) (fortran-to-lisp::make-f2cl-finfo :arg-types '((double-float) (double-float) (double-float)) :return-values '(nil fortran-to-lisp::ampl fortran-to-lisp::theta) :calls '(fortran-to-lisp::xermsg fortran-to-lisp::dcsevl fortran-to-lisp::initds fortran-to-lisp::d1mach))))