text:
The http://www.mw.com/cgibin/dictionary?bookDictionary&vaVegan&x0&y0 MerriamWebster dictionary defines vegan as:
  a strict vegetarian who consumes no animal food or dairy products; also : one who abstains from using animal products (as leather)

 Vegan Basics
For information on being vegan, eating advice, recipes and a listing of almost every American vegan product on the market (not limited to food) you may find http://vivausa.org/veganbasics/Vegan%20Basics%20guide.pdf Vegan Basics (Guide)(PDF file) useful.  Its designed for any person who is curious of the vegan lifestyle and offers a comprehensive list of foods that are vegan and accidentally vegan (products which were not intended to be vegan but are vegan by their ingredients). It was project that Users/PeteHernandez worked on at http://www.vivausa.org Viva!USA.

 Vegan Restaurant Options
  Bicycle Bakery  Two women from Davis own this local vegan bakery. They have walnutpineapple carrot cake with a cream cheese frosting (all vegan!), a double chocolate cake, gluten free brownie pies, gluten free peanut butter cookies, regular pb cookies, gluten free cranberry oat bars, and probably other stuff. Its all vegan, almost all organic, and as local as possible. I dont think they have a storefront yet, but they sell to other cafes as well as do all kinds of special orders. I got a vegan (of course) birthday cake with beautiful frosting and edible flowers on top for cheaper than safeway could pump out a generic one!
  Butterfly Vegan  A cottage food operation in Davis which makes vegan, lowfat and healthy cookies, cakes, and pies with glutenfree options. All their baked stuff is refinedsugar free and diabeticfriendly. They can cater your parties. They offer free samples!

  Burgers and Brew  They have tofu and portabello burgers on their menu, and both are very tasty. They probably cook them on the meat grill, but its a great place to go with mixed company (veg & nonveg).
        Last time I went, I was told by the waiter there were no vegan options on the menu.  Can anyone confirm? RyaneLogsdon
  Cenarios Pizza  Confirmed dough was vegan.  Pineapple, fresh tomatoes, and artichoke pizza is a vegan delight!
  Chipotle  The tofubased Sofritas is vegan. Its pretty damn good.
  CREAM  Has an assortment of vegan cookie options
  Davis Food Coop  Has many vegan deli items, including sushi, tamales, samosas, burritos, salads, and you can substitute hummus for cheese in some  sandwiches and dips. For those who dont eat honey, I would read the ingredients on Coop items. I remember seeing a salad dressing at the salad bar marked as vegan that has honey, so be sure to be aware when getting Coop made stuff. .
  Davis Noodle City  Has quite the abundance of vegan options; and they confirmed with me that their noodles are rice noodles, not egg noodles. A vegan favorite. Make sure to tell the server that you dont want your food made with chicken stock. They are happy to accommodate.
    I was told by my server that their noodles are egg noodles, so you might want to ask for yourself.
  Delta of Venus  They have a huge selection of wonderful vegan food, including sandwiches, omelettes, and even Caribbean dinner options.
  Ding How  Has an entire vegetarian menu, most items on it are vegan but make sure to ask, and ask for no egg.
  Ikedas  Their tamales are vegan and some of their pies. Many other spreads and fresh produce are vegan.
  Kathmandu Kitchen  Has a vegan platter (The Vegan Thali) on their menu.
  Let Them Eat Cake  Has one vegan cupcake flavor available on Mondays and another on Fridays
  Manna  has a few vegan dishes (someone should confirm): e.g., veggie tofu teriyaki and the bibimbap ordered with tofu
  Monticello Seasonal Cuisine  If the seasonal menu does not feature any vegan options that week, just let your server know and the kitchen will prepare something special for you.
  Namaste Nepal  Has a vegan thali (platter) on their dinein menu (menu on their website is the more limited takeout menu)
  Natural Food Works, Farmers Kitchen Cafe  Has various vegan options. Try their bioregional salad. The Rosas Black Bean Soup is yummy, and the tacos are great.
  Rajas  Has a number of vegan dishes, just ask if youre not sure.  The dinner menu includes a vegan section and they have started to explicitly label some of their lunch buffet dishes as vegan.  Apparently the owner, Taranbir, is a vegan.
  Red 88 Noodle Bar  Has a vegan soup bowl that could easily feed two! Delicious veggies, tofu and glass noodles. I havent actually asked and verified all the ingredients, however.
  Sams Mediterranean  Their falafel sandwich is excellent. Fried food isnt good for you, but their falafel and fries sure are tasty. The tahini sauce is veg. The dolmas are amazing too.
  Stones Cafe & Catering  Stones has confirmed that their veggie patty is vegan.
  Sunrise Restaurant  Allegedly, the entire vegetarian menu is already vegan. Also has blended pearl teas with option to use soy or coconut milk. The vegetarian sandwich must be ordered without mayo to be vegan.
  Tako Korean BBQ Tacos doesnt list any vegan options on its menu, but (according to Yelp reviews of the Sacramento location) many dishes can be made vegan.
  Taqueria Davis  They have a vegan burrito with veggie rice, grilled vegetables, guacamole, pico de gallo, and your choice of beans.
  Taqueria Guadalajara  The manager says that they have changed their recipes for rice and beans to make them vegetarian. They have removed chorizo from the beans and use vegetable stock in the beans. The guacamole is dairyfree as well.
  Thai Recipes  Thai Restaurant with a big vegetarian section. None of the veg items have fish sauce and are by default vegan (assuming they have no milk eggs or cheese).
  Yolo Berry Yogurt  Always has a nondairy sorbet option
  Woodstocks Pizza  Their pizza sauce doesnt have cheese in it. When ordering a cheeseless pizza be sure to ask for extra sauce its free and makes it extra good. They will also substitute anything you want for no extra charge.
  UC Davis Dining Commons  All items on their menu are marked blue for vegan. Cuarto Dining Commons also has an exceptional salad bar and lots of fun vegan options. The Dining Commons also offer vegan Coconut Bliss ice cream on request. If you dont see it in the ice cream freezer, then ask an employee for some. All Dining Commons also offer a vegan corner, complete with nutritional yeast, an organic seed mixture and lots of veganfriendly dips and spreads!

see also Vegetarian Options vegetarian restaurants

 Free Vegan Food
  Free soy milk and cookies at the MU/Quad tables from 12:30 to 1:30 on finals days (in 2007, December 1015), given just to take a load off of stressedout students!
  The Seventh Day Adventists and guests have a free vegan/vegetarian options vegetarian meal on Saturdays (the Sabbath Day), where each one brings a dish or something to share with others.

 Vegan on the Cheap/ Fast Food Vegan
  Coffee House  Depending on the day, you can find reasonably priced vegan dishes.  For a list of their daily hot food items (vegan items are marked accordingly) click http://www.coffeehouse.ucdavis.edu/hotfood.cfm Here.
  InNOut  You can order a Veggie Burger, simply a burger without their meat and cheese.  Make sure to ask for no special sauce if you order it animal style. as the spread contains mayo.  Ive confirmed the buns as vegan with the company.

     Asking for something animal style will also get you cheese on it. You can ask for something animal style without cheese or special sauce which will get you just grilled onions (which are cooked on the grill where the patties are, essentially in meat juice, not recd) but you will be charged for animal style.
  Sunrise Restaurant Has a 2.50 Vegetarian sandwich (#8) which you can ask as vegan by simply subtracting the mayo, similarly with Fluffy Donuts (ask for tofu).
  Taco Bell  You can order any item off the menu and have them replace the beef with beans, free of charge. You can also order the item fresco style which means replacing the cheese with a vegan pico de gallo salsa. Adding guacamole is also delicious and highly recommended.
  Subway  You can order a veggie delight on Italian bread with no cheese and just vegetables.  Also these individual items do not contain animalderived ingredients: all vegetables, oil, vinegar, mustard and sweet onion sauce. The wheat bread and deli roll contain honey. Also note that their veggie max patty contains egg whites.

 Vegan shopping in Davis
  Davis Food Coop  By far is the most vegan friendly store for groceries, cosmetics and household products.
  Whole Foods Market  Good selection. Offers some products that the Coop does not.
  Ethnic Markets  Sell various soy, gluten, and legume based products.
  International Food Market  Has soy products Dhanraj Nutrela that can be cooked up to be faux meats, great if youre low on cash! Only 1.19 a box, ask the owner to order more if theyre out, as this is a high demand item.
  Local produce, dips, sauces, etc. can be bought at the Farmers Market, Ikedas, and Pedrick Produce.
  Mainstream Supermarkets like Safeway and SaveMart have small but substantial natural food sections in which you can buy soy products.

Product Lines
 Gardein is a popular, acclaimed brand of vegan meat substitutes available at Safeway, Save Mart, Target, Nugget, Davis Food CoOp, and Whole Foods Market.

 Vegan recipes/cookbooks
  The http://www.amazon.com/VeganomiconUltimateIsaChandraMoskowitz/dp/156924264X/refsr_1_1?ieUTF8&sbooks&qid1199727549&sr11 Veganomicon is the newest cookbook from the writers of http://www.amazon.com/VeganCupcakesTakeOverWorld/dp/1569242739/refpd_sim_b_img_3 Vegan Cupcakes Take Over the World, and they are the best cookbooks on the market.
  The Blossoming Lotus
  Friendly Foods
  How It All Vegan Great beginner book as it utilizes products that are easily available.
  http://www.veganchef.com Vegan Chef  try the chocolate tofu cheesecake one...its amazingly good.  Users/JessicaElb
  Vegan with a Vengeance make sure and check out the website too! http://www.theppk.com Users/DanielleLee
  I Am Grateful Recipe Book Excellent recipes for Vegan/raw foodies http://cafegratitude.com/  Users/Myabrn
  http://www.joyofveganbaking.com The Joy of Vegan Baking and http://www.vegantable.com The Vegan Table by Colleen PatrickGoudreau  Users/AsmaMaryamMohseni

 Vegan BumOuts
  Davis Food Coop  The empanadas at the coop are not vegan; they have butter in the crust.
  Natural Food Works  All the glutenfree bread we make isnt vegan, most contain egg whites. And be careful, the Gluten Free pizza dough contains gelatin (for a binding agent) so its not vegetarian. I work here, so the info is reliable. But do try the Vegan Tamales...they are YUMMY! Users/JessicaElb
  Sophias  Most of their dishes have fish sauce, so be sure to ask/make sure that there is no fish sauce in the dish.
  Quickly  Their milk teas are made with nondairy creamer (which ironically, contains dairy) not soymilk, which their menu advertises
  Bistro 33  Veggie burger patty has cheese in it.
  Davis Noodle City  xAll of their noodles are egg noodles.x They have Egg and Rice noodles ~Daubert
 Vegan advice
http://vivausa.org/veganbasics/Vegan%20Basics%20guide.pdf Vegan Basics (Guide) has a ton of helpful advice for beginning vegans.

Products to be mindful of:
 Food
  eggs
  dairy (milk, yogurt, cheese)
  honey (bees)
  gelatin (from animal bone)
    avoid jello, starburst, skittles, sour cream, marshmallows, Extra Polar Ice gum, some gummy bears
      Skittles from the Czech Republic and Starburst from England do not contain gelatin.
      Supposedly Skittles are now both glutenfree and gelatinfree (but check the packaging, it states so at the end of the ingredients, this is a relatively new thing) and http://www.marscandykills.com/ supposedly Mars Inc. tests on animals, which isnt very vegan.
    note: most camera film is made from gelatin.
  nougat (contains egg white)
  Marzipan  some marzipans are made with egg whites, some are not, check the ingredients.
  lipase (from calves, lambs, or kidsa enzyme used in food processing)
  A lot of wine and beer is not vegan  anyone know about hard alcohol?
     almost all cheap and imported beers and wines are filtered with isinglass (derived from fish) or bone char. Some are even processed with small amounts of eggs, cream, and milk. a list of vegan alcohol can be found at http://www.veganporn.com/booze.pl vegan porn
 http://www.barnivore.com/ Barnivore is the ultimate vegan alcohol resource!
  White flour and white sugar supposedly the calcium carbonate used to bleach these products can derive from animal bones. Can anyone provide a primary source to confirm or deny this claim?
  Chocolate  yes its true. apparently the refined sugar in it is made using a process involving animal bone charcoal.
  Sugar  some brands of refined cane sugar are made with a process using animal bone charcoal to scrub it clean of impurities, color, flavors, and minerals. C&H used to be vegan (as of 2001), but not Imperial. All sugar derived from sugar beets is vegan (not filtered with bone char). This is also true of common Brown sugar which is <i>indeed</i> white sugar before the brown (molasses) is added back in, according to my FST 10 professor.
    The This is also true in the last sentence is ambiguous. Im guessing that brown sugar has been filtered with bone char, but it isnt clear due to the position of the sentence.
  Watch out for casein. Always read ingredients! Its a milk protein and they slip it into vegetarian cheeses. The only vegetarian cheese that is really vegan is Tofutti. There are also some vegan cheeses such as Daiya but just make sure to check.
    Vegan gourmet cheese is also completely vegan (made by Follow Your Heart, the people that make Vegenaise).

 Products
  elastin (from cows, in skin care products)
  hyaluronic (from animal umbilical cords, skin care oils)
  musk oil (from muskdeer, beavers, muskrats, etcfragrance obtained by whipping genitals)
  premarin (taken from pregnant horses, an estrogen supplement)
  For those of you who are concerned about vegan beauty products, http://www.mymakeupmirror.com/MakeupWithoutCruelty.html this site provides a fairly comprehensive and accurate list (though not all Aubrey Organics products are vegan anymore, bummer)

 Famous Davis Vegans
  Users/PeteHernandez
  Users/CristinaDeptula (but I am very open to eating whatever others cook for me when I am a guest, regardless of their dietary preferences.)
  Jordan Steiner
  Users/JesseMiller
  Users/CandiceWang
  Users/KatieDelwiche
  Users/JessicaElb
  Users/MariahMontanez
  Users/NicholineLee (not really famous)
  Users/EricRedpath  As an employee of Delta of Venus, he is one of the reasons why they stay so Vegan friendly. (Even though Eric isnt actually a friendly person. He is just Vegan friendly.)
  Users/DanielleLee
  users/ScottWeintraub
  http://fennelfiles.com A vegan mom living in Davis blogs about food and life.
  Users/AprilAries  Not famous, but working on infamous.
  Users/NilliGrutman  Davis Veg Society president.
  Users/ShilpaSiva (not really really famous)
  Users/MiranPark  definitely infamous, but maybe a little famous for her vegan cupcakes and cookies.
  Users/BonnieStewart  she just cant bear to support factory farms with her dollars.
  Jay Erker  makes great pancakes
  Users/ConstantiaOomen (once an itsy bitsy famous in the Netherlands, now living in Davis with her also vegan husband)
  Users/JosephKaplan  Kaplan Real Estate

Check out http://www.vivausa.org VivaUSA! an animal rights organization based out of Davis!

 Vegan Poems

Sweet, Sweet Appetizer by Users/MichaelGiardina
Primal rage is the strangest vegan salad.
It’s nothing extraordinary, slightly superstitious, and
indefinable by meatloving company who fear the ingredients.
So, my guilt intensifies, so slick with sweat, afraid
The tofu will slip from their grasp when they squeeze.
The food falling crashes through salad forests, echoes
through the lawn, and police reports are filed when my brush rustles.
They think I have tried to kill them, so I run northwest on a curve
Hoping they won’t follow the trail of turmeric root.
But I am a creature of many senses, trying to cut them off,
force them out to the more and better. These are my opportunities
for attack, striking before they understand.
It’s primordial survival, instinct. I don’t need to think for this
quiet military action of my eye spying telltale trouble.
My backpack is filled with veggies, dangerous weapons that
Demand retreat. Unfortunately my guests were not fast enough
to overtake the unknown enemy, to retreat. I fire.
He tried the gluten. This time he fires. Twice into the brush.
Man down. He misses, for I am so full of sunlight that I blind.
They always leave badly wounded, muscles aching, soul singed,
heart thumping, surprised to hear that I had secretly sautéed
a few jumbo shrimp into that tasty little mix.
Sweet danger, unknown variety of disturbing weeds.
  I dont quite get your poem. It even seems antivegan.  Users/JackHaskel
   Bummer! For poems that are even easier to understand, try http://journals.aol.com/justus3121/CollegeBound/entries/295 Steins, Susie Asado

Id be open to adding some recipes or food recommendations  have a few of those and Im sure others do too.  Users/CristinaDeptula

20050313 20:12:54 nbsp Just as Vegetarians endure going through mainstream menus and foodlistings to figure out what they can eat, Vegans have to go through Vegetarian menus to figure out what they can eat.  I am sympathetic to a seperate Vegan list, provided it really focused on what options Vegans have in Davis.  At the outset it would seem to be a pretty small list, but I think some vegans are very creative and perhaps could share some of that creativity here. Users/JaimeRaba

20050313 20:18:17 nbsp Try the Delta of Venus  they have some wonderful tofu dishes and sandwiches. Also the samosas and the empanadas at the CoOp are vegan, and you can substitute hummus for cheese in some sandwiches and dips. And theres a wonderful product called the Egg Replacer available at the CoOp, which I would get even if I were not vegan since its powdered and in a cardboard box. Theres no risk that it will make a huge mess all over the sidewalk if my shopping bag were to break while I carried it home on my bike, as real eggs could.  Users/CristinaDeptula

20050323 04:34:55 nbsp at least someones being productive. i take back 10% of the mean things ive ever said about vegans. Users/ArlenAbraham

20050516 03:46:55 nbsp Hey guys. I used to live in Mountain View, where a small little vegan restaurant existed that served mimicked beef, pork, and pretty much every other meat. The consistency of the sweet and sour pork was amazingly close to real pork, a little chewie but soft... some grislelike material on the inside. The beef was long and slender like broccoli beef. Ive heard people say this is made from tofu, others from gluten. Could someone explain how they make these tasty fake meats. Is it possible to make them at home in your own kitchen? Id love to try.Users/MichaelGiardina
  Your descriptions sound very much like Gluten (Seitan). Ive never bought any really good gluten products in Davis, but I suspect they can be found at the Davis Food Coop. SF Market in Sac has a wide variety of gluten products that are ultrayummy. Most are in cans (labeled curried gluten, vegetarian mock abalone, vegetarian mock duck). I suspect they have some fresher products, but Im not certain. As for making them at home, do you mean cook with them, or make them from scratch? If the latter, unlike paneer cheese and tofu, I suspect its quite a time consuming and specialized process. But I dont know that for a fact ...
  While Im not vegan, my Users/LeonaScanlan sister was for many years, and I picked up some knowledge of nonmeat foods from her...  Fake meats are made from either seitan or bean curd, which tofu is made from.  Ive never made seitan myself, but Ive eaten homemade.  Its kinda weird, but I dont think its too difficult.  http://vegweb.com/recipes/subs/4539.shtml Heres a recipe from a Veggie website that looks promising. Also, bulgar wheat is a good substitute for ground beaf in dishes like chili.  It cooks like rice, but is larger and has a more substantial texture...  Let me know if you make the seitan and it turns out well!  Users/SummerSong ss
   Wow, thats an amazingly simple and inexpensive recipe! Ill have to try it sometime. I also found for how to make gluten based http://www.veganmania.com/pages/seitan.htm fake chicken and steak. I dont know the quality of these recipes though they make use of Nutritional Yeast and Braggs Liquid Aminos. I dont mean to knock these products, but I doubt theyre ingredients in what you ate at the Mountainview Restaurant. Users/CraigBrozinsky
     No way!  Braggs and Nutritional Yeast (also called Brewers Yeast) are two staples in any vegans dietwell, any that I know, anyway!  Brewers Yeast is seriously yummy on rice, veggies, and popcorn, and animalsat least the cats and dogs Ive knownreally like it too.  I once left a bag of Brewers yeast on the counter, and my two kittens tore into it and ate it upits just that tasty!  Hmmm... Is yeast alive?  Does that mean it isnt vegan?   Users/SummerSong ss
                  Even though yeast is alive, its not animal so it is vegan.  In the same way that flax and vegetables are alive (also vegan).  So go yeast!   Users/BobbyGray
      Yeah, my bad I was assuming MG was referring to an Asian restaurant, but there was nothing really to base that on. The Asian restaurants where Ive eaten gluten didnt have a Vegan feel as much as a substituteglutenformeat feel. They didnt even have a brown rice option. As such, I really didnt expect them to embrace vegan products such as Braggs, Nutritional Yeast, etc. While Im writing, can anyone recommend a good vegan cookbook? Ive become allergic to Soy, and cant enjoy many of the tasty vegan recipes I used to like.Users/CraigBrozinsky
  Im going to bet Seitan is what I was talking about. Ill have to take a look at SFMarket to see what they have. Somehow I didnt imagine it being in a can... but who am I to judge? Any other Seitan tips? Man, I feel like im quoting the bible or an orbital track.
    I eat it straight out of the can, but theyre really good when added to stir fries. I should mention that the ones I mentioned above wouldnt fool anyone into thinking theyre meat theyre sizable cubes that have a pretty big moisture content, so theyre kind of halfway betwen meat and tofu texture. Braising or grilling might make them more meat like if thats what youre looking for. Alternatively, there must be fresher products that are already meat like in texture. Please comment here if you find them!
  For fake steak strips try Soy Strips from the bulk bins at the coop. Theyll take on whatever flavor you give them and they are awesome!!! I like them in burritos, fajitas, and sandwiches so far. Users/JackHaskel
    Where are these bulk bins? Im only familiar with the salsa and the tofu bins. Users/MichaelGiardina
     Pretty much the entire left side of the store (as you come in) are bulk bins. The soy strips are near the dehydrated soups and chocolate chips in one of the vertical dispensers opposite the rice cakes.
     Oh, so you have to cook them, boil them, etc?
       yes

20060420 10:13:09 nbsp Actually the empanadas at the coop are NOT vegan; they have butter in the crust. Theyve been carrying vegan tamales, and the samosas as well as a variety of the salads (and usually half of the lunch buffet) are vegan. Also if youre looking for a butter substitute, go and get Earth Balance. Doesnt even taste like a substitute. Users/EmmaCoats(vegan by association)

20060812 16:52:05 nbsp If the Hot Food Line at the CoHo doesnt have a vegan option, our black beans, refried beans, tortillas, and spanish rice have all been confirmed vegan.  Once you take the cheese out, our vegetarian burritos are also vegan by default.  In addition, during the school year, our salad bar (duh) is an option, and the tofu salad was just recently changed to use veganaise instead of mayonaise.  No word on the bread in the sandwiches or the bagels yet, but I will look into them. Users/TaylorMoseley

20061220 13:39:11 nbsp Im not sure if its worth its own section, but I have questions about specific items at restaurants being vegan. Most pizza can be done vegan without cheese, but some place sneak cheezy bits into the sauce. Anyone know where its ok? And do any pizza places offer soy or vegan cheezes? Does anyone have any other questions about the veganality of items that a restaurant employee, owner, or regular customer could answer? users/ScottWeintraub

20070210 18:50:29 nbsp Cenarios makes vegan pizza if you ask them to. They take out the cheese and fool around with the veggie pizza. Users/VictoriaGimpelevich

20090116 12:25:09 nbsp Most days, the Coffee House Bakery has a vegan treat for sale. Its usually one of their jam Bozo Bars or peanut butter rice krispie treats, but sometimes they have vegan fudge bars. Yum! (The fudge bars contain coconut, so if thats one of your foods to avoid, be aware.) Users/LizPhillips

20090603 20:55:25 nbsp how about the veg burrito (no cheese or sour cream of course) at Del Taco... and I think that the Guad is now making their rice with vegetable stock instead of chicken stock.  Users/NicoletteD

20100207 19:20:52 nbsp John Natsoulas Gallery Cafe now has vegan potato knishes/rustic pies. They have a cornstarch glaze, not egg. They also offer delicious glutenfree/vegan chocolate chip cookies, as well as raspberryspelt vegan scones.  Users/RuthFankushen

20100805 20:18:35 nbsp Davis Noodle City is listed under Vegan Restaurant Options as having rice noodles, and its also listed under Vegan BumOuts as having only egg noodles. Someone should find out the solution to this contradiction next time he/she visits DNC. Users/TheShah

20100805 22:51:39 nbsp This page is Glines status Users/StevenDaubert
  ? Users/TheShah SS

20120728 02:25:08 nbsp I am a hardcore meat eater. Yet, my girlfriend dragged me to this place in Elk Grove called Loving Hut  an all vegan restaurant. Ive got to say, I was quite impressed. The food was quite delicious. There is a location off of Stockton Boulevard, too.  Users/CecilioPadilla


text:
      PROGRAM MAIN

*  Program to compute the NMSSM Higgs masses, couplings and
*  Branching ratios, with experimental and theoretical constraints
*
*   On input:
*
*      PAR(1) = lambda
*      PAR(2) = kappa
*      PAR(3) = tan(beta)
*      PAR(4) = mu (effective mu term = lambda*s)
*      PAR(5) = Alambda (if MA is not an input)
*      PAR(6) = Akappa
*      PAR(7) = mQ3**2
*      PAR(8) = mU3**2
*      PAR(9) = mD3**2
*      PAR(10) = mL3**2
*      PAR(11) = mE3**2
*      PAR(12) = AU3
*      PAR(13) = AD3
*      PAR(14) = AE3
*      PAR(15) = mQ2**2
*      PAR(16) = mU2**2
*      PAR(17) = mD2**2
*      PAR(18) = mL2**2
*      PAR(19) = mE2**2
*      PAR(20) = M1
*      PAR(21) = M2
*      PAR(22) = M3
*      PAR(23) = MA (diagonal doublet CP-odd mass matrix element)
*      PAR(24) = MP (diagonal singlet CP-odd mass matrix element)
*      PAR(25) = AE2
*
*      All these parameters are assumed to be defined in DRbar
*      at the scale Q2, except for tan(beta) defined at MZ.
*      Q2 is either defined by the user in the input file or
*      computed as Q2 = (2*mQ2+mU2+mD2)/4
*
*      The input file contains the starting point
*      as well as the total number of MCMC steps
*
*   On output:
*
*      SMASS(1-3): CP-even masses (ordered)
*
*      SCOMP(1-3,1-3): Mixing angles: if HB(I) are the bare states,
*        HB(I) = Re(H1), Re(H2), Re(S), and HM(I) are the mass eigenstates,
*        the convention is HB(I) = SUM_(J=1,3) SCOMP(J,I)*HM(J)
*        which is equivalent to HM(I) = SUM_(J=1,3) SCOMP(I,J)*HB(J)
*
*      PMASS(1-2): CP-odd masses (ordered)
*
*      PCOMP(1-2,1-2): Mixing angles: if AB(I) are the bare states,
*        AB(I) = Im(H1), Im(H2), Im(S), and AM(I) are the mass eigenstates,
*        the convention is
*        AM(I) = PCOMP(I,1)*(COSBETA*AB(1)+SINBETA*AB(2))
*              + PCOMP(I,2)*AB(3)
*
*      CMASS: Charged Higgs mass
*
*      CU,CD,CV,CJ,CG(i) Reduced couplings of h1,h2,h3 (i=1,2,3) or
*                        a1,a2 (i=4,5) to up type fermions, down type
*                        fermions, gauge bosons, gluons and photons
*                        Note: CV(4)=CV(5)=0
*
*      WIDTH(i) Total decay width of h1,h2,h3,a1,a2 (i=1..5)
*               with the following branching ratios:
*      BRJJ(i) h1,h2,h3,a1,a2 -> hadrons
*      BRMM(i)        "       -> mu mu
*      BRLL(i)        "       -> tau tau
*      BRCC(i)        "       -> cc
*      BRBB(i)        "       -> bb
*      BRTT(i)        "       -> tt
*      BRWW(i)        "       -> WW (BRWW(4)=BRWW(5)=0)
*      BRZZ(i)        "       -> ZZ (BRZZ(4)=BRZZ(5)=0)
*      BRGG(i)        "       -> gamma gamma
*      BRZG(i)        "       -> Z gamma
*      BRHIGGS(i)   (i=1..5)  -> other Higgses, including:
*        BRHAA(i,j)   hi      -> a1a1, a1a2, a2a2 (i=1..3, j=1..3)
*        BRHCHC(i)    hi      -> h+h- (i=1..3)
*        BRHAZ(i,j)   hi      -> Zaj  (i=1..3)
*        BRHCW(i)  h1,h2,h3   -> h+W- (i=1..3), a1,a2 -> h+W- (i=4,5)
*        BRHHH(i)     h2      -> h1h1, h3-> h1h1, h1h2, h2h2 (i=1..4)
*        BRAHA(i)     a2      -> a1hi (i=1..3)
*        BRAHZ(i,j)   ai      -> Zhj  (i=1,2, j=1..3)
*      BRSUSY(i)    (i=1..5)  -> susy particles, including:
*        BRNEU(i,j,k)         -> neutralinos j,k (i=1..5, j,k=1..5)
*        BRCHA(i,j)           -> charginos 11, 12, 22 (i=1..5, j=1..3)
*        BRHSQ(i,j)   hi      -> uLuL, uRuR, dLdL, dRdR, t1t1, t2t2,
*                                t1t2, b1b1, b2b2, b1b2 (i=1..3, j=1..10)
*        BRASQ(i,j)   ai      -> t1t2, b1b2 (i=1,2, j=1,2)
*        BRHSL(i,j)   hi      -> lLlL, lRlR, nLnL, l1l1, l2l2, l1l2,
*                                ntnt (i=1..3, j=1..7)
*        BRASL(i)     ai      -> l1l2 (i=1,2)
*
*      HCWIDTH  Total decay width of the charged Higgs
*               with the following branching ratios:
*      HCBRM         h+ -> mu nu_mu
*      HCBRL         "  -> tau nu_tau
*      HCBRSU        "  -> s u
*      HCBRBU        "  -> b u
*      HCBRSC        "  -> s c
*      HCBRBC        "  -> b c
*      HCBRBT        "  -> b t
*      HCBRWHT       "  -> neutral Higgs W+, including:
*        HCBRWH(i)   "  -> H1W+, H2W+, h3W+, a1W+, a2W+ (i=1..5)
*      HCBRSUSY      "  -> susy particles,including
*        HCBRNC(i,j) "  -> neutralino i chargino j (i=1..5, j=1,2)
*        HCBRSQ(i)   "  -> uLdL, t1b1, t1b2, t2b1, t2b2 (i=1..5)
*        HCBRSL(i)   "  -> lLnL, t1nt, t2nt (i=1..3)
*
*      MNEU(i)   Mass of neutralino chi_i (i=1,5, ordered in mass)
*      NEU(i,j)  chi_i components of bino, wino, higgsino u&d, singlino
*                (i,j=1..5)
*
*      MCHA(i)       Chargino masses
*      U(i,j),V(i,j) Chargino mixing matrices
*
*  ERRORS: IFAIL = 0..13
*
*  IFAIL = 0         OK
*          1,3,5,7   m_h1^2 < 0
*          2,3,6,7   m_a1^2 < 0
*          4,5,6,7   m_h+^2 < 0
*          8         m_sfermion^2 < 0
*          9         mu = 0 or (kappa=0 and Akappa=/=0)
*          10        Violation of phenomenological constraint(s)
*          11,12     Problem in integration of RGEs
*          13        Convergence problem
*
*  Phenomenological constraints:
*
*      PROB(I)  = 0, I = 1..62: OK
*
*      PROB(1) =/= 0   chargino too light
*      PROB(2) =/= 0   excluded by Z -> neutralinos
*      PROB(3) =/= 0   charged Higgs too light
*      PROB(4) =/= 0   excluded by ee -> hZ
*      PROB(5) =/= 0   excluded by ee -> hZ, h -> bb
*      PROB(6) =/= 0   excluded by ee -> hZ, h -> tautau
*      PROB(7) =/= 0   excluded by ee -> hZ, h -> invisible
*      PROB(8) =/= 0   excluded by ee -> hZ, h -> 2jets
*      PROB(9) =/= 0   excluded by ee -> hZ, h -> 2photons
*      PROB(10) =/= 0  excluded by ee -> hZ, h -> AA -> 4bs
*      PROB(11) =/= 0  excluded by ee -> hZ, h -> AA -> 4taus
*      PROB(12) =/= 0  excluded by ee -> hZ, h -> AA -> 2bs 2taus
*      PROB(13) =/= 0  excluded by Z -> hA (Z width)
*      PROB(14) =/= 0  excluded by ee -> hA -> 4bs
*      PROB(15) =/= 0  excluded by ee -> hA -> 4taus
*      PROB(16) =/= 0  excluded by ee -> hA -> 2bs 2taus
*      PROB(17) =/= 0  excluded by ee -> hA -> AAA -> 6bs
*      PROB(18) =/= 0  excluded by ee -> hA -> AAA -> 6taus
*      PROB(19) =/= 0  excluded by ee -> Zh -> ZAA -> Z + light pairs
*      PROB(20) =/= 0  excluded by stop -> b l sneutrino
*      PROB(21) =/= 0  excluded by stop -> neutralino c
*      PROB(22) =/= 0  excluded by sbottom -> neutralino b
*      PROB(23) =/= 0  squark/gluino too light
*      PROB(24) =/= 0  selectron/smuon too light
*      PROB(25) =/= 0  stau too light
*      PROB(26) =/= 0  lightest neutralino is not LSP or < 511 keV
*      PROB(27) =/= 0  Landau Pole in l, k, ht, hb below MGUT
*      PROB(28) =/= 0  unphysical global minimum
*      PROB(29) =/= 0  Higgs soft masses >> Msusy
*      PROB(30) =/= 0  excluded by DM relic density (checked only if OMGFLAG=/=0)
*      PROB(31) =/= 0  excluded by DM SI WIMP-nucleon xs (checked if |OMGFLAG|=2 or 4)
*      PROB(32) =/= 0  b->s gamma more than 2 sigma away
*      PROB(33) =/= 0  Delta M_s more than 2 sigma away
*      PROB(34) =/= 0  Delta M_d more than 2 sigma away
*      PROB(35) =/= 0  B_s->mu+mu- more than 2 sigma away
*      PROB(36) =/= 0  B+-> tau+nu_tau more than 2 sigma away
*      PROB(37) =/= 0  (g-2)_muon more than 2 sigma away
*      PROB(38) =/= 0  excluded by Upsilon(1S) -> A gamma
*      PROB(39) =/= 0  excluded by eta_b(1S) mass measurement
*      PROB(40) =/= 0  BR(B-->X_s mu+ mu-) more than 2 sigma away
*      PROB(41) =/= 0  excluded by ee -> hZ, h -> AA -> 4taus (ALEPH analysis)
*      PROB(42) =/= 0  excluded by top -> b H+, H+ -> c s (CDF, D0)
*      PROB(43) =/= 0  excluded by top -> b H+, H+ -> tau nu_tau (D0)
*      PROB(44) =/= 0  excluded by top -> b H+, H+ -> W+ A1, A1 -> 2taus (CDF)
*      PROB(45) =/= 0  excluded by t -> bH+ (LHC)
*      PROB(46) =/= 0  No Higgs in the MHmin-MHmax GeV range
*      PROB(47) =/= 0  chi2gam > chi2max
*      PROB(48) =/= 0  chi2bb > chi2max
*      PROB(49) =/= 0  chi2zz > chi2max
*      PROB(51) =/= 0: excluded by H/A->tautau
*      PROB(52) =/= 0: Excluded by H->AA->4leptons/2lept.+2b (LHC)
*      PROB(53) =/= 0: excluded by ggF->H/A->gamgam (65GeV < M < 122GeV, ATLAS)
*      PROB(55) =/= 0: b -> d gamma more than 2 sigma away
*      PROB(56) =/= 0: B_d -> mu+ mu- more than 2 sigma away
*      PROB(57) =/= 0: b -> s nu nubar more than 2 sigma away
*      PROB(58) =/= 0: b -> c tau nu more than 2 sigma away (as SM)
*      PROB(59) =/= 0: K -> pi nu nubar more than 2 sigma away
*      PROB(60) =/= 0: DMK / epsK more than 2 sigma away
*      PROB(61) =/= 0  excluded by DM SD WIMP-neutron xs (checked if |OMGFLAG|=2 or 4)
*      PROB(62) =/= 0  excluded by DM SD WIMP-proton xs (checked if |OMGFLAG|=2 or 4)
*
************************************************************************

      IMPLICIT NONE

      INTEGER NFL,NPROB,NPAR
      PARAMETER (NFL=13,NPROB=62,NPAR=25)
      INTEGER NFAIL(NFL),IFAIL,I,TOT,ITOT,NTOT,IDUM
      INTEGER M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,NMSFLAG
      INTEGER MSFLAG,AKFLAG,ALFLAG,OMGFLAG,MAFLAG,MOFLAG,GMUFLAG,HFLAG
      INTEGER TOTMIN,TOTMAX,NMAX,IP
      INTEGER CFLAG(5)

      DOUBLE PRECISION PAR(NPAR),PROB(NPROB),GAU
      DOUBLE PRECISION LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV
      DOUBLE PRECISION ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN
      DOUBLE PRECISION XISDEV,MUPCEN,MUPDEV,MSPCEN,MSPDEV,M3HCEN
      DOUBLE PRECISION M3HDEV,MACEN,MADEV,MPCEN,MPDEV,M1CEN,M1DEV
      DOUBLE PRECISION M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN
      DOUBLE PRECISION TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN
      DOUBLE PRECISION MSPMIN,M3HMIN,MAMIN,MPMIN,M1MIN,M2MIN,M3MIN
      DOUBLE PRECISION AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      DOUBLE PRECISION LN,LNN,KN,KNN,TBN,TBNN,MUN,MUNN
      DOUBLE PRECISION ALN,ALNN,AKN,AKNN,XIFN,XIFNN
      DOUBLE PRECISION XISN,XISNN,MUPN,MUPNN,MSPN,MSPNN
      DOUBLE PRECISION M3HN,M3HNN,MAN,MANN,MPN,MPNN
      DOUBLE PRECISION M1N,M1NN,M2N,M2NN,M3N,M3NN
      DOUBLE PRECISION AQN,AQNN,MQNN,MQN
      DOUBLE PRECISION XIF,XIS,MUP,MSP,M3H,DELMB
      DOUBLE PRECISION M32,CGR,MPL,Q2

      COMMON/NMSFLAG/NMSFLAG
      COMMON/FLAGS/OMGFLAG,MAFLAG,MOFLAG
      COMMON/GMUFLAG/GMUFLAG,HFLAG
      COMMON/SCANFLAGS/M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,
     . MSFLAG,AKFLAG,ALFLAG
      COMMON/STEPS/NTOT,IDUM,TOTMIN,TOTMAX,NMAX
      COMMON/BOUNDS/LN,LNN,KN,KNN,TBN,TBNN,MUN,MUNN,
     . ALN,ALNN,AKN,AKNN,XIFN,XIFNN,
     . XISN,XISNN,MUPN,MUPNN,MSPN,MSPNN,
     . M3HN,M3HNN,MAN,MANN,MPN,MPNN,
     . M1N,M1NN,M2N,M2NN,M3N,M3NN,
     . AQN,AQNN,MQN,MQNN
      COMMON/MCMCPAR/LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV,
     . ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN,XISDEV,MUPCEN,
     . MUPDEV,MSPCEN,MSPDEV,M3HCEN,M3HDEV,MACEN,MADEV,MPCEN,MPDEV,
     . M1CEN,M1DEV,M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN,
     . TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN,MSPMIN,M3HMIN,
     . MAMIN,MPMIN,M1MIN,M2MIN,M3MIN,
     . AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      COMMON/SUSYEXT/XIF,XIS,MUP,MSP,M3H
      COMMON/DELMB/DELMB
      COMMON/M32/M32,CGR,MPL
      COMMON/RENSCALE/Q2
      COMMON/CFLAG/CFLAG

*   Initialization

      CALL INITIALIZE()
      DO I=1,NFL
       NFAIL(I)=0
      ENDDO
      TOT=0
      IP=0

*   Reading of the input parameters

      CALL INPUT(PAR,NPAR)

*   Initialization of the range of parameters that has passed all tests

      TBN=1d99
      TBNN=-1d99
      M1N=1d99
      M1NN=-1d99
      M2N=1d99
      M2NN=-1d99
      M3N=1d99
      M3NN=-1d99
      LN=1d99
      LNN=-1d99
      KN=1d99
      KNN=-1d99
      MUN=1d99
      MUNN=-1d99
      MAN=1d99
      MANN=-1d99
      ALN=1d99
      ALNN=-1d99
      XIFN=1d99
      XIFNN=-1d99
      MPN=1d99
      MPNN=-1d99
      AKN=1d99
      AKNN=-1d99
      XISN=1d99
      XISNN=-1d99
      MUPN=1d99
      MUPNN=-1d99
      MSPN=1d99
      MSPNN=-1d99
      M3HN=1d99
      M3HNN=-1d99
      AQN=1d99
      AQNN=-1d99
      MQN=1d99
      MQNN=-1d99

*   Beginning of the scan

      DO ITOT=1,NTOT

 14   IF(ITOT.EQ.1)THEN

       PAR(3)=TBCEN
       PAR(21)=M2CEN
       IF(M1FLAG.EQ.0)THEN
        PAR(20)=PAR(21)/2d0
       ELSE
        PAR(20)=M1CEN
       ENDIF
       IF(M3FLAG.EQ.0)THEN
        PAR(22)=PAR(21)*3d0
       ELSE
        PAR(22)=M3CEN
       ENDIF
       PAR(1)=LCEN
       PAR(2)=KCEN
       PAR(4)=MUCEN
       IF(MOD(MAFLAG,3).EQ.0)THEN
        PAR(5)=ALCEN
        XIF=XIFCEN
       ELSEIF(MOD(MAFLAG,3).EQ.1)THEN
        PAR(23)=MACEN
        XIF=XIFCEN
       ELSE
        PAR(5)=ALCEN
        PAR(23)=MACEN
       ENDIF
       IF(MAFLAG/3.EQ.0)THEN
        PAR(6)=AKCEN
        XIS=XISCEN
       ELSEIF(MAFLAG/3.EQ.1)THEN
        PAR(24)=MPCEN
        XIS=XISCEN
       ELSE
        PAR(6)=AKCEN
        PAR(24)=MPCEN
       ENDIF
       MUP=MUPCEN
       MSP=MSPCEN
       M3H=M3HCEN
       PAR(12)=AQCEN
       PAR(7)=MQCEN**2

      ELSE

       IF(TBDEV.EQ.0d0)THEN
        PAR(3)=TBCEN
       ELSE
 101    PAR(3)=TBCEN+MAX(DABS(TBCEN),TBMIN)*TBDEV*GAU(IDUM)
        IF(PAR(3).LT.1d0)GOTO 101
       ENDIF

       IF(M2DEV.EQ.0d0)THEN
        PAR(21)=M2CEN
       ELSE
        PAR(21)=M2CEN+MAX(DABS(M2CEN),M2MIN)*M2DEV*GAU(IDUM)
       ENDIF

       IF(M1FLAG.EQ.0)THEN
        PAR(20)=PAR(21)/2d0
       ELSEIF(M1DEV.EQ.0d0)THEN
        PAR(20)=M1CEN
       ELSE
        PAR(20)=M1CEN+MAX(DABS(M1CEN),M1MIN)*M1DEV*GAU(IDUM)
       ENDIF

       IF(M3FLAG.EQ.0)THEN
        PAR(22)=PAR(21)*3d0
       ELSEIF(M3DEV.EQ.0d0)THEN
        PAR(22)=M3CEN
       ELSE
        PAR(22)=M3CEN+MAX(DABS(M3CEN),M3MIN)*M3DEV*GAU(IDUM)
       ENDIF

       IF(LDEV.EQ.0d0)THEN
        PAR(1)=LCEN
       ELSE
 102    PAR(1)=LCEN+MAX(DABS(LCEN),LMIN)*LDEV*GAU(IDUM)
        IF(PAR(1).LE.0d0)GOTO 102
       ENDIF

       IF(KDEV.EQ.0d0)THEN
        PAR(2)=KCEN
       ELSE
        PAR(2)=KCEN+MAX(DABS(KCEN),KMIN)*KDEV*GAU(IDUM)
       ENDIF

       IF(MUDEV.EQ.0d0)THEN
        PAR(4)=MUCEN
       ELSE
        PAR(4)=MUCEN+MAX(DABS(MUCEN),MUMIN)*MUDEV*GAU(IDUM)
       ENDIF

       IF(MOD(MAFLAG,3).EQ.0)THEN
        IF(ALDEV.EQ.0d0)THEN
         PAR(5)=ALCEN
        ELSE
         PAR(5)=ALCEN+MAX(DABS(ALCEN),ALMIN)*ALDEV*GAU(IDUM)
        ENDIF
        IF(XIFDEV.EQ.0d0)THEN
         XIF=XIFCEN
        ELSE
         XIF=XIFCEN+MAX(DABS(XIFCEN),XIFMIN)*XIFDEV*GAU(IDUM)
        ENDIF
       ELSEIF(MOD(MAFLAG,3).EQ.1)THEN
        IF(MADEV.EQ.0d0)THEN
         PAR(23)=MACEN
        ELSE
         PAR(23)=MACEN+MAX(DABS(MACEN),MAMIN)*MADEV*GAU(IDUM)
        ENDIF
        IF(XIFDEV.EQ.0d0)THEN
         XIF=XIFCEN
        ELSE
         XIF=XIFCEN+MAX(DABS(XIFCEN),XIFMIN)*XIFDEV*GAU(IDUM)
        ENDIF
       ELSE
        IF(ALDEV.EQ.0d0)THEN
         PAR(5)=ALCEN
        ELSE
         PAR(5)=ALCEN+MAX(DABS(ALCEN),ALMIN)*ALDEV*GAU(IDUM)
        ENDIF
        IF(MADEV.EQ.0d0)THEN
         PAR(23)=MACEN
        ELSE
         PAR(23)=MACEN+MAX(DABS(MACEN),MAMIN)*MADEV*GAU(IDUM)
        ENDIF
       ENDIF

       IF(MAFLAG/3.EQ.0)THEN
        IF(AKDEV.EQ.0d0)THEN
         PAR(6)=AKCEN
        ELSE
         PAR(6)=AKCEN+MAX(DABS(AKCEN),AKMIN)*AKDEV*GAU(IDUM)
        ENDIF
        IF(XISDEV.EQ.0d0)THEN
         XIS=XISCEN
        ELSE
         XIS=XISCEN+MAX(DABS(XISCEN),XISMIN)*XISDEV*GAU(IDUM)
        ENDIF
       ELSEIF(MAFLAG/3.EQ.1)THEN
        IF(MPDEV.EQ.0d0)THEN
         PAR(24)=MPCEN
        ELSE
         PAR(24)=MPCEN+MAX(DABS(MPCEN),MPMIN)*MPDEV*GAU(IDUM)
        ENDIF
        IF(XISDEV.EQ.0d0)THEN
         XIS=XISCEN
        ELSE
         XIS=XISCEN+MAX(DABS(XISCEN),XISMIN)*XISDEV*GAU(IDUM)
        ENDIF
       ELSE
        IF(AKDEV.EQ.0d0)THEN
         PAR(6)=AKCEN
        ELSE
         PAR(6)=AKCEN+MAX(DABS(AKCEN),AKMIN)*AKDEV*GAU(IDUM)
        ENDIF
        IF(MPDEV.EQ.0d0)THEN
         PAR(24)=MPCEN
        ELSE
         PAR(24)=MPCEN+MAX(DABS(MPCEN),MPMIN)*MPDEV*GAU(IDUM)
        ENDIF
       ENDIF

       IF(MUPDEV.EQ.0d0)THEN
        MUP=MUPCEN
       ELSE
        MUP=MUPCEN+MAX(DABS(MUPCEN),MUPMIN)*MUPDEV*GAU(IDUM)
       ENDIF

       IF(MSPDEV.EQ.0d0)THEN
        MSP=MSPCEN
       ELSE
        MSP=MSPCEN+MAX(DABS(MSPCEN),MSPMIN)*MSPDEV*GAU(IDUM)
       ENDIF

       IF(M3HDEV.EQ.0d0)THEN
        M3H=M3HCEN
       ELSE
        M3H=M3HCEN+MAX(DABS(M3HCEN),M3HMIN)*M3HDEV*GAU(IDUM)
       ENDIF

       IF(AQDEV.EQ.0d0)THEN
        PAR(12)=AQCEN
       ELSE
        PAR(12)=AQCEN+MAX(DABS(AQCEN),AQMIN)*AQDEV*GAU(IDUM)
       ENDIF

       IF(MQDEV.EQ.0d0)THEN
        PAR(7)=MQCEN**2
       ELSE
        PAR(7)=(MQCEN+MAX(DABS(MQCEN),MQMIN)*MQDEV*GAU(IDUM))**2
       ENDIF

      ENDIF

      PAR(13)=PAR(12)
      PAR(8)=PAR(7)
      PAR(9)=PAR(7)
      PAR(15)=PAR(7)
      PAR(16)=PAR(7)
      PAR(17)=PAR(7)

!      WRITE(0,*)""
!      WRITE(0,*)"------------------------------------------------------"
!      WRITE(0,*)""
!      WRITE(0,*)"Point ",ITOT
!      WRITE(0,*)""
!      WRITE(0,*)"MAFLAG=",MAFLAG
!      WRITE(0,*)""
!      WRITE(0,*)"TANB =",PAR(3)
!      WRITE(0,*)"M1 =",PAR(20)
!      WRITE(0,*)"M2 =",PAR(21)
!      WRITE(0,*)"M3 =",PAR(22)
!      WRITE(0,*)"LAMBDA =",PAR(1)
!      WRITE(0,*)"KAPPA =",PAR(2)
!      WRITE(0,*)"MUEFF =",PAR(4)
!      WRITE(0,*)"ALAMBDA =",PAR(5)
!      WRITE(0,*)"AKAPPA =",PAR(6)
!      WRITE(0,*)"XIF =",XIF
!      WRITE(0,*)"XIS =",XIS
!      WRITE(0,*)"MUP =",MUP
!      WRITE(0,*)"MSP =",MSP
!      WRITE(0,*)"M3H =",M3H
!      WRITE(0,*)"MA =",PAR(23)
!      WRITE(0,*)"MP =",PAR(24)
!      WRITE(0,*)""

*   Initialization of PROB and IFAIL

      DO I=1,NPROB
       PROB(I)=0d0
      ENDDO
      IFAIL=0
      DELMB=.1d0

*   Check for mu = 0 or (kappa=0 and Akappa=/=0)

      IF(PAR(4).EQ.0d0 .OR. (PAR(2).EQ.0d0 .AND. MAFLAG/3.EQ.1))THEN
       IFAIL=9
       GOTO 11
      ENDIF

*   Computation of parameters at QSTSB

      CALL RUNPAR(PAR)

*   Computation of sfermion masses

      CALL MSFERM(PAR,IFAIL,1)
      IF(IFAIL.NE.0)GOTO 11

*   Computation of Higgs masses

      CALL MHIGGS(PAR,IFAIL)
      IF(IFAIL.EQ.-1)IFAIL=13
      IF(IFAIL.NE.0)GOTO 11

*   Computation of gluino mass

      CALL GLUINO(PAR)

*   Computation of chargino masses

      CALL CHARGINO(PAR)

*   Computation of neutralino masses

      CALL NEUTRALINO(PAR)

*   Computation of Higgs + top branching ratios

      CALL DECAY(PAR)
      CALL TDECAY(PAR)

*   Exp. constraints on sparticles/Higgses

      IF(CFLAG(2).EQ.1)CALL SUBEXP(PAR,PROB)
      IF(CFLAG(3).EQ.1)THEN
       CALL LHCHIG(PAR,PROB)
       CALL Higgs_CHI2(PAR,PROB)
       CALL CMS_TAUTAU(PAR,PROB)
       CALL ATLAS_H_GAMGAM(PROB)
       CALL LHC_HSMAA_LEPTONS(PROB)
      ENDIF

*   B + K physics

      IF(CFLAG(4).EQ.1)THEN
       CALL BOTTOMONIUM(PAR,PROB)
       CALL BSG(PAR,PROB)
       CALL KPHYS(PAR,PROB)
       PROB(58)=0d0
      ENDIF

*   Anom. magn. moment of the Muon

      IF(GMUFLAG.EQ.1)CALL MAGNMU(PAR,PROB)

*   Global minimum?

      CALL CHECKMIN(PROB)

*   Landau Pole?

      CALL RGES(PAR,PROB,IFAIL)
      IF(IFAIL.NE.0)THEN
       PROB(27)=1d0
       IFAIL=0
      ENDIF

*   RGEs for the soft terms

      CALL RGESOFT(PAR,IFAIL)
      IF(IFAIL.NE.0)THEN
       PROB(27)=1d0
       IFAIL=0
      ENDIF

*   Relic density

      M32=CGR*DSQRT(Q2/3d0)
      CALL RELDEN(PAR,PROB)

*   Computation of the fine-tuning

      CALL FTPAR(PAR,0)

*   Check for problems

      DO I=1,NPROB
       IF(PROB(I).NE.0d0)IFAIL=10
      ENDDO
      IF(IFAIL.NE.0)GOTO 11

*   Sparticle decays

      IF(NMSFLAG.NE.0)CALL NMSDECAY(PAR)

*   Recording of the results

 11   CALL MCMCSTEP(PAR,PROB,NPROB,IFAIL)
      CALL OUTPUT(PAR,PROB,IFAIL)
      IF(IFAIL.EQ.0)THEN
       TOT=TOT+1
       LN=MIN(PAR(1),LN)
       LNN=MAX(PAR(1),LNN)
       KN=MIN(PAR(2),KN)
       KNN=MAX(PAR(2),KNN)
       TBN=MIN(PAR(3),TBN)
       TBNN=MAX(PAR(3),TBNN)
       MUN=MIN(PAR(4),MUN)
       MUNN=MAX(PAR(4),MUNN)
       ALN=MIN(PAR(5),ALN)
       ALNN=MAX(PAR(5),ALNN)
       AKN=MIN(PAR(6),AKN)
       AKNN=MAX(PAR(6),AKNN)
       XIFN=MIN(XIF,XIFN)
       XIFNN=MAX(XIF,XIFNN)
       XISN=MIN(XIS,XISN)
       XISNN=MAX(XIS,XISNN)
       MUPN=MIN(MUP,MUPN)
       MUPNN=MAX(MUP,MUPNN)
       MSPN=MIN(MSP,MSPN)
       MSPNN=MAX(MSP,MSPNN)
       M3HN=MIN(M3H,M3HN)
       M3HNN=MAX(M3H,M3HNN)
       M1N=MIN(PAR(20),M1N)
       M1NN=MAX(PAR(20),M1NN)
       M2N=MIN(PAR(21),M2N)
       M2NN=MAX(PAR(21),M2NN)
       M3N=MIN(PAR(22),M3N)
       M3NN=MAX(PAR(22),M3NN)
       MAN=MIN(PAR(23),MAN)
       MANN=MAX(PAR(23),MANN)
       MPN=MIN(PAR(24),MPN)
       MPNN=MAX(PAR(24),MPNN)
       AQN=MIN(PAR(12),AQN)
       AQNN=MAX(PAR(12),AQNN)
       MQN=MIN(DSQRT(PAR(7)),MQN)
       MQNN=MAX(DSQRT(PAR(7)),MQNN)
      ELSE
       NFAIL(IFAIL)=NFAIL(IFAIL)+1
      ENDIF

      IF(TOT.EQ.TOTMAX)THEN
       NTOT=ITOT
       GOTO 12
      ENDIF
      IF(IP.EQ.1)GOTO 13

      ENDDO

      IP=1
 13   IF(TOT.LT.TOTMIN .AND. NTOT.LT.NMAX)THEN
       NTOT=NTOT+1
       ITOT=ITOT+1
       GOTO 14
      ENDIF

*   Summary of the scanning:
*   Number of points that passed/failed the tests
*   and range for scanned parameters

 12   CALL ERROR(TOT,NTOT,NFAIL)

      END

      SUBROUTINE INPUT(PAR,NPAR)

*******************************************************************
*   This subroutine reads SM and NMSSM parameters from input file   .
*******************************************************************

      IMPLICIT NONE

      CHARACTER CHINL*120,CHBLCK*60,CHDUM*120

      INTEGER I,NLINE,INL,ICH,IX,IVAL,Q2FIX,MCFLAG,TOTMIN,TOTMAX,NMAX
      INTEGER N0,NLOOP,NBER,NPAR,ERR,NTOT,ISEED,GMUFLAG,HFLAG,VFLAG
      INTEGER M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,MSFLAG,Z3FLAG
      INTEGER AKFLAG,ALFLAG,OMGFLAG,MAFLAG,MOFLAG,PFLAG,NMSFLAG
      INTEGER CFLAG(5)

      DOUBLE PRECISION PAR(*),VAL
      DOUBLE PRECISION ACC,XITLA,XLAMBDA,MC0,MB0,MT0
      DOUBLE PRECISION ALSMZ,ALEMMZ,GF,g1,g2,S2TW
      DOUBLE PRECISION MS,MC,MB,MBP,MT,MTAU,MMUON,MZ,MW
      DOUBLE PRECISION VUS,VCB,VUB,Q2,Q2MIN
      DOUBLE PRECISION LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV
      DOUBLE PRECISION ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN
      DOUBLE PRECISION XISDEV,MUPCEN,MUPDEV,MSPCEN,MSPDEV,M3HCEN
      DOUBLE PRECISION M3HDEV,MACEN,MADEV,MPCEN,MPDEV,M1CEN,M1DEV
      DOUBLE PRECISION M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN
      DOUBLE PRECISION TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN
      DOUBLE PRECISION MSPMIN,M3HMIN,MAMIN,MPMIN,M1MIN,M2MIN,M3MIN
      DOUBLE PRECISION AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      DOUBLE PRECISION M32,CGR,MPL

      COMMON/GAUGE/ALSMZ,ALEMMZ,GF,g1,g2,S2TW
      COMMON/SMSPEC/MS,MC,MB,MBP,MT,MTAU,MMUON,MZ,MW
      COMMON/CKM/VUS,VCB,VUB
      COMMON/ALS/XLAMBDA,MC0,MB0,MT0,N0
      COMMON/RENSCALE/Q2
      COMMON/Q2FIX/Q2MIN,Q2FIX
      COMMON/MCMCPAR/LCEN,LDEV,KCEN,KDEV,TBCEN,TBDEV,MUCEN,MUDEV,
     . ALCEN,ALDEV,AKCEN,AKDEV,XIFCEN,XIFDEV,XISCEN,XISDEV,MUPCEN,
     . MUPDEV,MSPCEN,MSPDEV,M3HCEN,M3HDEV,MACEN,MADEV,MPCEN,MPDEV,
     . M1CEN,M1DEV,M2CEN,M2DEV,M3CEN,M3DEV,XCEN,XDEV,X,LMIN,KMIN,
     . TBMIN,MUMIN,ALMIN,AKMIN,XIFMIN,XISMIN,MUPMIN,MSPMIN,M3HMIN,
     . MAMIN,MPMIN,M1MIN,M2MIN,M3MIN,
     . AQCEN,AQDEV,AQMIN,MQCEN,MQDEV,MQMIN
      COMMON/STEPS/NTOT,ISEED,TOTMIN,TOTMAX,NMAX
      COMMON/SCANFLAGS/M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,
     . MSFLAG,AKFLAG,ALFLAG
      COMMON/FLAGS/OMGFLAG,MAFLAG,MOFLAG
      COMMON/PFLAG/PFLAG
      COMMON/NMSFLAG/NMSFLAG
      COMMON/GMUFLAG/GMUFLAG,HFLAG
      COMMON/MCFLAG/MCFLAG
      COMMON/VFLAG/VFLAG
      COMMON/M32/M32,CGR,MPL
      COMMON/CFLAG/CFLAG

*   INITIALIZATION OF THE SUSY PARAMETERS
      DO I=1,NPAR
       PAR(I)=1d99
      ENDDO

*   INITIALIZATION OF THE SCANNING PARAMETERS
      TBCEN=1d99
      TBDEV=1d99
      TBMIN=0d0
      M1CEN=1d99
      M1DEV=1d99
      M1MIN=0d0
      M2CEN=1d99
      M2DEV=1d99
      M2MIN=0d0
      M3CEN=1d99
      M3DEV=1d99
      M3MIN=0d0
      LCEN=1d99
      LDEV=1d99
      LMIN=0d0
      KCEN=0d0
      KDEV=1d99
      KMIN=0d0
      ALCEN=1d99
      ALDEV=1d99
      ALMIN=0d0
      AKCEN=1d99
      AKDEV=1d99
      AKMIN=0d0
      MUCEN=1d99
      MUDEV=1d99
      MUMIN=0d0
      XIFCEN=1d99
      XIFDEV=1d99
      XIFMIN=0d0
      XISCEN=1d99
      XISDEV=1d99
      XISMIN=0d0
      MUPCEN=0d0
      MUPDEV=1d99
      MUPMIN=0d0
      MSPCEN=0d0
      MSPDEV=1d99
      MSPMIN=0d0
      M3HCEN=0d0
      M3HDEV=1d99
      M3HMIN=0d0
      MACEN=1d99
      MADEV=1d99
      MAMIN=0d0
      MPMIN=0d0
      MPCEN=1d99
      MPDEV=1d99
      AQCEN=1d99
      AQDEV=1d99
      AQMIN=0d0
      MQCEN=1d99
      MQDEV=1d99
      MQMIN=0d0
      XCEN=1d99
      XDEV=1d0
      NTOT=0
      TOTMIN=0
      TOTMAX=1000000
      NMAX=1000000
      CGR=1d0
      MPL=2.4d18

*   DEFAULT VALUES FOR FLAGS
      GMUFLAG=1
      PFLAG=0
      OMGFLAG=0
      NMSFLAG=0
      HFLAG=0
      VFLAG=0
      MOFLAG=0
      M1FLAG=0
      M3FLAG=0
      MCFLAG=0
      DO I=1,5
       CFLAG(I)=1
      ENDDO

*   DEFAULT VALUE FOR THE RANDOM SEED
      ISEED=-1

*   DEFAULT VALUE FOR THE RENSCALE Q2
      Q2=0d0

*   INITIALIZE READ LOOP
      NLINE=0
      CHBLCK=' '

*   START TO READ NEW LINE INTO CHINL
 21   CHINL=' '

*   LINE NUMBER
      NLINE=NLINE+1

      READ(5,'(A120)',END=29,ERR=999) CHINL

*   CHECK FOR EMPTY OR COMMENT LINES
      IF(CHINL.EQ.' '.OR.CHINL(1:1).EQ.'#'
     .  .OR.CHINL(1:1).EQ.'*') GOTO 21

*   FORCE UPPER CASE LETTERS IN CHINL (AS REQUIRED BELOW)
      INL=0
 22   INL=INL+1
      IF(CHINL(INL:INL).NE.'#')THEN
       DO ICH=97,122
        IF(CHINL(INL:INL).EQ.CHAR(ICH)) CHINL(INL:INL)=CHAR(ICH-32)
       ENDDO
       IF(INL.LT.120) GOTO 22
      ENDIF

*   CHECK FOR BLOCK STATEMENT
      IF(CHINL(1:1).EQ.'B')THEN
       READ(CHINL,'(A6,A)',ERR=999) CHDUM,CHBLCK
       GOTO 21
      ENDIF

*   CHECK FOR NMSSM MODEL IN MODSEL
*   IF THE RELIC DENSITY SHOULD BE COMPUTED
*   THE BLOCK MODSEL MUST CONTAIN THE LINE "  9     1    "
      IF(CHBLCK(1:6).EQ.'MODSEL')THEN
       READ(CHINL,*,ERR=999) IX,IVAL
       IF(IX.EQ.1) Z3FLAG=IVAL
       IF(IX.EQ.8) PFLAG=IVAL
       IF(IX.EQ.9) OMGFLAG=IVAL
       IF(IX.EQ.11) GMUFLAG=IVAL
       IF(IX.EQ.13) NMSFLAG=IVAL
       IF(IX.EQ.14) VFLAG=IVAL
       IF(IX.EQ.15) MOFLAG=IVAL
       IF(IX.EQ.17) CFLAG(1)=IVAL
       IF(IX.EQ.18) CFLAG(2)=IVAL
       IF(IX.EQ.19) CFLAG(3)=IVAL
       IF(IX.EQ.20) CFLAG(4)=IVAL

*   READ SMINPUTS
      ELSEIF(CHBLCK(1:8).EQ.'SMINPUTS')THEN
       READ(CHINL,*,ERR=999) IX,VAL
       IF(IX.EQ.2) GF=VAL
       IF(IX.EQ.3) ALSMZ=VAL
       IF(IX.EQ.4) MZ=VAL
       IF(IX.EQ.5) MB=VAL
       IF(IX.EQ.6) MT=VAL
       IF(IX.EQ.7) MTAU=VAL

*   READ Q2 AND TANBETA
      ELSEIF(CHBLCK(1:6).EQ.'MINPAR')THEN
       READ(CHINL,*,ERR=999) IX,VAL
       IF(IX.EQ.0.AND.Q2.EQ.0d0) Q2=VAL**2
       IF(IX.EQ.3) TBCEN=VAL
       IF(IX.EQ.36) TBDEV=VAL
       IF(IX.EQ.37) TBMIN=VAL
       IF(IX.EQ.6) CGR=VAL

*   READ EXTPAR
      ELSEIF(CHBLCK(1:6).EQ.'EXTPAR')THEN
       READ(CHINL,*,ERR=999) IX,VAL
       IF(IX.EQ.0) Q2=VAL**2
       IF(IX.EQ.-1) XDEV=VAL
       IF(IX.EQ.1) M1CEN=VAL
       IF(IX.EQ.106) M1DEV=VAL
       IF(IX.EQ.107) M1MIN=VAL
       IF(IX.EQ.2) M2CEN=VAL
       IF(IX.EQ.206) M2DEV=VAL
       IF(IX.EQ.207) M2MIN=VAL
       IF(IX.EQ.3) M3CEN=VAL
       IF(IX.EQ.306) M3DEV=VAL
       IF(IX.EQ.307) M3MIN=VAL
       IF(IX.EQ.11) AQCEN=VAL
       IF(IX.EQ.116) AQDEV=VAL
       IF(IX.EQ.117) AQMIN=VAL
       IF(IX.EQ.13) PAR(14)=VAL
       IF(IX.EQ.16) PAR(25)=VAL
       IF(IX.EQ.32) PAR(18)=VAL**2
       IF(IX.EQ.33) PAR(10)=VAL**2
       IF(IX.EQ.35) PAR(19)=VAL**2
       IF(IX.EQ.36) PAR(11)=VAL**2
       IF(IX.EQ.43) MQCEN=VAL
       IF(IX.EQ.436) MQDEV=VAL
       IF(IX.EQ.437) MQMIN=VAL
       IF(IX.EQ.61) LCEN=VAL
       IF(IX.EQ.616) LDEV=VAL
       IF(IX.EQ.617) LMIN=VAL
       IF(IX.EQ.62) KCEN=VAL
       IF(IX.EQ.626) KDEV=VAL
       IF(IX.EQ.627) KMIN=VAL
       IF(IX.EQ.63) ALCEN=VAL
       IF(IX.EQ.636) ALDEV=VAL
       IF(IX.EQ.637) ALMIN=VAL
       IF(IX.EQ.64) AKCEN=VAL
       IF(IX.EQ.646) AKDEV=VAL
       IF(IX.EQ.647) AKMIN=VAL
       IF(IX.EQ.65) MUCEN=VAL
       IF(IX.EQ.656) MUDEV=VAL
       IF(IX.EQ.657) MUMIN=VAL
       IF(IX.EQ.66) XIFCEN=VAL
       IF(IX.EQ.666) XIFDEV=VAL
       IF(IX.EQ.667) XIFMIN=VAL
       IF(IX.EQ.67) XISCEN=VAL
       IF(IX.EQ.676) XISDEV=VAL
       IF(IX.EQ.677) XISMIN=VAL
       IF(IX.EQ.68) MUPCEN=VAL
       IF(IX.EQ.686) MUPDEV=VAL
       IF(IX.EQ.687) MUPMIN=VAL
       IF(IX.EQ.69) MSPCEN=VAL
       IF(IX.EQ.696) MSPDEV=VAL
       IF(IX.EQ.697) MSPMIN=VAL
       IF(IX.EQ.72) M3HCEN=VAL
       IF(IX.EQ.726) M3HDEV=VAL
       IF(IX.EQ.727) M3HMIN=VAL
       IF(IX.EQ.124) MACEN=VAL
       IF(IX.EQ.1246) MADEV=VAL
       IF(IX.EQ.1247) MAMIN=VAL
       IF(IX.EQ.125) MPCEN=VAL
       IF(IX.EQ.1256) MPDEV=VAL
       IF(IX.EQ.1257) MPMIN=VAL

*   READ STEPS
       ELSEIF(CHBLCK(1:6).EQ.'STEPS')THEN
       READ(CHINL,*,ERR=999) IX,IVAL
       IF(IX.EQ.0) NTOT=IVAL
       IF(IX.EQ.1) ISEED=IVAL
       IF(IX.EQ.2) HFLAG=IVAL
       IF(IX.EQ.3) MCFLAG=IVAL
       IF(IX.EQ.4) TOTMIN=IVAL
       IF(IX.EQ.5) TOTMAX=IVAL
       IF(IX.EQ.6) NMAX=IVAL

      ENDIF

      GOTO 21

*   END OF READING FROM INPUT FILE

*   Check for errors

 29   ERR=0
      DO I=1,5
       IF(CFLAG(I).LT.0 .OR. CFLAG(I).GT.1)THEN
        WRITE(0,1)"CONSTRAINT FLAGS MUST BE IN [0-1]"
        ERR=1
       ENDIF
      ENDDO
      IF(GMUFLAG.LT.0 .OR. GMUFLAG.GT.1)THEN
       WRITE(0,1)"GMUFLAG MUST BE IN [0-1]"
       ERR=1
      ENDIF
      IF(VFLAG.LT.0 .OR. VFLAG.GT.1)THEN
       WRITE(0,1)"VFLAG MUST BE IN [0-1]"
       ERR=1
      ENDIF
      IF(MOFLAG.LT.0 .OR. MOFLAG.GT.7)THEN
       WRITE(0,1)"MOFLAG MUST BE IN [0-7]"
       ERR=1
      ENDIF
      IF(XDEV.EQ.1d99)THEN
       WRITE(0,1)"XDEV MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(LCEN.EQ.1d99)THEN
       WRITE(0,1)"LCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ELSEIF(LCEN.LE.0d0)THEN
       WRITE(0,1)"LCEN MUST BE STRICTLY POSITIVE"
       ERR=1
      ENDIF
      IF(TBCEN.EQ.1d99)THEN
       WRITE(0,1)"TBCEN MUST BE GIVEN IN BLOCK MINPAR"
       ERR=1
      ELSEIF(TBCEN.LE.0d0)THEN
       WRITE(0,1)"TBCEN MUST BE STRICTLY POSITIVE"
       ERR=1
      ENDIF
      IF(MUCEN.EQ.1d99)THEN
       WRITE(0,1)"MUCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ELSEIF(MUCEN.EQ.0d0)THEN
       WRITE(0,1)"MUCEN MUST BE NON ZERO"
       ERR=1
      ENDIF
      IF(M1CEN.EQ.1d99 .AND. M1DEV.NE.1d99)THEN
       WRITE(0,1)"M1CEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(M2CEN.EQ.1d99)THEN
       WRITE(0,1)"M2CEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(M3CEN.EQ.1d99 .AND. M3DEV.NE.1d99)THEN
       WRITE(0,1)"M3CEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(AQCEN.EQ.1d99)THEN
       WRITE(0,1)"AU3CEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(PAR(14).EQ.1d99)THEN
       WRITE(0,1)"AE3 MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(MQCEN.EQ.1d99)THEN
       WRITE(0,1)"MQ3CEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(PAR(10).EQ.1d99)THEN
       WRITE(0,1)"ML3 MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(PAR(11).EQ.1d99)THEN
       WRITE(0,1)"ME3 MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(MACEN.EQ.1d99 .AND. MADEV.NE.1d99)THEN
       WRITE(0,1)"MACEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(MPCEN.EQ.1d99 .AND. MPDEV.NE.1d99)THEN
       WRITE(0,1)"MPCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(ALCEN.EQ.1d99 .AND. ALDEV.NE.1d99)THEN
       WRITE(0,1)"ALCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(AKCEN.EQ.1d99 .AND. AKDEV.NE.1d99)THEN
       WRITE(0,1)"AKCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(XIFCEN.EQ.1d99 .AND. XIFDEV.NE.1d99)THEN
       WRITE(0,1)"XIFCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(XISCEN.EQ.1d99 .AND. XISDEV.NE.1d99)THEN
       WRITE(0,1)"XISCEN MUST BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF
      IF(PAR(18).EQ.1d99)PAR(18)=PAR(10)
      IF(PAR(19).EQ.1d99)PAR(19)=PAR(11)
      IF(PAR(25).EQ.1d99)PAR(25)=PAR(14)

*   Relations between (ALAMBDA, MA, XIF) and (AKAPPA, MP, XIS)

      IF(ALCEN.NE.1d99 .AND. XIFCEN.NE.1d99 .AND. MACEN.NE.1d99)THEN
       WRITE(0,1)"AT MOST 2 OF THE 3 PARAMETERS ALAMBDA, MA AND XIF",
     . " CAN BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF

      IF(AKCEN.NE.1d99 .AND. XISCEN.NE.1d99 .AND. MPCEN.NE.1d99)THEN
       WRITE(0,1)"AT MOST 2 OF THE 3 PARAMETERS AKAPPA, MP AND XIS",
     . " CAN BE GIVEN IN BLOCK EXTPAR"
       ERR=1
      ENDIF

      IF(KCEN.EQ.0d0)THEN
       IF((AKCEN.NE.0d0 .AND. AKCEN.NE.1d99) .OR. (AKCEN.EQ.0d0
     . .AND. AKDEV.NE.0d0 .AND. AKMIN.NE.0d0))THEN
        WRITE(0,1)"IF KAPPA IS 0, AKAPPA MUST BE 0"
        ERR=1
       ELSE
        AKCEN=0d0
        AKDEV=0d0
        AKMIN=0d0
        IF(XISCEN.NE.1d99 .AND. MPCEN.NE.1d99)THEN
         WRITE(0,1)"IF KAPPA IS 0, EITHER MP OR XIS",
     .   " CAN BE GIVEN IN BLOCK EXTPAR"
         ERR=1
        ENDIF
       ENDIF
      ENDIF

*   Set default values

      IF(ALCEN.EQ.1d99.AND.MACEN.EQ.1d99.AND.XIFCEN.EQ.1d99)THEN
       ALCEN=0d0
       XIFCEN=0d0
      ELSEIF(ALCEN.EQ.1d99.AND.MACEN.EQ.1d99)THEN
       ALCEN=0d0
      ELSEIF(ALCEN.EQ.1d99.AND.XIFCEN.EQ.1d99)THEN
       XIFCEN=0d0
      ELSEIF(MACEN.EQ.1d99.AND.XIFCEN.EQ.1d99)THEN
       XIFCEN=0d0
      ENDIF

      IF(AKCEN.EQ.1d99.AND.MPCEN.EQ.1d99.AND.XISCEN.EQ.1d99)THEN
       AKCEN=0d0
       XISCEN=0d0
      ELSEIF(AKCEN.EQ.1d99.AND.MPCEN.EQ.1d99)THEN
       AKCEN=0d0
      ELSEIF(AKCEN.EQ.1d99.AND.XISCEN.EQ.1d99)THEN
       XISCEN=0d0
      ELSEIF(MPCEN.EQ.1d99.AND.XISCEN.EQ.1d99)THEN
       XISCEN=0d0
      ENDIF

*   Set MAFLAG, SCANFLAGS

      IF(MACEN.EQ.1d99)MAFLAG=0
      IF(ALCEN.EQ.1d99)MAFLAG=1
      IF(XIFCEN.EQ.1d99)MAFLAG=2
      IF(AKCEN.EQ.1d99)MAFLAG=MAFLAG+3
      IF(XISCEN.EQ.1d99)MAFLAG=MAFLAG+6
      IF(M1CEN.NE.1d99)M1FLAG=1
      IF(M3CEN.NE.1d99)M3FLAG=1

*   Bounds

      IF(TBDEV.EQ.1d99)TBDEV=0d0
      IF(M1DEV.EQ.1d99)M1DEV=0d0
      IF(M2DEV.EQ.1d99)M2DEV=0d0
      IF(M3DEV.EQ.1d99)M3DEV=0d0
      IF(LDEV.EQ.1d99)LDEV=0d0
      IF(KDEV.EQ.1d99)KDEV=0d0
      IF(ALDEV.EQ.1d99)ALDEV=0d0
      IF(AKDEV.EQ.1d99)AKDEV=0d0
      IF(MUDEV.EQ.1d99)MUDEV=0d0
      IF(XIFDEV.EQ.1d99)XIFDEV=0d0
      IF(XISDEV.EQ.1d99)XISDEV=0d0
      IF(MUPDEV.EQ.1d99)MUPDEV=0d0
      IF(MSPDEV.EQ.1d99)MSPDEV=0d0
      IF(M3HDEV.EQ.1d99)M3HDEV=0d0
      IF(MADEV.EQ.1d99)MADEV=0d0
      IF(MPDEV.EQ.1d99)MPDEV=0d0
      IF(AQDEV.EQ.1d99)AQDEV=0d0
      IF(MQDEV.EQ.1d99)MQDEV=0d0

*   Total number of points

      IF(NTOT.LE.0)THEN
       WRITE(0,1)"WRONG NUMBER OF POINTS IN BLOCK STEPS"
       ERR=1
      ENDIF
      IF(TOTMIN.GT.TOTMAX)THEN
       WRITE(0,1)"TOTMIN must be smaller than TOTMAX"
       ERR=1
      ENDIF

*   Check for Z3 breaking terms

      IF(MOD(MAFLAG,3).EQ.2 .OR. MAFLAG/3.EQ.2 .OR.
     . MUPCEN.NE.0d0 .OR. MUPDEV.NE.0d0 .OR. MSPCEN.NE.0d0 .OR.
     . MSPDEV.NE.0d0 .OR. XIFCEN.NE.0d0 .OR. XIFDEV.NE.0d0 .OR.
     . XISCEN.NE.0d0 .OR. XISDEV.NE.0d0 .OR. M3HCEN.NE.0d0 .OR.
     . M3HDEV.NE.0d0)THEN
       IF(PFLAG.NE.0)THEN
        WRITE(0,1)"HIGGS MASS PRECISION = 1 OR 2 ONLY FOR Z3-NMSSM"
        ERR=1
       ENDIF
       IF(Z3FLAG.GT.2)THEN
        WRITE(0,1)"PRESENCE OF Z3 BREAKING TERMS"
        ERR=1
       ENDIF
      ENDIF

*   Stop if error

      IF(ERR.EQ.1)THEN
       WRITE(0,1)"ERROR IN INPUT FILE"
       STOP 1
      ENDIF

*   Set Q2MIN, Q2FIX:
      Q2MIN=100d0**2
      Q2FIX=1
      IF(Q2.LE.Q2MIN)THEN
       Q2FIX=0
      ENDIF

*   Initialization for ALPHAS and RUNM (as in hdecay)
*   The bottom quark pole mass MBP is set in INIT and can be changed
*   only there (changing its running mass MB above has no effect
*   on MBP, since one would have to compute alpha_s(MB) first)

      MC0=MC
      MB0=MBP
      MT0=MT
      N0=5
      NLOOP=2
      NBER=18
      ACC=1d-8
      XLAMBDA=XITLA(NLOOP,ALSMZ,ACC)
      CALL ALSINI(ACC)
      CALL BERNINI(NBER)

*    g1,g2  and sin(theta)^2 in the on-shell scheme in terms of
*    GF, MZ(pole) and MW(pole)

      g2=4d0*DSQRT(2d0)*GF*MW**2
      g1=4d0*DSQRT(2d0)*GF*(MZ**2-MW**2)
      S2TW=1d0-(MW/MZ)**2

      RETURN

 999  WRITE(0,1)"READ ERROR ON LINE:", NLINE
      WRITE(0,*)CHINL(1:80)
      STOP 1

 1    FORMAT(2A)

      END

      SUBROUTINE OUTPUT(PAR,PROB,IFAIL)

*********************************************************************
*   Subroutine writing all the results in the the output file.
*********************************************************************

      IMPLICIT NONE

      INTEGER NBIN,I,J,NRES,IRES,NSUSY,NGUT,NMES,IMAX,IFAIL
      PARAMETER (NSUSY=14,NGUT=21,NMES=20,IMAX=200)

      DOUBLE PRECISION RES(IMAX),PAR(*),PROB(*),SIG(3,10)
      DOUBLE PRECISION SMASS(3),SCOMP(3,3),PMASS(2),PCOMP(2,2),CMASS
      DOUBLE PRECISION MGL,MCHA(2),U(2,2),V(2,2),MNEU(5),NEU(5,5)
      DOUBLE PRECISION BRJJ(5),BREE(5),BRMM(5),BRLL(5)
      DOUBLE PRECISION BRCC(5),BRBB(5),BRTT(5),BRWW(3),BRZZ(3)
      DOUBLE PRECISION BRGG(5),BRZG(5),BRHHH(4),BRHAA(3,3)
      DOUBLE PRECISION BRHCHC(3),BRHAZ(3,2),BRAHA(3),BRAHZ(2,3)
      DOUBLE PRECISION BRHCW(5),BRHIGGS(5),BRNEU(5,5,5),BRCHA(5,3)
      DOUBLE PRECISION BRHSQ(3,10),BRHSL(3,7),BRASQ(2,2),BRASL(2)
      DOUBLE PRECISION BRSUSY(5),WIDTH(5)
      DOUBLE PRECISION HCBRM,HCBRL,HCBRSU,HCBRBU,HCBRSC,HCBRBC
      DOUBLE PRECISION HCBRBT,HCBRWH(5),HCBRWHT,HCBRNC(5,2)
      DOUBLE PRECISION HCBRSQ(5),HCBRSL(3),HCBRSUSY,HCWIDTH
      DOUBLE PRECISION CU(5),CD(5),CV(3),CJ(5),CG(5),CB(5)
      DOUBLE PRECISION ALSMZ,ALEMMZ,GF,g1,g2,S2TW
      DOUBLE PRECISION MS,MC,MB,MBP,MT,MTAU,MMUON,MZ,MW
      DOUBLE PRECISION VUS,VCB,VUB
      DOUBLE PRECISION MUR,MUL,MDR,MDL,MLR,MLL,MNL
      DOUBLE PRECISION MST1,MST2,MSB1,MSB2,MSL1,MSL2,MSNT
      DOUBLE PRECISION CST,CSB,CSL,MSMU1,MSMU2,MSNM,CSMU,Q2
      DOUBLE PRECISION MGUT,g1s,g2s,g3s,HTOPS,HBOTS,HTAUS
      DOUBLE PRECISION MHUS,MHDS,MSS
      DOUBLE PRECISION G1GUT,G2GUT,G3GUT,LGUT,KGUT,HTOPGUT
      DOUBLE PRECISION HBOTGUT,HTAUGUT,M1GUT,M2GUT,M3GUT,ALGUT,AKGUT
      DOUBLE PRECISION ATGUT,ABGUT,ATAUGUT,AMUGUT,MHUGUT,MHDGUT
      DOUBLE PRECISION MSGUT,MQ3GUT,MU3GUT,MD3GUT,MQGUT,MUGUT
      DOUBLE PRECISION MDGUT,ML3GUT,ME3GUT,MLGUT,MEGUT
      DOUBLE PRECISION XIFGUT,XISGUT,MUPGUT,MSPGUT,M3HGUT
      DOUBLE PRECISION XIFSUSY,XISSUSY,MUPSUSY,MSPSUSY,M3HSUSY
      DOUBLE PRECISION OMG,OMGMIN,OMGMAX
      DOUBLE PRECISION Xf,sigmaV,vcsll,vcsbb,x(100),dNdx(100),EMIN
      DOUBLE PRECISION sigmaPiN,sigmaS,csPsi,csNsi,csPsd,csNsd
      DOUBLE PRECISION MHUQ,MHDQ,MSX,LQ,KQ,ALQ,AKQ,MUQ,NUQ
      DOUBLE PRECISION ZHU,ZHD,ZS,H1Q,H2Q,TANBQ,QSTSB
      DOUBLE PRECISION BRSG,BRSGmax,BRSGmin,DMd,DMdmin,DMdmax,DMs,
     . DMsmax,DMsmin,BRBMUMU,BRBMUMUmax,BRBMUMUmin,BRBtaunu,
     . BRBtaunumax,BRBtaunumin
      DOUBLE PRECISION BRBSll,BRBSllmin,BRBSllMax,
     .             BRBShll,BRBShllmin,BRBShllMax,
     .             BRDG,BRDGmin,BRDGmax,
     .             BRBdMUMU,BRBdMUMUmin,BRBdMUMUmax,
     .             BRBXsnunu,BRBXsnunumin,BRBXsnunumax,
     .             BRBpKpnunu,BRBpKpnunumin,BRBpKpnunuMax,
     .             BRBKsnunu,BRBKsnunumin,BRBKsnunuMax,
     .             RD_taul,RD_taulmin,RD_taulmax,
     .             RDs_taul,RDs_taulmin,RDs_taulmax
      DOUBLE PRECISION BRKp_Pipnunub,BRKp_Pipnunubmin,BRKp_PipnunubMax,
     .       BRKL_Pi0nunub,BRKL_Pi0nunubmin,BRKL_Pi0nunubMax,
     .       DMK,DMKmin,DMKmax,epsK,epsKmin,epsKmax
      DOUBLE PRECISION eps0,epst0,epst1,epst2,epst3,epsts,epstb
      DOUBLE PRECISION epsY32,epsY31,epsY23,epsY13,epscs,epscb
      DOUBLE PRECISION delmagmu,damumin,damumax,amuthmax,amuthmin
      DOUBLE PRECISION brtopbw,brtopbh,brtopneutrstop(5,2),toptot
      DOUBLE PRECISION FTSUSY(NSUSY+2),FTGUT(NGUT+2),FTMES(NMES+2)
      DOUBLE PRECISION DELMB,PX,PA(6),PB(2),PL(7),PK(8),MH(3),MMH(3)
      DOUBLE PRECISION DMH(3),MA(2),MMA(2),DMA(2),MHC,MMHC,DMHC
      DOUBLE PRECISION MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      DOUBLE PRECISION M32,CGR,MPL
*
      DOUBLE PRECISION chartot2(2),chartot(2),chartot3(2)
      DOUBLE PRECISION brcharsel(2),brcharser(2),brcharsmu1(2),
     .         brcharsmu2(2),brcharstau1(2),brcharstau2(2),
     .         brcharsne1(2),brcharsne2(2),brcharsnm1(2),brcharsnm2(2),
     .         brcharsnt1(2),brcharsnt2(2),brcharsupl(2),brcharsupr(2),
     .         brcharsdownl(2),brcharsdownr(2),brcharst1(2),
     .         brcharst2(2),brcharsb1(2),brcharsb2(2),brcharwneut(2,5),
     .         brcharhcneut(2,5),brcharzchic,brcharHchic(3),
     .         brcharAchic(2),brntaunut(2,5),brnelnue(2,5),
     .         brnmunumu(2,5),brnupdb(2,5),brnchsb(2,5),brntopbb(2,5),
     .         brglupdb(2),brglchsb(2),brgltopbb(2),brchee,brchmumu,
     .         brchtautau,brchnene,brchnmunmu,brchntauntau,brchupup,
     .         brchdodo,brchchch,brchstst,brchtoptop,brchbotbot
*
      DOUBLE PRECISION neuttot2(5),neuttot(5),neuttot3(5),neuttotrad(5)
      DOUBLE PRECISION brneutst1(5),brneutst2(5),brneutsb1(5),
     .         brneutsb2(5),
     .         brneutsupl(5),brneutsupr(5),brneutsdownl(5),
     .         brneutsdownr(5),brneutsnel(5),brneutsn1(5),
     .         brneutsn2(5),brneutsell(5),brneutselr(5),
     .         brneutsnmu(5),brneutsmu1(5),brneutsmu2(5),
     .         brneutstau1(5),brneutstau2(5),brneutwchar(5,2),
     .         brneuthcchar(5,2),brneutzneut(5,5),
     .         brneutHneut(5,5,3),brneutAneut(5,5,2),brnraddec(5,5)
      DOUBLE PRECISION brneutup(5,5),brneutdow(5,5),brneutch(5,5),
     .         brneutst(5,5),brneutbot(5,5),brneuttop(5,5),
     .         brneutel(5,5),brneutmu(5,5),brneuttau(5,5),
     .         brneutnue(5,5),brneutnumu(5,5),brneutnutau(5,5),
     .         brchubd(5,2),brchcbs(5,2),brchtbb(5,2),brchelne(5,2),
     .         brchmunmu(5,2),brchtauntau(5,2),brglup(5),brgldo(5),
     .         brglch(5),brglst(5),brgltop(5),brglbot(5)
*
      DOUBLE PRECISION selltot,selltot2,selltot3,selrtot,selrtot2,
     .         selrtot3,smu1tot,smu1tot2,smu1tot3,smu2tot,smu2tot2,
     .         smu2tot3,stau1tot2,stau2tot,stau2tot2,stau2tot3,
     .         snelltot,snelltot2,snelltot3,snmu1tot,snmu1tot2,
     .         snmu1tot3,sntautot,sntautot2,sntautot3
      DOUBLE PRECISION brsellneute(5),brselrneute(5),brsellcharnue(2),
     .         brselrcharnue(2),brsnellneut(5),brsnellchar(5),
     .         brsmu1neutmu(5),brsmu2neutmu(5),brsmu1charnumu(2),
     .         brsmu2charnumu(2),brsnmu1neut(5),brsnmu1char(5),
     .         brstau1neut(5),brstau2neut(5),brstau1char(2),
     .         brstau2char(2),brstau1hcsn(2),brstau2hcsn(2),
     .         brstau1wsn(2),brstau2wsn(2),brstau2ztau,brstau2H(3),
     .         brstau2A(2),brsntauneut(5),brsntauchar(2),
     .         brsntau1hcstau(2),brsntau1wstau(2)
      DOUBLE PRECISION brsellstau1star,brsellstau1,
     .         brsellstau1nutau,brselrstau1star,brselrstau1,
     .         brselrstau1nutau,brsnestau1star,brsnestau1,
     .         brsnestau1nutau,brsmu1stau1star,brsmu1stau1,
     .         brsmu1stau1nutau,brsmu2stau1star,brsmu2stau1,
     .         brsmu2stau1nutau,brsnmustau1star,brsnmustau1,
     .         brsnmustau1nutau,brstau2stau1star,brstau2stau1,
     .         brstau2stau1nn,brsntaustau1star,brsntaustau1,
     .         brsntaustau1nutau
*
      DOUBLE PRECISION supltot2,suprtot2,sdowltot2,sdowrtot2
      DOUBLE PRECISION brsuplnup(5),brsuplcdow(2),brsuplglui,
     .         brsuprnup(5),brsuprcdow(2),brsuprglui,
     .         brsdowlndow(5),brsdowlchup(2),brsdowlglui,
     .         brsdowrndow(5),brsdowrchup(2),brsdowrglui
*
      DOUBLE PRECISION stoptot(2),stoptot2(2),stoptot3(2),stoptotrad(2)
      DOUBLE PRECISION brst1neutt(5),brst2neutt(5),brst1charb(2),
     .         brst2charb(2),brst1hcsb(2),brst2hcsb(2),brst1wsb(2),
     .         brst2wsb(2),brst1glui,brst2glui,brst2H(3),brst2A(2),
     .         brst2ztop,brgamma,brgammaup,brgammagluino
      DOUBLE PRECISION brstopw(2,5),brstoph(2,5),brststau(2,2),
     .         brstsntau(2,2),brstsmu(2,2),brstsnmu(2),brstsel(2,2),
     .         brstsnel(2),brstbsbst(2,2),brstbbsbt(2,2),
     .         brsttausbnu(2,2),brstelsbnu(2,2),brstupsbdow(2,2),
     .         brst2st1tt,brst2st1startt,brst2st1bb,brst2st1uu,
     .         brst2st1dd,brst2st1ee,brst2st1nunu,brst2st1tautau
*
      DOUBLE PRECISION sbottot(2),sbottot2(2),sbottot3(2)
      DOUBLE PRECISION brsb1neutt(5),brsb2neutt(5),brsb1chart(2),
     .         brsb2chart(2),brsb1hcst(2),brsb2hcst(2),
     .         brsb1glui,brsb2glui,brsb1wst(2),
     .         brsb2wst(2),brsb2H(3),brsb2A(2),brsb2zbot
      DOUBLE PRECISION  brsbstau(2,2),brsbsntau(2,2),brsbsel(2,2),
     .         brsbtstsb(2,2),brsbtbstb(2,2),brsbtaustnu(2,2),
     .         brsbelstnu(2,2),brsbupstdow(2,2),brsbsnel(2),
     .         brsb2sb1bb,brsb2sb1starbb,brsb2sb1tt,
     .         brsb2sb1uu,brsb2sb1dd,brsb2sb1ee,brsb2sb1nunu,
     .         brsb2sb1tautau,brsbsmu(2,2),brsbsnmu(2)
*
      DOUBLE PRECISION gluitot,gluitot2,gluitot3,gluitotrad
      DOUBLE PRECISION brgst1,brgst2,brgsb1,brgsb2,brgsupl,brgsupr,
     .         brgsdownl,brgsdownr,brglnjgluon(5)
      DOUBLE PRECISION brgoup(5),brgoch(5),brgodn(5),brgost(5),
     .         brgotp(5),brgobt(5),brgoud(2),brgocs(2),brgotb(2),
     .         brhcst1b,brwst1b
*
      COMMON/CHARGINO_WIDTH/chartot2,chartot,chartot3
      COMMON/CHARGINO_BR_2BD/brcharsel,brcharser,brcharsmu1,
     .         brcharsmu2,brcharstau1,brcharstau2,
     .         brcharsne1,brcharsne2,brcharsnm1,brcharsnm2,
     .         brcharsnt1,brcharsnt2,brcharsupl,brcharsupr,
     .         brcharsdownl,brcharsdownr,brcharst1,
     .         brcharst2,brcharsb1,brcharsb2,brcharwneut,
     .         brcharhcneut,brcharzchic,brcharHchic,
     .         brcharAchic
      COMMON/CHARGINO_BR_3BD/brntaunut,brnelnue,brnmunumu,
     .         brnupdb,brnchsb,brntopbb,
     .         brglupdb,brglchsb,brgltopbb,
     .         brchee,brchmumu,brchtautau,brchnene,
     .         brchnmunmu,brchntauntau,brchupup,brchdodo,
     .         brchchch,brchstst,brchtoptop,brchbotbot
*
      COMMON/NEUTRALINO_WIDTH/neuttot2,neuttot,neuttot3,neuttotrad
      COMMON/NEUTRALINO_BR_2BD/brneutst1,brneutst2,brneutsb1,brneutsb2,
     .         brneutsupl,brneutsupr,brneutsdownl,brneutsdownr,
     .         brneutsnel,brneutsn1,brneutsn2,brneutsell,brneutselr,
     .         brneutsnmu,brneutsmu1,brneutsmu2,
     .         brneutstau1,brneutstau2,brneutwchar,brneuthcchar,
     .         brneutzneut,brneutHneut,brneutAneut,brnraddec
      COMMON/NEUTRALINO_BR_3BD/brneutup,brneutdow,brneutch,brneutst,
     .         brneutbot,brneuttop,brneutel,brneutmu,brneuttau,
     .         brneutnue,brneutnumu,brneutnutau,brchubd,brchcbs,
     .         brchtbb,brchelne,brchmunmu,brchtauntau,brglup,brgldo,
     .         brglch,brglst,brgltop,brglbot
*
      COMMON/SLEPTON_WIDTH/selltot,selltot2,selltot3,selrtot,
     .         selrtot2,selrtot3,smu1tot,smu1tot2,smu1tot3,smu2tot,
     .         smu2tot2,smu2tot3,stau1tot2,stau2tot,stau2tot2,
     .         stau2tot3,snelltot,snelltot2,snelltot3,snmu1tot,
     .         snmu1tot2,snmu1tot3,sntautot2,sntautot3,sntautot
      COMMON/SLEPTON_BR_2BD/brsellneute,brselrneute,brsellcharnue,
     .         brselrcharnue,brsnellneut,brsnellchar,brsmu1neutmu,
     .         brsmu2neutmu,brsmu1charnumu,brsmu2charnumu,brsnmu1neut,
     .         brsnmu1char,brstau1neut,brstau2neut,brstau1char,
     .         brstau2char,brstau1hcsn,brstau2hcsn,brstau1wsn,
     .         brstau2wsn,brstau2ztau,brstau2H,brstau2A,brsntauneut,
     .         brsntauchar,brsntau1hcstau,brsntau1wstau
      COMMON/SLEPTON_BR_3BD/brsellstau1star,brsellstau1,
     .         brsellstau1nutau,brselrstau1star,brselrstau1,
     .         brselrstau1nutau,brsnestau1star,brsnestau1,
     .         brsnestau1nutau,brsmu1stau1star,brsmu1stau1,
     .         brsmu1stau1nutau,brsmu2stau1star,brsmu2stau1,
     .         brsmu2stau1nutau,brsnmustau1star,brsnmustau1,
     .         brsnmustau1nutau,brstau2stau1star,brstau2stau1,
     .         brstau2stau1nn,brsntaustau1star,brsntaustau1,
     .         brsntaustau1nutau
*
      COMMON/SQUARK_WIDTH/supltot2,suprtot2,sdowltot2,sdowrtot2
      COMMON/SQUARK_BR_2BD/brsuplnup,brsuplcdow,brsuplglui,
     .         brsuprnup,brsuprcdow,brsuprglui,
     .         brsdowlndow,brsdowlchup,brsdowlglui,
     .         brsdowrndow,brsdowrchup,brsdowrglui
*
      COMMON/STOP_WIDTH/stoptot,stoptot2,stoptot3,stoptotrad
      COMMON/STOP_BR_2BD/brst1neutt,brst2neutt,brst1charb,
     .         brst2charb,brst1hcsb,brst2hcsb,brst1wsb,
     .         brst2wsb,brst1glui,brst2glui,brst2H,brst2A,
     .         brst2ztop,brgamma,brgammaup,brgammagluino
      COMMON/STOP_BR_3BD/brstopw,brstoph,brststau,
     .         brstsntau,brstsmu,brstsnmu,brstsel,
     .         brstsnel,brstbsbst,brstbbsbt,
     .         brsttausbnu,brstelsbnu,brstupsbdow,
     .         brst2st1tt,brst2st1startt,brst2st1bb,brst2st1uu,
     .         brst2st1dd,brst2st1ee,brst2st1nunu,brst2st1tautau
*
      COMMON/SBOTTOM_WIDTH/sbottot,sbottot2,sbottot3
      COMMON/SBOTTOM_BR_2BD/brsb1neutt,brsb2neutt,brsb1chart,
     .         brsb2chart,brsb1hcst,brsb2hcst,
     .         brsb1glui,brsb2glui,brsb1wst,
     .         brsb2wst,brsb2H,brsb2A,brsb2zbot
      COMMON/SBOTTOM_BR_3BD/brsbstau,brsbsntau,brsbsel,
     .         brsbtstsb,brsbtbstb,brsbtaustnu,
     .         brsbelstnu,brsbupstdow,brsbsnel,
     .         brsb2sb1bb,brsb2sb1starbb,brsb2sb1tt,
     .         brsb2sb1uu,brsb2sb1dd,brsb2sb1ee,brsb2sb1nunu,
     .         brsb2sb1tautau,brsbsmu,brsbsnmu
*
      COMMON/GLUINO_WIDTH/gluitot,gluitot2,gluitot3,gluitotrad
      COMMON/GLUINO_BR_2BD/brgst1,brgst2,brgsb1,brgsb2,brgsupl,brgsupr,
     .         brgsdownl,brgsdownr,brglnjgluon
      COMMON/GLUINO_BR_3BD/brgoup,brgoch,brgodn,brgost,brgotp,
     .         brgobt,brgoud,brgocs,brgotb,brhcst1b,brwst1b
*
      COMMON/BRN/BRJJ,BREE,BRMM,BRLL,BRCC,BRBB,BRTT,BRWW,
     . BRZZ,BRGG,BRZG,BRHHH,BRHAA,BRHCHC,BRHAZ,BRAHA,BRAHZ,
     . BRHCW,BRHIGGS,BRNEU,BRCHA,BRHSQ,BRHSL,BRASQ,BRASL,
     . BRSUSY,WIDTH
      COMMON/BRC/HCBRM,HCBRL,HCBRSU,HCBRBU,HCBRSC,HCBRBC,
     . HCBRBT,HCBRWH,HCBRWHT,HCBRNC,HCBRSQ,HCBRSL,
     . HCBRSUSY,HCWIDTH
      COMMON/BRSG/BRSG,BRSGmax,BRSGmin,DMd,DMdmin,DMdmax,DMs,
     .      DMsmax,DMsmin,BRBMUMU,BRBMUMUmax,BRBMUMUmin,BRBtaunu,
     .      BRBtaunumax,BRBtaunumin
      COMMON/FLAV2/BRBSll,BRBSllmin,BRBSllMax,
     .      BRBShll,BRBShllmin,BRBShllMax,
     .      BRDG,BRDGmin,BRDGmax,
     .      BRBdMUMU,BRBdMUMUmin,BRBdMUMUmax,
     .      BRBXsnunu,BRBXsnunumin,BRBXsnunumax,
     .      BRBpKpnunu,BRBpKpnunumin,BRBpKpnunuMax,
     .      BRBKsnunu,BRBKsnunumin,BRBKsnunuMax,
     .      RD_taul,RD_taulmin,RD_taulmax,
     .      RDs_taul,RDs_taulmin,RDs_taulmax
      COMMON/FLAV3/BRKp_Pipnunub,BRKp_Pipnunubmin,BRKp_PipnunubMax,
     .             BRKL_Pi0nunub,BRKL_Pi0nunubmin,BRKL_Pi0nunubMax,
     .             DMK,DMKmin,DMKmax,epsK,epsKmin,epsKmax
      COMMON/EPSCOUP/eps0,epst0,epst1,epst2,epst3,epsts,epstb,
     .               epsY32,epsY31,epsY23,epsY13,epscs,epscb
      COMMON/MAGMU/delmagmu,damumin,damumax,amuthmax,amuthmin
      COMMON/BR_top2body/brtopbw,brtopbh,brtopneutrstop
      COMMON/topwidth/toptot
      COMMON/REDCOUP/CU,CD,CV,CJ,CG
      COMMON/CB/CB
      COMMON/HIGGSPEC/SMASS,SCOMP,PMASS,PCOMP,CMASS
      COMMON/SUSYSPEC/MGL,MCHA,U,V,MNEU,NEU
      COMMON/GAUGE/ALSMZ,ALEMMZ,GF,g1,g2,S2TW
      COMMON/SMSPEC/MS,MC,MB,MBP,MT,MTAU,MMUON,MZ,MW
      COMMON/CKM/VUS,VCB,VUB
      COMMON/SFSPEC/MUR,MUL,MDR,MDL,MLR,MLL,MNL,
     . MST1,MST2,MSB1,MSB2,MSL1,MSL2,MSNT,
     . CST,CSB,CSL,MSMU1,MSMU2,MSNM,CSMU
      COMMON/RENSCALE/Q2
      COMMON/STSBSCALE/QSTSB
      COMMON/MGUT/MGUT
      COMMON/SUSYCOUP/g1s,g2s,g3s,HTOPS,HBOTS,HTAUS
      COMMON/SUSYMH/MHUS,MHDS,MSS
      COMMON/QMHIGGS/MHUQ,MHDQ,MSX
      COMMON/QPAR/LQ,KQ,ALQ,AKQ,MUQ,NUQ
      COMMON/QHIGGS/ZHU,ZHD,ZS,H1Q,H2Q,TANBQ
      COMMON/GUTCOUP/G1GUT,G2GUT,G3GUT,LGUT,KGUT,HTOPGUT,
     . HBOTGUT,HTAUGUT
      COMMON/GUTPAR/M1GUT,M2GUT,M3GUT,ALGUT,AKGUT,ATGUT,ABGUT,
     . ATAUGUT,AMUGUT,MHUGUT,MHDGUT,MSGUT,MQ3GUT,MU3GUT,MD3GUT,
     . MQGUT,MUGUT,MDGUT,ML3GUT,ME3GUT,MLGUT,MEGUT
      COMMON/GUTEXT/XIFGUT,XISGUT,MUPGUT,MSPGUT,M3HGUT
      COMMON/SUSYEXT/XIFSUSY,XISSUSY,MUPSUSY,MSPSUSY,M3HSUSY
      COMMON/MICROMG/OMG,OMGMIN,OMGMAX,Xf,sigmaV,vcsll,vcsbb,
     .      x,dNdx,EMIN,NBIN
      COMMON/MICROMG2/sigmaPiN,sigmaS,csPsi,csNsi,csPsd,csNsd
      COMMON/FINETUN/FTSUSY,FTGUT,FTMES
      COMMON/EFFHIGM/MH,MMH,DMH,MA,MMA,DMA,MHC,MMHC,DMHC
      COMMON/EFFCOUP/PX,PA,PB,PL,PK
      COMMON/DELMB/DELMB
      COMMON/LHCSIG/SIG
      COMMON/HIGGSFIT/MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      COMMON/M32/M32,CGR,MPL

      IF(IFAIL.NE.0)RETURN

      IRES=11
      NRES=108+IRES

      RES(1)=PAR(1)
      RES(2)=PAR(2)
      RES(3)=PAR(3)
      RES(4)=PAR(4)
      RES(5)=PAR(5)
      RES(6)=PAR(6)
      RES(7)=PAR(21)
      RES(8)=PAR(23)
      RES(9)=PAR(24)
      RES(10)=XIFSUSY
      RES(11)=XISSUSY

      DO I=1,3
       RES(IRES-6+7*I)=SMASS(I)
       RES(IRES-5+7*I)=CV(I)
       RES(IRES-4+7*I)=CG(I)
       RES(IRES-3+7*I)=CJ(I)
       RES(IRES-2+7*I)=CU(I)
       RES(IRES-1+7*I)=CD(I)
       RES(IRES+7*I)=SCOMP(I,3)**2
      ENDDO
      DO I=1,2
       RES(IRES+16+6*I)=PMASS(I)
       RES(IRES+17+6*I)=CG(I+3)
       RES(IRES+18+6*I)=CJ(I+3)
       RES(IRES+19+6*I)=CU(I+3)
       RES(IRES+20+6*I)=CD(I+3)
       RES(IRES+21+6*I)=PCOMP(I,2)**2
      ENDDO
      DO I=1,3
       RES(IRES+33+I)=BRHAA(I,1)
      ENDDO
      DO I=1,4
       RES(IRES+36+I)=BRHHH(I)
      ENDDO
      DO I=1,5
       RES(IRES+40+I)=BRNEU(I,1,1)
      ENDDO
      DO I=1,3
       DO J=1,10
        RES(IRES+35+10*I+J)=SIG(I,J)
       ENDDO
      ENDDO
      RES(IRES+76)=chi2gam
      RES(IRES+77)=chi2bb
      RES(IRES+78)=chi2zz
      RES(IRES+79)=CMASS
      DO I=1,5
       RES(IRES+79+I)=DABS(MNEU(I))
      ENDDO
      RES(IRES+85)=NEU(1,1)**2
      RES(IRES+86)=NEU(1,3)**2+NEU(1,4)**2
      RES(IRES+87)=DABS(NEU(1,3)**2-NEU(1,4)**2)
      RES(IRES+88)=NEU(1,5)**2
      RES(IRES+89)=MCHA(1)
      RES(IRES+90)=MCHA(2)
      RES(IRES+91)=MGL
      RES(IRES+92)=MUR
      RES(IRES+93)=MUL
      RES(IRES+94)=MDR
      RES(IRES+95)=MDL
      RES(IRES+96)=MLR
      RES(IRES+97)=MLL
      RES(IRES+98)=MNL
      RES(IRES+99)=MST1
      RES(IRES+100)=MST2
      RES(IRES+101)=MSB1
      RES(IRES+102)=MSB2
      RES(IRES+103)=MSL1
      RES(IRES+104)=MSL2
      RES(IRES+105)=MSNT
      RES(IRES+106)=OMG
      RES(IRES+107)=csPsi
      RES(IRES+108)=FTSUSY(NSUSY+1)

      WRITE(6,11)(RES(I),I=1,NRES)
 11   FORMAT(200E14.6)

      END

      SUBROUTINE ERROR(TOT,NTOT,NFAIL)

*********************************************************************
*   Subroutine for the error file. It contains a summary of the scan:
*   Number of points that passed/failed the tests
*   and ranges for scanned parameters that passed the tests
*********************************************************************

      IMPLICIT NONE

      INTEGER I,S,TOT,NTOT,NFAIL(*),GMUFLAG,HFLAG,CFLAG(5)
      INTEGER M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG
      INTEGER MSFLAG,AKFLAG,ALFLAG,OMGFLAG,MAFLAG,MOFLAG

      DOUBLE PRECISION LN,LNN,KN,KNN,TBN,TBNN,MUN,MUNN
      DOUBLE PRECISION ALN,ALNN,AKN,AKNN,XIFN,XIFNN
      DOUBLE PRECISION XISN,XISNN,MUPN,MUPNN,MSPN,MSPNN
      DOUBLE PRECISION M3HN,M3HNN,MAN,MANN,MPN,MPNN
      DOUBLE PRECISION M1N,M1NN,M2N,M2NN,M3N,M3NN
      DOUBLE PRECISION AQN,AQNN,MQNN,MQN,DEV

      COMMON/BOUNDS/LN,LNN,KN,KNN,TBN,TBNN,MUN,MUNN,
     . ALN,ALNN,AKN,AKNN,XIFN,XIFNN,
     . XISN,XISNN,MUPN,MUPNN,MSPN,MSPNN,
     . M3HN,M3HNN,MAN,MANN,MPN,MPNN,
     . M1N,M1NN,M2N,M2NN,M3N,M3NN,
     . AQN,AQNN,MQN,MQNN
      COMMON/SCANFLAGS/M1FLAG,M2FLAG,M3FLAG,MHDFLAG,MHUFLAG,
     . MSFLAG,AKFLAG,ALFLAG
      COMMON/FLAGS/OMGFLAG,MAFLAG,MOFLAG
      COMMON/GMUFLAG/GMUFLAG,HFLAG
      COMMON/CFLAG/CFLAG

      WRITE(0,10)"Number of points:                  "
      WRITE(0,*)
      WRITE(0,10)"  scanned                          ",NTOT
      WRITE(0,10)"  mu=0 or (kappa=0 and Akappa=/=0) ",NFAIL(9)
      S=0
      DO I=1,7
       S=S+NFAIL(I)
      ENDDO
      WRITE(0,10)"  with mh1^2 or ma1^2 or mhc^2 < 0 ",S
      WRITE(0,10)"  with m_sfermion^2 < 0            ",NFAIL(8)
      WRITE(0,10)"  violating constraints            ",NFAIL(10)
      S=NFAIL(11)+NFAIL(12)
      WRITE(0,10)"  RGE integration problem          ",S
      WRITE(0,10)"  convergence problem              ",NFAIL(13)
      WRITE(0,*)
      WRITE(0,10)"Remaining good points              ",TOT
      WRITE(0,*)
      WRITE(0,*)

      IF(OMGFLAG.EQ.0 .AND. CFLAG(1).EQ.0 .AND. CFLAG(2).EQ.0 .AND.
     .   CFLAG(3).EQ.0 .AND. CFLAG(4).EQ.0 .AND. GMUFLAG.EQ.0)THEN
       WRITE(0,20)"Contraints taken into account: none               "
      ELSE
       WRITE(0,20)"Contraints taken into account:                    "
       IF(OMGFLAG.GT.0)
     .  WRITE(0,20)" - Relic density from Planck +/- 10% [0.107,0.131]"
       IF(OMGFLAG.LT.0)
     .  WRITE(0,20)" - Relic density from Planck upper bound < 0.131  "
       IF(IABS(OMGFLAG).EQ.2 .OR. IABS(OMGFLAG).EQ.4)
     .  WRITE(0,20)" - DM direct detection                            "
       IF(IABS(OMGFLAG).EQ.3 .OR. IABS(OMGFLAG).EQ.4)
     .  WRITE(0,20)" - DM indirect detection                          "
       IF(CFLAG(1).EQ.1)
     .  WRITE(0,20)" - Landau poles and false minima                  "
       IF(CFLAG(2).EQ.1)
     .  WRITE(0,20)" - LEP/Tevatron Higgs+sparticle                   "
       IF(CFLAG(3).EQ.1)
     .  WRITE(0,20)" - LHC Higgs                                      "
       IF(CFLAG(4).EQ.1)
     .  WRITE(0,20)" - Upsilon, B and K decays                        "
       IF(GMUFLAG.EQ.1)
     .  WRITE(0,20)" - (g-2)_muon                                     "
      ENDIF

      IF(TOT.GT.0)THEN

       WRITE(0,*)
       WRITE(0,*)
       WRITE(0,20)"Parameter ranges for good points:"
       WRITE(0,*)
       WRITE(0,30)" TANB: ",TBN,TBNN,DEV(TBN,TBNN)
       IF(M1FLAG.EQ.1)THEN
        WRITE(0,30)" M1: ",M1N,M1NN,DEV(M1N,M1NN)
       ENDIF
       WRITE(0,30)" M2: ",M2N,M2NN,DEV(M2N,M2NN)
       IF(M3FLAG.EQ.1)THEN
        WRITE(0,30)" M3: ",M3N,M3NN,DEV(M3N,M3NN)
       ENDIF
       WRITE(0,30)" AU3: ",AQN,AQNN,DEV(AQN,AQNN)
       WRITE(0,30)" MQ3: ",MQN,MQNN,DEV(MQN,MQNN)
       WRITE(0,30)" LAMBDA: ",LN,LNN,DEV(LN,LNN)
       WRITE(0,30)" KAPPA: ",KN,KNN,DEV(KN,KNN)
       WRITE(0,30)" MUEFF: ",MUN,MUNN,DEV(MUN,MUNN)
       IF(MOD(MAFLAG,3).EQ.0)THEN
        WRITE(0,30)" ALAMBDA: ",ALN,ALNN,DEV(ALN,ALNN)
        WRITE(0,30)" MA: ",MAN,MANN
        WRITE(0,40)"(MA is not an input parameter)"
        IF(XIFN.NE.0d0 .OR. XIFNN.NE.0d0)
     .   WRITE(0,30)" XIF: ",XIFN,XIFNN,DEV(XIFN,XIFNN)
       ELSEIF(MOD(MAFLAG,3).EQ.1)THEN
        WRITE(0,30)" ALAMBDA: ",ALN,ALNN
        WRITE(0,40)"(ALAMBDA is not an input parameter)"
        WRITE(0,30)" MA: ",MAN,MANN,DEV(MAN,MANN)
        IF(XIFN.NE.0d0 .OR. XIFNN.NE.0d0)
     .   WRITE(0,30)" XIF: ",XIFN,XIFNN,DEV(MAN,MANN)
       ELSE
        WRITE(0,30)" ALAMBDA: ",ALN,ALNN,DEV(ALN,ALNN)
        WRITE(0,30)" MA: ",MAN,MANN,DEV(MAN,MANN)
        WRITE(0,30)" XIF: ",XIFN,XIFNN
        WRITE(0,40)"(XIF is not an input parameter)"
       ENDIF
       IF(MAFLAG/3.EQ.0)THEN
        WRITE(0,30)" AKAPPA: ",AKN,AKNN,DEV(AKN,AKNN)
        WRITE(0,30)" MP: ",MPN,MPNN
        WRITE(0,40)"(MP is not an input parameter)"
        IF(XISN.NE.0d0 .OR. XISNN.NE.0d0)
     .   WRITE(0,30)" XIS: ",XISN,XISNN,DEV(XISN,XISNN)
       ELSEIF(MAFLAG/3.EQ.1)THEN
        WRITE(0,30)" AKAPPA: ",AKN,AKNN
        WRITE(0,40)"(AKAPPA is not an input parameter)"
        WRITE(0,30)" MP: ",MPN,MPNN,DEV(MPN,MPNN)
        IF(XISN.NE.0d0 .OR. XISNN.NE.0d0)
     .   WRITE(0,30)" XIS: ",XISN,XISNN,DEV(XISN,XISNN)
       ELSE
        WRITE(0,30)" AKAPPA: ",AKN,AKNN,DEV(AKN,AKNN)
        WRITE(0,30)" MP: ",MPN,MPNN,DEV(MPN,MPNN)
        WRITE(0,30)" XIS: ",XISN,XISNN
        WRITE(0,40)"(XIS is not an input parameter)"
       ENDIF
       IF(MUPN.NE.0d0 .OR. MUPNN.NE.0d0)
     .  WRITE(0,30)" MUP: ",MUPN,MUPNN,DEV(MUPN,MUPNN)
       IF(MSPN.NE.0d0 .OR. MSPNN.NE.0d0)
     .  WRITE(0,30)" MSP: ",MSPN,MSPNN,DEV(MSPN,MSPNN)
       IF(M3HN.NE.0d0 .OR. M3HNN.NE.0d0)
     .  WRITE(0,30)" M3H: ",M3HN,M3HNN,DEV(M3HN,M3HNN)

      ENDIF

 10   FORMAT(A35,I10)
 20   FORMAT(A50)
 30   FORMAT(A11,3E15.4)
 40   FORMAT(A36)

      END

ext: f


text:
	integer*4	i,j
	logical*4	x

	i = '0000f0f0'x
	j = '12345678'x
	x = ( i .and. j) .gt. 0
	type *, x

	stop
	end

ext: for


text:
!*******************************************************************
!> author: Akira Kageyama
!  license: MIT
!  date: 2020.01.22
!
!  シミュレーションパラメータ
!
!  @note
!     パラメーターはnamelistを使ってファイルから読み込む
!
!  @note
!     先頭一文字だけが大文字になっている変数例えば Read_done などは
!     このモジュールを名前空間とする変数を意味する。つまりモジュール
!     外からはアクセスできないがモジュール内のルーチン関数からは
!     アクセスできるものである。
!     このようにスコープの広い変数を乱用するとバグの温床になるが
!     この程度の小さなプログラムであれば問題ないであろう。
!
!  @note
!     ファイル番号10番をparams__readで使っている。
!
!  @note
!    namelistファイルの内容を変更する場合は:
!      (1) このファイルの少し下の行にあるnamelist文を書き換える。
!      (2) params__readを書き換える。
!      (3) namelist__get_double, _integer等の対応する行も書き換える。
!
!  @note
!    namelist文中のスラッシュで囲まれた名称（たとえば/simulation/）
!    や、namelist変数名（たとえばTotal_nloop）はnamelistファイル
!    の中での記述と対応していなければいけない。
!

module params_m
  use constants_m  ! 定数定義
  use ut_m         ! ユーティリティ
  implicit none    ! 暗黙の型宣言無効化。必須
  private ! このモジュール内の変数・ルーチン等はデフォルトで非公開
  public :: & ![routines]
            params__get_double,   &
            params__get_integer,  &
            params__get_logical,  &
            params__read,         &
            params__get_string

  logical, save :: Read_done = .false.  ! 読み込みが済んだか否か

  integer(SI), parameter :: STRING_LENGTH_MAX = 200  ! 文字列長
                                  ! 足りなくなったら大きくする。

  integer(SI) :: Total_nloop      ! 一度のジョブで計算するループ回数
  integer(SI) :: Slicedata_nskip  ! 何ステップに一度、断面データを書き出すか
  character(len=STRING_LENGTH_MAX) :: Slicedata_tag  ! 断面データファイル名用
  real(DR) :: Viscosity, Kappa    ! 粘性率と熱拡散率
  logical  :: Debug               ! デバッグ出力用フラグ

  namelist /simulation/     Total_nloop
  namelist /visualization/  Slicedata_nskip,  Slicedata_tag
  namelist /fluid_property/ Viscosity, Kappa
  namelist /flags/          Debug

contains

  function params__get_double(variable)
    !! このモジュールの外からの問い合わせに応じてnamelistデータを返す。
    !! この関数は問い合わせ変数が倍精度浮動小数点数の場合。
    !! この関数の前にnamelist__readが呼ばれている必要がある。
    !! この点はassertで確認している。
    character(len=*), intent(in) :: variable  !! 問い合わせ変数の名前
    real(DR) :: params__get_double            !! その値

    call ut__assert(Read_done, &
                    '<params__get_double> Read params file first.')

    select case (variable)
      case                 ('Kappa')     ! 熱拡散率
        params__get_double = Kappa
      case                 ('Viscosity') ! 粘性率
        params__get_double = Viscosity
      case default                       ! そんなnamelist変数は想定外
        call ut__message('? arg = ', variable)
        call ut__fatal('<params__get_double> not in the params?')
    end select
  end function params__get_double

  function params__get_integer(variable)
    !! このモジュールの外からの問い合わせに応じてnamelistデータを返す。
    !! この関数は問い合わせ変数が整数の場合。
    !! この関数の前にnamelist__readが呼ばれている必要がある。
    !! この点はassertで確認している。
    character(len=*), intent(in) :: variable    !! 問い合わせ変数の名前
    integer(SI) :: params__get_integer          !! その値

    call ut__assert(Read_done, &
                    '<params__get_integer> Read params file first.')

    select case (variable)
      case                  ('Slicedata_nskip')  ! 何ステップごとに
        params__get_integer = Slicedata_nskip    ! 断面をディスクに書き出すか
      case                  ('Total_nloop')      ! シミュレーションジョブ
        params__get_integer = Total_nloop        ! の実行最大ループ数
      case default                               ! 想定外
        call ut__message('? arg = ', variable)
        call ut__fatal('<params__get_integer> not in the params?')
    end select
  end function params__get_integer

  function params__get_logical(variable)
    !! このモジュールの外からの問い合わせに応じてnamelistデータを返す。
    !! この関数は問い合わせ変数が論理値の場合。
    !! この関数の前にnamelist__readが呼ばれている必要がある。
    !! この点はassertで確認している。
    character(len=*), intent(in) :: variable  !! 問い合わせ変数の名前
    logical :: params__get_logical            !! その値

    call ut__assert(Read_done, &
                    '<params__get_logical> Read params file first.')

    select case (variable)
      case                  ('Debug')  ! デバッグモードか否か
        params__get_logical = Debug
      case default                     ! 想定外
        call ut__message('? arg = ', variable)
        call ut__fatal('<params__get_logical> not in the params?')
    end select
  end function params__get_logical

  subroutine params__read
    !! namelistファイルをディスクから読み込む。
    !! ファイル名はコマンド第一引数。
    !!
    !! ファイル番号10番をここで使っている。他の場所で
    !! 10番を使う（開きっぱなしにする）場合は問題だが、
    !! その場所でもここのようにopenした後、closeしていれば
    !! 特に問題ではない。
    !!
    !! namelistデータファイルの内容を変更する場合は
    !! 以下のread文も適宜変更すること。
    !!
    character(len=STRING_LENGTH_MAX) :: params_file

    call ut__assert(command_argument_count()==1, &
                    "Usage: smoke_ring param_file")
    call get_command_argument(1,params_file)

    !*******<params_file のサンプル>*********
    ! &simulation      Total_nloop = 2000 /
    ! &visualization   Slicedata_nskip  = 100, Slicedata_tag = '_data_slice' /
    ! &fluid_property  Viscosity = 3.0e-2, Kappa = 3.e-2 /
    ! &flags           Debug = .false. /
    !*******</params_file のサンプル>*********

    open(10,file=trim(params_file))
      read(10,nml=simulation)
      read(10,nml=visualization)
      read(10,nml=fluid_property)
      read(10,nml=flags)
    close(10)

    write(6,nml=simulation)
    write(6,nml=visualization)
    write(6,nml=fluid_property)
    write(6,nml=flags)

    Read_done = .true.
  end subroutine params__read

  function params__get_string(variable)
    !! このモジュールの外からの問い合わせに応じてnamelistデータを返す。
    !! この関数は問い合わせ変数が文字列の場合。
    !! この関数の前にnamelist__readが呼ばれている必要がある。
    !! この点はassertで確認している。
    character(len=*), intent(in) :: variable  !! 問い合わせ変数の名前
    character(len=STRING_LENGTH_MAX) :: params__get_string  !! その値

    call ut__assert(Read_done, &
                    '<params__get_string> Read params file first.')

    select case (variable)
      case                 ('Slicedata_tag')   ! 断面ファイル名に使う
        params__get_string = Slicedata_tag
      case default
        call ut__message('? arg = ', variable) ! 想定外
        call ut__fatal('<params__get_string> not in the params?')
    end select
  end function params__get_string

end module params_m

max_stars_repo_name: akageyama/class-hpc-smoke-ring

max_issues_repo_name: akageyama/class-hpc-smoke-ring

max_forks_repo_name: akageyama/class-hpc-smoke-ring