text:
! MIT License
!
! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
!
! 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.
!
! HOHQMesh contains code that, to the best of our knowledge, has been released as
! public domain software:
! * `b3hs_hash_key_jenkins`: originally by Rich Townsend,
!    https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
! * `fmin`: originally by George Elmer Forsythe, Michael A. Malcolm, Cleve B. Moler,
!    Computer Methods for Mathematical Computations, 1977
! * `spline`: originally by George Elmer Forsythe, Michael A. Malcolm, Cleve B. Moler,
!    Computer Methods for Mathematical Computations, 1977
! * `seval`: originally by George Elmer Forsythe, Michael A. Malcolm, Cleve B. Moler,
!    Computer Methods for Mathematical Computations, 1977
!
! --- End License
!
!////////////////////////////////////////////////////////////////////////
!
!      SMSplineCurveClass.f90
!      Created: July 31, 2013 12:27 PM
!      By: David Kopriva
!
!////////////////////////////////////////////////////////////////////////
!
      Module SMSplineCurveClass
      USE SMCurveClass
      USE SMConstants
      IMPLICIT NONE
!
!     ---------------------
!     Class type definition
!     ---------------------
!
      TYPE, EXTENDS(SMCurve) :: SMSplineCurve
         INTEGER                                  :: numKnots
         REAL(KIND=RP), DIMENSION(:), ALLOCATABLE :: bX,cX,dX
         REAL(KIND=RP), DIMENSION(:), ALLOCATABLE :: bY,cY,dY
         REAL(KIND=RP), DIMENSION(:), ALLOCATABLE :: bZ,cZ,dZ
         REAL(KIND=RP), DIMENSION(:), ALLOCATABLE :: t, x, y, z
!
!        ========
         CONTAINS
!        ========
!
         PROCEDURE :: initWithPointsNameAndID
         FINAL     :: destructSplineCurve
         PROCEDURE :: positionAt => positionOnSplineCurveAt
         PROCEDURE :: className  => SplineClassName
      END TYPE SMSplineCurve

      PRIVATE :: spline, seval, swapOrder
!
!     ========
      CONTAINS
!     ========
!
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE initWithPointsNameAndID( self, t, x, y, z, curveName, id )
         USE Geometry
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(SMSplineCurve)        :: self
         REAL(KIND=RP), DIMENSION(:) :: x, y, z, t
         CHARACTER(LEN=*)            :: curveName
         INTEGER                     :: id
!
!        ---------------
!        Local variables
!        ---------------
!
         INTEGER       :: N, nDim
         REAL(KIND=RP) :: xx(2,SIZE(x))
         INTEGER       :: circ, j
!
!        -----------------------------
!        Check orientation of the data
!        -----------------------------
!
         N       = SIZE(x)
         xx(1,:) = x
         xx(2,:) = y
         circ = Circulation(x = xx)
         IF(circ == CLOCKWISE)     THEN
            CALL swapOrder(x = x,N = N)
            CALL swapOrder(x = y,N = N)
            CALL swapOrder(x = z,N = N)
            CALL swapOrder(x = t,N = N)
            DO j = 1, N
               t(j) = 1.0_RP - t(j)
            END DO
         END IF

         CALL self % SMCurve % initWithNameAndID(curveName,id)

         nDim           = N
         self%numKnots  = N

         ALLOCATE( self%bX(N) )
         ALLOCATE( self%cX(N) )
         ALLOCATE( self%dX(N) )
         ALLOCATE( self%bY(N) )
         ALLOCATE( self%cY(N) )
         ALLOCATE( self%dY(N) )
         ALLOCATE( self%bZ(N) )
         ALLOCATE( self%cZ(N) )
         ALLOCATE( self%dZ(N) )
         ALLOCATE( self%t(N) )
         ALLOCATE( self%x(N) )
         ALLOCATE( self%y(N) )
         ALLOCATE( self%z(N) )

         self%t = t
         self%x = x
         self%y = y
         self%z = z

         CALL spline( N, nDim, t , x, self%bX, self%cX, self%dX )
         CALL spline( N, nDim, t , y, self%bY, self%cY, self%dY )
         CALL spline( N, nDim, t , z, self%bZ, self%cZ, self%dZ )

      END SUBROUTINE initWithPointsNameAndID
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE DestructSplineCurve( self )
         IMPLICIT NONE
         TYPE(SMSplineCurve)           :: self

         self%numKnots = 0

      END SUBROUTINE DestructSplineCurve
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE releaseSplineCurve(self)
         IMPLICIT NONE
         TYPE (SMSplineCurve) , POINTER :: self
         CLASS(FTObject), POINTER :: obj

         IF(.NOT. ASSOCIATED(self)) RETURN

         obj => self
         CALL releaseFTObject(self = obj)
         IF ( .NOT. ASSOCIATED(obj) )     THEN
            self => NULL()
         END IF
      END SUBROUTINE releaseSplineCurve
!
!////////////////////////////////////////////////////////////////////////
!
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>  ### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className = "Spline")
!>
      FUNCTION SplineClassName(self)  RESULT(s)
         IMPLICIT NONE
         CLASS(SMSplineCurve)                       :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s

         s = "Spline"
         IF( self % refCount() >= 0 ) CONTINUE

      END FUNCTION SplineClassName
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE castCurveToSplineCurve(obj,cast)
!
!     -----------------------------------------------------
!     Cast the base class FTObject to the FTValue class
!     -----------------------------------------------------
!
         IMPLICIT NONE
         CLASS(SMCurve)      , POINTER :: obj
         CLASS(SMSplineCurve), POINTER :: cast

         cast => NULL()
         SELECT TYPE (e => obj)
            CLASS IS(SMSplineCurve)
               cast => e
            CLASS DEFAULT

         END SELECT

      END SUBROUTINE castCurveToSplineCurve
!
!////////////////////////////////////////////////////////////////////////
!
      FUNCTION positionOnSplineCurveAt( self, t ) RESULT(x)
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS( SMSplineCurve )      :: self
         REAL(KIND=RP)               :: t
!
!        ---------------
!        Local variables
!        ---------------
!
         REAL(KIND=RP), DIMENSION(3) :: x
         INTEGER                     :: N, nDim

         N    = self%numKnots
         nDim = N

         x(1) = seval( nDim, N, t, self%t, self%x, self%bX, self%cX, self%dX )
         x(2) = seval( nDim, N, t, self%t, self%y, self%bY, self%cY, self%dY )
         x(3) = seval( nDim, N, t, self%t, self%z, self%bZ, self%cZ, self%dZ )

      END FUNCTION positionOnSplineCurveAt
!
!///////////////////////////////////////////////////////////////////////
!
   SUBROUTINE spline(ndim,n,x,y,b,c,d)
!
!     .. scalar arguments ..
      integer n,ndim
!     ..
!     .. array arguments ..
      REAL(KIND=RP) :: b(ndim),c(ndim),d(ndim),x(ndim),y(ndim)
!     ..
!     .. local scalars ..
      REAL(KIND=RP) :: t
      integer i,ib,nm1
!     ..
      nm1 = n - 1
!
!      set up tri-diagonal system
!
      d(1) = x(2) - x(1)
      c(2) = (y(2)-y(1))/d(1)
      do 100 i = 2,nm1
          d(i) = x(i+1) - x(i)
          b(i) = 2* (d(i-1)+d(i))
          c(i+1) = (y(i+1)-y(i))/d(i)
          c(i) = c(i+1) - c(i)
  100 continue
!
!      end conditions
!
      b(1) = -d(1)
      b(n) = -d(n-1)
      c(1) = c(3)/ (x(4)-x(2)) - c(2)/ (x(3)-x(1))
      c(n) = c(n-1)/ (x(n)-x(n-2)) - c(n-2)/ (x(n-1)-x(n-3))
      c(1) = c(1)*d(1)**2/ (x(4)-x(1))
      c(n) = -c(n)*d(n-1)**2/ (x(n)-x(n-3))
!
!     forward elimination
!
      do 200 i = 2,n
          t = d(i-1)/b(i-1)
          b(i) = b(i) - t*d(i-1)
          c(i) = c(i) - t*c(i-1)
  200 continue
!
!     back substitution
!
      c(n) = c(n)/b(n)
      do 300 ib = 1,nm1
          i = n - ib
          c(i) = (c(i)-d(i)*c(i+1))/b(i)
  300 continue
!
!     compute polynomial coefficients
!
      b(n) = (y(n)-y(nm1))/d(nm1) + d(nm1)* (c(nm1)+2.d0*c(n))
      do 400 i = 1,nm1
          b(i) = (y(i+1)-y(i))/d(i) - d(i)* (c(i+1)+2.d0*c(i))
          d(i) = (c(i+1)-c(i))/d(i)
          c(i) = 3.d0*c(i)
  400 continue
      c(n) = 3.d0*c(n)
      d(n) = d(n-1)
!
      return

   END SUBROUTINE spline
!
!///////////////////////////////////////////////////////////////////////
!
   REAL(KIND=RP) FUNCTION seval(ndim,n,u,x,y,b,c,d)
!
!     .. scalar arguments ..
      REAL(KIND=RP) :: u
      integer n,ndim
!     ..
!     .. array arguments ..
      REAL(KIND=RP) :: b(ndim),c(ndim),d(ndim),x(ndim),y(ndim)
!     ..
!     .. local scalars ..
      REAL(KIND=RP) :: dx
      integer i,j,k
!     ..
!     .. save statement ..
      save i
!     ..
!     .. data statements ..
      data i/1/
!     ..
!
      if (i.ge.n) i = 1
      if (u.lt.x(i)) go to 100
      if (u.le.x(i+1)) go to 300
  100 continue
      i = 1
      j = n + 1
  200 continue
      k = (i+j)/2
      if (u.lt.x(k)) j = k
      if (u.ge.x(k)) i = k
      if (j.gt.i+1) go to 200
!
!     evaluate spline
!
  300 continue
      dx = u - x(i)
      seval = y(i) + dx* (b(i)+dx* (c(i)+dx*d(i)))
!
      return

   END FUNCTION seval
!
!////////////////////////////////////////////////////////////////////////
!
      SUBROUTINE swapOrder(x,N)
         IMPLICIT NONE
         INTEGER       :: N
         REAL(KIND=RP) :: x(N)
         INTEGER       :: j
         REAL(KIND=RP) :: tmp

         DO j = 1, N/2
            tmp      =  x(N-j+1)
            x(N-j+1) = x(j)
            x(j)     = tmp
         END DO

      END SUBROUTINE swapOrder
      END Module SMSplineCurveClass

max_stars_repo_name: HigherOrderMethods/HOHQMesh

max_issues_repo_name: HigherOrderMethods/HOHQMesh

max_forks_repo_name: HigherOrderMethods/HOHQMesh


text:
20091124 13:43:15 nbsp What was inaccurate on Ari Kalfayan? You cant just delete things you dont like on here. In the future, please add to the pages you edit, dont gut them.

You may have written some useful information. However, as long as you replace the page wholesale, it will just have to be put back as it was. I have neither the time nor patience to integrate this information.

P.S. You dont have to keep on creating new accounts.
 Users/WilliamLewis

20091124 13:52:34 nbsp 1. the old account was under my UC Davis email address and has been deleted.  My new username is dlabs.  the changes made last weekend were not by me but a separate user who is familiar with the situation.

To find an adequate solution, lets integrate the old page and updated page and also create discussion page separate from Ari Kalfayan for the now outdated conversation from 2005.  This is important since there are multiple statements on the page that are slanderous as well as inaccurate.  i believe a discussions page will reflect the conversation as exactly that, not fact as it seems on the current page.  how does that sound? Users/dlabs

20091124 13:53:37 nbsp Discussion pages are for discussing the page in question, not discussing the subject the page is about. For example, if you want to discuss the edits you want to make to Ari Kalfayan, you would discuss this at Ari Kalfayan/Talk. However, if you want to talk about Ari Kalfayan himself, it would go on Ari Kalfayan.

Also, why do you need to clean up the page? Anyway, by clean up, you seem to mean removing the opinions of others that reflect negatively on Ari. Its not like people are claiming Ari eats babies for lunch every day and being absolutely serious about it. If anything is being said that is factually incorrect, thats another issue.

Anyway, please write about your concerns at Ari Kalfayan/Talk. Users/WilliamLewis

20091124 14:11:08 nbsp You are claiming that there are slanderous statements on Ari Kalfayan.

Slander is spoken, ephemeral defamation. If anything, you must be alleging libel, which is defamation put into a fixed medium.

The elements of libel are as follows
 1. There must be a statement.
 1. The statement must name a specific person or group or imply a specific person or group.
 1. The statement must be false.
 1. The statement must be disseminated.
 1. The statement must cause injury.

Additionally, libel against a public figure must be made with actual malice. As an ASUCD senator, Ari counts as a public figure here.

I see plenty of statements on the page that name Ari in particular. These statements are being disseminated. The actual injury and actual malice here are dubious, but for the sake of argument, Ill give you those two as well.

The remaining element is the factual correctness of the statements.

The factual statements on the page are as follows.

  Ari Kalfayan was an ASUCD senator.
  Ari was the president of SOS.
  Ari was affiliated with Student Focus.
  Ari used a laptop at an ASUCD senate meeting.
  Travis Grathwell claims that Ari was using AIM during a senate meeting.
  Jenn del la Vega and Kristen Birdsall requested that Ari not use his laptop during senate meetings.
  Ari claimed he needed to use his laptop to look things up during the meeting.
  Ari said he wouldnt stop using his laptop during senate meetings unless a bill was passed to that effect.
  A bill was passed to that effect, 111, with the sole opposing vote coming from Ari.

If any of these statements are incorrect, please let me know. If I missed a factual statement that you believe to be incorrect, please let me know as well.
  Users/WilliamLewis

20091124 15:13:36 nbsp I have updated the content of the page to include pertinent personal information as well as updated the picture.

My recommendation based on your notes is to move the discussions on the laptop usage to a page called Ari Kalfayan laptop usage because the discussions is on laptop usage, not about Ari Kalfayan as a person.

Furthermore, based on your guidelines, the quotes that people have written are inaccurate and harmful, thus I would ask for them to be removed.

I would also ask you to change the picture to the current picture provided as the page is on Ari kalfayan, not Ari Kalfayan Senator.   Users/dlabs
 There is no good reason to create a page on Aris laptop usage. Its pretty notable that the senate had to pass a bill on it. Thus, it belongs on the main page.

 Furthermore, if you are going to claim that there is anything inaccurate on the page, please state EXACTLY what youre talking about. Its getting frustrating when you continue to say things are wrong on the page and yet you refuse to identify what they are. This is the last time I am going to ask you to put up or shut up. Ive listed all the statements of fact so it should be easy for you to pick the ones you believe to be false.

 Finally, the page on Ari here is about him as he relates to Davis. It seems the most notable thing he did here was being a Senator in ASUCD. The information on what he is doing now is nice in a where are they now? kind of way, but it should not be the focus of the page as this wiki is about Davis. wl

20091124 16:10:43 nbsp I repeat myself:

Identify the specific statements on Ari Kalfayan that you believe to be false.

Further discussion with you is fruitless unless you do this or you admit that you do not believe any statement on the page to be false.

 Users/WilliamLewis

20091124 17:39:50 nbsp Lets start from the begining

I dont care what you think. Theres no rule against it, and until you write a pointless bill to make it so I cant use my laptop I will continue to use it.  This was not a direct quote.  The conversation was longer than what is quoted.  The gist of the conversation was that I did not agree with their opinion and that laptop usage was allowed.  I did not say I dont care what your think.

If you were to paraphrase the statement rather than quote it, it would follow the rest of the conversation more closely.  Based on that comment, I am called an ass which is a personal attack.

The statement Senators wrote a bill to keep Kalfayan from using his laptop. It passed 111, with Kalfayan voting No.: is false.  Kirsten Birdsal who authored the bill wrote  for note, its not necessarily against him.

Although I acknowledge that I am the catalyst of the Laptop Usage discussion, the author of the bill directly states that the Laptop bill was not a personal attack thus the conversation should be moved off the Ari Kalfayan page. At the time, this discussions was pertinent to the senate and the students involved.  Looking at this almost 5 years later, the subject is not Ari Kalfayan Laptop Usage, but is the brown act and how to protect the integrity of ASUCD as a institution.  The discussion then turns to Ari Kalfayan ASUCD Senator vs Ari Kalfayans personal page.

For my purposes, I would ask you to either allow me to change the main picture to my own or the picture of the senate meeting with my laptop in front of me.  Is there a problem with my recommendation?

These are the minutes from the meeting.  If we are going to frame this discussion, lets make sure its accurate and titled appropriately.

Kalfayan said I am using the computer unless you pass legislation that states otherwise. It has helped me in the past. I disagree with passing something else thats useless. I really feel that there are some things that we shouldnt be passing. Considering that we have spent an hour and thirty minutes on events, I cant even really concentrate on whats at hand. There are thirteen and fourteen events thrown at me at one time during public announcements, with all these dates and times that it is really easy to get lost. I really want a different way of doing this, thats how I feel. Users/dlabs

20091124 18:24:33 nbsp Thank you for identifying the statement you believe to be false, namely that Senators wrote a bill to keep Kalfayan from using his laptop. It passed 111, with Kalfayan voting No. You justify your belief that this statement is false by noting that Kirsten Birdsal, who authored the bill, wrote that for note, its not necessarily against him.

After reviewing the minutes from that meeting, reading what other people have written about the meeting, and consulting with people who were at the meeting, it is clear to me that while the bill does not name Ari specifically and numerous senators said the bill was to deal with issues besides Aris use, the bill was written in response to Aris actions. Numerous people who were in attendance attest that Ari was specifically asked not to use a laptop during the meeting. When he responded that it would take a bill to prevent him from doing so, such a bill was written and passed, with Ari providing the sole dissenting vote. The alternative you present is present on the page already.

If you have any other statements of fact that you dispute, please mention them. In the future, however, I ask that you not allege defamation without identifying precisely what you believe to be defamatory. If you dont do that, we cant work with you and your removals of alleged defamation will simply be undone if it isnt obvious why what you removed is defamation. Also, defamation doesnt mean stuff that you dont like that youre trying to remove. Please dont use this term to mean that again.

As for personal attacks, someone calling someone else an ass for specific things theyve done is generally allowed here. Thats Arlens opinion and hes entitled to it. He stands by his words under his real name, in fact.

As for the picture, again, please remember that Davis Wiki is about Davis and not just people who once went to school here. You will be primarily remembered in Davis as an ASUCD senator, not for what you are doing now.  Users/WilliamLewis

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
Nahzi is a local Beauty Salons and Barber Shops stylist who provides a variety of services, including haircuts, coloring, highlights, lowlights, threading,extensions,  styles, chemical straightening, permanent wave, and facial waxing.

  To learn about other businesses in Davis that provide professional aesthetic services, visit our Beauty Salons and Barber Shops page.

20100508 17:49:46 nbsp Nahzi is great! I went to her to get my eyebrows threaded and she did an amazing job! Other places Ive gone to have only spent 510 minutes, but she takes her time and is really good at knowing what shape fits your face.  Users/rlwindmill

20100509 17:15:34 nbsp Nahzi is absolutely wonderful. I get my eyebrows threaded at Exclusives, and I love it. A good friend recommended Nahzi to me after another place completely messed up my eyebrows. My eyebrows were completely uneven and looked terrible, I had no idea what to do. I went to Nahzi and she took the time to measure out the perfect arch for me, as well as let me know what areas to let grow. After just two appointments my eyebrows looked substantially better, and now they are better than they have ever been! She is a miracle worker! Users/kmcwilliams

20100522 09:45:35 nbsp I have been going to Nahzi for over a year now for my eyebrows and haircuts. She is so friendly and her work has always been flawless!!!  Everyone always compliments me on the shape of my eyebrows!!! She threads them for me once every four weeks.  I highly recommend her.  Users/Negin

20100524 16:16:53 nbsp I have been going to Nahzi for over a year now and I love her professional work ethic and positivity. She has provided me with wonderful threading and waxing services and I am always happy with her work. She also styled me and my friends hair for prom and it turned out so amazing! I would definitely recommend her if you are looking for an experienced professional to provide you with flawless work. Shes great!!     Users/Sadaf

20100609 16:59:36 nbsp I have been going to Nahzi for threading for over a year and a half, and she is fabulous!  Another salon (not in Davis) had completely butchered my eyebrows, and Nahzi worked at them meticulously until they made a comeback.  Now they are beautifully shaped.  She always takes her time and does a great job.  I highly recommend her services. Users/gillianc

20100609 20:20:19 nbsp I went to Nahzi today for eyebrow threading, and she did an amazing job.  She has quite a light hand so most of the hand motions felt like a massage.  I will definately be going back to her.  She is also a sweet person, and very easy to talk to. Users/onlyleo

20100807 12:31:08 nbsp I have been going to Nahzi for two years for hair cuts and color.  No one else has gotten it so right so often.  She takes the time to make it perfect.  Shes talented, easy to talk to, and really cares about her clients.  Once you try her, youll never look back.   Users/Carolynmwood

20100808 11:33:00 nbsp Throughout may life I have been to many hair salons in SF and NYC and now Davis.  Nahzi was recommended to me after I grew tired of having my former stylist misstyle my hair and be so rough on my scalp.  Nahzi took the time to ask what I was looking for...she does an excellent job styling and dyeing my hair and she introduced me to the art of threading...she made my eyebrows perfect and I also had her thread my face...much better results than waxing and no breakouts afterword...it stimulates the collagen and gives you the benefit of exfoliation and skin firming immediatelyLOVE IT!  Nahzis calm manner has you on your way looking beautiful and relaxed...and her prices wont make you flinch.   Users/PilarRivera

20101023 10:09:10 nbsp Nahzi,  Just wanted to let you know that you are the best.  I always get compliments about my hair color and cut.  People really need to try your services.  You are extremely knowledgeable in doing hair color to perfection.  Also, to please my cousin is a feat!!  So that again tells, you are the best, because you are first one in California to please her.  Thank you!  M.Jenkins  Users/MariaJenkins

20101105 22:03:32 nbsp Ive been going to Nahzi for eyebrow threading for over a year now.  Even during the 14 months I was working and living in San Antonio,TX Nahzi always took care of me on my trips home.  She is always available to make you look fab. Attention to detail makes Nahzi standout amoung other stylist, she is in a league of her own.  Thank you Nahzi! Users/ShirleyS

20101123 18:29:33 nbsp I love Nahzi!!! I am very very picky about my eyebrows and I always leave happy after my appointment with Nahzi. She really works with you on what kind of look you are trying to accomplish. Plus, Nahzi does not try to rush your appointment (unlike other places I have been to). She is very friendly & professional. I highly recommend her! Users/JessicaJ

20110117 16:06:59 nbsp in my opinion she charged me a lotshe charged me $15 i dont know if its just me. it was a good job but i had done before for a lot less than that. Users/edna5

20110206 11:40:17 nbsp Nahzi is so professional. Im so picky about my eyebrows but she did a great job on them! I highly recommend her. Users/SusanEjlalmaneshan

20111116 15:59:25 nbsp I absolutely LOVE Nahzi! My eyebrows were a mess and shes been diligently working on them for the past few months and theyve never looked better! My favorite thing about Nahzi is that she really takes her time working on your eyebrows never rushing and trying to get you out of there like other threading salons. I would highly recommend Nahzi, she really knows what shes doing and knows exactly what looks good with your face!  Users/FatimaBaig1

20111214 21:59:08 nbsp Nahzi is wonderful she took her time to correct the mistake made by another person that did my eyebrows, helped reshape them, and did an awesome job! I love that she gives a consultation before you start so she knows what you want, gives her recommendations, and you know exactly what will happen. I prefer my eyebrows thicker, more natural, with a slight arch. In the past I had people just rush through, miss hairs, and butcher my poor eyebrows then have me take a look when their already bad; not the case with Nahzi. For Davis she is fairly priced at $15 and it is worth it because your eyebrows are very important to balance your face, and really makes a difference in your confidence when they are well done. I have gotten my eyebrows threaded for $12, but I dont mind paying more when its such a good job. I highly recommend her eyebrow threading services, and you can tell she really cares about the customer looking their best. I will provide an update as soon as I grow out my hair and get a haircut from her. The salon is also nice and clean.....I definitely feel confident going back for a haircut, since she is very meticulous with eyebrows, I have no doubt in her abilities to cut hair (checking around town those prices are better too, and she told me she has over 20 yrs experience). Only thing make sure you bring cash; no credit cards. Just finished my 1st quarter at UC Davis, and being new to the area daviswiki has been a lifesaver in finding these wonderful services. Users/Michellex79

20120128 13:08:33 nbsp Michellex79 was my user name but cannot remember the password. So here are a few updates:

Got my hair done very satisfied, and thanks to her suggestions on hair products it truly makes my hair healthy and provides essential nutrients it was lacking since it was dry. I received a color/cut, and the hair is very natural brown matching my original, so as it grows I love it more and more. She fixed the layer mistakes from a previous stylist and my hair is great. She recommended several hair products, and these have made my hair look healthy, soft, and the color wonderful. Prices are fair you would have to speak to her depending on what you want, but she is very good at discussing options during your consultation.
Correction on previous cash only statement, she just doesnt accept credit cards as far as forms of payment.
Eyebrows are definitely looking better than when I first started, still a work in progress but I am more impressed every visit. I prefer everything very natural looking and low maintenance, thanks to her techniques I can just comb my hair and go to school without much effort. I use to straighten it which would take long since it has a natural wave, but its not frizzy and so easy to maintain now. Nothing more to say except she is the best in Davis, and makes every effort to make sure you look your best as well. Users/MichelleRx7

20120221 12:35:41 nbsp I went to Nahzi for a haircut. Great service, did a good job,and listened to what I wanted. She explained to me exactly how she was going to cut my hair and in the end it turned out great. I love my new haircut! Users/Krissun

20120314 20:55:16 nbsp I have been going to Nahzi for about two months to get my eyebrows threaded, and she does an amazing job!  She spends a great amount of time with me each visit, and never makes me feel rushed.  Her work is so much nicer than the quickie threading places or any waxing place Ive ever been to.  My eyebrows have looked better every time Ive gone, even though it does take a little bit of time for them to grow enough for her to shape them.  Im very happy I found her, and will keep going back.   Users/BrittanyL

20120428 14:40:14 nbsp Nahzi is amazing! I have been going to her for about two years to get my eyebrows threaded. She is very kind and always spends a lot time making sure the shape of the eyebrow is perfect for your face. She definitely does the best job on my eyebrows of any salon I have every gone to. I am so glad I found her!  Users/rlwindmill

20120506 22:18:44 nbsp Ive been going to Nahzi for threading for over a year now, and she consistently does a great job. I used to get my eyebrows waxed, and after a bad wax job (and some skin issues) I decided to go to her to get my eyebrows threaded for the first time. Shes has a lot of patience, shes sensitive, and Ive always felt that she pays close attention to what shes doing and really wants to make you look good.
In addition, Ive gotten a haircut from her to fix a bad haircut from another stylist and it was very well done! She did an amazing job listening and trying to convey what she was going to do, so theres no surprises.
I go back to her because shes good at listening, shess good and she knows what shes doing, and she does her best to make you look good! And it shows. Users/RachelR

20130220 15:13:33 nbsp Ive been going to Nahzy about 7 months now.  Im the rare hairy Asian woman so even my facial hair is thick and dark.  (If I could afford it, Id do laser removal).  Tried waxing my face last summer and my sensitive skin reacted horribly to the wax, plus my face broke out like crazy.  Was afraid to try anything else, but decided to try threading and picked Nahzy because of these wiki reviews.  She was very gentle, and results were great.  Had a bad hair dye job from another salon so decided to have her try my hair since her reviews were good.  The cut was good and the color was perfect (Id been trying for months with my other stylist and never got the color right).  Shes been doing my hair and face ever since.  Shes very nice, easy to talk to and makes even this hairy beast feel like a girl again.  :) Users/xtine

20140301 11:59:38 nbsp Were sitting here at Nhazis salon and Im watching my mom get threaded. I just had my eyebrows done and I gotta say, Ive honestly never had any eyebrow work done by anyone ever that made me feel as good about my eyebrows as Nhazi has just now. I have arches now! And being in Nhazis company is very comfortable. For as meticulous and attentive she is, its definitely worth the $15! Ill be back before my brows get all furry again! Thanks Nhazi!

 Users/Arcamedes123

20140610 09:49:19 nbsp I recently called Nahzi hoping to get an appointment in later that day, due to a job interview the next day. She was able to squeeze me in at a time that fit my schedule, and did an excellent job threading my eyebrows. Ill be making my appointments with her a regular occurrence, and I definitely recommend her. Users/Killbasa


text:
      subroutine route
c
c     + + + PURPOSE + + +
c     Calculates detachment (when shear stress exceeds critical shear
c     stress) or deposition at the upper end of the slope segment and
c     routes sediment through the hillslope profile.
c
c     Called from subroutine CONTIN.
c     Author(s): G. Foster, M. Nearing, D. Flanagan
c     Reference in User Guide:
c
c     Changes: 1) Since MSHEAR is a discrete integer variable (flag),
c                 computed GOTO's were substituted for IF's with .LE.'s
c                 to handle cases in "deposition at upper end of segment"
c                 section, and in "detachment at upper end of segment"
c                 section.  This seemed to reduce the runtime by about
c                 3-5% (A 9.9-10.0 second run was reduced to 9.5 seconds.)
c              2) Variable ERD was deleted.
c              3) KTRATO & QOSTAR were added to the argument lists of
c                 functions DEPEND & DEPC, to eliminate the need for
c                 them to access common blocks.
c              4) In the third call to EROD after 155, the 6th argument
c                 was changed from EATA to 0.0 (Dennis's Suggestion).
c                 CRM - 1/22/91.
c              5) Re: the values of MSHEAR, since 2 & 3 were lumped
c                 together, and a computed GOTO can't handle a zero,
c                 the original "3" was eliminated, and 0-2 were "pro-
c                 moted" to 1-3. CRM - 1/24/91.
c              6) GOTO's were massively changed to nested IF's.
c                 CRM - 2/04/91.
c              7) Removed old L2 IF-ELSE logic (v97.3) so that model
c                 always calculates where deposition ends, regardless
c                 of the shape of the segment.  This is because with the
c                 adjustments made in PARAM at OFE breaks - slope shape
c                 is not always true predictor of processes on OFE.
c                 dcf  (changed L3 to L2 IF/ELSE)
c
c     Version: This module recoded from WEPP version 90.92.
c     Date recoded: 12/21/90 - 2/08/91.
c     Recoded by: Charles R. Meyer.
c
c     + + + KEYWORDS + + +
c
c     + + + PARAMETERS + + +
      include 'pmxelm.inc'
      include 'pmxhil.inc'
      include 'pmxnsl.inc'
      include 'pmxpln.inc'
      include 'pmxprt.inc'
      include 'pmxslp.inc'
      include 'pmxtls.inc'
c
c     + + + COMMON BLOCKS + + +
      include 'cends1.inc'
      include 'cends2.inc'
      include 'cends3.inc'
c       read: ktrato, qout, qin, strldn
      include 'cenrpa1.inc'
c     modify: frcflw(10,mxplan)
      include 'cerdva1.inc'
c      write: tc(101),load(101)
      include 'cinfco1.inc'
c       read: qostar
      include 'cinfco2.inc'
c       read: ainf(mxslp), binf(mxslp), cinf(mxslp)
      include 'cirriga.inc'
c       read: noirr
      include 'cpart1.inc'
c       read: npart, frac
      include 'cparva1.inc'
c       read: eata, tauc, theta, phi
      include 'cslope1.inc'
c       read: xl(mxslp,mxplan), nslpts(mxplan), a(mxslp,mxplan)
c     modify: xu(mxslp,mxplan)
      include 'cstruc.inc'
c       read: iplane
c
c     + + + LOCAL VARIABLES + + +
      real ldlast, loadup, lddend, xdend, xdbeg, xdetst, cdep, dl, du,
     1     xc1, xc2
      integer i, iendfg, ilast, jj, k, mshear, ndep
c
c     ldlast - n.d. sediment load calculated at last point
c     loadup - n.d. load computed entering deposition region - value
c              is sent and used in subroutine enrich.f
c     lddend - n.d. load computed at end of previous deposition
c              region or overland flow element (i.e., load at xdetst)
c     xdend  - n.d. distance where deposition computed to end
c     xdbeg  - n.d. distance where deposition begins on a segment
c     xdetst - n.d. distance at start of previous detachment area
c     ilast  - counter index variable at last point
c     iendfg - flag to subroutine enrich.f indicating last call at
c              end of an overland flow element
c     dl     - n.d. deposition rate
c     du     - n.d. deposition rate at the top of a segment
c     cdep   - portion of solution to deposition equation
c     erd    - n.d. rill erodibility parameter sent to erod.f
c              if shear < critical erd=0, otherwise erd=eata
c     mshear - flag indicating what shear conditions exist on segment
c
c     + + + SUBROUTINES CALLED + + +
c     xcrit
c     depos
c     erod
c
c     + + + FUNCTION DECLARATIONS + + +
      real depc
      real depend
c
c     + + + END SPECIFICATIONS + + +
c
c
c*********************************************************************
c
c ... initialize erosion variables at the top of an OFE.
c
      lddend = strldn
      ldlast = strldn
      ilast = 1
      ndep = 0
      iendfg = 0
      xdbeg = 0.0
      xdetst = 0.0
c
c     .... Set sediment loads and transport capacity at each point,
c     equal to zero.
      do 10 jj = 1, 101
        load(jj) = 0.0
        tc(jj) = 0.0
   10 continue
c
c     .... Set distance, transport capacity, and sediment load at
c     first point on OFE.
      xu(2,iplane) = 0.0
c     tc(1)=cinf(2)*ktrato
      tc(1) = cinftc(2) * ktrato
      load(1) = strldn
c
c     ... initialize particle fractions in the flow at top of OFE
c     with no inflow from previous OFE.
c
      if (qout.gt.0.0) then
        if (qin.le.0.0.or.(noirr.gt.0.and.irsyst.eq.2.and.iplane.eq.1))
     1      then
          do 20 i = 1, npart
            frcflw(i,iplane) = frac(i,iplane)
   20     continue
        else
c
c         ........... Initialize particle fractions in the flow for OFE's
c         with inflow from previous OFE.
          do 30 i = 1, npart
            frcflw(i,iplane) = frcflw(i,iplane-1)
   30     continue
        end if
      else
        do 40 i = 1, npart
          frcflw(i,iplane) = 0.0
   40   continue
      end if
c
c******************************************************************
c     upper boundary condition for overland flow elements
c
c     Determine if deposition is occuring at X=0 on OFE.
c     ...if qostar = 0.0 (no inflow) estimate dl from deposition equation
c     ...else, estimate dl from the incoming sediment load and flow rate
c
      if (abs(qostar).lt..0011) then
        dl = phi / (phi+1.0) * (ktrato*binftc(2)-theta)
      else
        dl = phi / qostar * (ktrato*cinftc(2)-ldlast)
      end if
c
c
c     ...  **************************************************************
c     ...  *** For Each Slope Segment Within an Overland Flow Element ***
c     ...  **************************************************************
c     ... perform detachment and deposition calculations.
c
c
c     *** Start of BIG DO-LOOP ***
      do 170 k = 2, nslpts(iplane)
c
c       For a CASE 4 plane - bypass all calculations if flow
c       has ended before current segment
c       *** Start of BIG IF ***
        if (qout.gt.0.0.or.xu(k,iplane).lt.-qostar) then
c
c         If a Case 2 or 3 plane, or a Case 4 plane segment
c         on which runoff does not end.
          if (qout.gt.0.0.or.(qout.le.0.0.and.xl(k,iplane).lt.-qostar))
     1        then
c
c           .......... Calculate shear conditions in segment, then
c           Find where shear equals critical shear for segment.
            call xcrit(ainf(k),binf(k),cinf(k),tauc,xu(k,iplane),
     1          xl(k,iplane),qostar,xc1,xc2,mshear)
c
c         For a Case 4 plane segment on which the flow ends
          else
            call xcrit(ainf(k),binf(k),cinf(k),tauc,xu(k,iplane),-
     1          qostar,qostar,xc1,xc2,mshear)
          end if
c
c         ... determine if there is deposition at the beginning of the
c         ... segment - if there is - calculate where deposition ends
c
          du = dl
c
c         *** L1 IF ***
          if (du.lt.0.) then
c
c           deposition at upper end of segment
c
            cdep = depc(xu(k,iplane),ainftc(k),binftc(k),phi,theta,du,
     1          ktrato,qostar)
c
c             check for deposition ending within segment
c
              xdend = depend(xu(k,iplane),xl(k,iplane),ainftc(k),
     1            binftc(k),cdep,phi,theta,ktrato,qostar)
c
c             deposition does not end
c
c             *** L2 IF ***
              if (xdend.ge.xl(k,iplane)) then
                xdend = xl(k,iplane)
c
                loadup = ldlast
                call depos(xu(k,iplane),xdend,cdep,ainftc(k),binftc(k),
     1              cinftc(k),phi,theta,ilast,dl,ldlast)
                ndep = 0
                if (ldlast.gt.0.0.and.qout.gt.0.0) then
                  call enrich(k,xu(k,iplane),xdend,xdetst,loadup,ldlast,
     1                lddend,theta,iendfg)
                  lddend = ldlast
                  xdetst = xdend
                end if
c             *** L2 ELSE ***
              else
c
c               Deposition ends in segment
c
                loadup = ldlast
                call depos(xu(k,iplane),xdend,cdep,ainftc(k),binftc(k),
     1              cinftc(k),phi,theta,ilast,dl,ldlast)
                ndep = 0
                if (ldlast.gt.0.0.and.qout.gt.0.0) then
                  call enrich(k,xu(k,iplane),xdend,xdetst,loadup,ldlast,
     1                lddend,theta,iendfg)
                  lddend = ldlast
                  xdetst = xdend
                end if
c
c
c               Detachment After Deposition
c
c
c               Note: MSHEAR is an integer from 1 to 5.  Notice that in the first two
c               cases, as well as the second two, the only difference is in the
c               value assigned to ERD.  Also, note the games played with the first
c               two arguments to EROD in the various cases.  Except for the first
c               argument passed to EROD, the 1st case is identical to the ELSE
c               of the 3rd, and the 2nd to the ELSE of the 4th.  There may be
c               some real opportunities to simplify the code here! -- CRM 1/7/91
c
                go to (50,60,70,80,90)mshear
c
c               ............. Shear below critical in entire segment.
c               ** MSHEAR = 1 **
   50           continue
                call erod(xdend,xl(k,iplane),ainf(k),binf(k),cinf(k),
     1              ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,
     1              ilast,dl,ldlast,xdbeg,ndep)
                go to 100
c
c               ............. Shear exceeds critical in entire segment.
c               ** MSHEAR = 2 **
   60           continue
                call erod(xdend,xl(k,iplane),ainf(k),binf(k),cinf(k),
     1              ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,phi,
     1              ilast,dl,ldlast,xdbeg,ndep)
                go to 100
c
c               ............. Shear increases down slope and exceeds critical at X=XC1.
c               ** MSHEAR = 3 **
   70           continue
                if (xdend.le.xc1) then
                  call erod(xdend,xc1,ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                  if (ndep.eq.0) call erod(xc1,xl(k,iplane),ainf(k),
     1                binf(k),cinf(k),ainftc(k),binftc(k),cinftc(k),
     1                eata,tauc,theta,phi,ilast,dl,ldlast,xdbeg,ndep)
                else
                  call erod(xdend,xl(k,iplane),ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                end if
                go to 100
c
c               ............. Shear decreases down slope and drops below critical at X=XC1.
c               ** MSHEAR = 4 **
   80           continue
                if (xdend.le.xc1) then
                  call erod(xdend,xc1,ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                  if (ndep.eq.0) call erod(xc1,xl(k,iplane),ainf(k),
     1                binf(k),cinf(k),ainftc(k),binftc(k),cinftc(k),0.0,
     1                tauc,theta,phi,ilast,dl,ldlast,xdbeg,ndep)
                else
                  call erod(xdend,xl(k,iplane),ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                end if
                go to 100
c
c               ............ Shear increases down slope -- exceeds critical at X=XCL,
c               then decreases from XCL to XC2, and drops below critical
c               at XC2.
c               ** MSHEAR = 5 **
   90           continue
                if (xdend.le.xc1) then
                  call erod(xdend,xc1,ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                  if (ndep.eq.0) then
                    call erod(xc1,xc2,ainf(k),binf(k),cinf(k),
     1                  ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,
     1                  phi,ilast,dl,ldlast,xdbeg,ndep)
                    if (ndep.eq.0) call erod(xc2,xl(k,iplane),ainf(k),
     1                  binf(k),cinf(k),ainftc(k),binftc(k),cinftc(k),
     1                  0.0,tauc,theta,phi,ilast,dl,ldlast,xdbeg,ndep)
                  end if
                else if (xdend.gt.xc2) then
                  call erod(xdend,xl(k,iplane),ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                else
                  call erod(xdend,xc2,ainf(k),binf(k),cinf(k),
     1                ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,phi,
     1                ilast,dl,ldlast,xdbeg,ndep)
                  if (ndep.eq.0) call erod(xc2,xl(k,iplane),ainf(k),
     1                binf(k),cinf(k),ainftc(k),binftc(k),cinftc(k),0.0,
     1                tauc,theta,phi,ilast,dl,ldlast,xdbeg,ndep)
                end if
  100           continue
c             *** L2 ENDIF ***
              end if
c
c         detachment at upper end of segment
c
c         *** L1 ELSE ***
          else
c
            dl = 0.0
            du = 0.0
c
c           Note: MSHEAR is an integer from 1 to 5.  Notice that in the first two
c           cases, as well as the second two, the only difference in in the
c           value assigned to ERD.  Also, note the games played with the first
c           two arguments to EROD in the various cases.  Except for the first
c           argument passed to EROD, the 1st case is identical to the last half
c           of the 3rd, and the 2nd to the last half of the 4th.  There may be
c           some real opportunities to simplify the code here! -- CRM 1/7/91
c
            go to (110,120,130,140,150)mshear
c
c           ............. Shear below critical in entire segment.
c           ** MSHEAR = 1 **
  110       continue
            call erod(xu(k,iplane),xl(k,iplane),ainf(k),binf(k),
     1          cinf(k),ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,
     1          phi,ilast,dl,ldlast,xdbeg,ndep)
            go to 160
c
c           ............. Shear exceeds critical in entire segment.
c           ** MSHEAR = 2 **
  120       continue
            call erod(xu(k,iplane),xl(k,iplane),ainf(k),binf(k),
     1          cinf(k),ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,
     1          phi,ilast,dl,ldlast,xdbeg,ndep)
            go to 160
c
c           ............. Shear increases down slope and exceeds critical at X=XC1.
c           ** MSHEAR = 3 **
  130       continue
            call erod(xu(k,iplane),xc1,ainf(k),binf(k),cinf(k),
     1          ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,ilast,
     1          dl,ldlast,xdbeg,ndep)
            if (ndep.eq.0) call erod(xc1,xl(k,iplane),ainf(k),binf(k),
     1          cinf(k),ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,
     1          phi,ilast,dl,ldlast,xdbeg,ndep)
            go to 160
c
c           ............. Shear decreases down slope and drops below critical at X=XC1.
c           ** MSHEAR = 4 **
  140       continue
            call erod(xu(k,iplane),xc1,ainf(k),binf(k),cinf(k),
     1          ainftc(k),binftc(k),cinftc(k),eata,tauc,theta,phi,ilast,
     1          dl,ldlast,xdbeg,ndep)
            if (ndep.eq.0) call erod(xc1,xl(k,iplane),ainf(k),binf(k),
     1          cinf(k),ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,
     1          phi,ilast,dl,ldlast,xdbeg,ndep)
            go to 160
c
c           ......... Shear increases down slope -- exceeds critical at X=XCL,
c           then decreases from XCL to XC2, and drops below critical
c           at XC2.
c           ** MSHEAR = 5 **
  150       continue
            call erod(xu(k,iplane),xc1,ainf(k),binf(k),cinf(k),
     1          ainftc(k),binftc(k),cinftc(k),0.0,tauc,theta,phi,ilast,
     1          dl,ldlast,xdbeg,ndep)
            if (ndep.eq.0) then
              call erod(xc1,xc2,ainf(k),binf(k),cinf(k),ainftc(k),
     1            binftc(k),cinftc(k),eata,tauc,theta,phi,ilast,dl,
     1            ldlast,xdbeg,ndep)
              if (ndep.eq.0) call erod(xc2,xl(k,iplane),ainf(k),
     1            binf(k),cinf(k),ainftc(k),binftc(k),cinftc(k),0.0,
     1            tauc,theta,phi,ilast,dl,ldlast,xdbeg,ndep)
            end if
c
c         *** L1 ENDIF ***
          end if
c
  160     continue
c
c         If this was a detachment section on the segment of the
c         OFE which went into deposition (NDEP = 1) then call
c         the deposition routine from the point where load equals
c         transport capacity to the end of the segment.
c
          if (ndep.ne.0) then
            if (ilast.lt.102) then
              dl = 0.0
              du = 0.0
              cdep = depc(xdbeg,ainftc(k),binftc(k),phi,theta,du,ktrato,
     1            qostar)
              loadup = ldlast
              if (loadup.lt.lddend) loadup = lddend
              call depos(xdbeg,xl(k,iplane),cdep,ainftc(k),binftc(k),
     1            cinftc(k),phi,theta,ilast,dl,ldlast)
              ndep = 0
              if (ldlast.gt.0.0.and.qout.gt.0.0) then
                call enrich(k,xdbeg,xl(k,iplane),xdetst,loadup,ldlast,
     1              lddend,theta,iendfg)
                lddend = ldlast
                xdetst = xl(k,iplane)
              end if
            end if
          end if
c
c       End of BIG IF
        end if
c
c     End of BIG DO-LOOP
  170 continue
c
c     Compute enrichment ratio at the end of each
c     overland flow element.
c
      iendfg = 1
c
c     Changed following call to ENRICH 6/30/94 because new code
c     inserted in ENRICH by Nearing must have actual value for location
c     of the beginning and end of the deposition region at the last
c     point on the OFE - thus:  xtop = xbot = 1.0
c     dcf  6/30/94
c
      call enrich(k,1.0,1.0,xdetst,ldlast,ldlast,lddend,theta,iendfg)
c
      return
      end

ext: for

max_stars_repo_name: jarad/dep

max_issues_repo_name: jarad/dep

max_forks_repo_name: akrherz/idep


text:
C***********************************************************************
C    Module:  iopol.f
C
C    Copyright (C) 2000 Mark Drela, Harold Youngren
C
C    This program is free software; you can redistribute it and/or modify
C    it under the terms of the GNU General Public License as published by
C    the Free Software Foundation; either version 2 of the License, or
C    (at your option) any later version.
C
C    This program is distributed in the hope that it will be useful,
C    but WITHOUT ANY WARRANTY; without even the implied warranty of
C    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C    GNU General Public License for more details.
C
C    You should have received a copy of the GNU General Public License
C    along with this program; if not, write to the Free Software
C    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
C***********************************************************************

      SUBROUTINE POLREAD(LU,FNPOL,ERROR,
     &                   NAX,NA,CPOL,
     &                   REYN1,MACH1,ACRIT,XTRIP,
     &                   PTRAT,ETAP,
     &                   NAME, IRETYP,IMATYP,
     &                   ISX,NBL,CPOLSD,
     &                   CODE,VERSION )
      INCLUDE 'PINDEX.INC'
      CHARACTER*(*) FNPOL, NAME
      LOGICAL ERROR
      CHARACTER*(*) CODE
      REAL CPOL(NAX,IPTOT), CPOLSD(NAX,ISX,JPTOT)
      REAL MACH1, ACRIT(ISX), XTRIP(ISX)
C--------------------------------------------------------
C     Reads in polar save file
C
C  Input:
C     LU      logical unit to use for reading
C     FNPOL   name of polar file to be read,
C               if FNPOL(1:1).eq.' ', unit LU will be read
C               if it is already open
C     NAX     polar point array dimension
C     ISX     airfoil side array dimension
C
C  Output:
C     ERROR   T if a READ error occurred
C     NA      number polar points
C     CPOL    polar coefficients and parameters
C     REYN1   Reynolds number for CL=1
C     MACH1   Mach number for CL=1
C     ACRIT   Critical amplification ratio
C     XTRIP   Trip locations
C     PTRAT   Actuator disk total-pressure ratio
C     ETAP    Actuator disk thermal efficiency
C     NAME    airfoil name string
C     IRETYP  flag giving type of Re variation with CL
C     IMATYP  flag giving type of Ma variation with CL
C     NBL     number of airfoil elements
C     CPOLSD  airfoil side-related parameters
C     CODE    code used to compute polar
C     VERSION code version
C--------------------------------------------------------
      CHARACTER*128 LINE
      CHARACTER*1 DUMMY
      REAL RINP(0:IPTOT+2*JPTOT)
C
      INTEGER IPOL(IPTOT), ISPOL(2,IPTOT)
      INTEGER ITMP(IPTOT+2*JPTOT), ITMP0(IPTOT+2*JPTOT)
      LOGICAL LOPEN, LHEAD, LDLAB
      LOGICAL LIRE, LIMA, LJNC, LJTP
      CHARACTER*20 CPNAME
C
C
      ERROR = .FALSE.
      LHEAD = .TRUE.
C
      NA = 0
      NBL = 1
C
c      KCH = 0
c      KMC = 0
C
      NIPOL = 0
      DO IP = 1, IPTOT
        IPOL(IP) = 0
      ENDDO
      DO JP = 1, JPTOT
        ISPOL(1,JP) = 0
        ISPOL(2,JP) = 0
      ENDDO
C
C---- assume Re,Mach will not be given in header
      IRETYP = 0
      IMATYP = 0
C
C---- do we have to open the file?
      LOPEN = FNPOL .NE. ' '
C
      IF(LOPEN) OPEN(LU,FILE=FNPOL,STATUS='OLD',ERR=90)
C
C=============================================================
C---- start data reading loop
 500  CONTINUE
      READ(LU,1000,END=80) LINE
      IF(LINE.EQ.' ') GO TO 500
C
      IF(LHEAD) THEN
C----- parse to get header info
C
C----- assume this will be the data-label line
       LDLAB = .TRUE.
C
C--------------------------------------------
       K = INDEX(LINE,'Version')
       IF(K.NE.0) THEN
C------ code,version line
        DO K1=1, 128
          IF(LINE(K1:K1).NE.' ') GO TO 10
        ENDDO
C
 10     CONTINUE
        IF(K.GT.K1) THEN
         CODE = LINE(K1:K-1)
         READ(LINE(K+7:128),*,ERR=11) VERSION
        ENDIF
 11     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       KF = INDEX(LINE,'for:')
       IF(KF.NE.0) THEN
C------ airfoil name line
        NAME = LINE(KF+5:128)
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       KE = INDEX(LINE,'elements')
       IF(KE.GT.0) THEN
C------ element-number line
        READ(LINE(KE-4:KE-1),*,ERR=60) NBL
C------ truncate name line to eliminate elements #
        NAME = LINE(KF+5:KE-4)
C
        IF(2*NBL .GT. ISX) THEN
         NBL = ISX/2
         WRITE(*,*)
     &   'POLREAD: Number of elements set to array limit', NBL
        ENDIF
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       KR = INDEX(LINE,'Reynolds number')
       KM = INDEX(LINE,'Mach number')
C
       IF(KR.NE.0) THEN
C------ Re-type line
        IF(KM.GT.KR) THEN
         KEND = KM-1
        ELSE
         KEND = 128
        ENDIF
        IF    (INDEX(LINE(KR:KEND),'fixed').NE.0) THEN
         IRETYP = 1
        ELSEIF(INDEX(LINE(KR:KEND),'1/sqrt(CL)').NE.0) THEN
         IRETYP = 2
        ELSEIF(INDEX(LINE(KR:KEND),'1/CL').NE.0) THEN
         IRETYP = 3
        ENDIF
        LDLAB = .FALSE.
       ENDIF
C
       IF(KM.NE.0) THEN
C------ Ma-type line
        IF(KR.GT.KM) THEN
         KEND = KR-1
        ELSE
         KEND = 128
        ENDIF
        IF    (INDEX(LINE(KM:KEND),'fixed').NE.0) THEN
         IMATYP = 1
        ELSEIF(INDEX(LINE(KM:KEND),'1/sqrt(CL)').NE.0) THEN
         IMATYP = 2
        ELSEIF(INDEX(LINE(KM:KEND),'1/CL').NE.0) THEN
         IMATYP = 3
        ENDIF
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
C---- find specified BL trip location
       K = INDEX(LINE,'xtrf')
       IF(K.NE.0) THEN
C------ new style xtrip line
        KT = INDEX(LINE,'(top)')
        KB = INDEX(LINE,'(bottom)')
        KE = INDEX(LINE,'element ')
C--- check for old style trip line
        KS = INDEX(LINE,'(suc')
        KP = INDEX(LINE,'(pre')
C
        IF(KE.NE.0) THEN
         READ(LINE(KE+7:KE+12),*,ERR=21) N
        ELSE
         N = 1
        ENDIF
        IF(N.LE.NBL) THEN
         IS1 = 2*N-1
         IS2 = 2*N
         XTRIP(IS1) = 1.0
         XTRIP(IS2) = 1.0
         IF(KT.GT.0)  READ(LINE(K+6:KT-1) ,*,ERR=21) XTRIP(IS1)
         IF(KB.GT.KT) READ(LINE(KT+5:KB-1),*,ERR=21) XTRIP(IS2)
         IF(KS.GT.0)  READ(LINE(K+6:KS-1) ,*,ERR=21) XTRIP(IS1)
         IF(KP.GT.KS) READ(LINE(KS+5:KP-1),*,ERR=21) XTRIP(IS2)
        ENDIF
 21     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       K = INDEX(LINE,'Mach =')
       IF(K.NE.0) THEN
        READ(LINE(K+6:128),*,ERR=31) MACH1
 31     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       K = INDEX(LINE,'Re =')
       IF(K.NE.0) THEN
        READ(LINE(K+4:128),*,ERR=32) REYN1
        REYN1 = REYN1 * 1.0E6
 32     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       K = INDEX(LINE,'Ncrit =')
       IF(K.NE.0) THEN
        NINP = 2
        CALL GETFLT(LINE(k+7:128),RINP(1),NINP,ERROR)
        IF(NINP.LE.0 .OR. ERROR) GO TO 33
C
        IF(NINP.EQ.1) THEN
         ACRIT(1) = RINP(1)
         ACRIT(2) = RINP(1)
        ELSE
         ACRIT(1) = RINP(1)
         ACRIT(2) = RINP(2)
        ENDIF
 33     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       K = INDEX(LINE,'pi_p =')
       IF(K.NE.0) THEN
        READ(LINE(K+6:128),*,ERR=34) PTRAT
 34     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       K = INDEX(LINE,'eta_p =')
       IF(K.NE.0) THEN
        READ(LINE(K+7:128),*,ERR=35) ETAP
 35     CONTINUE
        LDLAB = .FALSE.
       ENDIF
C
C--------------------------------------------
       IF(LDLAB .AND. NIPOL.EQ.0) THEN
C------ process line for possible data labels
        DO IP = 1, IPTOT
          CALL STRIP(CPOLNAME(IP),NNAME)
C
C-------- mark this parameter for reading
          K = INDEX(LINE,CPOLNAME(IP)(1:NNAME))
          ITMP0(IP) = K
          ITMP(IP)  = K
        ENDDO
C
        DO JP = 1, JPTOT
          CALL STRIP(CPOLSNAME(JP),NNAME)
C
          CPNAME = 'Top ' // CPOLSNAME(JP)
          K1 = INDEX(LINE,CPNAME(1:NNAME+4))
          CPNAME = 'Top_' // CPOLSNAME(JP)
          K2 = INDEX(LINE,CPNAME(1:NNAME+4))
          ITMP0(IPTOT+JP) = MAX(K1,K2)
          ITMP (IPTOT+JP) = MAX(K1,K2)
C
          CPNAME = 'Bot ' // CPOLSNAME(JP)
          K1 = INDEX(LINE,CPNAME(1:NNAME+4))
          CPNAME = 'Bot_' // CPOLSNAME(JP)
          K2 = INDEX(LINE,CPNAME(1:NNAME+4))
          ITMP0(IPTOT+JP+JPTOT) = MAX(K1,K2)
          ITMP (IPTOT+JP+JPTOT) = MAX(K1,K2)
        ENDDO
C
C------ bubble-sort data label positions in line string
        DO IPASS = 1, IPTOT+2*JPTOT
          DO IP = 1, IPTOT+2*JPTOT-1
            IF(ITMP(IP).GT.ITMP(IP+1)) THEN
             ITMPP1 = ITMP(IP+1)
             ITMP(IP+1) = ITMP(IP)
             ITMP(IP) = ITMPP1
            ENDIF
          ENDDO
        ENDDO
C
C------ assign data position to each parameter
        DO IPT = 1, IPTOT+2*JPTOT
          IF(ITMP(IPT).GT.0) THEN
           NIPOL = NIPOL + 1
           DO IP = 1, IPTOT
             IF(ITMP(IPT).EQ.ITMP0(IP)) IPOL(IP) = NIPOL
           ENDDO
           DO JP = 1, JPTOT
             IF(ITMP(IPT).EQ.ITMP0(IPTOT+JP      )) ISPOL(1,JP) = NIPOL
             IF(ITMP(IPT).EQ.ITMP0(IPTOT+JPTOT+JP)) ISPOL(2,JP) = NIPOL
           ENDDO
          ENDIF
        ENDDO
C
       ENDIF
C
C--------------------------------------------
       IF(INDEX(LINE,'-----').NE.0) THEN
        LHEAD = .FALSE.
       ENDIF
C
C--------------------------------------------------------------
      ELSE
C----- read polar data lines
       IA = NA + 1
C
       NINP = IPTOT+2*JPTOT
       CALL GETFLT(LINE,RINP(1),NINP,ERROR)
       IF(ERROR) GO TO 90
C
       DO IP = 1, IPTOT
         CPOL(IA,IP) = RINP(IPOL(IP))
       ENDDO
C
       DO JP = 1, JPTOT
         DO N = 1, NBL
           IS1 = 2*N-1
           IS2 = 2*N
           CPOLSD(IA,IS1,JP) = RINP(ISPOL(1,JP)+2*(N-1))
           CPOLSD(IA,IS2,JP) = RINP(ISPOL(2,JP)+2*(N-1))
         ENDDO
       ENDDO
C
       ACL = MAX( CPOL(IA,ICL) , 0.001 )
C
C
C----- try to find Re, Ma, Ncrit, Xtrip  in polar data
       LIRE = .FALSE.
       LIMA = .FALSE.
       LJNC = .FALSE.
       LJTP = .FALSE.
       DO KP = 1, NIPOL
         IF(IPOL(KP) .EQ. IRE) LIRE = .TRUE.
         IF(IPOL(KP) .EQ. IMA) LIMA = .TRUE.
         IF(ISPOL(1,KP) .EQ. JNC) LJNC = .TRUE.
         IF(ISPOL(1,KP) .EQ. JTP) LJTP = .TRUE.
       ENDDO
C
       IF(.NOT. LIRE) THEN
C------ Re was not in polar data... set using header info
        IF    (IRETYP.EQ.1) THEN
         CPOL(IA,IRE) = REYN1
        ELSEIF(IRETYP.EQ.2) THEN
         CPOL(IA,IRE) = REYN1/SQRT(ACL)
        ELSEIF(IRETYP.EQ.3) THEN
        CPOL(IA,IRE) = REYN1/ACL
        ENDIF
       ENDIF
C
       IF(.NOT. LIMA) THEN
C------ Mach was not in polar data... set using header info
        IF    (IMATYP.EQ.1) THEN
         CPOL(IA,IMA) = MACH1
        ELSEIF(IMATYP.EQ.2) THEN
         CPOL(IA,IMA) = MACH1/SQRT(ACL)
        ELSEIF(IMATYP.EQ.3) THEN
         CPOL(IA,IMA) = MACH1/ACL
        ENDIF
       ENDIF
C
       IF(.NOT. LJNC) THEN
C------ Ncrit was not in polar data... set using header info
        DO IS = 1, 2*NBL
          CPOLSD(IA,IS,JNC) = ACRIT(IS)
        ENDDO
       ENDIF
C
       IF(.NOT. LJTP) THEN
C------ set trip data using header info
        DO IS = 1, 2*NBL
          CPOLSD(IA,IS,JTP) = XTRIP(IS)
        ENDDO
       ENDIF
C
       NA = IA
      ENDIF
C
 60   CONTINUE
C---- go read next line
      GO TO 500
C=============================================================
C
 80   CONTINUE
C---- if file was opened here, then close it
      IF(LOPEN) CLOSE(LU)
      RETURN
C
 90   CONTINUE
      IF(LOPEN) CLOSE(LU)
      ERROR = .TRUE.
      RETURN
C
C..........................................
 1000 FORMAT(A)
      END ! POLREAD

      SUBROUTINE POLWRIT(LU,FNPOL,ERROR, LHEAD,
     &                   NAX, IA1,IA2, CPOL, IPOL,NIPOL,
     &                   REYN1,MACH1,ACRIT,XTRIP,
     &                   PTRAT,ETAP,
     &                   NAME, IRETYP,IMATYP,
     &                   ISX,NBL,CPOLSD, JPOL,NJPOL,
     &                   CODE,VERSION, LQUERY )
      INCLUDE 'PINDEX.INC'
      CHARACTER*(*) FNPOL, NAME
      LOGICAL ERROR, LHEAD,LQUERY
      CHARACTER*(*) CODE
      REAL CPOL(NAX,IPTOT), CPOLSD(NAX,ISX,JPTOT)
      REAL MACH1, ACRIT(ISX), XTRIP(ISX)
      INTEGER IPOL(IPTOT), JPOL(JPTOT)
C--------------------------------------------------------
C     Writes polar save file
C
C  Input:
C     LU       logical unit to use for writing
C     FNPOL    name of polar file to be read,
C                if FNPOL(1:1).eq.' ', unit LU is assumed
C                to be already open
C     NAX      polar point array dimension
C     ISX      airfoil side array dimension
C     IA1,IA2  only polar points IA1..IA2 are written
C     CPOL     polar coefficients and parameters
C     IPOL(.)  indices of data quantities to be written
C     NIPOL    number  of data quantities to be written
C     REYN1    Reynolds number for CL=1
C     MACH1    Mach number for CL=1
C     ACRIT    Critical amplification ratio
C     XTRIP    Trip locations
C     PTRAT   Actuator disk total-pressure ratio
C     ETAP    Actuator disk thermal efficiency
C     NAME     airfoil name string
C     IRETYP   flag giving type of Re variation with CL
C     IMATYP   flag giving type of Ma variation with CL
C     NBL      number of airfoil elements
C     CPOLSD   airfoil side-related parameters
C     JPOL(.)  indices of side data quantities to be written
C     NJPOL    number  of side data quantities to be written
C     LHEAD    T if header and column label are to be written
C     CODE     code used to compute polar
C     VERSION  code version
C     LQUERY   if T, asks permission to overwrite existing file
C
C  Output:
C     ERROR   T if a OPER or WRITE error occurred
C--------------------------------------------------------
      CHARACTER*29 LINE1, LINE2
      CHARACTER*128 LINEL, LINED, LINEF
      CHARACTER*1 ANS
      LOGICAL LOPEN
C
      ERROR = .FALSE.
C
C---- do we have to open the file?
      LOPEN = FNPOL .NE. ' '
C
      IF(LOPEN) THEN
       OPEN(LU,FILE=FNPOL,STATUS='OLD',ERR=20)
C
       IF(LQUERY) THEN
        WRITE(*,*)
        WRITE(*,*) 'Output file exists.  Overwrite?  Y'
        READ(*,1000) ANS
C
        IF(INDEX('Nn',ANS).EQ.0) GO TO 22
C
        CLOSE(LU)
        WRITE(*,*) 'Polar file not saved'
        RETURN
       ENDIF
C
 20    OPEN(LU,FILE=FNPOL,STATUS='UNKNOWN',ERR=90)
 22    REWIND(LU)
      ENDIF
C
      IF(LHEAD) THEN
       WRITE(LU,*) ' '
       WRITE(LU,8000) CODE, VERSION
       WRITE(LU,*) ' '
       IF(NBL.EQ.1) THEN
        WRITE(LU,9001) NAME
       ELSE
        WRITE(LU,9002) NAME, NBL
       ENDIF
C
       IFFBC = 0
       ISMOM = 0
C
       IF(IFFBC.NE.0 .AND. ISMOM.NE.0) THEN
        IF(IFFBC.EQ.1)  LINE1 = ' Solid wall far field        '
        IF(IFFBC.EQ.2)  LINE1 = ' Vortex + doublet far field  '
        IF(IFFBC.EQ.3)  LINE1 = ' Constant pressure far field '
        IF(IFFBC.EQ.4)  LINE1 = ' Supersonic wave far field   '
        IF(IFFBC.GE.5)  LINE1 = '                             '
        IF(ISMOM.EQ.1)  LINE2 = '   S-momentum conserved      '
        IF(ISMOM.EQ.2)  LINE2 = '   Entropy conserved         '
        IF(ISMOM.EQ.3)  LINE2 = '   Entropy conserved near LE '
        IF(ISMOM.EQ.4)  LINE2 = '   S-mom conserved at shocks '
        IF(ISMOM.GE.5)  LINE2 = '                             '
        WRITE(LU,9006) LINE1, LINE2
 9006   FORMAT(1X,3X,2A29)
       ENDIF
C
       WRITE(LU,*) ' '
C
       LINE1 = ' '
       LINE2 = ' '
       IF(IRETYP.EQ.1) LINE1 = ' Reynolds number fixed       '
       IF(IRETYP.EQ.2) LINE1 = ' Reynolds number ~ 1/sqrt(CL)'
       IF(IRETYP.EQ.3) LINE1 = ' Reynolds number ~ 1/CL      '
       IF(IMATYP.EQ.1) LINE2 = '   Mach number fixed         '
       IF(IMATYP.EQ.2) LINE2 = '   Mach number ~ 1/sqrt(CL)  '
       IF(IMATYP.EQ.3) LINE2 = '   Mach number ~ 1/CL        '
       WRITE(LU,9005) IRETYP, IMATYP, LINE1, LINE2
C
       WRITE(LU,*) ' '
       DO N = 1, NBL
         IS1 = 2*N-1
         IS2 = 2*N
         IF(NBL.EQ.1) THEN
          WRITE(LU,9011) XTRIP(IS1), XTRIP(IS2)
         ELSE
          WRITE(LU,9012) XTRIP(IS1), XTRIP(IS2), N
         ENDIF
       ENDDO
       WRITE(LU,9015) MACH1, REYN1/1.0E6, ACRIT(1), ACRIT(2)
       IF(PTRAT .NE. 0.0) WRITE(LU,9017) PTRAT, ETAP
       WRITE(LU,*) ' '
C
       LINEL = ' '
       LINED = ' '
C
       KL = 1
       KD = 1
C
       DO 30 KP = 1, NIPOL
         IP = IPOL(KP)
         IF(IP.EQ.0) GO TO 30
C
         KDOT = INDEX(CPOLFORM(IP),'.')
         IF(KDOT.EQ.0) KDOT = LEN(CPOLFORM(IP))
         READ(CPOLFORM(IP)(2:KDOT-1),*,ERR=95) NFORM
C
         CALL STRIP(CPOLNAME(IP),NNAME)
         NBLANK = MAX( (NFORM-NNAME+2)/2 , 0 )
C
         LINEL(KL+1+NBLANK:KL+NNAME+NBLANK) = CPOLNAME(IP)(1:NNAME)
         KL = KL + NFORM
C
         LINED(KD+2:KD+NFORM) = '--------------------------------'
         KD = KD + NFORM
 30    CONTINUE
C
       DO 32 KP = 1, NJPOL
         JP = JPOL(KP)
         IF(JP.EQ.0) GO TO 32
C
         KDOT = INDEX(CPOLSFORM(JP),'.')
         IF(KDOT.EQ.0) KDOT = LEN(CPOLSFORM(JP))
         READ(CPOLSFORM(JP)(2:KDOT-1),*,ERR=95) NFORM
C
         CALL STRIP(CPOLSNAME(JP),NNAME)
         NBLANK = MAX( (NFORM-NNAME-2)/2 , 0 )
C
         DO N = 1, NBL
           LINEL(KL+1+NBLANK:KL+4+NNAME+NBLANK) =
     &      'Top_' // CPOLSNAME(JP)(1:NNAME)
           KL = KL + NFORM
C
           LINED(KD+2:KD+NFORM) = '--------------------------------'
           KD = KD + NFORM
C
           LINEL(KL+1+NBLANK:KL+4+NNAME+NBLANK) =
     &      'Bot_' // CPOLSNAME(JP)(1:NNAME)
           KL = KL + NFORM
C
           LINED(KD+2:KD+NFORM) = '--------------------------------'
           KD = KD + NFORM
         ENDDO
 32    CONTINUE
C
C
C
C       LINEL =
C     & '  alpha     CL        CD       CDp       CM    Top_Xtr Bot_Xtr'
CCC     1234567890123456789012345678901234567890123456789012345678901234567890
C       K = 62
C
C
C       LINEL =
C     & ' ------- -------- --------- --------- -------- ------- -------'
CCC       3.453   1.3750   0.00921   0.00512  -0.1450  0.9231  0.5382
CCC       3.453   1.3750   0.00921   0.00213  -0.1450  0.9231  0.5382
C       K = 62

       WRITE(LU,1000) LINEL(1:KL)
       WRITE(LU,1000) LINED(1:KD)
C
      ENDIF
C

      LINEF = '(1X'
      KF = 3
      DO KP = 1, NIPOL
        IP = IPOL(KP)
        NF = LEN(CPOLFORM(IP))
C
        LINEF(KF+1:KF+NF+1) = ',' // CPOLFORM(IP)
        KF = KF + NF + 1
      ENDDO
      DO KP = 1, NJPOL
        JP = JPOL(KP)
        NF = LEN(CPOLSFORM(JP))
C
        DO N = 1, NBL
          LINEF(KF+1:KF+NF+1) = ',' // CPOLSFORM(JP)
          KF = KF + NF + 1
C
          LINEF(KF+1:KF+NF+1) = ',' // CPOLSFORM(JP)
          KF = KF + NF + 1
        ENDDO
      ENDDO
      LINEF(KF+1:KF+1) = ')'
      KF = KF + 1
C
C
      DO 40 IA = IA1, IA2
        WRITE(LU,LINEF)
     &         (CPOL(IA,IPOL(KP)), KP=1, NIPOL),
     &        ((CPOLSD(IA,IS,JPOL(KP)), IS=1, 2*NBL), KP=1, NJPOL)
   40 CONTINUE
C
C
 80   CONTINUE
C---- if file was opened here, then close it
      IF(LOPEN) CLOSE(LU)
      RETURN
C
 90   CONTINUE
      ERROR = .TRUE.
      RETURN
C
 95   CONTINUE
      WRITE(*,*) '? Bad CPOLFORM set up in PINDEX.INC'
      STOP
C
C......................................................................
 1000 FORMAT(A)
 8000 FORMAT(7X,A,9X,'Version', F5.2)
 9001 FORMAT(1X,'Calculated polar for: ', A)
 9002 FORMAT(1X,'Calculated polar for: ', A, I4,' elements')
 9005 FORMAT(1X,I1,I2,2A29)
 9011 FORMAT(1X,
     &'xtrf = ',F7.3,' (top)    ',F9.3,' (bottom)  ')
 9012 FORMAT(1X,
     &'xtrf = ',F7.3,' (top)    ',F9.3,' (bottom)     element', I3)
 9015 FORMAT(1X,
     &'Mach = ',F7.3,5X,'Re = ',F9.3,' e 6',5X,'Ncrit = ',20F7.3)
 9017 FORMAT(1X,
     &'pi_p = ',F7.4,5X,'eta_p = ',F9.4)
 9100 FORMAT(1X,F7.3,F9.4,2F10.5,F9.4,2F8.4  ,  F9.5)
CCC      3.453   1.3750   0.00921     0.500  -0.1450  0.9231  0.5382 -0.00942
CCC      3.453   1.3750   0.00921     0.500  -0.1450  0.9231  0.5382
      END

      SUBROUTINE POLREF(LU,FNREF,ERROR,
     &            NFX,NF,XYREF,LABREF )
      INCLUDE 'PINDEX.INC'
      CHARACTER*(*) FNREF,LABREF
      LOGICAL ERROR
      DIMENSION NF(4)
      DIMENSION XYREF(NFX,2,4)
C--------------------------------------------------------
C     Reads in polar reference data file
C
C  Input:
C     LU      logical unit to use for reading
C     FNREF   name of polar file to be read,
C               if FNREF(1:1).eq.' ', unit LU is assumed
C               to be already open
C     NFX     polar point array dimension
C
C  Output:
C     ERROR      T if a READ error occurred
C     NF(.)      number of points in each data block
C     XYREF(...) reference polar data
C     LABREF(.)  reference polar label
C--------------------------------------------------------
      LOGICAL LOPEN
      CHARACTER*80 LINE
C
      ERROR = .FALSE.
      LOPEN = FNREF(1:1) .NE. ' '
      IF(LOPEN) OPEN(LU,FILE=FNREF,STATUS='OLD',ERR=900)
C
C---- try to read data label
      READ(LU,1000,END=900) LINE
 1000 FORMAT(A)
C
C---- set data label if present
      IF(LINE(1:1).EQ.'#') THEN
        LABREF = LINE(2:80)
      ELSE
        LABREF = ' '
        REWIND(LU)
      ENDIF
C
      DO 100 K=1, 4
        DO 10 I=1, NFX
          READ(LU,*,END=11,ERR=900) XYREF(I,1,K), XYREF(I,2,K)
          IF(XYREF(I,1,K) .EQ. 999.0) GO TO 11
   10   CONTINUE
   11   NF(K) = I-1
  100 CONTINUE
      IF(LOPEN) CLOSE(LU)
      RETURN
C
  900 CONTINUE
      ERROR = .TRUE.
C
      RETURN
      END ! POLREF


text:
include ramen/ramen.f           \ goes first
empty                           \ closes and frees any previous project
project: sample/platformer      \ sets the project's root folder so that LD knows where to look
depend ramen/basic.f
ld lib/tilemap2
depend afkit/ans/param-enclosures.f
ld tools
320 240 resolution

create startxy 0 , 0 ,
stage actor: cam

ld map                          \ loads the map data
ld helpers                      \ physics and tile stuff
ld particles                    \ simple particle system
ld break                        \ effect to turn tiles into particles

( ---=== set up playfield ===--- )
stage actor: blackness  ld blackness
stage actor: bg0  ld bg
particles stage push
stage actor: guy  ld player
ld camera

( define initialization code for exported game )
:make cold
    reload                   \ reload the tilemap data
;

( test stuff )
: test  guy 0 0 from stage *actor as blue /b6ox ;
:now stage *actor as act> <t> pressed if test then ;

max_stars_repo_name: RogerLevy/RamenEngine

max_issues_repo_name: Alim-Oezdemir/RamenEngine

max_forks_repo_name: Alim-Oezdemir/RamenEngine


text:
      SUBROUTINE FILTER_FLAG( CURTYP, FCUT, FSTP, FLAG )

!***********************************************************************
!* Sets Standard UDS File Filtering Flag Character
!*
!* Language: Fortran
!*
!* Author: Stuart G. Mentzer
!*
!* Date: 1999/08/20
!***********************************************************************

      ! Arguments ______________________________________________________

      CHARACTER*(*) CURTYP ! Curve type

      REAL FCUT ! Cutoff frequency

      REAL FSTP ! Stop frequency

      CHARACTER FLAG ! Filter class flag returned

      ! Variables ______________________________________________________

      REAL FMAX

      ! Set filtering flag
      IF ( CURTYP .EQ. 'TIME SERIES' ) THEN
        IF ( FCUT .EQ. 0. ) THEN
          FLAG = '0'
        ELSE IF ( FCUT .EQ. 15. ) THEN
          FLAG = 'a'
        ELSE IF ( FCUT .EQ. 30. ) THEN
          FLAG = 'b'
        ELSE IF ( FCUT .EQ. 60. ) THEN
          FLAG = 'c'
        ELSE IF ( FCUT .EQ. 100. ) THEN
          FLAG = 'd'
        ELSE IF ( FCUT .EQ. 300. ) THEN
          FLAG = 'e'
        ELSE IF ( FCUT .EQ. 500. ) THEN
          FLAG = 'f'
        ELSE IF ( FCUT .EQ. 1000. ) THEN
          FLAG = 'g'
        ELSE
          FLAG = 'x'
        END IF
      ELSE IF ( CURTYP(1:4) .EQ. 'DFT ') THEN
        IF ( FSTP .GT. 0. ) THEN
          FMAX = FSTP
        ELSE
          FMAX = FCUT * 2.5
        END IF
        IF ( FMAX .GE. 2500. ) THEN
          FLAG = 'g'
        ELSE IF ( FMAX .GE. 1250. ) THEN
          FLAG = 'f'
        ELSE IF ( FMAX .GE. 750. ) THEN
          FLAG = 'e'
        ELSE IF ( FMAX .GE. 250. ) THEN
          FLAG = 'd'
        ELSE IF ( FMAX .GE. 150. ) THEN
          FLAG = 'c'
        ELSE IF ( FMAX .GE. 75. ) THEN
          FLAG = 'b'
        ELSE IF ( FMAX .GE. 37.5 ) THEN
          FLAG = 'a'
        ELSE IF ( FMAX .GE. 0. ) THEN
          FLAG = 'x'
        ELSE
          FLAG = '0'
        END IF
      END IF

      RETURN
      END

max_stars_repo_name: DeadParrot/NHTSA-Tools

max_issues_repo_name: DeadParrot/NHTSA-Tools

max_forks_repo_name: DeadParrot/NHTSA-Tools


subroutine freq_array()
  use dyn_lc
  implicit none
  integer :: j

! !Frequency array
    df = 0.5 / (dt * int_len_dim)
    if (.not. allocated(freq)) allocate(freq(int_len_dim / 2))
    ! print *, dt, int_len_dim
    ! print *, 'Frequencies'
    do j = 1, int_len_dim / 2
       freq(j) = real(j) / (dt * int_len_dim)
       ! write(*,*) freq(j)
    enddo

end subroutine freq_array


text:
Real Function ppk0(srt)
  Real xarray(7), earray(7)
  Save
  Data xarray/0.030, 0.025, 0.025, 0.026, 0.02, 0.014, 0.06/
  Data earray/3.67, 4.95, 5.52, 6.05, 6.92, 7.87, 10./
  pmass = 0.9383
  ppk0 = 0
  If (srt<=2.63) Return
  If (srt>4.54) Then
     ppk0 = 0.037
     Return
  End If
  plab = sqrt(((srt**2-2.*pmass**2)/(2.*pmass))**2-pmass**2)
  If (plab<earray(1)) Then
     ppk0 = xarray(1)
     Return
  End If
  Do ie = 1, 7
     If (earray(ie)==plab) Then
        ppk0 = xarray(ie)
        Goto 10
     Else If (earray(ie)>plab) Then
        ymin = alog(xarray(ie-1))
        ymax = alog(xarray(ie))
        xmin = alog(earray(ie-1))
        xmax = alog(earray(ie))
        ppk0 = exp(ymin+(alog(plab)-xmin)*(ymax-ymin)/(xmax-xmin))
        Goto 10
     End If
  End Do
10 Continue
  Return
End Function ppk0

max_stars_repo_name: xiaohaijin/AMPT

max_issues_repo_name: xiaohaijin/AMPT

max_forks_repo_name: xiaohaijin/AMPT