text:
See Unitrans Buses for information on other buses.

The University Transport System owns nine of these imported London doubledecker buses. This unique system is owned and operated by the Associated Students of UC Davis Campus and serves the UC Davis Campus and the City of Davis with a regularly scheduled bus service during the school year. From the back of a Unitrans bus postcard, available for sale in the UCD Bookstore.

Two of these buses were purchased back in 1967 by ASUCD direct from England to attract people to use the service.  This was the inception of Unitrans, the only transit company in the United States to use authentic London doubledeck buses in daily service.

Over the years, other doubledecker buses were procured from London. The majority of the doubledeckers were of the RT type, though both RTL, RLH and Daimler models were also part of the fleet over the years.  The Daimler doubledeckers were retired from service in 1999, as upkeep was difficult (the parts were and still are simply unavailable). The RT buses remain in service thanks to the services of Wally Mellor, the former director of  Unitrans Maintenance. Most of the spare parts were handmade by Wally at the Shop facility, a practice that he still takes part in occasionally though he has since retired.  RTL 1014, one of the original pair to be purchased in 1968, is still part of the fleet today, though it has been retired from regular service.

Riding the DoubleDeckers
The DoubleDecker buses currently provide service to the MU terminal and Silo terminal, and operate only on the B Bus Line B, E Bus Line E, F Bus Line F, G Bus Line G, J Bus Line J, and V Bus Line V lines. Other lines pose significant hazards to the buses such as low hanging power lines, trees, and the Richards Underpass. Once the Alexander Dennis Enviro500 buses are added to the fleet, Unitrans may consider running them on lines from the Silo Terminal.

The RT DoubleDecker buses are not wheelchairaccessible and have no bike racks. Other runs during the day on these lines provide wheelchair accessibility. The Enviro500 buses are wheelchair accessible and feature a ramp and kneeler function.

Interestingly, in December of 2005 London finally http://news.bbc.co.uk/1/hi/england/london/4510410.stm retired their line of Routemaster doubledecker buses, making Davis perhaps the last bastion of regular vintage doubledecker operation.

Bus Information
Currently six buses remain from the original collection.

  RT 742 is currently in service after undergoing massive maintenance and restoration. This included replacing all of the wooden beams that hold the body panels to the bus, as well as new windows.  742 is easily identified by its unique (to Unitrans) route number box on the roof, which will once again display its route number 13 from its days in London. In Summer 2007, RT 742 was modified once again, removing the preselect transmission in favor of an Allison automatic, and replacing the engine with a clean diesel that would meet CARB 2007 emissions standards, allowing Unitrans to continue running the bus for the foreseeable future. Following conversion to the modern engine, RT 742 is the fastest doubledeck in the fleet, and features a modern rearend as well, making it very reliable at higher speeds.

  RTL 1014 returned to daily service in Spring Quarter 2006 after a three year absence. It is a coveted prize both here and in London, and museums all over the world are eager to get their hands on the bus. RTL signifies that the bus was an RT built by Leyland. Keen observers will note the slightly different front grill. This bus has been kept as original as possible. 1014 has its original preselect transmission, meaning that it is a pseudomanual transmission bus.  The next gear the driver wishes to shift to is preselected via a lever on the steering column and then a pedal is depressed and released to shift the transmission into that gear. RTL 1014s original engine does not meet any current emissions standards, and thus is not permitted to run in revenue service. It has been retired, but remains at the Unitrans garage. In January 2012, RTL was http://dateline.ucdavis.edu/dl_detail.php?id14315 sent back to London Esignbus Transport Museum.

  RT 1235 is slated to become the second London doubledecker to be converted to CNG. Over the last few years it has been easily recognizable as the frame of a doubledecker sitting next to the Fleet Services yard, and is visible from the new Tercero dorms. To date, even more of the frame has been stripped from 1235 in order to attach and install CNG tanks both underneath the frame and underneath the stairwell.

  RT 2819 is the first and only London doubledecker known to be converted into a CNG (Compressed Natural Gas) fueled bus. It runs in service daily, and is distinctive due to its brighter red paint and extra decals. It also is one the fastest double deck in the fleet and is capable of reaching highway speeds. The rearend of the bus remains original, however, and does not last long at higher speeds.

  RT 3123 is currently out of service for frame rebuilding. Previously, it was refit with a Cummins diesel engine and Allison automatic transmission. It can run a bit http://www.news.ucdavis.edu/in_the_news/full_text/view_clip.lasso?id11993 smoky so you may want to avoid bicycling directly behind it. This bus does not meet the 2010 CARB emissions standards, and thus plans for the future are currently unknown.

  RT 4735 is currently in service after being refitted with a modern Cummins diesel engine that meets the current CARB emissions standards.

Last revenue run of RT1014

On Dec 14, 2007, the 1014 made its last revenue run with its original engine.  Many Unitrans managers and drivers boarded to celebrate 40 years of faithful service. RTL 1014 remains at the Unitrans Garage, however it will no longer run in service due to stringent emissions standards.

Modern DoubleDeck Buses
Unitrans was considering the purchase of modern doubledeck buses. A bus was borrowed for a twoweek test drive to see if the bus will work well for Unitrans. Testing began on January 21st, 2006. Unfortunately these buses are not available for purchase with a CNG engine. However, the modern diesel engines (the 2007 engine model year specifically) are just as clean and efficient as 2007 CNG engines. Unitrans will be taking this issue to the City of Davis in the near future. More information can be found on the Unitrans website at http://www.unitrans.com.

Unitrans has purchased two Alexander Dennis Enviro500 buses, received in 2010. To prepare for these buses arrival, Alexander Dennis loaned Unitrans the bus that was tested in January 2006. The bus is affectionately known as Big Al, as it is one of the prototype Enviro500 buses and survived the Altoona Test for the Federal Government.

Below are photos of Big Al during her 2006 visit:

The new Unitrans Alexander Dennis Enviro500 busses by final product and through the building process:

These are the slowest things ever  SS

I love these buses.  There have been several times when I was in a down mood and just riding on a doubledecker bus cheered me up.  Users/KenjiYamada

These are my favorite busses to ride.  It makes my day if I get to ride on doubledeckers both to and from campus.  Users/MargieHalloran

20060121 10:15:08 nbsp I love doubledeckers. They may be slow and stinky, but the interiors are much more inviting (to me anyway) than the generic buses. Users/CindySperry

20060121 17:06:47 nbsp Those are some ugly, ugly new busses. The uplostery especially. Users/TravisGrathwell

20060121 17:48:22 nbsp eewwwwwwwww. I hate the paint job and upholstery... and the feel of the bus is way too sterile. :( Users/CindySperry
  Thats a demo bus, on loan from the wiki:WikiPedia:Canada Great White North.  The upholstery and paint job will probably be different, since all busses are essentially custom made. Users/BrentLaabs
  The paint job on the outside of the new buses will be identical to the rest of the fleet, and the upholstery will be similar to the current fleets seating. Users/DanielHill

20060121 18:11:02 nbsp Can anyone tell me what the purpose of the flag girl (may be sexist, but all Ive seen were young females) on the rear of the old busses? Users/GrumpyoldGeek
  Youve obviously have not ridden many of the DD because there are many male conductors also.  Conductors help out the driver by collecting fares, ensuring everyone is seated or standing in a designated area, and ring the bell for stops people need to get off of so the driver knows when to stop.  They hold out the reflector flags so that cars see this as a signal of passengers boarding or disembarking the bus, when the bus is travelling at slow speeds or merging with another lane of traffic.  Users/JoAnnaRich
   It is because in England vehicles drive on the left side of the road so the bus door is on the left. In the U.S. this faces traffic, so the flag person protects people getting on from traffic going by. Users/NickSchmalenberger

20070604 01:35:17 nbsp Cant the engineering dept modify the modern double deckers to run on CNG? Or would that be costprohibitive? Users/TusharRawat

20070605 12:08:12 nbsp I dont know if Unitrans shop mechanics can do that, and I dont know why they just cant be all CNG. Ill ask the General Manager later today and respond, :D Users/ChristyMarsden
 Different kind of engine.  Would be very expensive to change, Im surprized the manufacturere doesnt have a CNG option though as so many bus outfits are heading that way.  Users/rocksanddirt
 20071223 07:15:58 nbsp Hey Tushar, I work in the unitrans shop and the reason behind not converting all the doubledeckers to CNG is 1) it is cost prohibitive to change the engines. Each of these buses is about 30 grand...not including adding the CNG tanks and all the rehab work needed 2) the companies making CNG engines, like John Deer, are starting to stop offering CNG engines.  We had one already for the next CNG conversion on 1235 but now it will be a spare if 2819s John Deere has a meltdown. 3) The conversion process for each Double Deck takes at least a year and usually more like 5. 4) The biggest misconception is that CNG is better than Diesel, this is not necessarily true.  CNG has many chemicals and emissions that can be much more hazardous to your health than any emissions coming out of a diesel engines exhaust.  Remember just because its emissions clear doesnt necessarily mean that its better for the environment.  Anyways thats my 2cents on that whole issue. Users/NathanielJarrett
 Turning a modern diesel DD into CNG would require replacing the engine and finding a place to mount the CNG tanks. Retrofitting the old DD buses requires a significant amount of engineering (done mostly by our incredibly talented student shop mechanics) and is done while we have the bus stripped during a complete retrofit. Doing this to a modern bus is less than ideal. Nobody in the world makes a new CNG double deck bus, and Davis may have the only one in the world. Users/ScottWeintraub
   It would be great if one or several people who know the details could just add the information to the entry itself so people dont have to read through the comments to learn this stuff.  Its obviously a question that people have, so just rewrite the entry to answer it.  If your answer gets too long, feel free to create a whole new entry about it  the engineering (both modern and the history of what has been done to the buses in the past) is a neat little story unto itself! Users/JabberWokky

20070922 02:17:23 nbsp I had the privilege of being a passenger on the 1014 todayit was a real treat.  A grand old bus, so much of it looks to be original.  Too bad the original engine needs to be removed for smog purposes.  Hats of to Unitrans and 101440 years of continuous doubledecker bus service.   Users/TedBuehler
Are any of the old Daimler buses still around in 1 piece, or who could I ask about these as I have a single decker Daimler, thanks.

20100327 00:04:49 nbsp You cant beat riding on the top floor of a doubledecker on a spring day with the windows open! Users/ArianeMetz

  Totally agree. Its a great feeling. Too bad the new doubledeckers front windows on the top floor dont open. / Users/TheShah

20100327 02:51:02 nbsp The new double deckers have a very nice new paint job to match the current red fleet. Users/TheShah

20100526 12:12:29 nbsp Hi there, my name is Fethi, I live in long beach,ca . I have a double Decker bus that needs a transmission, used of course or rebuilt. Where and how can I find a place for that? Thanks!  Users/fethi
Most of the parts are very very hard to find, I know the university uses master machinists to machine whatever parts they need, perhaps you can follow up on that route? Daubert

20100526 17:36:10 nbsp New double deckers are sweet Users/StevenDaubert

20110108 01:29:48 nbsp Hey Wikignomes and Wikifairies

How about some pics of the new double decker buses? Users/TedBuehler


text:
program test
  integer :: a(10), r(5, 2)
  integer :: i, j

  do j = 1, 10
      a(j) = j
  end do

  r  = reshape(a, (/5, 2/))
  do i = 1, 5
    do j = 1, 2
      print *, r(i, j)
    end do
  end do
end program test

max_stars_repo_name: clementval/fc

max_issues_repo_name: clementval/fc

max_forks_repo_name: clementval/fc


text:
The Davis DMV recently implemented a muchneeded computer system for tracking waiting clients. Before, all the windows dealt with every customer request, and when youd go in, youd just take a paper number from the wheel and sit and wait for HOURS until they call you.  NOW when you walk in they have a nifty scrolling marquee which not only tells your current wait time, but also the current wait time at other DMVs nearby (West Sacramento, et cetera).  Then you go to a triagelike window where they ask you what your business is, and then give you a printedout number for the corresponding window.  Lastly, your number and window is announced over the loudspeaker, so if you go outside for some reason, you wont miss your place in line. A good idea is to check the http://apps.dmv.ca.gov/fo/offices/appl/fo_data_read.jsp?foNumb598 Davis Offices wait time through the website before you head out there.

It is still highly recommended that you make an appointment for any business you might have with the DMV, which can be done over the phone or through the incredibly easytouse website (above).

You can pay your fees with an ATM/Debit Card.

 Interesting Quirks

  If you are an out of state student attending college in California
      Age 22 or less  you can retain your drivers license and plates from home
      Age 23 and older you must obtain California Plates (Reference http://www.dmv.ca.gov/pubs/reg_hdbk_pdf/ch07.pdf PDF Document, page 2, section 7005  definition NonResident Student Exemption from Registration. You must surrender out of state plates unless you ask for Interstate Registration where you can keep your out of state plates especially if you are still a resident from outside California and return during breaks (Reference from PDF Document, page 17, section 7130)

  Pickup Truck Registration
      Unless a permanent camper shell is installed, your truck is considered a commercial vehicle subject to weight fees. Heavy trucks that weigh greater than 5000 lbs are subject to heavy fees.

  Other references include the CHP California Highway Patrol

20050915 19:09:59 nbsp A birth certificate or valid passport is REQUIRED to get a CA drivers license.  If for some reason the name on this does not match the name on your previous states DL, (like for example you got married at some point between the day you were born and now and you changed your name) you will need a CERTIFIED (not simply a photocopy) copy of your marriage license. Not that theres anything on the DMV website or any signs in the office informing you. Users/BlancheNonken
    Well its buried a bit, but that info is online: http://www.dmv.ca.gov/pubs/brochures/fast_facts/ffdl05.htm#true Users/JevanGray Jevan
    You can get these at the Yolo County ClerkRecorders Office, a painless whileyouwait printout process.  Theyre also necessary for changing your name at Social Security, and proof of SS name change is also required for newname DL issuance.  Users/JudithTruman JT, formerly JB

20051121 12:10:52 nbsp I had to registered my pick up which requires weight certification (WTF California) after a lot of digging, the only place is Sierra Sod and Supply Sierra Sod for $8 at 27991 Mace Boulevard  Users/OnsonLuong

20060516 16:46:17 nbsp When my wife and I moved to California from Wisconsin, she was not able to get a license with her married name on it because we didnt have an official marriage certificate with.  She did, however, have an official Wisconsin license with her married name on it, but that was not good enough.  Rules are rules, but things like this always make the DMV unpleasant.   Users/AdamSchneider

20080515 15:26:52 nbsp This is the best DMV in America.  It seems less crowded and usually  a short waiteven without an appt. Users/CurlyGirl26
  Please tell me that this is sarcasm at its finest!  Of all of the DMV offices that I have been to (about 10) this is one of the worst.  Just the other day, I had to transfer a vehicle from my brother to me.  I had the form filled out and checked the wait time for nonappointments on the website.  It said three minutes.  I went right over and got my tag, B 43.  As they gave me the tag, they were calling B 42.  Now, I dont know how they prioritize their queue, but they called some As and Bs, quite a few Hs and Js.  It was 39 minutes later when they called B 43.  I swear they have the slowest workers too.  I sat there as two of the agents chatted with each other for a few minutes before calling the next patrons.  Now, I would understand if this was a onetime thing, but the Davis DMV always seems to be this way.  At least every time a family member or coworker goes there.  I have not heard a single firsthand good experience.  I guess YMMV.   Users/DavidGrundler
    20080516 06:36:20 nbsp Id have to say it was better (circa 2002ish) than the Sacramento DMV I went to (in Citrus Heights? Off Madison, if I recall correctly) and better than most Florida DMVs.  About the same as North Carolina and Pennsylvania college town DMVs.  I will say that of the two visits I made to the Davis DMV, one was amazingly fast, easy and courteous (switching out of state DL).   The other was courteous, but there was a large number of people and it certainly wasnt fast (transferring in an out of state vehicle).   I wish I could remember the day/time of day I went, but it was likely some shade of morning on a weekday. Users/JabberWokky

20080516 08:27:58 nbsp When I was married I went to the Social Security Office in West Sac and the DMV the same day and was able to get a license with my name on it. I did not have to show a marriage license, just my paperwork that said I had applied for a new SS card with my new name. I agree though that the appointment thing is a joke. I do that everytime and still have to wait. Users/MyaBrn

20080924 16:35:16 nbsp I checked the DMV website before going to the Davis office and the wait said 12 minutes without an appointment. I got there and waited 15 minutes and was out of there in another 5 minutes. A very painless experience!  Users/DrWang

20081202 14:35:31 nbsp I needed to renew my license and I was 10 days away from moving to a permanent residence at a house in Woodland, but had already moved out of a Davis apartment (essentially homeless on my parents couch in the Bay Area). I asked if I could put my new address on my license, but have the new license mailed to an alternate (my parents) address while I waited for my house to close escrow in the next 10 days (we could not receive mail there yet). I was told no, the license has be mailed to the address on the license. So, I had to get a license with my parents address in Livermore, then immediately fill out one of those brown change of address cards to carry around with me until 2013. So annoying! Sometimes I wonder if these things are really rules, or if people just get a kick out of messing with you. Users/AmLin

20091125 14:42:32 nbsp I have been to the Davis DMV several times and not once has it been a pleasant visit.  On my last visit I went to change my name on my drivers license as I had just gotten married.  I had already been to the social security office and changed my name there without a problem.  I had my original marriage certificate and after the first person looked at it and said okay heres a number and I waited for 53 minutes the next person told me that they wouldnt accept my ORIGINAL marriage certificate (from Montana) as the seal wasnt in the proper place.  There was a seal and a signature but it was on the top half of the certificate not two inches lower (where she felt it should be!!).  This occurred after they told me I needed a letter from Ford Credit saying that I could register my leased vehicle in California (since I leased it in Montana) and after I couldnt get my drivers license because of problems they had with my birth certificate.  The workers are so slow and very very few are pleasant to be around.  Users/jeesp

20100811 11:52:53 nbsp The staff here really do not know anything about the CA DMV rules and regulations. When I moved here 2 years ago from out of state I passed the written test, but did not pass the vision test. Later I learned, by looking up the information at the CA DMV, that that vision test showed I actually did meet the minimum requirements, so I dont know why they failed me. I went to an optometrist to get the required examination and the doctor clearly wrote in a letter explaining my condition and that glasses would actually worsen my vision and acuity, and then the doctor further cited CA DMV vision requirements and stated that I more than met them. The lady I handed the form to would not grant me a CA license, refused to let me speak to another agent or supervisor, and would not explain why she was refusing to grant me a license. The DMV has a booklet of visual conditions and their policies regarding licensing requirements, but I guess this suddenly didnt apply? Finally she told me I would have to taken an HOUR LONG drive test to prove I could see well enough to drive. (For the record, I have 20/60 vision in one eye, but normal in the other. DMV requirements are that you see 20/40 or better in at least one eye or you need to wear glasses. So, not sure what her issue was!) I made the drive test appointment, but at the Woodland DMV. When I showed up with all the required paperwork they read it over, including the doctors statement, and had a chat with the guy about why I was there. He checked with his supervisor, and they both told me that I did NOT need a driving test and granted me a CA license right away. Such a headache, though!  Users/DanaMace

20101012 20:47:21 nbsp Both the Davis and Woodland DMV offices are apparently closed now? I cant find any official listings for them being closed (temporarily or for good) on any news website, Google, anything, and they arent officially listed as closed on the front page of DMV, but both individual office pages have a CLOSED stamp on them. Users/JenniferRutherford
 By closed, they mean that theyre not open right now at 8:47 PM. Users/WilliamLewis
  The DMV page is a little confusing. The parts in red show you the current status of each office: which Fridays they are closed, and whether or not they are open at this moment. They are open for business during the hours shown on that page (Mon., Tues., Thurs., Friday: 8:00 AM  5:00 PM; Wednesday: 9:00 AM  5:00 PM). Neither the Davis nor Woodland office have been closed temporarily or permanently.  Users/DonShor

20101223 12:29:32 nbsp I had to go to the DMV this week for a drivers license renewal.  This is definitely a good week to go  lots of spaces in the parking lot and not much waiting time.  One oddity, though  I had made an appointment online, and told the person so when I checked in.  I was given a slip of paper with my number on it (like at a deli counter), and the slip said Drivers License Renewal Appointment (or something like that).  But the person never actually checked to see if I had an appointment, or what time my appointment was, and it did not appear to me that I was seen an earlier than I would have been if I hadnt made an appointment.  Now, as I said, I didnt wait all that long as it was, and maybe things would have been different if the DMV had been more crowded.  But still, my appointment seemed very much like a nonappointment. Users/CovertProfessor

20110126 22:34:22 nbsp Getting a CA drivers license? Prepare for the long haul. 3 months... to the day. Alcohol... nope. Official government photo ID... nope. Call to see whats up... nope. Thanks California! In the state that I previously resided in, it took less than 5 minutes for the machine to print a license out. Even when accounting for the ratio of the two populations, it took California more than 4,000 times longer to produce a license. People consistently apply for and get an international photo ID, also known as a passport, in much less time than this. And to top it all off, the new improved licenses look and feel flimsy as can be. It has the structural integrity of about a phone card. I think Im going to get one of those nice plastic baseball card holders for it so it doesnt break. Users/LeeDarb
 This is a valuable comment.  It would be much better to get a duplicate drivers license on the spot. Users/BruceHansen

20120206 13:55:39 nbsp I will never go to this DMV again. Staff is very unpleasant. There should be a law against had hair dos affecting there quality of work! I will gladly travel to other cities to take care of my DMV matters because Davis DMV had a poor, poor communications system and it is evident that these folks do not like there jobs! Users/Stoneface
 I have to say, of all the times Ive been here, this particular DMV has been pretty pleasant. Yeah, the wait can be a little long sometimes, but its the DMV. Showing up early in the morning really, really helps. Like, really. The communications system is also extremely easy. Like take a number and wait easy. Simple as that. Users/CecilioPadilla

20120210 17:04:20 nbsp I always make an appointment online before I go and I am never there for more than 45 minutes.  Employees could perk up a bit.   Users/LoriOrf

20140731 17:37:38 nbsp The DMW here is easily the best one I have been to in CA. No, they dont serve you coffee and give you pastries, but the service is generally pretty fast, especially if you have an appointment. I had a question, if anyone sees this: upon moving, if you complete a change of address request online with the DMV, have you done all that is required by law? State law says that you need to update the DMV upon 10 days of moving. I did this, but I wont get a new physical DL that has my new address. Is this ok? I just dont want to get pulled over and get in trouble if my DL has my old address, even if I did the right thing and updated online. Any thoughts? Thanks, Eric Users/EricJensen

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2020 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine cfdconv(vold,vcon,v,nk,
     &  ielmat,ntmat_,shcon,nshcon,rhcon,nrhcon,iout,
     &  nmethod,convergence,physcon,iponoel,inoel,ithermal,
     &  nactdoh,iit,compressible,ismooth,vcontu,vtu,iturbulent,
     &  inomat,nodeboun,ndirboun,nboun,mi,co,factor,vconini,
     &  dtimef,del,sum,sumx,sumxx,sumy,sumxy,nstart,shockcoef)
!
!     calculates the change in solution
!
      implicit none
!
      integer convergence,compressible,
     &  nrhcon(*),ntmat_,nactdoh(0:4,*),iit,iturbulent,mi(*),
     &  nshcon(*),ielmat(mi(3),*),nk,ithermal(*),i,j,k,index,iout,
     &  nmethod,imat,nelem,iponoel(*),inoel(3,*),ismooth,
     &  inomat(*),node,nodeboun(*),ndirboun(*),nboun,nstart,
     &  nstartold
!
      real*8 v(0:mi(2),*),vold(0:mi(2),*),vcon(0:4,*),
     &  rhcon(0:1,ntmat_,*),rho,c1,vmax(0:6),dummy,press,
     &  vconmax(0:6),cp,r,temp,temp0,c2,c3,tempnew,vel2,
     &  shcon(0:3,ntmat_,*),drho,dtemp,physcon(*),dpress,
     &  vcontu(2,*),vtu(2,*),co(3,*),factor,vconini(0:4,*),
     &  dtimef,del(0:6,*),sum,sumx,sumxx,sumy(0:6),sumxy(0:6),
     &  b(0:6),bmax,denominator,shockcoef
!
      do j=0,6
         vmax(j)=0.d0
         vconmax(j)=0.d0
      enddo
!
      if(compressible.eq.1) then
         do i=1,nk
            if(inomat(i).eq.0) cycle
            do j=0,4
               vmax(j)=vmax(j)+(vcon(j,i)-vconini(j,i))**2
               vconmax(j)=vconmax(j)+vconini(j,i)**2
               vconini(j,i)=vcon(j,i)
            enddo
         enddo
      else
         do i=1,nk
            if(inomat(i).eq.0) cycle
            do j=0,3
               vmax(j)=vmax(j)+(vcon(j,i)-vconini(j,i))**2
               vconmax(j)=vconmax(j)+vconini(j,i)**2
               vconini(j,i)=vcon(j,i)
            enddo
!
!           for incompressible fluids the pressure is stored
!           in vold(4,*), the initial pressure in
!           vconini(4,*)
!
            do j=4,4
               vmax(j)=vmax(j)+(vold(j,i)-vconini(j,i))**2
               vconmax(j)=vconmax(j)+vconini(j,i)**2
               vconini(j,i)=vold(j,i)
            enddo
         enddo
      endif
      if(iturbulent.ne.0) then
         do i=1,nk
            if(inomat(i).eq.0) cycle
c            write(*,*) 'cfdconv.f ',i,vtu(1,i),vtu(2,i)
            do j=1,2
               vmax(4+j)=vmax(4+j)+vtu(j,i)**2
               vconmax(4+j)=vconmax(4+j)+vcontu(j,i)**2
            enddo
         enddo
      endif
!
!     for steady state calculations: check convergence
!
      convergence=0
!
      if(iturbulent.eq.0) then
!
!        laminar
!
         do i=0,4
            vmax(i)=dsqrt(vmax(i))
            vconmax(i)=dsqrt(vconmax(i))
            if(vconmax(i).lt.1.d-10) then
               vconmax(i)=1.d0
               vmax(i)=0.d0
            endif
         enddo
         if(nmethod.eq.1) then
            if(((vmax(0).lt.1.d-8*vconmax(0)).or.
     &           (vconmax(0).lt.1.d-10)).and.
     &           ((vmax(1).lt.1.d-8*vconmax(1)).or.
     &           (vconmax(1).lt.1.d-10)).and.
     &           ((vmax(2).lt.1.d-8*vconmax(2)).or.
     &           (vconmax(2).lt.1.d-10)).and.
     &           ((vmax(3).lt.1.d-8*vconmax(3)).or.
     &           (vconmax(3).lt.1.d-10)).and.
     &           ((vmax(4).lt.1.d-8*vconmax(4)).or.
     &           (vconmax(4).lt.1.d-10)).and.
     &           (iit.gt.1)) convergence=1
         endif
         if(iit.gt.1)
     &   write(12,'(i7,15(1x,e10.3))') iit,vmax(0)/vconmax(0),
     &     vmax(1)/vconmax(1),vmax(2)/vconmax(2),
     &     vmax(3)/vconmax(3),vmax(4)/vconmax(4),
     &     dtimef
!
!        linear regression of the last half of the iterations
!        for iterations exceeding 1000. If the regression is nearly
!        constant (zero slope) no improvement is deemed possible by further
!        iterations: convergence is assumed. This applies to
!        calculations with a nonzero shock coefficient
!
         if((compressible.eq.1).and.(shockcoef>0)) then
            if(iit.gt.500) then
               sum=sum+1
               sumx=sumx+iit
               sumxx=sumxx+iit*iit
               do i=0,4
                  if(vmax(i).lt.1.d-10*vconmax(i)) then
                     del(i,iit)=-10.d0
                  else
                     del(i,iit)=dlog10(vmax(i)/vconmax(i))
                  endif
                  sumy(i)=sumy(i)+del(i,iit)
                  sumxy(i)=sumxy(i)+iit*del(i,iit)
               enddo
            endif
!
!     check for zero slope
!
            if(iit.gt.1000) then
               nstartold=nstart
               nstart=int(iit/2.d0)
               do j=nstartold,nstart-1
                  sum=sum-1
                  sumx=sumx-j
                  sumxx=sumxx-j*j
                  do i=0,4
                     sumy(i)=sumy(i)-del(i,j)
                     sumxy(i)=sumxy(i)-j*del(i,j)
                  enddo
               enddo
               bmax=0.d0
               do i=0,4
                  denominator=sumx*sumx-sum*sumxx
                  if(dabs(denominator).gt.1.d-30) then
                     b(i)=(sumx*sumy(i)-sum*sumxy(i))/denominator
                  else
                     b(i)=0.d0
                  endif
                  if(dabs(b(i)).gt.bmax) bmax=dabs(b(i))
               enddo
c               write(*,*) 'cfdconv ',iit,bmax
c               if(bmax.lt.1.d-4) convergence=1
               if(bmax.lt.1.d-6) convergence=1
            endif
         endif
      else
!
!        turbulent
!
         do i=0,6
            vmax(i)=dsqrt(vmax(i))
            vconmax(i)=dsqrt(vconmax(i))
            if(vconmax(i).lt.1.d-10) then
               vconmax(i)=1.d0
               vmax(i)=0.d0
            endif
         enddo
         if(ithermal(1).eq.0) vconmax(0)=1.d0
         if(nmethod.eq.1) then
            if(((vmax(0).lt.1.d-8*vconmax(0)).or.
     &           (vconmax(0).lt.1.d-10)).and.
     &           ((vmax(1).lt.1.d-8*vconmax(1)).or.
     &           (vconmax(1).lt.1.d-10)).and.
     &           ((vmax(2).lt.1.d-8*vconmax(2)).or.
     &           (vconmax(2).lt.1.d-10)).and.
     &           ((vmax(3).lt.1.d-8*vconmax(3)).or.
     &           (vconmax(3).lt.1.d-10)).and.
     &           ((vmax(4).lt.1.d-8*vconmax(4)).or.
     &           (vconmax(4).lt.1.d-10)).and.
     &           ((vmax(5).lt.1.d-8*vconmax(5)).or.
     &           (vconmax(5).lt.1.d-10)).and.
     &           ((vmax(6).lt.1.d-8*vconmax(6)).or.
     &           (vconmax(6).lt.1.d-10)).and.
     &           (iit.gt.1)) convergence=1
         endif
         if(iit.gt.1)
     &   write(12,'(i7,15(1x,e10.3))') iit,vmax(0)/vconmax(0),
     &     vmax(1)/vconmax(1),vmax(2)/vconmax(2),
     &     vmax(3)/vconmax(3),vmax(4)/vconmax(4),
     &     vmax(5)/vconmax(5),vmax(6)/vconmax(6),dtimef
      endif
!
!     checking change exceeding 0.1 %
!
c      factor=min(1.d0,1.01d0*factor)
c      if(dabs(vconmax(0)).gt.1.d-3) then
c         factor=min(factor,vconmax(0)/vmax(0)*0.001)
c      endif
c      if(dabs(vconmax(1)).gt.1.d-3) then
c         factor=min(factor,vconmax(1)/vmax(1)*0.001)
c      endif
c      if(dabs(vconmax(2)).gt.1.d-3) then
c         factor=min(factor,vconmax(2)/vmax(2)*0.001)
c      endif
c      if(dabs(vconmax(3)).gt.1.d-3) then
c         factor=min(factor,vconmax(3)/vmax(3)*0.001)
c      endif
c      if(dabs(vconmax(4)).gt.1.d-3) then
c         factor=min(factor,vconmax(4)/vmax(4)*0.001)
c      endif
c      if(iturbulent.ne.0) then
c         if(dabs(vconmax(5)).gt.1.d-3) then
c            factor=min(factor,vconmax(5)/vmax(5)*0.001)
c         endif
c         if(dabs(vconmax(6)).gt.1.d-3) then
c            factor=min(factor,vconmax(6)/vmax(6)*0.001)
c         endif
c      endif
!
      return
      end

max_stars_repo_name: alleindrach/calculix-desktop

max_issues_repo_name: alleindrach/calculix-desktop

max_forks_repo_name: alleindrach/calculix-desktop


text:
Jump to Timeline #Navigation Navigation

Users/BarnabasTruman Barnabas Truman becomes eligible to run for President of the United States.


text:
-ovmhome ../../..

top.sv


text:
The FilAm (Filipino American) community at UC Davis is comprised of seven Filipino American organizations: Bridge, Chi Rho Omicron Chi Rho Omicron, Inc., FILAH, Kappa Psi Epsilon, Mga Kapatid, FAHC, and Pilipino Americans in Science and Engineering PASE.

The FilAm community works together to provide events relevant to current and historic issues within the Filipino and Filipino American community.

Annually, the FilAm at UC Davis hosts Icebreakers (September/October), FilAm Thanksgiving Dinner aka FATDs (November), Spring Fling (March/April), FilAm Leadership Retreat (May), and FilAm Golden Games (June).

20142015 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20142015 Student Director: Jonathan Abel

Chi Rho Omicron Chi Rho Omicron, Inc.
20142015 President: Jed Marvin Nugal

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20142015 President: Donita Barrameda

Filipinos in Liberal Arts and Humanities (FILAH)
20142015 CoPresidents: Melissa Villaber, Nickole Caimol

Kappa Psi Epsilon
20142015 President: Danielle Olazo

Mga Kapatid
20142015 President: Alyssa Limbo

Pilipino Americans in Science and Engineering (PASE)
20142015 CoPresidents: Matthew Galang, Veronica Dela Fuente

20132014 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20132014 Student Director: Angelica Singson

Chi Rho Omicron Chi Rho Omicron, Inc.
20132014 President: Marco Candelaria

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20132014 President: A.J. Ong

Filipinos in Liberal Arts and Humanities (FILAH)
20132014 President: Taylor Fulwiler

Kappa Psi Epsilon
20132014 President: Ana Pascual

Mga Kapatid
20132014 President: Michelle Martin

Pilipino Americans in Science and Engineering (PASE)
20132014 CoPresidents: Joseph Guzman, Brandon Lam

20122013 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20122013 Student Director: Kristian Marie Lirio Ocampo

Chi Rho Omicron Chi Rho Omicron, Inc.
20122013 President: Geoff Dold

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20122013 President: Miles Orantia

Filipinos in Liberal Arts and Humanities (FILAH)
20122013 President: Rissa Marasigan

Kappa Psi Epsilon
20122013 President: Stephanie Barreyro

Mga Kapatid
20122013 President: Norman Borgonia

Pilipino Americans in Science and Engineering (PASE)
20122013 CoPresidents: Alyssa Cabaltera, Kevin Gonzales

20112012 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20112012 Student Director: Lauren Ilano

Chi Rho Omicron Chi Rho Omicron, Inc.
20112012 President: Mike Formosa

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20112012 President: Jerrico Crisologo

Filipinos in Liberal Arts and Humanities (FILAH)
20112012 President: Christine Estee Erfe

Kappa Psi Epsilon
20112012 President: Missa Mendoza

Mga Kapatid
20112012 President: Bennett Lumban

Pilipino Americans in Science and Engineering (PASE)
20112012 CoPresidents: Nirel Rillera, John Espanola

20102011 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20102011 Student Director: Nicole Tomboc

Chi Rho Omicron Chi Rho Omicron, Inc.
20102011 President: Pilot Smith III

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20102011 President: Kenny Cortez

Filipinos in Liberal Arts and Humanities (FILAH)
20102011 President: Kaye Caburnay

Kappa Psi Epsilon
20102011 President: Jasmine Acebedo

Mga Kapatid
20102011 President: Kenneth Flores

Pilipino Americans in Science and Engineering (PASE)
20102011 CoPresidents: Julian Nolasco, Joseph Nolasco

20092010 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20092010 Student Director: Stephen Dimal

Chi Rho Omicron Chi Rho Omicron, Inc.
20092010 President: Jhan Ongoco

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20092010 President: J.J Stroud

Filipinos in Liberal Arts and Humanities (FILAH)
20092010 President: Courtney Lorca

Kappa Psi Epsilon
20092010 President: Katherine Emperador

Mga Kapatid
20092010 President: Jobelle Duka

Pilipino Americans in Science and Engineering (PASE)
20092010 CoPresidents: Dustin Ramirez, Katherine Emperador

20082009 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20082009 Student Director: Angelica Leonardo

Chi Rho Omicron Chi Rho Omicron, Inc.
20082009 President: Josh Kim

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20082009 President: Albert Gacerez

Filipinos in Liberal Arts and Humanities (FILAH)
20082009 President: Lauren Dimapasoc

Kappa Psi Epsilon
20082009 President: Jules Cruz

Mga Kapatid
20082009 President: Raphael Rap Sarmiento

Pilipino Americans in Science and Engineering (PASE)
20082009 CoPresidents: Lorraine Alonzo, Gretchen Paule

20072008 Presidents
Bridge Outreach and Retention Program Bridge  Pilipino Outreach and Retention
20072008 Student Director: Brian Macapinlac

Chi Rho Omicron Chi Rho Omicron, Inc.
20072008 President: John Datiles

Filipino Association for Health Careers Filipino Association for Health Careers (FAHC)
20072008 President: Elio Gutierrez

Filipinos in Liberal Arts and Humanities (FILAH)
20072008 President: Kelsey Yoro

Kappa Psi Epsilon
20072008 President: Anna Ranili

Mga Kapatid
20072008 President: Chris Tops Laparan

Pilipino Americans in Science and Engineering (PASE)
20072008 CoPresidents: Fred Francisco, Ryan Uy

Former FAHC Presidents
Norman Caba 198788
Mike Batongbacal 198889
John Aquino 198990
Fred Esteves 199091
Tim Canio 199192


text:
!  *********************************************************************
!  *                                                                   *
!  *                         subroutine printv                         *
!  *                                                                   *
!  *********************************************************************
!  Single Precision Version 1.61
!  Written by Gordon A. Fenton, TUNS, Sat Sep  9 13:21:15 1995
!  Latest Update: Jun 25, 2003
!
!  PURPOSE  prints real/integer values according to a C style format
!
!  This routine takes as input a format, which is a character string
!  containing C style format descriptors, along with a vector of additional
!  arguments and prints them to the given unit. Normally, this routine is
!  called by one of print1, print2, ... See their headers for usage
!  instructions.
!
!  Arguments to this routine are as follows;
!
!       k	unit number to which output is directed. (input)
!
!     fmt	format string. (input)
!
!     val	real vector of length at least MP containing the elements
!		to be printed. An element of val can be either real or integer,
!		it's type is determined by the presence of a corresponding
!	 	%f or %e (for real) or %i (for integer) descriptor. See notes
!		below on the optional format specification which may follow
!		any of these format descriptors.
!		(input)
!
!       n	the number of elements in val. Currently this must be less
!		than 256. (input)
!
!   The following % formats are recognized by this routine;
!
!	   %<space> to produce a space
!
!	   %%	to produce a % character
!
!	   %b	to produce a '\' character
!
!	   %t	to produce a tab character
!
!	   %n	to produce a newline character. Note that the newline
!		character is NOT added by default to the end of an ouput
!		string, as it is in regular fortran. It must be explicitly
!		asked for via the %n format (as in C).
!
!	   %f	to format a real value in the form '12.236'. If the value
!		is outside the range (1.e-6, 1.e+7) then the %e format is
!		automatically used (except if the value is zero). The %f
!		format can be optionally written in one of the following
!		forms;
!
!		%w.df	specifies that a field width of `w' is to be used
!			with d digits to the right of the decimal place.
!			The decimal place takes up one character in the
!			total field width. `w' is actually a minimum width
!			and will be increased if more digits are required to
!			the left of the decimal point at the expense of
!			digits to the right of the decimal, if any. If the
!			number to be printed occupies less than w digits,
!			it is right justified. Digits to the right of the
!			7'th significant digit are left blank. For example,
!			%6.2f implies that the number 12.345 will be
!			printed as ' 12.35'.
!
!		%wf	specifies a minimum field width. The number of
!			decimal places is determined as necessary. Smaller
!			numbers are right justified. At most 7 significant
!			digits will be displayed. For example, %8f implies
!			that the number 12.34500 will be printed as
!			'  12.345'.
!
!		%.df	specifies a maximum number of digits to display
!			to the right of the decimal place.
!			Trailing zeroes are not shown. For example, %.2f
!			implies that the number 12.345 will be printed
!			as '12.35'.
!
!		%.f	at the moment, this is only specifies that zero is
!			printed as '0.'. The default is '0'.
!
!	   %e	to format a real value in scientific notion. For example
!		the number 12.345 is written as 1.2345e+01 in scientific
!		notation (where the e+01 means 'times 10 to the power 1').
!		The %e format can be optionally written in the following
!		forms, where;
!
!			y = 6 if the value being printed is non-negative
!			y = 7 if the value being printed is negative
!
!		%w.de	specifies that a field width of `w' is to be used
!			with d digits to the right of the decimal place.
!			w must be at least (d+y) to accomodate the leading
!			digit, the decimal, and the trailing 'e+dd' characters.
!			If w < (d+y) it is internally set to (d+y). If w
!			is greater than (d+y), the number is right justified
!			with leading blanks. For example, %10.2e implies that
!			the number 12.345 will be printed as '  1.23e+01'.
!
!		%we	specifies the field width only. The number of decimal
!			digits is determined as d = (w-y), so w must be at
!			least y (if it isn't, it is set to y). Since this is
!			a single precision routine, values of w greater than
!			12 result in a 12 character right justified number
!			(at most 7 significant digits are shown). For example,
!			%10e implies that the number 12.345 will be printed
!			as '1.2340e+01'.
!
!		%.de	specifies the number of digits to display to the right
!			of the decimal place. w is computed as (d+y). If d is
!			greater than 6, it is set internally to 6 to provide
!			at most 7 significant digits. For example, %.2e implies
!			that the number 12.345 will be printed as '1.23e+01'.
!
!	   %i	to format an integer value. Normally, the minimum field width
!		required to represent the number is used. However, the %i
!		format can be optionally written in the following forms;
!
!		%wi	specifies that a field width of at least 'w' is used.
!			For example, %10i implies that the number 12 will be
!			printed as '        12'.
!
!
!  REVISION HISTORY:
!  1.1	turned fw.0 into iw
!  1.2	added %fw specification, where w is interpreted as the desired max.
!	number of significant digits to show on real output (Oct. 9, 1995)
!  1.21	added comment about trailing blanks in fmt not being printed (10/14/96)
!  1.3	revised %i, %f, and %e output formatting (Jun 9/97)
!  1.4	replaced \\ with char(92) for portability (Dec 1/99)
!  1.5	replaced '\n' with char(10) for portability (Sep 24/01)
!  1.6	replaced all \ escapes with % escapes (for compatibility with
!	Win98's Visual Fortran). '\' is now treated as an ordinary character
!	(Oct 1/01)
!  1.61	now properly handle '% ' at end of format string (in fact '%' at
!	end of format string will always produce a space now). (Jun 25/03)
!-------------------------------------------------------------------------
      subroutine printv( k, fmt, val, n )
      parameter (MPX = 256)
      character*(*) fmt
      character*1 bslash, spc, tab
      real*4 val(*), tmp(MPX)
      integer*4 itmp(MPX)
      logical ldot, ldigit
      equivalence (itmp(1),tmp(1))
      external lnblnk

   1  format(a,$)
   3  format()

      tab    = char(9)
      spc    = char(32)
      bslash = char(92)

      MP     = n
      if( MP .gt. MPX ) MP = MPX
      do 5 i = 1, MP
         tmp(i) = val(i)
   5  continue

      jt = 1
      lf = lnblnk(fmt)
      i  = 0
  10  i = i + 1
      if( i .gt. lf ) return
      if( fmt(i:i) .eq. '%' ) then				! DESCRIPTOR
         i = i + 1
         if( i .gt. lf ) then
            write(k,1) spc
            return
         endif
         if( fmt(i:i) .eq. 'b' ) then
            write(k,1) bslash
            go to 10
         elseif( fmt(i:i) .eq. 'n' ) then
            write(k,3)
            go to 10
         elseif( fmt(i:i) .eq. 't' ) then
            write(k,1) tab
            go to 10
         elseif( fmt(i:i) .eq. '%' ) then
            write(k,1) '%'
            go to 10
         elseif( fmt(i:i) .eq. spc ) then
            write(k,1) spc
            go to 10
         elseif( ldigit(fmt(i:i)) ) then
            call getfsp(fmt,lf,i,j,iw,id,ldot)
            if( fmt(j:j) .eq. 'f' ) then
               call prfmtf(tmp(jt),iw,id,ldot,k)
            elseif( fmt(j:j) .eq. 'e' ) then
               call prfmte(tmp(jt),iw,id,k)
            elseif( fmt(j:j) .eq. 'i' ) then
               call prfmti(tmp(jt),iw,k)
            else
               write(k,1) fmt(i-1:j)
               i = j
               go to 10
            endif
            i = j
         elseif( fmt(i:i) .eq. 'f' ) then
            call prfmtf(tmp(jt),-1,-1,.false.,k)
         elseif( fmt(i:i) .eq. 'e' ) then
            call prfmte(tmp(jt),-1,-1,k)
         elseif( fmt(i:i) .eq. 'i' ) then
            call prfmti(tmp(jt),-1,k)
         else
            write(k,1) fmt(i-1:i)
            go to 10
         endif
         jt = jt + 1
         if( jt .gt. MP ) jt = MP
         go to 10
      else							! CHARACTER
         write(k,1) fmt(i:i)
      endif
      go to 10

      end

max_stars_repo_name: leemargetts/PoreFEM

max_issues_repo_name: leemargetts/PoreFEM

max_forks_repo_name: leemargetts/PoreFEM


text:
c     DRDERFCE
c>> 1996-05-28 DRDERFCE Krogh Moved formats up.
c>> 1994-10-19 DRDERFCE Krogh  Changes to use M77CON
c>> 1992-04-29 DRDERFCE CAO Replaced '1' in format.
c>> 1992-01-29 DRDERFCE cao/cll eliminate underflow error message.
c>> 1992-01-29 DRDERFCE cao/cll better output labels.
c>> 1991-11-20 DRDERFCE CLL Edited for Fortran 90
c>> 1987-12-09 DRDERFCE Lawson  Initial Code.
c     DEMONSTRATION DRIVER FOR  DERFCE
c     ------------------------------------------------------------------
c--D replaces "?": DR?ERFCE, ?ERFC, ?ERFCE
c     ------------------------------------------------------------------
      external DERFC,DERFCE
      double precision DERFC, DERFCE
      double precision W, X, Y, Z
      integer J
c
  100 format(' ',3X,'X',8X,'DERFCE',7X,'DERFC*(X*X)',6X,'DIFF'/' ')
  200 format(1X,F5.1,3X,2(G15.8),1X,E9.2)
c     ------------------------------------------------------------------
c
      X = 0.0d0
      write(*,100)
      do 10 J=1,18
        W = DERFC(X) * EXP(X * X)
        Y = DERFCE(X)
        Z = Y - W
        write(*,200) X,Y,W,Z
        X = X + 0.5d0
   10 continue
      do 20 J=1,18
        Y = DERFCE(X)
        write(*,200) X,Y
        X = X + 1.0d0
   20 continue
      stop
      end


text:
!
! m_vstrplatform.f90 --
!   The m_vstrplatform module provides several routines,
!   which take dynamic strings arguments, to interact
!   with the operating system.
!
!  OVERVIEW
!    The goal of this module is to provide system access with
!    commands which take dynamic strings as arguments.
!    It is based on m_platform, which takes character-based arguments.
!
!    In the following example, extracted from the m_vfile module
!    included in flibs, one sets the current working directory
!    by using vstrplatform_cd on a dynamic string variable.
!
!        type ( t_vstring ) :: dirname
!        integer :: status
!        call vstrplatform_cd ( dirname , status )
!
!    This is a sketch of available routines :
!     vstrplatform_system                       Executes an external command on the system
!     vstrplatform_get_environment_variable     Get to one environment variable
!     vstrplatform_cd                           Change the system current directory
!     vstrplatform_stat                         Get status of a file
!
!   Dynamic or static buffer
!
!   The internal algorithms provided by m_vstrplatform are based on
!   basic fortran character strings. In several situations, the
!   dynamic vstring has to be converted into a basic fortran character
!   buffer string, which size has to be given explicitely in the source
!   code, with the "len = <something>" statement (in the
!   character ( len = <something>) ).
!   If the _VSTRPLATFORM_STATIC_BUFFER macro is defined, then character strings of
!   constant size VSTRPLATFORM_MAXIMUM_ENVVAR_LENGTH are used as buffers.
!   If the _VSTRPLATFORM_STATIC_BUFFER macro is not defined (which is the default),
!   then character strings of dynamic size are used as buffers
!   with the fortran 90 "len = vstring_length(this)" statement.
!
!   The second solution is more efficient, because the strings are not
!   oversized or undersized, depending on the real number of characters
!   in the dynamic string. But the feature may not be provided
!   by the compiler at hand. For example, problems with the dynamic
!   length character string have been experienced with Intel Fortran 8.
!
!   Preprocessing
!   The following preprocessing macro may be defined :
!   _VSTRPLATFORM_STATIC_BUFFER : see  the section "Dynamic or static buffer"
!
! Copyright (c) 2008 Arjen Markus arjenmarkus@sourceforge.net
! Copyright (c) 2008 Michael Baudin michael.baudin@gmail.com
!
! $Id$
!
module m_vstrplatform
  use m_platform, only : &
       platform_system , &
       platform_cd , &
       platform_stat , &
       platform_osstring ,&
       platform_platformstring , &
       platform_get_os , &
       platform_get_platform , &
       platform_get_environment_variable , &
       PLATFORM_OS_WINDOWS_95, &
       PLATFORM_OS_WINDOWS_NT, &
       PLATFORM_OS_MACOS , &
       PLATFORM_OS_SUNOS , &
       PLATFORM_OS_LINUX , &
       PLATFORM_OS_UNIX , &
       PLATFORM_PLATFORM_WINDOWS , &
       PLATFORM_PLATFORM_MAC , &
       PLATFORM_PLATFORM_UNIX
  use m_vstring, only : &
       t_vstring, &
       vstring_new , &
       vstring_free , &
       vstring_cast , &
       vstring_length , &
       vstring_trim, &
       vstring_append
  implicit none
  private
  !
  ! Public static methods
  !
  public :: vstrplatform_system
  public :: vstrplatform_get_environment_variable
  public :: vstrplatform_cd
  public :: vstrplatform_stat
  public :: vstrplatform_osstring
  public :: vstrplatform_platformstring
  !
  ! Constants
  !
  ! Maximum number of characters in an environment variable
  integer , parameter :: VSTRPLATFORM_MAXIMUM_ENVVAR_LENGTH = 10000
  !
  ! vstrplatform_get_environment_variable --
  !   Generic interface to get the value of an environment variable.
  !
  interface vstrplatform_get_environment_variable
     module procedure vstrplatform_getenvvar_vstring
     module procedure vstrplatform_getenvvar_charstring
  end interface vstrplatform_get_environment_variable
  !
  ! vstrplatform_cd --
  !   Generic interface to change the directory
  !
  interface vstrplatform_cd
     module procedure vstrplatform_cd_vstring
     module procedure vstrplatform_cd_charstring
  end interface vstrplatform_cd
  !
  ! Maximum number of characters in the buffer.
  !
  integer , parameter :: VSTRPLATFORM_BUFFER_SIZE = 1000
contains
  !
  ! vstrplatform_system --
  !   Consider the current string as a command and executes it
  !   under the operating system.
  !
  ! Arguments:
  !   status, optional : if supplied, it contains 0 on success or nonzero error code
  !     upon return
  !
  subroutine vstrplatform_system ( command , status )
    type ( t_vstring ), intent(in) :: command
    integer, intent(out) , optional :: status
#ifdef _VSTRPLATFORM_STATIC_BUFFER
    character ( len = VSTRPLATFORM_BUFFER_SIZE ) :: command_charstring
#else
    character(len=vstring_length( command)) :: command_charstring
#endif
    call vstring_cast ( command , command_charstring )
    call platform_system ( command_charstring , status )
  end subroutine vstrplatform_system
  !
  ! vstrplatform_osstring --
  !   Returns a string containing the current operating system running
  !   on the current machine, one of "Windows 95", "Windows NT", "MacOS", "SunOS",
  !   "Linux" or "Unix".
  !
  ! Arguments:
  !   currentos, output : the current operating system string
  function vstrplatform_osstring ( ) result ( currentos )
    type ( t_vstring ) :: currentos
    integer :: platform_os
    type ( t_vstring ) :: message
    platform_os = platform_get_os ( )
    select case ( platform_os )
    case ( PLATFORM_OS_WINDOWS_95 )
       call vstring_new ( currentos , "Windows 95" )
    case ( PLATFORM_OS_WINDOWS_NT )
       call vstring_new ( currentos , "Windows NT" )
    case ( PLATFORM_OS_MACOS )
       call vstring_new ( currentos , "MacOS" )
    case ( PLATFORM_OS_SUNOS )
       call vstring_new ( currentos , "SunOS" )
    case ( PLATFORM_OS_LINUX )
       call vstring_new ( currentos , "Linux" )
    case ( PLATFORM_OS_UNIX )
       call vstring_new ( currentos , "Unix" )
    case default
       call vstring_new ( message , "Unknown operating system in vstrplatform_osstring." )
       call vstrplatform_error ( message )
       call vstring_free ( message )
    end select
  end function vstrplatform_osstring
  !
  ! vstrplatform_platformstring --
  !   Returns a string containing the current platform running on the current machine,
  !   one of "Windows", "Mac", "Unix".
  ! Arguments:
  !   currentplatform, output : the current platform string
  function vstrplatform_platformstring (  ) result ( currentplatform )
    type ( t_vstring ) :: currentplatform
    integer :: platform_platform
    type ( t_vstring ) :: message
    platform_platform = platform_get_platform ()
    select case ( platform_platform )
    case ( PLATFORM_PLATFORM_WINDOWS )
       call vstring_new ( currentplatform , "Windows" )
    case ( PLATFORM_PLATFORM_MAC )
       call vstring_new ( currentplatform , "Mac" )
    case ( PLATFORM_PLATFORM_UNIX )
       call vstring_new ( currentplatform , "Unix" )
    case default
       call vstring_new ( message , "Unknown platform in vstrplatform_platformstring." )
       call vstrplatform_error ( message )
       call vstring_free ( message )
    end select
  end function vstrplatform_platformstring
  !
  ! vstrplatform_getenvvar_vstring --
  !   Returns the value of the environment variable envvar.
  ! Arguments:
  !   envvar : the name of the environment variable to get
  function vstrplatform_getenvvar_vstring ( envvar ) result ( value )
    type ( t_vstring ), intent(in) :: envvar
    type ( t_vstring ) :: value
    type ( t_vstring ) :: value_long
#ifdef _VSTRPLATFORM_STATIC_BUFFER
    character ( len = VSTRPLATFORM_BUFFER_SIZE ) :: envvar_charstring
#else
    character(len=vstring_length(envvar)) :: envvar_charstring
#endif
    ! TODO : remove the limitation that the environement variable is declared with a static size.
    character ( len=VSTRPLATFORM_MAXIMUM_ENVVAR_LENGTH) :: value_charstring
    call vstring_cast ( envvar , envvar_charstring )
    call platform_get_environment_variable ( envvar_charstring , value_charstring )
    call vstring_new ( value_long , value_charstring )
    value = vstring_trim ( value_long )
    call vstring_free ( value_long )
  end function vstrplatform_getenvvar_vstring
  !
  ! vstrplatform_getenvvar_charstring --
  !   Returns the value of the environment variable envvar.
  ! Arguments:
  !   envvar : the name of the environment variable to get
  function vstrplatform_getenvvar_charstring ( envvar ) result ( value )
    character(len=*), intent(in) :: envvar
    type ( t_vstring ) :: value
    type ( t_vstring ) :: envvar_string
    call vstring_new ( envvar_string , envvar )
    value = vstrplatform_getenvvar_vstring ( envvar_string )
    call vstring_free ( envvar_string )
  end function vstrplatform_getenvvar_charstring
  !
  ! vstrplatform_cd_vstring --
  !   Change working directory
  ! Arguments:
  !   filename   Name of the directory in which to enter
  !   status, optional : if supplied, it contains 0 on success or nonzero error code
  !      upon return
  !
  subroutine vstrplatform_cd_vstring ( dirname , status )
    type(t_vstring), intent(in) :: dirname
    integer, intent(out) , optional :: status
    integer :: local_status
    type ( t_vstring ) :: message
#ifdef _VSTRPLATFORM_STATIC_BUFFER
    character ( len = VSTRPLATFORM_BUFFER_SIZE ) :: dirname_charstring
#else
    character(len=vstring_length(dirname)) :: dirname_charstring
#endif
    call vstring_cast ( dirname , dirname_charstring )

    call platform_cd ( dirname_charstring , local_status )

    if ( present ( status ) ) then
       status = local_status
    elseif ( local_status /=0 ) then
       call vstring_new ( message , "Error while changing directory in vstrplatform_cd_vstring." )
       call vstrplatform_error ( message )
       call vstring_free ( message )
    endif
  end subroutine vstrplatform_cd_vstring
  !
  ! vstrplatform_cd_charstring --
  !   Change working directory
  ! Arguments:
  !   filename   Name of the directory in which to enter
  !   status, optional : if supplied, it contains 0 on success or nonzero error code
  !      upon return
  !
  subroutine vstrplatform_cd_charstring ( dirname , status )
    character(len=*), intent(in) :: dirname
    integer, intent(out) , optional :: status
    call platform_cd ( dirname , status )
  end subroutine vstrplatform_cd_charstring
  !
  ! vstrplatform_stat --
  !   Get status of a file.
  ! Arguments:
  !   filename   Name of the file
  !   statarray  Array of size 13,
  !       statarray(1) Device ID
  !       statarray(2) Inode number
  !       statarray(3) File mode
  !       statarray(4) Number of links
  !       statarray(5) Owner’s uid
  !       statarray(6) Owner’s gid
  !       statarray(7) ID of device containing directory entry for file (0 if not available)
  !       statarray(8) File size (bytes)
  !       statarray(9) Last access time
  !       statarray(10) Last modification time
  !       statarray(11) Last file status change time
  !       statarray(12) Preferred I/O block size (-1 if not available)
  !       statarray(13) Number of blocks allocated (-1 if not available)
  !   status, optional : if supplied, it contains 0 on success or nonzero error code
  !      upon return
  !
  subroutine vstrplatform_stat ( filename , statarray , status )
    type(t_vstring), intent(in)             :: filename
    integer, dimension (1:13) , intent(out)  :: statarray
    integer, intent(out) , optional :: status
    integer :: local_status
    type ( t_vstring ) :: message
#ifdef _VSTRPLATFORM_STATIC_BUFFER
    character ( len = VSTRPLATFORM_BUFFER_SIZE ) :: filename_charstring
#else
    character(len=vstring_length(filename)) :: filename_charstring
#endif
    call vstring_cast ( filename , filename_charstring )
    call platform_stat ( filename_charstring , statarray , local_status )
    if ( present ( status ) ) then
       status = local_status
    elseif ( local_status /=0 ) then
       call vstring_new ( message , "Error while computing stat for file ")
       call vstring_append ( message , filename )
       call vstring_append ( message , " in vstrplatform_stat." )
       call vstrplatform_error ( message )
       call vstring_free ( message )
    endif
  end subroutine vstrplatform_stat
  !
  ! vstrplatform_error --
  !   Manage an error for the filedir module
  ! Arguments :
  !   origin : the name of the subroutine/function which generated the error.
  !   message : the message to display
  !
  subroutine vstrplatform_error ( message )
    type(t_vstring), intent(in) :: message
#ifdef _VSTRPLATFORM_STATIC_BUFFER
    character ( len = VSTRPLATFORM_BUFFER_SIZE ) :: message_charstring
#else
    character(len=vstring_length(message)) :: message_charstring
#endif
    call vstring_cast ( message , message_charstring )
    write(*,*) "Error in m_vstrplatform."
    write(*,*) "Message: ", message_charstring
    stop
  end subroutine vstrplatform_error
end module m_vstrplatform

max_stars_repo_name: timcera/flibs

max_issues_repo_name: timcera/flibs

max_forks_repo_name: timcera/flibs


! RUN: %flang_fc1 -fsyntax-only -fno-automatic %s 2>&1 | FileCheck %s --allow-empty
! Checks that -fno-automatic implies the SAVE attribute.
! This same subroutine appears in test save01.f90 where it is an
! error case due to the absence of both SAVE and -fno-automatic.
subroutine foo
  integer, target :: t
  !CHECK-NOT: error:
  integer, pointer :: p => t
end


!> Module that defines the double precision and single
!! precision kinds.
MODULE kinds
  SAVE

  !single-precision kind
  INTEGER, PARAMETER :: sp = selected_real_kind( 6, 37 )

  !double-precision kind
  INTEGER, PARAMETER :: dp = selected_real_kind( 15, 307 )

END MODULE kinds


text:
      subroutine statd(n,x,mean,sd,sk,c4,c6,max,min,io)
c**************************************************
c     Version : 9-14-2005
c     Precision : single precision out/double arithmetic
c     Function : Calculates mean, standard deviation, skewness - sk,
c      kurtosis - c4, 6-th order cumulant - c6, maximum - max, and
c      minimum - min of the sample.
c=================================================
      real*8 s1,s2,s3,s4,s6,dx,dx3,dmn,dn,ds,xmin,xmax
      real x(n),mean,max,min
      intent(in) n,x,io
      intent(out) mean,sd,sk,c4,c6,max,min
c**************************************************
c  Initialize accumulators
      xmax=x(1)
      xmin=x(1)
      s1=0.d0
      s2=0.d0
      s3=0.d0
      s4=0.d0
      s6=0.d0
      dn=dfloat(n)
      do k=1,n
       dx=dble(x(k))
       xmax=dmax1(dx,xmax)
       xmin=dmin1(dx,xmin)
c  Sum x
       s1=s1+dx
c  Sum x*x
       s2=s2+dx*dx
      enddo
      max=xmax
      min=xmin
c  Mean
      dmn=s1/dn
      mean=sngl(dmn)
c  Sum(x*x)-Sum(x)*Sum(x)/n
      s2=s2-dmn*s1
c  Check if variance=0
      if(s2<=0.d0) then
       write(io,*) 'Variance ',sngl(s2),' in STAT = 0 & is set = -1'
       sd=-1.0
       return
      endif
c  Check if variance<1.d-5
      if(s2<=1.d-5) then
       s2=0.d0
       do k=1,n
        dx=dble(x(k))-dmn
        s2=s2+dx*dx
       enddo
      endif
c  Compute standard deviation
      ds=dsqrt(s2/dfloat(n-1))
      sd=sngl(ds)
c  Compute other stats
      do k=1,n
       dx=dble(x(k))-dmn
       dx3=dx*dx*dx
       s3=s3+dx3
       s4=s4+dx3*dx
       s6=s6+dx3*dx3
      enddo
      dx3=ds*ds*ds
      s3=s3/(dn*dx3)
      sk=sngl(s3)
      s4=s4/(dn*dx3*ds)-3.d0
      c4=sngl(s4)
      s6=s6/(dx3*dx3)
      c6=sngl(s6/dn-15.d0*s4-10.d0*s3*s3-15.d0)
c-------
      return
      end

ext: for

max_stars_repo_name: emammendes/bispectrum

max_issues_repo_name: emammendes/bispectrum

max_forks_repo_name: emammendes/bispectrum


!
!  Copyright 2019-2020 SALMON developers
!
!  Licensed under the Apache License, Version 2.0 (the "License");
!  you may not use this file except in compliance with the License.
!  You may obtain a copy of the License at
!
!      http://www.apache.org/licenses/LICENSE-2.0
!
!  Unless required by applicable law or agreed to in writing, software
!  distributed under the License is distributed on an "AS IS" BASIS,
!  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
!  See the License for the specific language governing permissions and
!  limitations under the License.
!
module perflog
  implicit none

  public  :: write_performance

  integer,parameter,public :: write_mode_readable = 1
  integer,parameter,public :: write_mode_csv      = 2

private
contains
  subroutine write_loadbalance(fd,nsize,tsrc,headers,write_mode)
    use parallelization
    use communication
    use timer
    use math_constants
    implicit none
    integer,intent(in)       :: fd,nsize
    real(8),intent(in)       :: tsrc(nsize)
    character(30),intent(in) :: headers(0:nsize)
    integer,intent(in)       :: write_mode

    real(8) :: tmin(nsize),tmax(nsize),tdif(nsize),trel(nsize)
    real(8) :: tavg(nsize),tnorm(nsize),tstdev(nsize)
    integer :: i

    call comm_get_min(tsrc,tmin,nsize,nproc_group_global)
    call comm_get_max(tsrc,tmax,nsize,nproc_group_global)
    call comm_summation(tsrc,tavg,nsize,nproc_group_global)

    do i=1,nsize
      if (is_zero(tmax(i))) then
        tdif(i) = 0.d0
        trel(i) = 0.d0
        tavg(i) = 0.d0
      else
        tdif(i) = tmax(i) - tmin(i)
        trel(i) = tmax(i) / tmin(i)
        tavg(i) = tavg(i) / nproc_size_global
      end if
    end do

    do i=1,nsize
      tnorm(i) = tsrc(i)**2 - tavg(i)**2
    end do

    call comm_summation(tnorm,tstdev,nsize,nproc_group_global)

    do i=1,nsize
      tstdev(i) = sqrt(tstdev(i) / nproc_size_global)
    end do

    if (comm_is_root(nproc_id_global)) then
      if (write_mode == write_mode_readable) then
        write (fd,'(a30,6(a12))') headers(0),'min','max','average','std. dev.','difference','relative'
      else
        write (fd,'(a,",",5(a,","),a)') trim(headers(0)),'min','max','average','std. dev.','difference','relative'
      end if
      do i=1,nsize
        if (.not. is_zero(trel(i))) then
          if (write_mode == write_mode_readable) then
            write (fd,'(a30,6(e12.5e2))') headers(i),tmin(i),tmax(i),tavg(i),tstdev(i),tdif(i),trel(i)
          else
            write (fd,'(a,",",5(e12.5e2,","),e12.5e2)') trim(headers(i)),tmin(i),tmax(i),tavg(i),tstdev(i),tdif(i),trel(i)
          end if
        end if
      end do
    end if
  end subroutine

  subroutine write_flops(fd,write_mode)
    use parallelization
    use communication
    use math_constants
!    use flops
    use salmon_global, only: theory, iperiodic
    implicit none
    integer, intent(in) :: fd, write_mode

    real(8) :: lg(4),pg(4),mg(4),sg(4)

    select case(theory)
      case('tddft')
        select case(iperiodic)
          ! TODO: calc flops on unified hpsi
          ! 0: GCEED
          ! 3: ARTED
          case(3)
            !  if (yn_domain_parallel == 'y') then
            !  call get_hamiltonian_flops(lg,pg,mg,sg)
              if (comm_is_root(nproc_id_global)) then
                if (write_mode == write_mode_readable) then
                  write (fd,'(a30,4(a12))') 'hamiltonian','all','stencil','pseudo-pt','update'
                  write (fd,'(a30,4(f12.2))') 'processor'       ,lg(4),lg(1),lg(2),lg(3)
                  write (fd,'(a30,4(f12.2))') 'processor (best)',pg(4),pg(1),pg(2),pg(3)
                  if (.not. is_zero(mg(4))) write (fd,'(a30,4(f12.2))') 'macro-grid',mg(4),mg(1),mg(2),mg(3)
                  write (fd,'(a30,4(f12.2))') 'system'          ,sg(4),sg(1),sg(2),sg(3)
                else
                  write (fd,'(a,",",3(a,","),a)') 'hamiltonian','all','stencil','pseudo-pt','update'
                  write (fd,'(a,",",3(f0.6,","),f0.6)') 'processor'       ,lg(4),lg(1),lg(2),lg(3)
                  write (fd,'(a,",",3(f0.6,","),f0.6)') 'processor (best)',pg(4),pg(1),pg(2),pg(3)
                  if (.not. is_zero(mg(4))) write (fd,'(a,",",3(f0.6,","),f0.6)') 'macro-grid'      ,mg(4),mg(1),mg(2),mg(3)
                  write (fd,'(a,",",3(f0.6,","),f0.6)') 'system'          ,sg(4),sg(1),sg(2),sg(3)
                end if
              end if
            !end if
        end select
    end select
  end subroutine

  subroutine write_root(fd, str)
    use parallelization
    use communication
    implicit none
    integer, intent(in)      :: fd
    character(*), intent(in) :: str
    if (comm_is_root(nproc_id_global)) then
      write (fd,'(a)') str
    end if
  end subroutine

  subroutine write_performance(fd,mode)
    use parallelization
    use communication
    use salmon_global, only: theory,method_singlescale,yn_ffte
    use timer
    implicit none
    integer, intent(in) :: fd, mode

    integer,parameter :: LOG_SIZE = 30
    real(8)       :: tsrc(LOG_SIZE)
    character(30) :: headers(0:LOG_SIZE)

    call write_root(fd, '=== application breakdown [s] ===')
    if (comm_is_root(nproc_id_global)) then
      write (fd,'(a,f0.8)') 'total calculation time,',timer_get(LOG_TOTAL)
    end if

    select case(theory)
    case('dft','dft_band','dft_md')
      call set(0, 0, 'scf calculation')
      call set(1, LOG_INIT_GS            , 'gs initialization')
      call set(2, LOG_INIT_GS_RESTART    , 'reading data')
      call set(3, LOG_INIT_GS_ITERATION  , 'init. scf iter.')
      call set(4, LOG_GS_ITERATION       , 'scf iterations')
      call set(5, LOG_DEINIT_GS_ITERATION, 'deinit. scf iter.')
      call set(6, LOG_WRITE_GS_RESULTS   , 'writing scf data')
      call set(7, LOG_WRITE_GS_DATA     , 'writing LDA data')
      call set(8, LOG_WRITE_GS_INFO     , 'writing LDA infos')
      call write_loadbalance(fd, 8, tsrc, headers, mode)

      call set(0, 0, 'in scf iterations')
      call set_sub( 1, LOG_CALC_MINIMIZATION  , 'Minimization')
      call set_sub( 2, LOG_CALC_GRAM_SCHMIDT  , 'Gram Schmidt')
      call set_sub( 3, LOG_CALC_SUBSPACE_DIAG , 'subspace-diag.')
      call set_sub( 4, LOG_CALC_RHO           , 'calculating rho')
      call set_sub( 5, LOG_CALC_HARTREE       , 'Hartree routine')
      call set_sub( 6, LOG_CALC_EXC_COR       , 'Exc_Cor routine')
      call set_sub( 7, LOG_CALC_TOTAL_ENERGY  , 'calculating Etot')
      call set_sub( 8, LOG_CALC_ESP           , 'calculating esp')
      call set_sub( 9, LOG_CALC_ION_FORCE     , 'calc force')
      call set_sub(10, LOG_MD_TEVOL_PART1     , 'MD-opt time-evol. part1')
      call set_sub(11, LOG_MD_TEVOL_PART2     , 'MD-opt time-evol. part2')
      call set_sub(12, LOG_MD_UPDATE_PSEUDO_PT, 'update pseudo-pt')
      call write_loadbalance(fd, 12, tsrc, headers, mode)
    case('dft2tddft')
      call set(0, 0, 'DFT data redistribution')
      call set(1, LOG_INIT_GS         , 'gs initialization')
      call set(2, LOG_INIT_GS_RESTART , 'reading data')
      call set(3, LOG_INIT_RT         , 'rt initialization')
      call set(4, LOG_WRITE_RT_DATA   , 'data redistribution')
      call set(5, LOG_WRITE_RT_RESULTS, 'writing data')
      call write_loadbalance(fd, 5, tsrc, headers, mode)
    case('tddft_response','tddft_pulse','single_scale_maxwell_tddft',&
         'multi_scale_maxwell_tddft','maxwell')
      call set(0, 0, 'rt calculation')
      call set(1, LOG_INIT_RT              , 'rt initialization')
      call set(2, LOG_READ_GS_DATA        , 'reading lda data')
      call set(3, LOG_READ_RT_DATA         , 'reading rt data')
      call set(4, LOG_INIT_TIME_PROPAGATION, 'prep. time prop.')
      call set(5, LOG_RT_ITERATION         , 'rt iterations')
      call set(6, LOG_WRITE_RT_DATA        , 'writing rt data')
      call set(7, LOG_WRITE_RT_RESULTS     , 'after writing rt data')
      call write_loadbalance(fd, 7, tsrc, headers, mode)

      call set(0, 0, 'in rt iterations')
      call set_sub( 1, LOG_CALC_EMFIELD         , 'Emfield')
      call set_sub( 2, LOG_CALC_VBOX            , 'Vbox')
      call set_sub( 3, LOG_CALC_TIME_PROPAGATION, 'time propagation')
      call set_sub( 4, LOG_CALC_RHO             , 'calculating rho')
      if (theory=='single_scale_maxwell_tddft' .and. method_singlescale=='1d_fourier' .and. yn_ffte=='y') then
        call set_sub( 5, LOG_CALC_HARTREE       , 'Hartree+FDTD by FFTE')
      else
        call set_sub( 5, LOG_CALC_HARTREE       , 'Hartree routine')
      end if
      call set_sub( 6, LOG_CALC_EXC_COR         , 'Exc_Cor routine')
      call set_sub( 7, LOG_CALC_ALLGATHERV_VLOCAL, 'allgatherv_vlocal')
      call set_sub( 8, LOG_CALC_DP              , 'calculating Dp')
      call set_sub( 9, LOG_CALC_DENSITY_MATRIX  , 'calculating density matrix')
      call set_sub(10, LOG_CALC_CURRENT         , 'calculating curr')
      call set_sub(11, LOG_CALC_TOTAL_ENERGY    , 'calculating Etot')
      call set_sub(12, LOG_CALC_PROJECTION      , 'calc. projection')
      call set_sub(13, LOG_WRITE_ENERGIES       , 'writing energies')
      call set_sub(14, LOG_CALC_EIGEN_ENERGY    , 'calc_eigen_energy')
      call set_sub(15, LOG_CALC_CURRENT_ION     , 'calc_current_ion')
      call set_sub(16, LOG_CALC_TOTAL_ENERGY_PERIODIC, 'calc_total_energy_periodic')
      call set_sub(17, LOG_CALC_SINGLESCALE     , 'calc singlescale')
      call set_sub(18, LOG_CALC_ION_FORCE       , 'calc force')
      call set_sub(19, LOG_MD_TEVOL_PART1       , 'MD-opt time-evol. part1')
      call set_sub(20, LOG_MD_TEVOL_PART2       , 'MD-opt time-evol. part2')
      call set_sub(21, LOG_MD_UPDATE_PSEUDO_PT  , 'update pseudo-pt')
      call set_sub(22, LOG_WRITE_RT_INFOS       , 'writing info etc.')
      call set_sub(23, LOG_RT_ANALYSIS          , 'analysis calc.')
      call set_sub(24, LOG_RT_MISC              , 'misc.')
      call write_loadbalance(fd, 24, tsrc, headers, mode)
    case default
      stop 'invalid theory @ perflog'
    end select

    if (theory == 'single_scale_maxwell_tddft') then
      call set(0, 0, 'in singlescale maxwell-tddft')
      call set_sub(1, LOG_SS_FDTD_CALC,      'FDTD calc')
      call set_sub(2, LOG_SS_FDTD_COMM,      'FDTD halo comm')
      call set_sub(3, LOG_SS_FDTD_COMM_COLL, 'FDTD coll comm')
      call set_sub(4, LOG_SS_UPDATE_NONLOCALPT_MICROAC, 'update nonlocal microAc')
      call write_loadbalance(fd, 4, tsrc, headers, mode)
    end if

    call set(0, 0, 'total_energy module')
    call set_sub(1, LOG_TE_ISOLATED_CALC,       'isolated calc.')
    call set_sub(2, LOG_TE_ISOLATED_COMM_COLL,  'isolated comm. coll')
    call set_sub(3, LOG_TE_PERIODIC_CALC,       'periodic calc.')
    call set_sub(4, LOG_TE_PERIODIC_COMM_COLL,  'periodic comm. coll.')
    call set_sub(5, LOG_EIGEN_ENERGY_CALC,      'eigen_energy calc.')
    call set_sub(6, LOG_EIGEN_ENERGY_COMM_COLL, 'eigen_energy comm. coll.')
    call set_sub(7, LOG_EIGEN_ENERGY_HPSI,      'eigen_energy hpsi')
    call write_loadbalance(fd, 7, tsrc, headers, mode)

    call set(0, 0, 'density_matrix module')
    call set_sub( 1, LOG_DENSITY_MATRIX_CALC,          'density_matrix calc.')
    call set_sub( 2, LOG_DENSITY_MATRIX_COMM_COLL,     'density_matrix comm. coll.')
    call set_sub( 3, LOG_DENSITY_MATRIX_COMM_HALO,     'density_matrix comm. halo')
    call set_sub( 4, LOG_DENSITY_CALC,                 'density calc.')
    call set_sub( 5, LOG_DENSITY_COMM_COLL,            'density comm. coll.')
    call set_sub( 6, LOG_CURRENT_CALC,                 'current calc.')
    call set_sub( 7, LOG_CURRENT_CALC_UVPSI_RDIVIDED,  'current rDivided uVpsi calc.')
    call set_sub( 8, LOG_CURRENT_COMM_COLL,            'current comm. coll.')
    call set_sub( 9, LOG_CURRENT_COMM_HALO,            'current comm. halo.')
    call set_sub(10, LOG_MCURRENT_CALC,                'micro-current calc.')
    call set_sub(11, LOG_MCURRENT_COMM_COLL,           'micro-current comm. coll.')
    call write_loadbalance(fd, 11, tsrc, headers, mode)

    call set(0, 0, 'conjugate_gradient module')
    call set_sub(1, LOG_GSCG_ISOLATED_CALC,      'isolated calc.')
    call set_sub(2, LOG_GSCG_ISOLATED_COMM_COLL, 'isolated comm. coll.')
    call set_sub(3, LOG_GSCG_ISOLATED_HPSI,      'isolated hpsi')
    call set_sub(4, LOG_GSCG_PERIODIC_CALC,      'periodic calc.')
    call set_sub(5, LOG_GSCG_PERIODIC_COMM_COLL, 'periodic comm. coll.')
    call set_sub(6, LOG_GSCG_PERIODIC_HPSI,      'periodic hpsi')
    call write_loadbalance(fd, 6, tsrc, headers, mode)

    call set(0, 0, 'subspace_diag module')
    call set_sub(1, LOG_SSDG_ISOLATED_CALC,      'isolated calc.')
    call set_sub(2, LOG_SSDG_ISOLATED_COMM_COLL, 'isolated comm. coll.')
    call set_sub(3, LOG_SSDG_ISOLATED_HPSI,      'isolated hpsi')
    call set_sub(4, LOG_SSDG_PERIODIC_CALC,      'periodic calc.')
    call set_sub(5, LOG_SSDG_PERIODIC_COMM_COLL, 'periodic comm. coll.')
    call set_sub(6, LOG_SSDG_PERIODIC_HPSI,      'periodic hpsi')
    call set_sub(7, LOG_SSDG_PERIODIC_EIGEN,     'periodic eigen')
    call write_loadbalance(fd, 7, tsrc, headers, mode)

    call set(0, 0, 'subspace_diag so module')
    call set_sub(1, LOG_SSDG_SO_ISOLATED_CALC,      'isolated calc.')
    call set_sub(2, LOG_SSDG_SO_ISOLATED_COMM_COLL, 'isolated comm. coll.')
    call set_sub(3, LOG_SSDG_SO_ISOLATED_HPSI,      'isolated hpsi')
    call set_sub(4, LOG_SSDG_SO_PERIODIC_CALC,      'periodic calc.')
    call set_sub(5, LOG_SSDG_SO_PERIODIC_COMM_COLL, 'periodic comm. coll.')
    call set_sub(6, LOG_SSDG_SO_PERIODIC_HPSI,      'periodic hpsi')
    call write_loadbalance(fd, 6, tsrc, headers, mode)

    call set(0, 0, 'force module')
    call set_sub(1, LOG_CALC_ION_FORCE,      'total')
    call set_sub(2, LOG_CALC_FORCE_ION_ION,  'calc ion-ion')
    call set_sub(3, LOG_CALC_FORCE_FOURIER,  'calc fouier')
    call set_sub(4, LOG_CALC_FORCE_ELEC_ION, 'calc electron-ion')
    call set_sub(5, LOG_CALC_FORCE_GTPSI,    '::calc gtpsi')
    call set_sub(6, LOG_CALC_FORCE_DDEN,     '::calc dden')
    call set_sub(7, LOG_CALC_FORCE_NONLOCAL, '::calc nonlocal')
    call set_sub(8, LOG_CALC_FORCE_LOCAL,    'calc local')
    call write_loadbalance(fd, 8, tsrc, headers, mode)

    call set(0, 0, 'init_ps')
    call set_sub(1, LOG_INIT_PS_TOTAL,      'total')
    call set_sub(2, LOG_INIT_PS_CALC_NPS,   '::calc nps')
    call set_sub(3, LOG_INIT_PS_CALC_JXYZ,  '::calc jxyz')
    call set_sub(4, LOG_INIT_PS_LMA_UV,     '::calc lma and uv')
    call set_sub(5, LOG_INIT_PS_CALC_VPSL,  '::calc vpsl')
    call set_sub(6, LOG_INIT_PS_UVPSI,      '::init uvpsi')
    call write_loadbalance(fd, 6, tsrc, headers, mode)

    call set(0, 0, 'hamiltonian module')
    call set_sub(1, LOG_UHPSI_ALL,            'total')
    call set_sub(2, LOG_UHPSI_UPDATE_OVERLAP, 'update overlap (comm.)')
    call set_sub(3, LOG_UHPSI_STENCIL,        'stencil')
    call set_sub(4, LOG_UHPSI_SUBTRACTION,    'subtraction')
    call set_sub(5, LOG_UHPSI_PSEUDO,         'pseudo-pt')
    call set_sub(6, LOG_UHPSI_PSEUDO_COMM,    'pseudo-pt (comm.)')
    call write_loadbalance(fd, 6, tsrc, headers, mode)

    call set(0, 0, 'hpsi-overlapped')
    call set_sub(1, LOG_UHPSI_OVL_PHASE1,      'pack halo')
    call set_sub(2, LOG_UHPSI_OVL_PHASE2,      'comp/comm overlap')
    call set_sub(3, LOG_UHPSI_OVL_PHASE2_COMM, 'halo communication')
    call set_sub(4, LOG_UHPSI_OVL_PHASE3,      'unpack halo')
    call set_sub(5, LOG_UHPSI_OVL_PHASE4,      'halo computation')
    call write_loadbalance(fd, 5, tsrc, headers, mode)

    call set(0, 0, 'checkpoint/restart')
    call set(1, LOG_RESTART_SELF,         'restart self')
    call set(2, LOG_RESTART_SYNC,         'restart sync')
    call set(3, LOG_CHECKPOINT_SELF,      'checkpoint self')
    call set(4, LOG_CHECKPOINT_SYNC,      'checkpoint sync')
    call write_loadbalance(fd, 4, tsrc, headers, mode)

    call write_root(fd, '=== performance [GFLOPS] ===')
    call write_flops(fd, mode)
  contains
    subroutine set(nid, tid, header)
      implicit none
      integer, intent(in)      :: nid, tid
      character(*), intent(in) :: header
      if (nid > 0) then
        tsrc(nid) = timer_get(tid)
      end if
      write (headers(nid),'(a)') header
    end subroutine

    subroutine set_sub(nid, tid, header)
      implicit none
      integer, intent(in)      :: nid, tid
      character(*), intent(in) :: header
      if (nid > 0) then
        tsrc(nid) = timer_get_sub(tid)
      end if
      write (headers(nid),'(a)') header
    end subroutine
  end subroutine write_performance
end module perflog


text:
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!   EVB-QMDFF - RPMD molecular dynamics and rate constant calculations on
!               black-box generated potential energy surfaces
!
!   Copyright (c) 2021 by Julien Steffen (steffen@pctc.uni-kiel.de)
!                         Stefan Grimme (grimme@thch.uni-bonn.de) (QMDFF code)
!
!   Permission is hereby granted, free of charge, to any person obtaining a
!   copy of this software and associated documentation files (the "Software"),
!   to deal in the Software without restriction, including without limitation
!   the rights to use, copy, modify, merge, publish, distribute, sublicense,
!   and/or sell copies of the Software, and to permit persons to whom the
!   Software is furnished to do so, subject to the following conditions:
!
!   The above copyright notice and this permission notice shall be included in
!   all copies or substantial portions of the Software.
!
!   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
!   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
!   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
!   THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
!   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
!   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
!   DEALINGS IN THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!
!     subroutine egqmdff_corr: for an 2-dimensional evb-qmdff-forcefield,
!     the energies and gradients are calculated for the 2 QMDFFs
!     HERE: for the RP-EVB coupling term, the QMDFF energies and gradients
!     are corrected to imply a bias energy/force at the TS region to correct
!     possible errors offside the path
!
!     part of EVB
!
subroutine egqmdff_corr (xyz2,s_act,z_act,deltq,internal,e_qmdff1,e_qmdff2,g1,g2)
use evb_mod
use general
implicit none
integer::i,j,n2
real(kind=8)::s_act,z_act  ! RP-EVB path variables
real(kind=8)::xyz2(3,natoms),e_evb,g_evb(3,natoms)
real(kind=8)::g1(3,natoms),g2(3,natoms)
real(kind=8)::deltq(nat6)   ! shift vector to the IRC
real(kind=8)::internal(nat6)  ! actual coordinates in internal coordinates
real(kind=8)::grad_add(3,natoms)  ! shift vector in cartesian coordinates
real(kind=8)::e1_shifted,e2_shifted,e1,gnorm_two
real(kind=8)::ediff,offdiag,off4,root2,deldiscr,delsqrt
real(kind=8)::e,gnorm,e_qmdff1,e_qmdff2,e2
real(kind=8)::corr_stren  ! force constant for QMDFF correction
n=natoms
!
!
!     First QMDFF
!
call ff_eg(n,at,xyz2,e1,g1)
call ff_nonb(n,at,xyz2,q,r0ab,zab,r094_mod,sr42,c6xy,e1,g1)
call ff_hb(n,at,xyz2,e1,g1)
!
!     Second QMDFF
!
call ff_eg_two(n,at,xyz2,e2,g2)
call ff_nonb_two(n,at,xyz2,q_two,r0ab,zab,r094_mod,sr42, &
  &             c6xy_two,e2,g2)
call ff_hb_two(n,at,xyz2,e2,g2)

!
!     Correct the energies and gradients
!
!     First, calculate the actual value of the correction force constant
!write(*,*) "s,z",s_act,z_act
!if ((s_act .lt. s_ts-deltp) .or. (s_act .gt. s_ts+deltp)) then
!   corr_stren=0.d0
!else
!   corr_stren=corr_max-((s_act-s_ts)*sqrt(corr_max)/deltp)*((s_act-s_ts)*sqrt(corr_max)/deltp)
!end if
   if ((s_act .lt. s_ts-deltp) .or. (s_act .gt. s_ts+deltp)) then
      corr_stren=0.d0
   else
      corr_stren=corr_max*(1.d0-(1.d0/deltp)*abs(s_act-s_ts))
   end if
!corr_stren=0.d0
!
!    then apply the correction to the energies of both QMDFFs
!
!write(*,*) corr_stren*z_act*z_act
e1=e1+corr_stren*z_act*z_act
e2=e2+corr_stren*z_act*z_act
!
!    also apply the correction to the gradients of both QMDFFs
!
!    first, convert the deltq vector to cartesian coordinates
!
call int2grad(xyz2,internal,deltq,grad_add)
g1=g1+2.d0*corr_stren*grad_add!/bohr/bohr
g2=g2+2.d0*corr_stren*grad_add!/bohr/bohr
!
!     Shift the energies
!
e1_shifted=e1+E_zero1  !E(qmdff1)
e2_shifted=e2+E_zero2  !E(qmdff2)
e_qmdff1=e1_shifted
e_qmdff2=e2_shifted

!write(*,*) s_act,corr_stren
return
end subroutine egqmdff_corr

max_stars_repo_licenses: MIT Unlicense

max_issues_repo_name: chrinide/EVB-QMDFF

max_issues_repo_licenses: MIT Unlicense

max_forks_repo_name: chrinide/EVB-QMDFF

max_forks_repo_licenses: MIT Unlicense


text:
program main
  implicit none
  integer :: a(1,1)
  if (rank(a)/=2) error stop
end program

max_stars_repo_name: rouson/bug-reports

max_issues_repo_name: rouson/bug-reports

max_forks_repo_name: rouson/bug-reports


module modE
  use mpi
end module modE


text:
The Russell Intramural Fields Intramural Sports Field is one of the larger fields (if not the largest) on campus, but has recently (2005) shrunk with the construction of the Marya Welch Tennis Center. Because of its large size, the field is used for a lot of special events, such as Davis Ultimate Invitational ultimate frisbee invites. The field is also a shortcut for people walking from campus to Oak Avenue. The field features a tall, narrow concrete wall for lacrosse players to practice throwing/catching.

This is also the location for the Davis Boffer Club.


text:
*
*    ------------------------------------------------------------------
*      E C O R E
*    ------------------------------------------------------------------
*
*
      SUBROUTINE ECORE(EL,EC,REL)
*
* *** COMPUTES THE ENERGY OF THE COMMON CLOSED SHELLS
*
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER (NOD=220,NWD=30,NWD2=2*NWD)
      COMMON /PARAM/H,H1,H3,CH,EH,RHO,Z,TOL,NO,ND,NWF,MASS,NCFG,IB,IC,ID
     :   ,D0,D1,D2,D3,D4,D5,D6,D8,D10,D12,D16,D30,FINE,NSCF,NCLOSD,RMASS
      COMMON /RADIAL/R(NOD),RR(NOD),R2(NOD),P(NOD,NWD2),YK(NOD),
     :   YR(NOD),X(NOD),AZ(NWD2),L(NWD2),MAX(NWD2),N(NWD2)
      CHARACTER EL(*)*3
      LOGICAL REL
*
      EC = D0
      DO 10 I = 1,NCLOSD
         SUMI = 4*L(I)+2
         TI   = FK(I,I,0,REL)
         DO 20 K = 2,2*L(I),2
            TI = TI - CA(L(I),K)*FK(I,I,K,REL)
   20    CONTINUE
         EC = EC + SUMI*((SUMI-1)*TI - HL(EL,I,I,REL))/D2
         DO 30 J = 1,I-1
            SUMJ = 4*L(J)+2
            TIJ = FK(I,J,0,REL)
            DO 40 K=IABS(L(I)-L(J)),L(I)+L(J),2
               TIJ = TIJ -CB(L(I),L(J),K)*GK(I,J,K,REL)
   40       CONTINUE
            EC = EC + SUMI*SUMJ*TIJ
   30    CONTINUE
   10 CONTINUE
      END


text:
c------------------------------------------------------------------------
c       subroutine scfft( )
c
c       return
c       end
c------------------------------------------------------------------------
        subroutine ccfft( )
c
        write(*,*) 'Call to ccfft'
        stop
        end
c------------------------------------------------------------------------
        subroutine exit( i )
c
c.... A simple hack to mimic the tremain routine on the Cray
c
        stop
c
        return
        end
c------------------------------------------------------------------------
        subroutine tremain( rtime )
c
c.... A simple hack to mimic the tremain routine on the Cray
c
        rtime = 1.0e10
c
        return
        end
c------------------------------------------------------------------------
        function ishell( command )
c
c.... A simple hack to mimic the ishell routine on the Cray
c
        integer ishell
        character*256 command

        ishell = 1

        return
        end
#ifndef __GFORTRAN__
c------------------------------------------------------------------------
      REAL  FUNCTION SECOND( )
*
*  -- LAPACK auxiliary routine (version 1.1) --
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
*     Courant Institute, Argonne National Lab, and Rice University
*     February 29, 1992
*
*  Purpose
*  =======
*
*  SECOND returns the user time for a process in seconds.
*  This version gets the time from the system function ETIME.
*
*     .. Local Scalars ..
      REAL*4             T1
*     ..
*     .. Local Arrays ..
      REAL*4             TARRAY( 2 )
*     ..
*     .. External Functions ..
      REAL*4             ETIME
      EXTERNAL           ETIME
*     ..
*     .. Executable Statements ..
*
      T1 = ETIME( TARRAY )
      SECOND = TARRAY( 1 ) + TARRAY( 2 )
      RETURN
*
*     End of SECOND
*
      END
#endif
c------------------------------------------------------------------------
c       subroutine flush(iunit)
c
c.... A simple hack to mimic the flush routine on the Cray
c
c       integer iunit
c
c       return
c       end
c------------------------------------------------------------------------
        subroutine scfft(i1,i2,r1,r2,r3,r4,r5,i3)
c
c.... A simple hack to mimic the FFT routine on the Cray
c
        write (*,*) 'SCFFT not supported on SGI machines...'
        call exit(1)
        ierr = 0

        return
        end
c------------------------------------------------------------------------
c
c.... SSD rooutines on the Iris
c
c------------------------------------------------------------------------
        subroutine opendr( iunit, index, length, it, ierr )

        write (*,*) 'SSD not supported on SGI machines...'
        call exit(1)

        return
        end
c------------------------------------------------------------------------
        subroutine readdr( iunit, ubuff, n, irec, irflag, is, ierr )

        ierr = 0

        return
        end
c------------------------------------------------------------------------
        subroutine writdr( iunit, ubuff, n, irec, irflag, is, ierr )

        ierr = 0

        return
        end
c------------------------------------------------------------------------
        subroutine waitdr( iunit, is, ierr )

        ierr = 0

        return
        end
c------------------------------------------------------------------------
        subroutine asyncdr( iunit, ierr )

        ierr = 0

        return
        end
c------------------------------------------------------------------------
        subroutine closdr( iunit, ierr )

        close(99)

        return
        end
c------------------------------------------------------------------------


text:
      double precision function lotopdecaywidth(mt,mb,mw,gamw)
************************************************************************
*     Authors: R.K. Ellis and J. Campbell, February 2012               *
*                                                                      *
*     LO width of the top quark, including the effect of the           *
*     bottom quark mass and off shellness                              *
*                                                                      *
*     Formula is taken from Eq. (27) of                                *
*                                                                      *
*     \bibitem{Czarnecki:1990kv}                                       *
*     A.~Czarnecki,                                                    *
*     ``QCD corrections to the decay t ---> W b                        *
*       in dimensional regularization,''                               *
*     Phys.\ Lett.\ B {\bf 252}, 467 (1990).                           *
*     %%CITATION = PHLTA,B252,467;%%                                   *
*                                                                      *
*                                                                      *
************************************************************************
      implicit none
      include 'zerowidth.f'
      double precision mb,mt,mt1,mw,om,omsq,be,besq,dgauss,Gamma0,
     & xlo,xhi,xi,gamw,ga,Gamma0int
      double precision cachemass,cachewidth,tiny
      data cachemass,cachewidth,tiny/0d0,0d0,1d-8/
      common/transfer/mt1,besq,xi,ga
      save cachemass,cachewidth,tiny
!$omp threadprivate(cachemass,cachewidth,tiny,/transfer/)
      external Gamma0int

c--- check to see if result has already been computed
      if (abs(mt*mw-mb-cachemass) .lt. tiny) then
        lotopdecaywidth=cachewidth
        return
      endif

      mt1=mt
      om=mw/mt
      be=mb/mt
      besq=be**2

      if (zerowidth) then
      omsq=om**2
      lotopdecaywidth=Gamma0(mt,besq,omsq)
      else
      xlo=0d0
      xhi=(1d0-be)**2
      ga=gamw/mw
      xi=(mt/mw)**2
      lotopdecaywidth=dgauss(Gamma0int,xlo,xhi,tiny)
      endif

c--- set-up caching variables
      cachemass=mt*mw-mb
      cachewidth=lotopdecaywidth

      return
      end

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen