text:
These were reviews of Sogas starting in July, 2007 when a new General Manager was hired, up until late 2008 when the restaurant closed for good.

20070701 02:29:36 nbsp There is no other bar in Davis that more closely resembles a fraternity party. If youre a girl, only go if you like being approached by random guys. The use of personal fans rather than industrial illustrates their lack of care for their customers and only helps circulate the humid, B.O. stained air. I find their Grey Goose rack to be a laugh riot. Since Cantina del Cabo closed, Sogas has gotten quite a bit more shady. Users/MichaelAWoods

20070728 20:11:47 nbsp Several years ago Sogas used to be THE place to have a swanky meal with your significant other or an upscale lunch with colleagues, but now their food is consistently poor (though it is still expensive). I have eaten both lunch and dinner at Sogas in the past year and everyone at my table was unhappy with their food. Service has always been slow but now, combined with bad food and high prices, Sogas has really gone to the dogs. I wouldnt eat here unless the food was FREE and I was starving. Users/GradStudent06

20070731 22:07:24 nbsp I actually HATE this restaurant. The service is horrible, I waited easily over twenty minutes for my salad and beverage and shockingly, over an hour for a medium cooked $36.00 dollar steak. My boyfriend ordered pasta that was over cooked and tasted like ocean. The manager was a sarcastic unhelpful rude man who tried to apologize (after i complained twice) with a free desert. To make things worse, after i waited out my order, i found a huge THICK black hair intertwined in my mashed potatoes and tucked under my dry steak. The place probably had at most 5 other tables to serve and they never came to fill my water. This was actually the worst most disappointing meal ive ever eaten. I left in a horrible mood. I wouldnt eat here ever again. Not even if it was free. The food tasted like prepackaged just add water instant mush. Im not a cheep person, and im more then happy to pay extra money for a quality meal. But there is absolutely no way you could ever get me to go there again.  Users/zoe

20070801 10:17:50 nbsp Sogas is a fun place to go out for the evening, but on many occasions I have waited for 20 + minutes to be served a drink from the bar. When is is less crowded, the bar service is great but when crowded the arrangement makes it difficult to get to the bar.  Users/Furly707

20070805 20:22:12 nbsp As far as the dance club goes... drinks are expensive and lines are long. I think they have professional dancers there a few nights a week now and when they do there is a cover for nonstudents. Sean and John are two of the best bartenders in Davis though, and a few of the bouncers (Josh, Sully?) are awesome. The others are dicks but I can see why with how people treat them at the door concerning the line and cover. Its a crazy place since Cantina closed, Id go to Bistro or Sofias instead but it seems like everyone just goes to Sogas to make an appearance anyways. Users/MCB2009

20070807 10:23:47 nbsp We had dinner at Sogas twice before they changed owners and had the most memorable experiences.  We dont eat at expensive restuarants very often, so dinner at Sogas should have been a treat.  This was not the case.  We should have taken a clue from there being no one else in the restuarant.  Under the previous ownership it was tough to get a table without a reservation.  The wine selection was excellent, the bread was stale, even though I was assured that it had been baked this morning.  The rib eye steak was 40% grissle, the almond sole was good, but the rissoto was going.  I would give the meal a b.  The bathroom was disgustingly dirty, any fast food restuarant has a cleaner bathroom and the manager would not even listen to my complaint, he just assured me that it was cleaned today. Users/stephaniesherlock

20070818 15:09:01 nbsp Do not go to this place! The bouncer, Josh at the door is a jerk! My friend and I were both treated really badly on several different occasions.  I was told that my id was fake.  He put it in his pocket and told me to get the hell out of there.  He had a scanner inside the restuarant but instead of scanning it, before making assumptions, he told me to get out of his face.  I needed my id but he wouldnt give it back.  My id was not fake by the way! I am 22 years old and have been going to sogas regularly to dance on friday nights.  Also, when my boyfriend tried to tell him it wasnt fake and try to talk to him about it, Josh began to grab him pushing him away without reason.  I will not be going there again and i suggest if you want to have a fun, no drama night to not go there either.   Users/sarahm

20070818 15:17:20 nbsp If you want to be treated like a human being, DO NOT go to Sogas. The new owners and bouncer are young and inexperienced. They could care less about their customers and care only about making a profit. Ive gone few times at night to dance and had horrible experiences every single damn time. The bouncer JOSH, is a total ass, and is on a powertrip. He has being disrespectful to me and my friends on many occasions, for no reason at all!! Save your money and go to clubs in sac..i refuse to go out in davis, if im treated like unfairly at sogas. PLUS..the go go dancers are just nasty and makes the place cheap and shady, and the place is too small anyways!  Users/sassyf

20070831 19:51:51 nbsp I tried Sogas for dinner tonight and was sorely disappointed.  We arrived at 6:30 on a Friday night and no one was in the restaraunt, nor did anyone come the whole time we were there.  I ordered the seared ahi which was mealy and tough, and my date ordered grouperglorified fish and chips.  The vodka tonic was subpar too!  When we paid, the server ran the credit card for $8 more than the bill, or roughly 15% of the bill.  When we questioned her she said that shed put a bar drink on our table.  How does someone do that in an empty restaurant?? Seemed shady to me.  All in all, Id like to forget the experience. Users/MonicaB

20070904 18:37:49 nbsp Dont order a salad here unless you want to get a pile of iceberg lettuce for $10. The Ahi tuna was not bad, however, we were ignored (while dressed up, go figure) when we ate here so we ate once and thats it. Foods better elsewhere, and drinking and dancing is better elsewhere too. Users/KarlMogel

20071025 21:05:10 nbsp EEW.  Sogas is gross.  never been there to eat, but judging by the reviews, i dont think i will.  ive gone to sogas at night to drink waayy too many times (victim of peer pressure), and ALL of the bouncers are powertripping assholes.  they have no appreciation for their customers, and dont expect any breaks for being a regular or a hot girl.  once inside, youll be greeted with wet stinky air, girls dressed up for no reason (come on, its davis, i go out in my sweatpants), creepy frat guys, ghetto people grinding on the makeshift dancefloor, broke looking gogo dancers (who cant dance) on certain nights (they dance on plywood platforms.  id be offended if i was a go go dancer and was asked to dance on shit like that.  id also be sad if the only place i could get a gig at was sogas :), the place is crowded to the point of being stuck suspended in a sea of sweaty kids and bad cologne with no way to get out, and why its so crowded beats me.  the music is bad (top 20 songs over and over and over and over....) and its near impossible to get a drink or anywhere near the bar in a timely fashion.  the bar is always dirty, so remember not to touch it.  long lines for the bathrooms, and hmmm, lets see, what else....  oh, the drinks have gotten smaller and smaller and weaker since ive been going, and they stay the same price.  so it taks 15 minutes to get through the people to the bar, another 1520 for a spot at the bar, 510 to order your drink, and all you get is a six ounce plastic cup filled with ice and a little bit of drink.  two minutes later, you do the same thing all over again.  dont be fooled by the club feel of this place, its far from a club, its a SMALL RESTURANT trying to be a club.  very tacky. Users/Lisa

20071108 19:02:50 nbsp This place is tolerable, but since the change in ownership/management, its gotten horrible.  The bouncers and bartenders are powertripping jerks no matter how you look at it.  They think theyre gods but theyre just pretty pathetic.  Service is horrible.  I went in early one night to sit at the bar.  I was alone sitting at the bar waiting to be served when someone else walked in.  The bartender passed me over and went immediately to him and I got up and left.  I tried again about a week later.  It was busy but I managed to get a drink after standing at the bar being ignored for about 20 minutes.  I ordered a martini (EVERYTHING in this place is expensive and low quality  that should be enough to keep you from coming here aside from the horrible service) and I got it in like, a SHOT GLASS! I wanted to turn around and ask what it was but I was already in the middle of an immovable group of loud sweaty drunks.  I also ordered a Guinness and he poured it from the tall can into a little plastic cup and kept the rest behind the counter...I didnt even get the whole beer!  Why compromise the dignity of your restaurant on something so ridiculous!?  When I tried to complain (nicely) to the manager, he got defensive and didnt address the issue at all, just screamed about how they were too busy to concentrate on providing customer service to everyone.  I was pissed but I kind of just laughed at him and left.  Oh and the one time I ate here, the food was expensive and crappy (like everyone else said) but my friend got a caesar salad with chicken, and they didnt put chicken breast in it. Instead they put dark meat trimmings and fat!  So sad for the manager hes obviously not a businessman and its only a matter of time before management changes again.  I hope this helps. Users/dvntboy

20071112 10:08:15 nbsp After returning to Sogas after my previous visit, I must say that the bouncers and bartenders are definitely one of the low points of the place. They are all hyped up on muscle milk and roids and seem to think they are gods gift to the earth. It would be nice if they showed a little more customer appreciation, because after all, the customers are who will determine the success of the business. Acting like you are doing me a favor by letting me drink at your bar is not a good approach; mind you there are several others to choose from within walking distance. The fact that you can dance at sogas is the only thing keeping me coming back, because the service is terrible. If Cantina was still open I would go there, and the Grad is too far out of the way, so Sogas wins my bueinss by DEFAULT.  Jeremiah Users/Furly707

20071127 09:29:29 nbsp This place has the worst service imaginable! Mainly the Manager, Cliff, he is a despicable creature and I have no idea how he ever got the manager position at what is supposed to be an upscale restaurant. He is more suited for Plainfield Station or the graveyard shift at Denny’s in West Sac.  The last time I went there with my sister on a Saturday night and we both ran tabs at the bar, at the end of the night they charged both tabs on my card as well as charged my sister.  When I called the manager to explain my dilemma he immediately became defensive and hung up on me.  So we went in to try to fix it, he again was rude and didn’t help us at all.  A week later and they still had not reversed the charges and by now I had noticed that the sneaky little bartender had illegally added $10.00 for a tip on one of the tabs.  I finally went down there and patiently waited for 2 hours to get these charges reversed while Cliff told me to wait and then completely ignored me. When I finally stood up and asked him what the hell was going on he started screaming in my face and kicked me out.  Finally the professional and nice head bartender John came and explained what was happening and reversed the charges no problem.  I will never, never, never come back to this establishment again. I suggest that you keep a close eye on your bill and steer clear of the white trash manager who was obviously born in a barn to convict parents.  This was worst experience I have ever had at any place of business ever.  Make sure to tell your friends. Users/desmqh

20071215 02:07:14 nbsp ugh. there are the most disgusting guys ever at sogas.  some guy tried to put his hands up my shirt and i was barely even dancing with him. i wasnt even giving him a hint of wanting to dance with him. they put water in their drinks and charge the most. there should be a screening for the people they let in there! Users/JackkiCox

20071219 06:40:58 nbsp You know…Its too bad when Matt Soga SOLD Sogas Restaurant which he had to almost 18 years the new owners kept the same name of the Restaurant. Now that he has left and pursued business elsewhere, judging from your peoples reviews looks like it has gone way down hill. And so would most any establishment in a college town like Davis that has a full bar and lets in any drunken Frat boy that just discovered the effect of alcohol in to spend their parent money (remember the Paragon bar incident?). In its day Soga was the topnotch California Cuisine Restaurant to go to and catered to many of Davis’s professors, lawyers, doctors, and anyone else that wanted to fine dine. So before you go and bash the name of “Soga’s”, check yourself and recognize that this is under new owner ship that has obviously dropped the ball and direct your complaints to them. Users/DirkDiggler
  The notification that Sogas is no longer under Matt Sogas management went up in version 64 of this page (20070623 18:48:42), and several of the comments do refer to the quality of the establishment since this change. Comments from before the change in ownership Sogas/Comment Archive were archived; around the same time the entry also reflected that the restaurant was named after Mr. Soga, though I think the entry was altered to reflect its new beginning and reference to him was removed. Regardless, I believe people are bashing the business as it stands rather than its previous owner. Users/KevinChin

20071230 22:22:34 nbsp I used to frequent Sogas regularly.  Back in the day it was a fabulous place to eat, drink and hangout with friends.  It was also an excellent date spot.  At any rate, I ate there a few nights ago with some friends.  I was expecting the worst from all the negative reviews, but it was not bad at all.  Service was courteous, prompt and attentive. The drinks were great.  Food was excellent.  There were six of us at dinner and everyone enjoyed their meals.  My only real complaint is against the bread.  Sogas used to have tasty bread.  I mean ridiculously awesome bread. Now they serve dry, stale, tasteless rolls.  New Owners:  Please bring back the rockin bread! Users/CurlyGirl26

20080129 12:18:10 nbsp Whos that new black bartender??? DAMN!!!!! Users/RayLo23

20080203 20:53:08 nbsp Music is good but to be honest the DJ needs to up his musical skills:

1) play more mainstreamers mixed with old school crowd pleasers ( MJ, Sweet Home Alabama, Baby Got Back, etc....)

2) no repeats

3) songs that get girls up and dancing w/o getting humped by nasty ass boys! Ya heard!

Otherwise its a slammin place to be ThursSat.

 Users/NasMo

20080205 09:25:11 nbsp We ate at Sogas last night and the experience was mixed.  The cheeseandberries appetizer was excellent.  I ordered a pasta with crab that looked interesting; it was okay but not great.  Some of the other main courses at our table looked very good, but it may be easier to succeed with bigmeat dishes.  Moreover, the meatdominated specials were very expensive.  I had the creme brulee for dessert; it was okay but overcooked.  Actually they were out of the dessert that I picked first; in any case the dessert menu was okay but somehow lacked excitement.  (Three of the desserts were chocolate cake, cheesecake, and chocolatecheese cake.)  The waiters were entirely polite, but they forgot a salad and had to be reminded; they forgot a tea and we didnt bother reminding them.

And what happened to the web site for Sogas?  Finedining restaurants should put their menus on the web.

When I moved here in 1996, Davis only had room for two true finedining restaurants, Sogas plus one other place.  Now Sogas must compete with Osteria Fasulo, Seasons, and Tucos.  You cant expect any of them to be perfect and I respect all of them.  But the competition is stiff.  They should strive for perfection, while the new Sogas seems content with good enough.
 Users/GregKuperberg

20080214 11:28:30 nbsp I was at sogas last night, and there was a guy saying hes the owner of the bar. I just wonder if the owner is named Brian. I know theres anything could happen in bars, but claiming the ownership of a bar is pretty random. Users/helhng

20080226 10:45:29 nbsp The only place in town to go if youd like to be hit on and taken advantage of by the 52 year old owner, Cliff Mohr.  He has repeatedly had his bartenders make strong drinks for girls he is talking to, because this scumbag is either unwilling to try to get sober girls, or unable to.  If your ideal Saturday night involves having creepy old men pump strong drinks into you and then make out with you while your passed out, then Sogas is the place for you.  If you have an ounce of class or self respect, find another bar.
 Users/KelliDorey

20080306 16:51:31   Cliff is NOT the owner and has been nothing short of VERY nice to me and my friends. He has PERSONALLY given three drunk girlfriends of mine rides home and was a gentleman. They have changed the ENTIRE bouncer staff and made a big effort to make the place better in every way. Before you judge the place by a few people check them out and you will se they are wrong to slam the place. Oh, the plastic glasses they use for the club are the SAME size they use for drinks during the day. They use plastic glasses do people do not break a galss when they are drunk and cut someone bad. —ojdavis

20080306 16:53:43   Sogas was also just nominated as one of the three best places to dance by The Aggie Newspaper and one of the Best Restaurants in the Sacramento area by KCRA TV 3. Those are not easy nominations to come by. If you have any suggestions stop and talk to Cliff and he WILL listen to you. They will have a website up next week. —ojdavis
    Actually, anyone can nominate a business for the KCRA 3 contest.

20080307 12:31:29 nbsp I feel I must address some of the things said about me on this website. I am NOT the owner and have NEVER told anyone I am. I NEVER get  girls drunk and would NOT even think of doing any  such thing EVER. I take pride in Sogas and try to make sure everyone has a good time when they come in. I have given many  people rides home  after the club closes to make sure they get home safely. If you doubt this, come and talk to me instead of listening to these lies other people say about me. The girl who was accidentally double charged was not handled well by either  me or her. I told her on a Monday I needed  both receipts to fix her problem. She came back on a Thurs day yelling at me to fix it and she had given me only one receipt. She then produced the other receipt and I offered her the cash and she then said she needed a credit to her debit card. I  called John, the bartender in to fix the problem. This takes a LONG time and she became belligerent to me and started to yell at me in the front of the restaurant. I then did lose my temper and yelled back at her and I am sorry. John was able to give her a credit and  we did NOT charge her credit card ANY additional money after her bill was closed out. In fact it is impossible to do so as our computers do not have that capability once a bill has been closed.The things people say about me are VERY uncalled for and are VERY close to libel and slander. I strongly  suggest you remove them or I will take legal action . If you do not believe what I am saying, come in and talk to me in person. Users/cliff

20080307 16:34:24 nbsp If Sogas is so bad why is it so damn crowded? Users/AliceChoe

20080307 20:06:12 nbsp I hate Sogas (bar) as much as the next guy, but I sometimes find myself there. Due to its former popularity, people still feel the need to go there, if only to stop by for a single drink. Not long ago, I made one of those forgettable visits to Sogas. It wasnt extremely crowded, but the air was still clouded in sweat vapor. Anyway, I forgot to close my tab before moving on to another bar. The next day I went back to close my tab and pick up my card. I ran in to ask for it, and the same bartender who had helped me the night before took a look around the bar for a couple minutes and said that he couldnt find it. He shurgged and suggested I call to cancel it and get a new card. I was shocked. I had to wait to get the attention of another bartender who took another look around, but with the same result. They lost my debit card! No apology, nothing. Whats even worse is that they somehow were still able to charge me for the transaction! With all these transaction issues, it seems like thats a problem with either one of their bartenders or the management. I think its sad that one of Davis finest restaurants has become a dirty, unruly night spot.

Oh, and for the other people leaving comments  PLEASE refrain from stereotyping people. Talking about Ghetto people and generalizing Frat guys makes you sound stupid.  Users/AndrewBianchi

20080315 13:35:27 nbsp I really hate Sogas. The lines for drinks are long, the crowds are impenetrable, the music is obnoxious, and drinks are expensive. Also, everything in the place looks like its been rubbed with ham, or is as stained as a mattress in a bythehour motel. Users/JoePomidor

20080317 17:47:13 nbsp Do the changes in hours mean that Sogas no longer offers lunch?  Users/ElleWeber

20080319 18:22:18 nbsp Sogas is closed for lunch temporarily  and is remodeling the kitchen. Users/cliff

20080321 11:24:59 nbsp I guess being a 50something gives me a different perspective than all the college kids.  My wife and I enjoy stopping by in the early evening for a drink and the Ahi Tuna.  The blended marguitas are excellent, perhaps the best in town, the bartender is helpful and competent and the tuna is great.   Users/JimStewart

20080321 17:26:22 nbsp Ive never been to Sogas for dinner, Ill have to try it sometime. The head bartender John Michael (name ?) is very professional and helpful. While the nightclub/bar at Sogas is not my scene, when I walk by its always crowded. Not to stereotype this IS true, Sogas at night is very popular with the Greek crowd (here & Froggys). There are also a number of guys that tend to hang around the dance floor just watching people, giving off a creepy vibe. But for the most part, it seems that people are having a pretty good time. Im going to have to stick up for the doormen a little, I know they can be assholes, but you have to imagine all the drunk people stumbling in the bar, all the under 21s who use their older friends IDs, and the fake IDs they have to deal with every single night. They do have a liquor license on the line. You know what youre coming for when you to go Sogas at night, go to Sophias if you want a calm, nice place to enjoy a drink with a friend. Oh, and theres sometimes a cash only bar on the patio, which is actually very nice (you can avoid long lines & some of the crowd).
 Users/davistudent

20080327 21:24:45 nbsp Was at Sogas last night  (3/26/08) and saw a rat. Dont think I will be visiting again. Users/stevie13

20080421 22:32:39 nbsp Cliff seems to spend more time monitoring his Davis Wiki page than running Sogas.  Also, I sincerely hope he tries to take legal action, because I know everything I have written on this page is true.  Id like to see him chase his tail filing a libel lawsuit against someone who has witnesses to completely corroborate what theyre saying.  I could use the laugh. Users/KelliDorey

20080509 19:44:07 nbsp Sogas has definitely gone farther and farther downhill. It used to be packed on Friday/Saturday nights. When I pass by there now, its completely empty. They gotta listen and apply the comments people have made.  Users/UCD4thyr

20080801 05:24:27 nbsp What was the fight about amongst the workers at Sogas tonight? Users/AlXBoi

20080929 10:00:57 nbsp My wife and were going to try Sogas last night, but instead elected for Chipotle after passing by a completely empty Sogas. Bored chefs.. Never good Users/Aggieanthony

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
      MODULE m_lhcal
      use m_juDFT

!*********************************************************************
!     determines the lattice harmonics for the given local
!     symmetry defined in terms of the rotation matrices.
!
!     input:  lmax     max l for lattice harmonics
!             nrot     number of operations
!             orth     rotation matrices (cartesian coordinates)
!                          ( 1,1 1,2 1,3 )( x )   ( x' )
!                          ( 2,1 2,2 2,3 )( y ) = ( y' )
!                          ( 3,1 3,2 3,3 )( z )   ( z' )
!             memd     max. members/lattice harmonic dimensioned for
!             nlhd     max. number of lattice harmonics dimensioned for
!
!     output: nlh      number of harmonic from l=0 to l=lmax
!             lnu      l value of harmonic
!             mem      number of members in lattice harmonic
!             lmnu     lm index of each member of lattice harmonic
!             c        coefficients of lattice harmonic
!
!            m. weinert                           1989/98
!*********************************************************************

      CONTAINS
      SUBROUTINE lhcal(
     >                 memd,nlhd,lmax,nrot,orth,
     <                 nlh,lnu,mem,lmnu,c)
!DEC$ NOOPTIMIZE
      USE m_constants
      USE m_gaussp
      USE m_gtest
      USE m_ylm
      IMPLICIT NONE

!---> Arguments
      INTEGER, INTENT (IN) :: memd,nlhd
      INTEGER, INTENT (IN) :: lmax           !--->    max. l to consider
      INTEGER, INTENT (IN) :: nrot           !--->    number of
      REAL,    INTENT (IN) :: orth(3,3,nrot) !--->    rotation matrices

      INTEGER, INTENT(OUT) :: nlh
      INTEGER, INTENT(OUT) :: lnu((lmax+1)**2),mem((lmax+1)**2)
      INTEGER, INTENT(OUT) :: lmnu(memd,(lmax+1)**2)
      COMPLEX, INTENT(OUT) ::    c(memd,(lmax+1)**2)

!---> Locals
      INTEGER :: j,l,lh,lm,lm0,lmmax,l2,m,mems,mp,n,nn
      REAL    :: s
      REAL    :: v(3),vr(3),ovlp(0:2*lmax)
      COMPLEX :: a(0:lmax,0:2*lmax,0:lmax)
      COMPLEX, DIMENSION((LMAX+1)**2) :: ylm,ylmr,ylms

      INTEGER :: ngpts                                           ! gaussian
      REAL    :: vgauss(3,(2*lmax+1)*(lmax+1 + mod(lmax+1,2)))   ! integration
      REAL    :: wt((2*lmax+1)*( lmax+1 + mod(lmax+1,2) ))       ! points

      REAL, PARAMETER :: del = 1.e-5 ! parameter for machine roundoff, etc
!
!--->    generate gaussian points and test
!
!$OMP MASTER
      ngpts = (2*lmax+1)*( lmax+1 + mod(lmax+1,2) )
      CALL gaussp(
     >            lmax,
     <            vgauss,wt)
      CALL gtest(
     >           lmax,ngpts,vgauss,wt)

!--->    initialize
      lmmax = (lmax+1)**2
      a = cmplx(0.0,0.0)
!
!===>    loop over gaussian integration points
!
      DO nn = 1, ngpts
         v(:) = vgauss(:,nn)
         CALL ylm4(
     >             lmax,v,
     <             ylm)
         ylms(1:lmmax) = ylm(1:lmmax)
!--->    apply rotations
         DO n =2, nrot
            vr = matmul( orth(:,:,n), v )
            CALL ylm4(
     >                lmax,vr,
     <                ylmr)
            ylms(:) = ylms(:) + ylmr(:)
         ENDDO
         ylms = ylms/nrot
!--->    obtain coefficients
         DO l = 0, lmax
            lm0 = l*(l+1)+1
            DO mp = 0,l
               a(mp,0,l) = a(mp,0,l) +
     +                  wt(nn)*conjg(ylm(lm0+mp))*real(ylms(lm0))
            ENDDO
            DO m = 1, l
               lm = lm0+m
               DO mp = 0, l
                  a(mp,m,l)   = a(mp,m,l) +
     +                  wt(nn)*conjg(ylm(lm0+mp))* real(ylms(lm))
                  a(mp,m+l,l) = a(mp,m+l,l) +
     +                  wt(nn)*conjg(ylm(lm0+mp))*aimag(ylms(lm))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
!
!===>    orthonormalize the projections for each l (many maybe zero)
!
      nlh = 0
      DO l = 0, lmax
         lm0 = l*(l+1)+1
         l2  = 2*l
         DO m = 0, l2
!--->       calculate overlaps with previous harmonics for this l
            DO j = 0, m-1
               s = real( conjg(a(0,j,l)) * a(0,m,l))
               DO mp=1,l
                  s = s + 2*real( conjg(a(mp,j,l)) * a(mp,m,l) )
               ENDDO
               ovlp(j) = s
            ENDDO
!--->       Gram-Schmidt
            DO j = 0,m-1
               a(0:l,m,l) = a(0:l,m,l) - ovlp(j)*a(0:l,j,l)
            ENDDO
!--->       normalize
            s = real( conjg(a(0,m,l)) * a(0,m,l))
            DO mp = 1, l
               s = s + 2*real( conjg(a(mp,m,l)) * a(mp,m,l))
            ENDDO
            IF (s.GT.del) THEN
               s = sqrt(s)
               a(0:l,m,l) = a(0:l,m,l)/s
!--->          store lattice harmonic
               mems = 0
               nlh = nlh + 1
               IF (nlh>nlhd+1)  CALL juDFT_error("nlhd too small",
     +              calledby="lhcal")
               lnu(nlh) = l
               IF (abs(a(0,m,l)).GT.del) THEN
                  mems = mems+1
                  IF (mems>memd)  CALL juDFT_error("memd too small"
     +                 ,calledby ="lhcal")
                  c(mems,nlh) = a(0,m,l)
                  lmnu(mems,nlh) = lm0
               ENDIF
               DO mp=1,l
                  IF( abs(a(mp,m,l)).GT.del) THEN
                     mems = mems + 1
                     IF(mems>memd)  CALL juDFT_error("memd too small"
     +                    ,calledby ="lhcal")
                     c(mems,nlh) = a(mp,m,l)
                     lmnu(mems,nlh) = lm0 + mp
                     mems = mems + 1
                     IF (mems>memd)  CALL juDFT_error("memd too small"
     +                    ,calledby ="lhcal")
                     c(mems,nlh) = ((-1.)**mp)*conjg(c(mems-1,nlh))
                     lmnu(mems,nlh) = lm0 - mp
                  ENDIF
               ENDDO
               mem(nlh) = mems
            ELSE
               a(0:l,m,l) = cmplx(0.0,0.0)
            ENDIF
         ENDDO   ! m = 0, l2
      ENDDO      ! l = 0, lmax
!
!===>    test of lattice harmonics using an arbitary point
!
      v(1) = sqrt(2.0)
      v(2) = sqrt(5.0)
      v(3) = sqrt(17.0)
!---> generate lattice harmonic for this point
      CALL ylm4(
     >          lmax,v,
     <          ylm)
      DO lh = 1, nlh
         ylms(lh) = cmplx(0.0,0.0)
         DO m = 1, mem(lh)
            ylms(lh) = ylms(lh) + c(m,lh)*ylm(lmnu(m,lh))
         ENDDO
      ENDDO
!---> rotate point and generate lattice harmonic
      DO n = 2, nrot
         vr = matmul( orth(:,:,n), v )
         CALL ylm4(
     >             lmax,vr,
     <             ylm)
         DO lh = 1, nlh
            ylmr(lh) = cmplx(0.0,0.0)
            DO m = 1, mem(lh)
               ylmr(lh) = ylmr(lh) + c(m,lh)*ylm(lmnu(m,lh))
            ENDDO
            IF ( abs(ylms(lh)-ylmr(lh)).GT.del ) THEN
               WRITE (oUnit,'(/," error for operation",i3)') n
               WRITE (oUnit,'(  " lattice harmonic   ",i3)') lh
               WRITE (oUnit,'(4f12.6)') ylms(lh),ylmr(lh)
                CALL juDFT_error("k_lv(Rr)",calledby="lhcal")
            ENDIF
         ENDDO
      ENDDO
!$OMP END MASTER
      RETURN
      END SUBROUTINE lhcal
      END MODULE m_lhcal

ext: f

max_stars_repo_name: MRedies/FLEUR

max_issues_repo_name: MRedies/FLEUR

max_forks_repo_name: MRedies/FLEUR


text:
#define NPRE 4
module amr_parameters

  ! Define real types
  integer,parameter::sp=kind(1.0E0)
#ifndef NPRE
  integer,parameter::dp=kind(1.0E0) ! default
#else
#if NPRE==4
  integer,parameter::dp=kind(1.0E0) ! real*4
#else
  integer,parameter::dp=kind(1.0D0) ! real*8
#endif
#endif
  integer,parameter::ndim=3
  integer,parameter::twotondim=2**ndim
  integer,parameter::threetondim=3**ndim
  integer,parameter::twondim=2*ndim
  ! Vectorization parameter
  integer,parameter::nvector=16
end module

max_stars_repo_name: applejwjcat/dispatch

max_issues_repo_name: applejwjcat/dispatch

max_forks_repo_name: applejwjcat/dispatch


text:
20070505 11:21:45 nbsp hey kai, thanks for your comment on the bike church page. Users/JessicaRockwell

20071009 12:29:32 nbsp Yeah, we should change the local laws to make Stop signs into Yield signs for bicyclists. Users/TimQuick


text:
      PROGRAM RELAX_TRACER
      USE MOD_ZA  ! HYCOM array I/O interface
      IMPLICIT NONE
C
C     DIAGNOSTIC/DEBUGGING VARIABLES.
C
      INTEGER        ITEST,JTEST
      COMMON/DEBUGI/ ITEST,JTEST
      SAVE  /DEBUGI/
C
C     BLKDAT VARIABLES.
C
      CHARACTER*79 CTITLE
      CHARACTER*10 CNTERM
      INTEGER      IVERSN,IEXPT,YRFLAG,K_IN,KDM,MONTH,MONTH_IN,
     +             THFLAG
      REAL*4       SIGMA(99),THBASE,TIME
C
C     I/O VARIABLES.
C
      CHARACTER PREAMBL(5)*79, DUMAMBL(5)*79,CLINE*80
      REAL*4    HMINA,HMINB,HMAXA,HMAXB
C
C     INPUT CLIM ARRAYS.
C
      REAL*4               :: ZLEV(999)
      REAL*4,  ALLOCATABLE :: TRCZ(:,:,:)
C
C     INPUT/OUTPUT ARRAYS
C
      REAL*4,  ALLOCATABLE :: PM(:,:),TRCM(:,:),TM(:,:),SM(:,:)
C
C     OTHER ARRAYS.
C
      INTEGER, ALLOCATABLE :: MSK(:,:)
      REAL*4,  ALLOCATABLE :: DEPTH(:,:),PLAT(:,:),
     +                        PKM1(:,:),WORK(:,:)
      REAL*4               :: ZI(0:999),ZIL(0:999)
C
C**********
C*
C 1)  FROM A Z-LEVEL TRACER CLIMATOLOGY ON THE HYCOM REGION GRID,
C      CREATE A 'ISOPYCNAL' CLIMATOLOGY SUITABLE FOR INPUT TO HYCOM.
C
C     IF T&S CLIM FILES ARE PROVIDED: ALSO
C
C      ONLY FOR USE WITH HYCOM 2.0.00 OR LATER.
C
C 2)  PARAMETERS:
C
C     MODEL GRID SPECIFICATION (W.R.T. PRESSURE GRID):
C
C        IDM    = 1ST DIMENSION OF MAJOR (HYCOM) MODEL ARRAYS
C        JDM    = 2ND DIMENSION OF MAJOR (HYCOM) MODEL ARRAYS
C        KZ     = NUMBER OF Z-LEVELS IN INPUT CLIMATOLOGY
C
C 3)  INPUT:
C        ON UNIT 99:  A SUBSET OF blkdat.input FROM TARGET SIMULATION
C        ON UNIT 51:  BATHYMETRY FILE
C        ON UNIT 51A: BATHYMETRY FILE
C        ON UNIT 71:  TRACER      Z-LEVEL CLIM FILE (SINGLE MONTH)
C        ON UNIT 71A: TRACER      Z-LEVEL CLIM FILE (SINGLE MONTH)
C        ON UNIT 12:  INTERFACE   LAYER   CLIM FILE (ALL 12 MONTHS)
C        ON UNIT 12A: INTERFACE   LAYER   CLIM FILE (ALL 12 MONTHS)
C        ON UNIT 13:  TEMPERATURE LAYER   CLIM FILE (ALL 12 MONTHS), OPTIONAL
C        ON UNIT 13A: TEMPERATURE LAYER   CLIM FILE (ALL 12 MONTHS), OPTIONAL
C        ON UNIT 14:  SALINITY    LAYER   CLIM FILE (ALL 12 MONTHS), OPTIONAL
C        ON UNIT 14A: SALINITY    LAYER   CLIM FILE (ALL 12 MONTHS), OPTIONAL
C     OUTPUT:
C        ON UNIT 10:  TRACER    LAYER   CLIM FILE (SINGLE MONTH)
C        ON UNIT 10A: TRACER    LAYER   CLIM FILE (SINGLE MONTH)
C        ON UNIT 21:  DUMMY HYCOM ARCHIVE FILE, OPTIONAL
C        ON UNIT 21A: DUMMY HYCOM ARCHIVE FILE, OPTIONAL
C
C 4)  A DUMMY ARCHIVE IS PRODUCED IF ENVIRONMENT VARIABLE FOR013A EXISTS.
C
C 5)  ALAN J. WALLCRAFT,  NAVAL RESEARCH LABORATORY, NOVEMBER 2004.
C*
C**********
C
      REAL*4     ZERO,ONE,RADIAN
      PARAMETER (ZERO=0.0, ONE=1.0, RADIAN=57.2957795)
C
      CHARACTER*256 CFILE
      LOGICAL       LARCHV
      INTEGER       I,J,K,KK,KZ,KZL
      REAL*4        TRCZK,TRCMIN,TRCMAX,
     +              PAVE,XAVE,XMAX,XMIN,TMIN,PMIN,ZZ,
     +              SIGMAA,ZBOT,ZTOP
C
      REAL*4  R4
      REAL*8  R8
      REAL*8  T,S
      REAL*8  SIG
      REAL*8  C1,C2,C3,C4,C5,C6,C7
C
C --- auxiliary statement for real*4 to real*8 conversion
      R8(R4)=R4
C
C --- sigma-theta as a function of temp (deg c) and salinity (mil)
C --- (polynomial fit that is cubic in T and linear in S)
      SIG(T,S)=(C1+C3*S+T*(C2+C5*S+T*(C4+C7*S+C6*T)))
C
      CALL XCSPMD
C
      CALL ZHOPEN(71, 'FORMATTED', 'OLD', 0)
      READ(71,*) !5-line header
      READ(71,*)
      READ(71,*)
      READ(71,*)
      READ(71,*)
      DO K= 1,999
        READ(71,*,END=100) !one line per level
      ENDDO
  100 CONTINUE
      KZ = K-1
      write(6,*) 'kz = ',kz
      CLOSE(71)
C
      ALLOCATE( TRCZ(KZ+1,IDM,JDM) )
      ALLOCATE(        PM(IDM,JDM) )
      ALLOCATE(      TRCM(IDM,JDM) )
      ALLOCATE(     DEPTH(IDM,JDM) )
      ALLOCATE(      PLAT(IDM,JDM) )
      ALLOCATE(      PKM1(IDM,JDM) )
      ALLOCATE(      WORK(IDM,JDM) )
      ALLOCATE(       MSK(IDM,JDM) )
C
C     OUTPUT A DUMMY ARCHIVE?
C
      CFILE = ' '
      CALL GETENV('FOR013A',CFILE)
      LARCHV = CFILE .NE. ' '
      IF     (LARCHV) THEN
        ALLOCATE(TM(IDM,JDM))
        ALLOCATE(SM(IDM,JDM))
      ENDIF
C
C     BLKDAT INPUT.
C
      CALL ZHOPEN(99, 'FORMATTED', 'OLD', 0)
C
C --- 'ctitle' = tracer field title
C
      WRITE(6,*)
      READ(99,'(A79)') CTITLE
      WRITE(6,'(A79)') CTITLE
C
C --- 'month'  = month (1 to 12)
C --- 'iversn' = hycom version number x10
C --- 'iexpt'  = experiment number x10
C --- 'yrflag' = days in year flag (0=360,1=366,2=366Jan1)
C --- 'mapflg' = map flag (0=mercator,1=rotated,2=uniform,3=beta-plane)
C --- 'idm   ' = longitudinal array size
C --- 'jdm   ' = latitudinal  array size
C --- 'itest ' = longitudinal test point location
C --- 'jtest ' = latitudinal  test point location
C --- 'kdm   ' = layer        array size
C
      WRITE(6,*)
      CALL BLKINI(MONTH, 'month ')
      WRITE(6,*)
      CALL BLKINI(IVERSN,'iversn')
      CALL BLKINI(IEXPT, 'iexpt ')
      CALL BLKINI(YRFLAG,'yrflag')
      WRITE(6,*)
      CALL BLKINI(I,     'idm   ')
      CALL BLKINI(J,     'jdm   ')
      CALL BLKINI(ITEST, 'itest ')
      CALL BLKINI(JTEST, 'jtest ')
      CALL BLKINI(KDM,   'kdm   ')
C
      IF     (I.NE.IDM) THEN
        WRITE(6,*)
        WRITE(6,*) 'ERROR - wrong IDM'
        WRITE(6,*)
        CALL ZHFLSH(6)
        STOP
      ELSEIF (J.NE.JDM) THEN
        WRITE(6,*)
        WRITE(6,*) 'ERROR - wrong JDM'
        WRITE(6,*)
        CALL ZHFLSH(6)
        STOP
      ENDIF
C
      IF     (LARCHV) THEN
        DO K= 1,8
          READ(99,*)  !skip 1 line of blkdat input
        ENDDO
C
C ---   'thflag' = reference pressure flag (0=Sigma-0, 2=Sigma-2)
        WRITE(6,*)
        CALL BLKINI(THFLAG,'thflag')
C
C ---   'thbase' = reference density (sigma units)
        WRITE(6,*)
        CALL BLKINR(THBASE,'thbase','(a6," =",f10.4," sigma")')
        WRITE(6,*)
C
        IF     (THFLAG.EQ.0) THEN
C ---     coefficients for sigma-0 (based on Brydon & Sun fit)
          C1=-1.36471E-01
          C2= 4.68181E-02
          C3= 8.07004E-01
          C4=-7.45353E-03
          C5=-2.94418E-03
          C6= 3.43570E-05
          C7= 3.48658E-05
        ELSE
C ---     coefficients for sigma-2 (based on Brydon & Sun fit)
          C1= 9.77093E+00
          C2=-2.26493E-02
          C3= 7.89879E-01
          C4=-6.43205E-03
          C5=-2.62983E-03
          C6= 2.75835E-05
          C7= 3.15235E-05
        ENDIF
      ENDIF
      CLOSE(UNIT=99)
C
C     TOPOGRAPHY INPUT.
C
      CALL ZAIOST
C
      CALL ZHOPEN(51, 'FORMATTED', 'OLD', 0)
      READ (51,'(A79)') PREAMBL
      READ (51,'(A)')   CLINE
      CLOSE(UNIT=51)
      WRITE(6,'(/(1X,A79))') PREAMBL,CLINE
C
      I = INDEX(CLINE,'=')
      READ (CLINE(I+1:),*)   HMINB,HMAXB
C
      CALL ZAIOPN('OLD', 51)
      CALL ZAIORD(DEPTH,MSK,.FALSE., HMINA,HMAXA, 51)
      CALL ZAIOCL(51)
C
      IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &        ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
        WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 /)')
     &    'error - .a and .b topography files not consistent:',
     &    '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &    '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB
        CALL ZHFLSH(6)
        STOP
      ENDIF
C
C     INITIALIZE LAND MASK.
C
      DO J= 1,JDM
        DO I= 1,IDM
          IF     (DEPTH(I,J).LT.2.0**99) THEN
            MSK(  I,J) = 1
          ELSE
            MSK(  I,J) = 0
            DEPTH(I,J) = ZERO
          ENDIF
        ENDDO
      ENDDO
C
C     CHECK ITEST,JTEST.
C
      IF     (MIN(ITEST,JTEST).GT.0) THEN
        IF     (ITEST.GT.IDM) THEN
          WRITE(6,'(/ a /)') 'error - itest > idm'
          CALL ZHFLSH(6)
          STOP
        ELSEIF (JTEST.GT.JDM) THEN
          WRITE(6,'(/ a /)') 'error - jtest > jdm'
          CALL ZHFLSH(6)
          STOP
        ELSEIF(MSK(ITEST,JTEST).EQ.0) THEN
          WRITE(6,'(/ a /)') 'error - itest,jtest is a land point'
          CALL ZHFLSH(6)
          STOP
        ENDIF
      ENDIF
C
C     LATITUDE GRID INPUT.
C
      CALL ZHOPNC(31, 'regional.grid.b', 'FORMATTED', 'OLD', 0)
      CALL ZAIOPF('regional.grid.a', 'OLD', 31)
C
      READ(31,*) ! skip idm
      READ(31,*) ! skip jdm
      READ(31,*) ! skip mapflg
      READ(31,*) ! skip plon
      CALL ZAIOSK(31)
      READ(31,'(A)') CLINE
      I = INDEX(CLINE,'=')
      READ (CLINE(I+1:),*)   HMINB,HMAXB
      CALL ZAIORD(PLAT,MSK,.FALSE., HMINA,HMAXA, 31)
      IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &        ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
        WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 /)')
     &    'error - .a and .b grid files not consistent (plat):',
     &    '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &    '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB
        CALL ZHFLSH(6)
        STOP
      ENDIF
C
C     Z-LEVEL CLIMATOLOGY INPUT.
C
      CALL ZAIOPN('OLD', 71)
      CALL ZHOPEN(71, 'FORMATTED', 'OLD', 0)
      READ (71,'(A79)') PREAMBL
      WRITE(6, '(/(1X,A79))') PREAMBL
      DO K= 1,KZ
        READ (71,'(A)') CLINE
        I = INDEX(CLINE,'=')
        READ (CLINE(I+1:),*) ZLEV(K),HMINB,HMAXB
        IF     (HMINB.EQ.HMAXB) THEN  ! constant field
          DO J= 1,JDM
            DO I= 1,IDM
              TRCZ(K,I,J) = HMINB
            ENDDO
          ENDDO
          CALL ZAIOSK(71)
        ELSE
          CALL ZAIORD(WORK,MSK,.FALSE., HMINA,HMAXA, 71)
          IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &            ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
            WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 / a /)')
     &       'error - .a and .b tracer files not consistent:',
     &       '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &       '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB,
     &       TRIM(CLINE)
            CALL ZHFLSH(6)
            STOP
          ENDIF
          DO J= 1,JDM
            DO I= 1,IDM
              TRCZ(K,I,J) = WORK(I,J)
            ENDDO
          ENDDO
        ENDIF
      ENDDO
      CLOSE(UNIT=71)
      CALL ZAIOCL(71)
C
      TRCMIN = MINVAL(TRCZ(:,:,:))
      TRCMAX = MAXVAL(TRCZ(:,:,:))
C
C     CONVERT Z-LEVELS TO FINITE VOLUMES.
C
      ZI(0) = ZERO
      DO K= 1,KZ-1
        ZI(K) = 0.5*(ZLEV(K) + ZLEV(K+1))
      ENDDO
      ZI(KZ) = 9999.0
C
      WRITE(6,'(/A,10F7.1/(7X,10F7.1))') 'ZI = ',ZI
C
C     DIAGNOSTIC PRINTOUT.
C
      IF     (MIN(ITEST,JTEST).GT.0) THEN
        WRITE(6,*)
        DO KZL= 0,KZ
          ZIL(KZL) = ZI(KZL)
          IF     (ZI(KZL).GT.DEPTH(ITEST,JTEST)) THEN
            ZIL(KZL) = DEPTH(ITEST,JTEST)
            EXIT
          ENDIF
        ENDDO
        DO K= 1,KZL
          WRITE(6,'(A,2I5,I3,A,F8.2,A,F7.3)')
     +     'I,J,K =',ITEST,JTEST,K,
     +     '  ZIL =',ZIL(K),
     +     ' TRCR =',TRCZ(K,ITEST,JTEST)
        ENDDO
      ENDIF
C
C     INITIALIZE CLIMATOLOGY INPUT/OUTPUT.
C
      CALL ZAIOPN('NEW', 10)
      CALL ZAIOPN('OLD', 12)
C
      CALL ZHOPEN(10, 'FORMATTED', 'NEW', 0)
      CALL ZHOPEN(12, 'FORMATTED', 'OLD', 0)
C
      READ( 12,4101) PREAMBL
      PREAMBL(4) = CTITLE
      WRITE(10,4101) PREAMBL
C
      WRITE(6,*)
      WRITE(6, 4101) PREAMBL
      WRITE(6,*)
C
C     SKIP PRECEEDING MONTHS.
C
      DO K= 1,(MONTH-1)*KDM
        READ(12,*)
        CALL ZAIOSK(12)
      ENDDO
C
C     INITIALIZE INPUT AND OUTPUT FOR DUMMY ARCHIVE
C
      IF     (LARCHV) THEN
        CALL ZAIOPN('OLD', 13)
        CALL ZAIOPN('OLD', 14)
        CALL ZHOPEN(13, 'FORMATTED', 'OLD', 0)
        CALL ZHOPEN(14, 'FORMATTED', 'OLD', 0)
        READ( 13,4101) DUMAMBL
        READ( 14,4101) DUMAMBL
        DO K= 1,(MONTH-1)*KDM
          READ(13,*)
          CALL ZAIOSK(13)
          READ(14,*)
          CALL ZAIOSK(14)
        ENDDO
C
        CALL ZAIOPN('NEW', 21)
        CALL ZHOPEN(21, 'FORMATTED', 'NEW', 0)
        YRFLAG = MAX(0,MIN(2,YRFLAG))
        WRITE(21,4200) MONTH,PREAMBL(1),PREAMBL(2),
     &                 IVERSN,IEXPT,YRFLAG,IDM,JDM
        IF     (YRFLAG.EQ.0) THEN  ! 360 days, starting Jan 16
          TIME = (MONTH-1)*30.0
        ELSEIF (YRFLAG.EQ.1) THEN  ! 366 days, starting Jan 16
          TIME = (MONTH-1)*30.5
        ELSEIF (YRFLAG.EQ.2) THEN  ! 366 days, starting Jan 1
          TIME = (MONTH-1)*30.5 + 15.0
        ENDIF
        DO J= 1,JDM
          DO I= 1,IDM
            WORK(I,J) = ZERO
          ENDDO
        ENDDO
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'montg1  ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'srfhgt  ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'surflx  ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'salflx  ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'bl_dpth ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'mix_dpth',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'tmix    ',MONTH,TIME,0,  ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'smix    ',MONTH,TIME,0,  ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'thmix   ',MONTH,TIME,0,THBASE,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'umix    ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'vmix    ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'u_btrop ',MONTH,TIME,0,ZERO,XMIN,XMAX
        CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
        WRITE(21,4201) 'v_btrop ',MONTH,TIME,0,ZERO,XMIN,XMAX
      ENDIF !larchv
C
C     FIRST INTERFACE IS AT SURFACE.
C
      READ(12,'(A)') CLINE
      I = INDEX(CLINE,'=')
      READ (CLINE(I+1:),*) MONTH_IN,K_IN,SIGMA(1),HMINB,HMAXB
      IF     (MONTH_IN.NE.MONTH) THEN
        WRITE(6,'(/ a / a / a,2i3 /)')
     &    'error - intf. month not consistent',
     $    TRIM(CLINE),
     &    'month,intf_month = ',MONTH,MONTH_IN
        CALL ZHFLSH(6)
        STOP
      ENDIF
      IF     (K_IN.NE.1) THEN
        WRITE(6,'(/ a / a / a,2i3 /)')
     &    'error - intf. layer not consistent',
     $    TRIM(CLINE),
     &    'k+1,intf_k = ',1,K_IN
        CALL ZHFLSH(6)
        STOP
      ENDIF
      CALL ZAIOSK(12)
      DO J= 1,JDM
        DO I= 1,IDM
          IF     (DEPTH(I,J).GT.ZERO) THEN
            PKM1(I,J) = ZERO
          ELSE
            PKM1(I,J) = ZERO
            TRCM(I,J) = ZERO
            PM(  I,J) = ZERO
C
            DEPTH(I,J) = ZERO  ! should already be zero
          ENDIF
        ENDDO
      ENDDO
C
C     PROCESS ALL THE LAYERS.
C
      DO 810 K= 1,KDM
        IF     (K.LT.KDM) THEN
C
C         INPUT PM.
C
          READ(12,'(A)') CLINE
          I = INDEX(CLINE,'=')
          READ (CLINE(I+1:),*) MONTH_IN,K_IN,SIGMA(K+1),HMINB,HMAXB
          IF     (MONTH_IN.NE.MONTH) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - intf. month not consistent',
     $        TRIM(CLINE),
     &        'month,intf_month = ',MONTH,MONTH_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (K_IN.NE.K+1) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - intf. layer not consistent',
     $        TRIM(CLINE),
     &        'k+1,intf_k = ',K+1,K_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (HMINB.EQ.HMAXB) THEN  ! constant field
            CALL ZAIOSK(12)
            DO J= 1,JDM
              DO I= 1,IDM
                PM(I,J) = HMINB
              ENDDO
            ENDDO
          ELSE
            CALL ZAIORD(PM,MSK,.FALSE., HMINA,HMAXA, 12)
            IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &              ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
              WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 / a /)')
     &          'error - .a and .b intf. files not consistent:',
     &          '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &          '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB,
     &        TRIM(CLINE)
              CALL ZHFLSH(6)
              STOP
            ENDIF
          ENDIF
        ELSE  !k==kdm
          DO J= 1,JDM
            DO I= 1,IDM
              PM(I,J) = DEPTH(I,J)*9806.0  !lowest layer
            ENDDO
          ENDDO
        ENDIF
        IF     (LARCHV) THEN
          READ(13,'(A)') CLINE
          I = INDEX(CLINE,'=')
          READ (CLINE(I+1:),*) MONTH_IN,K_IN,SIGMA(K),HMINB,HMAXB
          IF     (MONTH_IN.NE.MONTH) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - temp. month not consistent',
     $        TRIM(CLINE),
     &        'month,temp_month = ',MONTH,MONTH_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (K_IN.NE.K) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - temp. layer not consistent',
     $        TRIM(CLINE),
     &        'k,temp_k = ',K,K_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (HMINB.EQ.HMAXB) THEN  ! constant field
            CALL ZAIOSK(13)
            DO J= 1,JDM
              DO I= 1,IDM
                TM(I,J) = HMINB
              ENDDO
            ENDDO
          ELSE
            CALL ZAIORD(TM,MSK,.FALSE., HMINA,HMAXA, 13)
            IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &              ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
              WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 / a /)')
     &          'error - .a and .b temp. files not consistent:',
     &          '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &          '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB,
     &        TRIM(CLINE)
              CALL ZHFLSH(6)
              STOP
            ENDIF
          ENDIF
          READ(14,'(A)') CLINE
          I = INDEX(CLINE,'=')
          READ (CLINE(I+1:),*) MONTH_IN,K_IN,SIGMA(K),HMINB,HMAXB
          IF     (MONTH_IN.NE.MONTH) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - saln. month not consistent',
     $        TRIM(CLINE),
     &        'month,saln_month = ',MONTH,MONTH_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (K_IN.NE.K) THEN
            WRITE(6,'(/ a / a / a,2i3 /)')
     &        'error - saln. layer not consistent',
     $        TRIM(CLINE),
     &        'k,saln_k = ',K,K_IN
            CALL ZHFLSH(6)
            STOP
          ENDIF
          IF     (HMINB.EQ.HMAXB) THEN  ! constant field
            CALL ZAIOSK(14)
            DO J= 1,JDM
              DO I= 1,IDM
                SM(I,J) = HMINB
              ENDDO
            ENDDO
          ELSE
            CALL ZAIORD(SM,MSK,.FALSE., HMINA,HMAXA, 14)
            IF     (ABS(HMINA-HMINB).GT.ABS(HMINB)*1.E-4 .OR.
     &              ABS(HMAXA-HMAXB).GT.ABS(HMAXB)*1.E-4     ) THEN
              WRITE(6,'(/ a / a,1p3e14.6 / a,1p3e14.6 / a /)')
     &          'error - .a and .b saln. files not consistent:',
     &          '.a,.b min = ',HMINA,HMINB,HMINA-HMINB,
     &          '.a,.b max = ',HMAXA,HMAXB,HMAXA-HMAXB,
     &        TRIM(CLINE)
              CALL ZHFLSH(6)
              STOP
            ENDIF
          ENDIF
        ENDIF !larchv
C
        DO J= 1,JDM
          DO I= 1,IDM
            IF     (DEPTH(I,J).GT.ZERO) THEN
C
C             ONEM IN HYCOM MKS PRESSURE UNITS IS 9806.
C
              PM(I,J) = PM(I,J)/9806.0
C
C             ALLOW FOR BATHYMETRY.
C
              DO KZL= 0,KZ
                ZIL(KZL) = ZI(KZL)
                IF     (ZI(KZL).GT.DEPTH(I,J)) THEN
                  ZIL(KZL) = DEPTH(I,J)
                  EXIT
                ENDIF
              ENDDO
C
C             FIND TRACER
C
              IF     (PM(I,J).GT.PKM1(I,J)) THEN
                SIGMAA = ZERO
                DO KK= 1,KZL
                  ZTOP   =          MAX(ZIL(KK-1),PKM1(I,J))
                  ZBOT   = MAX(ZTOP,MIN(ZIL(KK  ),PM(  I,J)))
                  SIGMAA = SIGMAA + TRCZ(KK,I,J)*(ZBOT-ZTOP)
*
*                 IF     (I.EQ.ITEST .AND. J.EQ.JTEST) THEN
*                   WRITE(6,'(A,2I5,2I3,A,4F12.4)')
*    +                'I,J,K,KK =',ITEST,JTEST,K,KK,
*    +               ' TRC,ZTOP,ZBOT,S =',
*    +               TRCZ(KK,I,J),ZTOP,ZBOT,SIGMAA
*                   CALL ZHFLSH(6)
*                 ENDIF !test point
                ENDDO
                TRCM(I,J) = SIGMAA/(PM(I,J)-PKM1(I,J))
                IF     (TRCM(I,J).LT.TRCMIN .OR.
     +                  TRCM(I,J).GT.TRCMAX     ) THEN
                  WRITE(6,*)
                  WRITE(6,*) 'ERROR - TRACER OUTSIDE RANGE'
                  WRITE(6,*) 'K,I,J = ',K,I,J
                  WRITE(6,*) 'MIN,TRC,MAX = ',
     +                       TRCMIN,TRCM(I,J),TRCMAX
                  WRITE(6,*) 'SIGMAA,THK = ',SIGMAA,PM(I,J)-PKM1(I,J)
                  WRITE(6,*)
                ENDIF
              ENDIF
            ENDIF  !DEPTH>0
          ENDDO  !J=1,JDM
        ENDDO  !I=1,IDM
C
C       STATISTICS
C
        DO J= 1,JDM
          DO I= 1,IDM
            IF     (DEPTH(I,J).LE.ZERO) THEN
              WORK(I,J) = 0.0
            ELSE
              WORK(I,J) = PM(I,J) - PKM1(I,J)
            ENDIF
          ENDDO
        ENDDO
        CALL LAYSTAT(TRCM,  WORK,IDM,JDM, TMIN,XAVE,XMAX)
        WRITE(6,8100) ' trc', TMIN,XAVE,XMAX, K,SIGMA(K)
        CALL LAYSTAT(PKM1, WORK,IDM,JDM, PMIN,XAVE,XMAX)
        WRITE(6,8100) ' inf', PMIN,XAVE,XMAX, K,SIGMA(K)
        CALL LAYSTAT(WORK, WORK,IDM,JDM, XMIN,XAVE,XMAX)
        WRITE(6,8100) ' thk', XMIN,XAVE,XMAX, K,SIGMA(K)
C
C       DIAGNOSTIC PRINTOUT.
C
        IF     (MIN(ITEST,JTEST).GT.0) THEN
          WRITE(6,*)
          WRITE(6,'(A,2I5,I3,A,F9.2,F8.2,A,F7.3)')
     +     'I,J,K =',ITEST,JTEST,K,
     +     '   INF,THK =',PKM1(ITEST,JTEST),
     +                    WORK(ITEST,JTEST),
     +     '  TRACER =',  TRCM(ITEST,JTEST)
          WRITE(6,*)
          CALL ZHFLSH(6)
        ENDIF
C
C       WRITE OUT CLIMS.
C
        CALL ZAIOWR(TRCM,MSK,.TRUE., XMIN,XMAX, 10, .FALSE.)
        WRITE(10,4102) ' trc',MONTH,K,SIGMA(K),XMIN,XMAX
C
        WRITE(6,6300) K,SIGMA(K)
        CALL ZHFLSH(6)
C
        IF     (LARCHV) THEN
C
C         WRITE OUT DUMMY ARCHIVE LAYER.
C
          DO J= 1,JDM
            DO I= 1,IDM
              WORK(I,J) = ZERO
            ENDDO
          ENDDO
          CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'u-vel.  ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          CALL ZAIOWR(WORK,MSK,.FALSE., XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'v-vel.  ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          DO J= 1,JDM
            DO I= 1,IDM
              WORK(I,J) = (PM(I,J) - PKM1(I,J))*9806.0
            ENDDO
          ENDDO
          CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'thknss  ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          CALL ZAIOWR(TM,  MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'temp    ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          CALL ZAIOWR(SM,  MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'salin   ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          DO J= 1,JDM
            DO I= 1,IDM
              WORK(I,J) = SIG( R8(TM(I,J)),R8(SM(I,J)) ) - THBASE
            ENDDO
          ENDDO
          CALL ZAIOWR(WORK,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'density ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
          CALL ZAIOWR(TRCM,MSK,.TRUE.,  XMIN,XMAX, 21, .FALSE.)
          WRITE(21,4201) 'tracer  ',MONTH,TIME,K,SIGMA(K),XMIN,XMAX
        ENDIF !larchv
C
C       PREPARE FOR NEXT K-LOOP
C
        DO J= 1,JDM
          DO I= 1,IDM
            IF     (DEPTH(I,J).GT.ZERO) THEN
              PKM1(I,J) = PM(  I,J)
            ENDIF
          ENDDO
        ENDDO
C
 810  CONTINUE  !K=1,KDM
C
      CLOSE (UNIT=10)
      CLOSE (UNIT=12)
      CALL ZAIOCL(10)
      CALL ZAIOCL(12)
      IF     (LARCHV) THEN
        CLOSE (UNIT=21)
        CLOSE (UNIT=13)
        CLOSE (UNIT=14)
        CALL ZAIOCL(21)
        CALL ZAIOCL(13)
        CALL ZAIOCL(14)
      ENDIF !larchv
      STOP
C
 4101 FORMAT(A79)
 4102 FORMAT(A,': month,layer,dens,range = ',I2.2,I4.2,F7.3,1P2E16.7)
 4200 FORMAT(
     + 'Dummy HYCOM archive from climatology for month ',I2.2,'.' /
     + A80/A80/
     + '1234567890123456789012345678901234567890',
     + '1234567890123456789012345678901234567890'/
     & I5,4X,'''iversn'' = hycom version number x10'/
     & I5,4X,'''iexpt '' = experiment number x10'/
     & I5,4x,'''yrflag'' = days in year flag'/
     & I5,4x,'''idm   '' = longitudinal array size'/
     & I5,4x,'''jdm   '' = latitudinal  array size'/
     & 'field       time step  model day',
     & '  k  dens        min              max')
 4201 FORMAT(a8,' =',i11,f11.2,i3,f7.3,1p2e16.7)
 5000 FORMAT(A40)
 5500 FORMAT(6E13.6)
 6200 FORMAT(/ 1X,'MIN,MAX I COORDS = ',F8.2,',',F8.2
     +       / 1X,'MIN,MAX J COORDS = ',F8.2,',',F8.2 /)
 6300 FORMAT(10X,'WRITING CLIM LAYER',I3,'     SIGMA =',F7.3 /)
 8100 FORMAT(1X,A,': min=',F9.2,' ave=',F9.2,' max=',F9.2,
     +   '   (k,sigma =',i3,F7.2,')')
 8200 FORMAT(' k =',I3.2,' j = ',I4.4,' to ',I4.4,
     +       ' sig =',F7.3,' lat =',F6.1,' inf =',F8.2)
C     END OF PROGRAM RELAX_TRACER
      END
      SUBROUTINE LAYSTAT(PM, THICK, IDM,JDM, PMIN,PAVE,PMAX)
      IMPLICIT NONE
C
      INTEGER IDM,JDM
      REAL*4  PM(IDM,JDM),THICK(IDM,JDM), PMIN,PAVE,PMAX
C
C --- CALCULATE STATISTICS FOR PM.
C --- ONLY WHERE LAYER THICKNESS IS AT LEAST 10 CM.
C --- AVERAGE DOES NOT ALLOW FOR VARIATION IN GRID CELL SIZE.
C
      REAL*4     TENCM
      PARAMETER (TENCM=0.1)
C
      INTEGER I,J,IJSUM
      REAL*4  PPMIN,PPMAX
      REAL*8  PPSUM
C
      PPMIN =  1.E10
      PPMAX = -1.E10
      IJSUM =  0
      PPSUM =  0.0D0
      DO J= 1,JDM
        DO I= 1,IDM
          IF     (THICK(I,J).GT.TENCM) THEN
            PPMIN = MIN( PPMIN, PM(I,J) )
            PPMAX = MAX( PPMAX, PM(I,J) )
            IJSUM = IJSUM + 1
            PPSUM = PPSUM + PM(I,J)
          ENDIF
        ENDDO
      ENDDO
      IF     (IJSUM.NE.0) THEN
        PMIN = PPMIN
        PMAX = PPMAX
        PAVE = PPSUM / IJSUM
      ELSE
        PMIN = 99.9
        PMAX = 99.9
        PAVE = 99.9
      ENDIF
      RETURN
C     END OF LAYSTAT.
      END

max_stars_repo_name: TillRasmussen/HYCOM-tools

max_issues_repo_name: TillRasmussen/HYCOM-tools

max_forks_repo_name: TillRasmussen/HYCOM-tools


text:
Maynard Skinner served on the City Council from 4/20/1966 to 4/20/1974 and 6/20/1988 to 6/20/1994.  Serving as Mayor from 1972 to 1973 and 1991 to 1992. He never held office as Mayor Pro Tem despite holding office after the new system was in place.

He is the only person to serve on the council in four different Davis Timeline/Decades decades 60s, 70s, 80s, 90s.

Maynard served as Asst. Vice chancellor of student affairs at UCD from 19711991.

Currently Maynard works as an adjunct asst. professor/ academic coordinator for the Community Connections project at CSUS.

His contributions to the City of Davis are many, but notably, conception and implementation of Central Park, the Davis Municipal Code/34 smoking codes, Davis Municipal Code/27 Save open Space, and Davis Municipal Code/6 bicycle lanes.


text:
module stats
  !> real64 statistics accumulator
  !> based on the nim std/stats module: https://nim-lang.org/docs/stats.html

  use stdlib_kinds, only: int32, dp

  implicit none
  private

  type, public                     :: acc
    integer(int32)                 :: n    = 0
    real(dp)                       :: min  = 0
    real(dp)                       :: max  = 0
    real(dp)                       :: sum  = 0
    real(dp)                       :: mom1 = 0
    real(dp)                       :: mom2 = 0
    real(dp)                       :: mom3 = 0
    real(dp)                       :: mom4 = 0

    contains

      procedure                    :: push_real, push_reala
      generic                      :: push => push_real, push_reala
      procedure                    :: clear, mean, vars, varp, stds, stdp, skews, skewp, kurts, kurtp, show

  end type

  contains

    subroutine push_real(s, x)
      !> pushes a real value x into the accumulator.
      class(acc), intent(inout)  :: s
      real(dp), intent(in)       :: x
      real(dp)                   :: m, p, delta, delta_n, delta_n2, term1
      if (s%n == 0) then
        s%min = x
        s%max = x
      else
        if (s%min > x) then
          s%min = x
        end if
        if (s%max < x) then
          s%max = x
        end if
      end if
      ! see Knuth TAOCP vol 2, 3rd edition, page 232
      s%n      = s%n+1
      s%sum    = s%sum+x
      m        = real(s%n, dp)
      p        = real(s%n-1, dp)
      delta    = x-s%mom1
      delta_n  = delta/m
      delta_n2 = delta_n*delta_n
      term1    = delta*delta_n*p
      s%mom4   = s%mom4+term1*delta_n2*(m*m-3*m+3)+6*delta_n2*s%mom2-4*delta_n*s%mom3
      s%mom3   = s%mom3+term1*delta_n*(m-2)-3*delta_n*s%mom2
      s%mom2   = s%mom2+term1
      s%mom1   = s%mom1+delta_n
    end subroutine push_real

    subroutine push_reala(s, a)
      !> pushes a real array into the accumulator.
      class(acc), intent(inout)  :: s
      real(dp), intent(in)       :: a(:)
      integer(int32)             :: i, n
      n = size(a)
      do i = 1, n
        call s%push(a(i))
      end do
    end subroutine push_reala

    subroutine clear(s)
      !> rets accumulator.
      class(acc), intent(inout)    :: s
      s%n    = 0
      s%min  = 0
      s%max  = 0
      s%sum  = 0
      s%mom1 = 0
      s%mom2 = 0
      s%mom3 = 0
      s%mom4 = 0
    end subroutine clear

    function mean(s) result(r)
      !> computes the current mean of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = s%mom1
    end function mean

    function varp(s) result(r)
      !> computes the current population variance of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      if (s%n > 1) then
        r = s%mom2/real(s%n, dp)
      else
        r = 0
      end if
    end function varp

    function vars(s) result(r)
      !> computes the current sample variance of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      if (s%n > 1) then
        r = s%mom2/real(s%n-1, dp)
      else
        r = 0
      end if
    end function vars

    function stdp(s) result(r)
      !> computes the current population standard deviation of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = sqrt(varp(s))
    end function stdp

    function stds(s) result(r)
      !> computes the current sample standard deviation of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = sqrt(vars(s))
    end function stds

    function skewp(s) result(r)
      !> computes the current population skewness of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = sqrt(real(s%n, dp))*s%mom3/s%mom2**1.5
    end function skewp

    function skews(s) result(r)
      !> computes the current sample skewness of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r, s2
      s2 = skewp(s)
      if (s%n > 2) then
        r = sqrt(real(s%n*(s%n-1), dp))*s2/real(s%n-2, dp)
      else
        r = 0
      end if
    end function skews

    function kurtp(s) result(r)
      !> computes the current population kurtosis of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = real(s%n, dp)*s%mom4/(s%mom2*s%mom2)-3.0_dp
    end function kurtp

    function kurts(s) result(r)
      !> computes the current sample kurtosis of the accumulator.
      class(acc), intent(in)       :: s
      real(dp)                     :: r
      r = real(s%n-1, dp)/real((s%n-2)*(s%n-3), dp)*(real(s%n+1,dp)*kurtp(s)+6)
    end function kurts

    subroutine show(s)
      !> print stats.
      class(acc), intent(in)       :: s
      print *            , ""
      print "(a25)"      , "running stats"
      print "(25a)"      , repeat("-", 25)
      print "(a12, i13)"  , "n:"          , s%n
      print "(a12, f13.3)", "mean:"       , s%mean()
      print "(a12, f13.3)", "min:"        , s%min
      print "(a12, f13.3)", "max:"        , s%max
      print "(a12, f13.3)", "sum:"        , s%sum
      print "(a12, f13.3)", "stdev, p:"   , s%stdp()
      print "(a12, f13.3)", "stdev, s:"   , s%stds()
      print "(a12, f13.3)", "skewness, p:", s%skewp()
      print "(a12, f13.3)", "skewness, s:", s%skews()
      print "(a12, f13.3)", "kurtosis, p:", s%kurtp()
      print "(a12, f13.3)", "kurtosis, s:", s%kurts()
      print "(25a)"      , repeat("-", 25)
    end subroutine show

end module stats

max_stars_repo_name: freevryheid/stats

max_issues_repo_name: freevryheid/stats

max_forks_repo_name: freevryheid/stats