      subroutine cntour(xaxd, yaxd, psivl, xemin, xemax, yemin, yemax, 
     1   yxmin, yxmax, xymin, xymax, dang, arcl, bperr, dx, dy, xmin, 
     2   xmax, ymin, ymax, iauto, iautoc, xc, yc, ipts, x, nw, y, nh, 
     3   cspln, n2cspln, nh2, itty, iptsm, ierr, bpmag, iconvg)
C...Translated by Pacific-Sierra Research VAST-90 2.06G2  10:58:46   6/14/01  
C...Switches: -p4 -yb
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer iauto, iautoc, ipts, nw, nh, n2cspln, nh2, itty, iptsm, 
     1   ierr, iconvg
      real xaxd, yaxd, psivl, xemin, xemax, yemin, yemax, yxmin, yxmax, 
     1   xymin, xymax, dang, arcl, bperr, dx, dy, xmin, xmax, ymin, ymax
      real, dimension(1) :: xc, yc
      real, dimension(nw) :: x
      real, dimension(nh) :: y
      real, dimension(n2cspln,nw,nh2) :: cspln
      real, dimension(1) :: bpmag
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: nitr8, iprint, itry, ier, isgn, iflg, newti, ihalf
      real, dimension(6) :: pds
      real :: pi, piov2, piov4, fpiov4, spiov4, twopi, tpiov4, tpiov2, 
     1   psiin, bperrsav, dbperr, psiaxd, thet, dthet0, dthet1, dthet, 
     2   dxx, dyy, dxmin, serrt, derrt, a, bincp, thet1, x1, y1, cost, 
     3   sint, psi1, x2, y2, psi2, dpsi, xn, yn, dpsids, serr, delx, 
     4   dely, bp2, bp1, rad1, psivln, psiout, psivl0, dapsi
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      real , EXTERNAL :: write
C-----------------------------------------------
c-----------------------------------------------------------------------
c    this routine uses the bicubic spline representation of psi to get
c    psi values at an arbitrary point on the mhd grid. the spline
c    coefficients must exist (in cspln) before this subroutine is called.
c     given (xaxd,yaxd) and a psi value, psivl, generate a contour of
c     ordered points,(xc(i),yc(i)), i=1,ipts, which has (xaxd,yaxd) as
c     as an interior point. the contour must fully encircle (xaxd,yaxd).
c     the search is limited to a rectangle specified by (xmin,xmax,ymin
c     ymax).  dx and dy determine the basic increment in x and y for
c     the coarse grid search.  they should be picked so that over the
c     distance dx or dy, psi is single valued.  a sliding interval
c     search rather than a binary search is used for the coarse grid so
c     that non-monotonic psi can be handled.  dx and dy are in meters.
c     dx=dy=0.01 is suggested.  dang is angular step for the rays which
c     emmanate from (xaxd,yaxd) in degrees.  dang should be set
c     according to shape of equilibrium.  if dang is too small, many
c     unnecessary points will be generated in (xc,yc).  if dang is too
c     large for bperr(see below), the routine wastes computation time
c     reducing the magnitude of dang.  dang=10 deg. near psilim and
c     dang=30 deg. near psimax is suggested.  for highly elongated
c     plasmas control with dang is difficult to set for all contours.
c     therefore arcl may be used to set dang internally.  arcl is the
c     arclength in meters taken from the current point to get to the
c     next point.  set arcl to a large number (e.g. 10 meters) to
c     overide this option and use dang only.  the angle increment will
c     be the minimum of (arcl/rad,dang).  bperr is relative change in
c     poloidal b field between (xc(i),yc(i)) and (xc(i+1),yc(i+1)).
c     if the number of elements (xc,yc) exceeds the limit
c     bperr is relaxed (up to twice) by a constant increment
c     dbperr before an error exit is taken.
c     bperr=0.03 is suggested.  note: if dang yields bperr(computed)<
c     bperr(input), then dang is used.  otherwise dang is successively
c     reduced by 0.5 until this condition is meet.  (xemin,xemax,yemin,
c     yemax) are min and max values of contour.  (yxmin,yxmax), are y
c     values at x=xemin and x=xemax respectively.  (xymin,xymax) are x
c     values at y=yemin and y=yemax respectively.  iauto is used as an
c     "error recovery switch".  that is, if a flux surface is found to
c     pass outside the search box an error exit is taken by way of label
c     1000, if iauto=0.  if iauto=1, the input value of psi, psivl, is
c     increased toward the value of psi at (xaxd,yaxd) until a closed
c     surface inside the search box is found.  obviously this option
c     makes sense only for the limiter flux surface.  it could be used
c     to find the plasma boundary if an appopriate search box were
c     defined.  however its primary use here is to slightly modify
c     psilim so that a closed limiter flux surface is found.  the option
c     is necessary due to the fact some codes generate eqdsks
c     using linear interpolation, which differs from the bicubic inter-
c     polation used here.  the user is informed that psivl was changed
c     by returning iautoc=1.  if no change occured iautoc=0.
c    if no error ocurred ierr=0 is returned. if an error ocurred then
c    ierr=1 is returned and the results of this calculation are not valid.
c---input (see description above)
c  xaxd
c  yaxd
c  psivl   psi value for which contour is desired
c  dang
c  arcl
c  bperr   dang,arcl,bperr control point density on contour returned
c  dx
c  dy      defines step length taken
c          input dx and dy as 0.0 to set step length in this subroutine
c  xmin
c  xmax
c  ymin
c  ymax    define the search box
c             NOTE: the search box could be defined as the entire
c                   mhd grid (ie xmin=x(1),xmax=x(nw),ymin=y(1),
c                   ymax=y(nh)) However this will normally not work
c                   satisfactorily because there are local minima and
c                   maxima around the f coils which would confuse the
c                   contour tracing and require many more calculations.
c                   (these additional calculations are not done here!)
c                   The best way to define the search box is to set it
c                   equal to a rectangle,within which the plasma must
c                   reside under all circumstances. The only such
c                   rectangle to suggest itself is the one defined by
c                   the extremes of the limiter. Hence it is suggested
c                   that xmin be set to the min x value of the limiter
c                   points vector,xmax the max x value of limiter points
c                   vector and similarly for ymin,ymax.
c  iaouto  =1 automatic error recovery,=0 no recovery
c             (iauto may be set to 0 in this subroutine
c              if a failure occurs)
c  x(1..nw)
c  y(1..nh)   the mhd grid vectors
c  cspln(n2cspln,nw,nh2)  bicubic spline coefficient array
c  itty      iounit for diagnostic messages. set to 0 to suppress.
c  iptsm     max allowed number of points to be returned in
c            vectors xc,yc
c---output:
c  xemin
c  xemax
c  yemin
c  yemax
c  yxmin
c  yxmax
c  xymax
c  xymin    limits of contour (see above)
c  xc(1,..ipts)
c  yc(1,..ipts)   the ipts contour points found
c  bpmag(1,..ipts)    magnitude of poloidal bfield at xc,yc
c  ipts
c  ierr   error flag,=0 no error,=1 error,output not useable.
c             if ierr .gt. 1 then ierr equals the number of points found
c             on the contour up to this point. Since this number will
c             be exceeded if the code continues,the subroutine must
c             stop. The error condition on bperr has allready been relaxed
c             before this condition causes the subroutine to terminate.
c             Hence in order to continue this subroutine could be called
c             again with a larger value of arcl. (Note: in practice we have
c             not found this to be a problem,provided that iptsm is large
c             enough to begin with toi give an reasonable representation
c             of the contour).
c--------------------------------------------------------------------hsj
      data pi, piov2, piov4, fpiov4, spiov4/3.141592654, 1.570796327, 
     1   0.7853981634, 3.926990818, 5.497787145/
      data twopi, tpiov4, tpiov2, nitr8/6.283185307, 2.356194491, 
     1   4.712388904, 20/
c
c
      iprint = 0
      itry = 0
      psiin = 0.0
      ierr = 0
      iautoc = 0
      bperrsav = bperr
      dbperr = bperr/2.
c---get psi at (xaxd,yaxd)
      call dbcevl1 (x, nw, y, nh, cspln, nw, xaxd, yaxd, pds, ier, 1)
      if (ier /= 0) stop 'cnt1'
      psiaxd = pds(1)
c     if(psiaxd.lt.psivl)stop 'psiax'
    5 continue
      xemin = 1.E10
      xemax = -1.E10
      yemin = 1.E10
      yemax = -1.E10
      xymin = 0.0
      xymax = 0.0
      yxmin = 0.0
      yxmax = 0.0
      ipts = 0
      thet = 0.0
      dthet0 = twopi*dang/360.
      dthet1 = dthet0
      dthet = 0.0
      dxx = dx
      dyy = dy
      if (dxx == 0.0) dxx = x(3) - x(1)    ! 2. times grid spacing is ok
      if (dyy == 0.0) dyy = y(3) - y(1)
      dxmin = .25*(x(2)-x(1))       !sub stops if dxx becomes .lt. dxmin
      serrt = 3.5E-06
      derrt = 0.5E-07
c---serrt is absolute error convergence criteria for newtons method below.
c---
c---
c---loop over theta from 0 to twopi
c---
   10 continue
      thet = thet + dthet
      thet = amin1(thet,twopi)
      if (thet == twopi) go to 200
c---
c---get equation of ray emanating from (xaxd,yaxd)
      if (piov4<=thet .and. thet<=tpiov4) go to 20
      if (fpiov4<=thet .and. thet<=spiov4) go to 20
c---
c---y as a function of x            y=a*x+bincp
c---
      isgn = -1
      if (thet<piov4 .or. thet>spiov4) isgn = 1
      a = tan(thet)
      iflg = 0
      bincp = yaxd - a*xaxd
      go to 30
c---
c---x as a function of y            x=a*y+bincp
   20 continue
      isgn = 1
      if (thet > pi) isgn = -1
      if (isgn /= (-1)) then
         thet1 = piov2 - thet
         if (thet > piov2) thet1 = twopi - abs(thet1)
      else
         thet1 = tpiov2 - thet
         if (thet > tpiov2) thet1 = pi - abs(thet1)
      endif
      a = tan(thet1)
      iflg = 1
      bincp = xaxd - a*yaxd
   30 continue
c---
c---now have y=a*x+bincp    (iflg=0)   or
c---x=a*y+bincp             (iflg=1)
c---
      x1 = xaxd
      y1 = yaxd
      cost = cos(thet)
      sint = sin(thet)
      psi1 = psiaxd
c---sliding interval search. max width of interval ~1.41*(dx or dy)
   40 continue
      if (iflg /= 1) then
c---search in x
         x2 = x1 + isgn*dxx                      ! increment x
         y2 = a*x2 + bincp                ! get corresponding value of y
      else
c---search in y
         y2 = y1 + isgn*dyy
         x2 = a*y2 + bincp                ! get corresponding value of x
c  60 if((x2.lt.xmin).or.(x2.gt.xmax))go to 1000
c     if((y2.lt.ymin).or.(y2.gt.ymax))go to 1000
      endif
      x2 = amax1(x2,xmin)
      x2 = amin1(x2,xmax)
      y2 = amax1(y2,ymin)
      y2 = amin1(y2,ymax)
c                                                !error exit
      if(x2==xmin.and.x1==xmin.or.x2==xmax.and.x1==xmax)go to1000
c                                                !error exit
      if(y2==ymin.and.y1==ymin.or.y2==ymax.and.y1==ymax)go to1000
      call dbcevl1 (x, nw, y, nh, cspln, nw, x2, y2, pds, ier, 1)
      if (ier /= 0) stop 'cntour'
      psi2 = pds(1)
      dpsi = (psivl - psi1)*(psivl - psi2)
      if (dpsi <= 0.0) go to 70
      x1 = x2
      y1 = y2
      psi1 = psi2
      go to 40
c---
c---now have psivl between psi1 and psi2,converge using newton-raphson
c---
   70 continue
      newti = 0
      if (iflg /= 1) then
         xn = x1 + isgn*dxx*0.5
         yn = a*xn + bincp
      else
         yn = y1 + isgn*dyy*0.5
         xn = a*yn + bincp
      endif
   80 continue
      call dbcevl1 (x, nw, y, nh, cspln, nw, xn, yn, pds, ier, 3)
      if (ier /= 0) then
         newti = nitr8
         go to 76
      endif
      dpsids = pds(2)*cost + pds(3)*sint
      dpsi = pds(1) - psivl
      serr = -dpsi/dpsids
      if (abs(serr) < serrt) go to 90
      if (psivl==0 .and. abs(dpsi)<derrt) go to 90
      if (psivl /= 0.) then
         if (abs(dpsi/psivl) < derrt) go to 90
      endif
      delx = serr*cost
      dely = serr*sint
      xn = xn + delx
      yn = yn + dely
      newti = newti + 1
   76 continue
      if (newti >= nitr8) then
         if (dxx <= dxmin) stop 'newti'
         dxx = 0.5*dxx
         dyy = 0.5*dyy
         go to 30
      endif
      go to 80
c---end of newton iteration
c---check for sufficient accuracy in point spacing as determined by thet
c---accuracy test is based on a relative error in poloidal b field of bperr
   90 continue
      bp2 = (1./xn)*sqrt(pds(2)**2+pds(3)**2)
      if (thet == 0.0) go to 100
      dthet1 = 2.*dthet
      if (abs((bp2 - bp1)/amax1(bp2,bp1)) < bperr) go to 100
c---avoid accumulation at x points
      ihalf = ihalf + 1
c     if(ihalf.gt.4)go to 100
      if (ihalf > 8) go to 100
c---spacing too large for grad psi. decrease theta and try again
      thet = thet - dthet
      dthet = dthet*0.5
      dthet1 = dthet
      go to 10
  100 continue
      bp1 = bp2
      ipts = ipts + 1
      if (ipts > iptsm - 1) then
         if (bperr - bperrsav >= 2.*dbperr) go to 110
         bperr = bperr + dbperr
         go to 5
  110    continue
         if (itty /= 0) then
            write (itty, 1040) iptsm
 1040       format(2x,'code has to stop because more points on plasma ',
     1         /,2x,
     2'boundary were found than dimension of xcontr,ycontr allows',/,2x,
     3         'allowed number = ',i5)
         endif
         ierr = ipts
         return 
      endif
      xc(ipts) = xn
      yc(ipts) = yn
      bpmag(ipts) = bp2
      xemin = amin1(xemin,xn)
      xemax = amax1(xemax,xn)
      if (xemax == xn) yxmax = yn
      if (xemin == xn) yxmin = yn
      yemin = amin1(yemin,yn)
      yemax = amax1(yemax,yn)
      if (yemax == yn) xymax = xn
      if (yemin == yn) xymin = xn
c---limit angle increment to approximately arcl meters per step
      rad1 = sqrt((xn - xaxd)**2 + (yn - yaxd)**2)
      dthet = amin1(dthet0,arcl/rad1,dthet1)
      ihalf = 0
      go to 10
c---
c---close contour
c---
  200 continue
      if (abs(((xc(ipts)-xc(1))**2+(yc(ipts)-yc(1))**2)/(xc(1)**2+yc(1)
     1   **2)) >= 1.E-8) then
         ipts = ipts + 1
         xc(ipts) = xc(1)
         yc(ipts) = yc(1)
         bpmag(ipts) = bpmag(1)
c
         bperr = bperrsav
      endif
      if (itry/=0 .and. iconvg==1) then
         psiin = psivl
         psivln = 0.5*(psiout + psiin)
         if(abs(psivln-psivl)<1.E-06.and.itty/=0)write(itty,1045)psivln
 1045    format(2x,'final converged value of psi =',1pe16.8)
         if (abs(psivln - psivl) < 1.E-06) return 
         psivl = psivln
         go to 5
      endif
      return 
c---
c---errors
c---
c1000 if(itty.ne.0.and.iprint.eq.0)
 1000 continue
      if (itty/=0 .and. iprint<=0) write (itty, 1010) x(1), x(nw), x2, y
     1   (1), y(nh), y2
 1010 format(1x,'open contour in cntour',/,'x(1),x(nw),x = ',3(2x,e16.8)
     1   ,/,1x,'y(1),y(nh),y = ',3(2x,e16.8))
      if (iauto /= 1) then
         ierr = 1
         return 
      endif
      psivl0 = psivl
      psiout = psivl
      dapsi = psiaxd - psivl0
      psivl = psivl0 + dapsi*0.0005
      if(itry>1.and.psiin/=0.0.and.iconvg==1)psivl=0.5*(psiin+psiout)
      iautoc = 1
c     if(itty.ne.0.and.iprint.eq.0)
      if (itty/=0 .and. iprint<=0) write (itty, 1020) psivl0, psivl
 1020 format(2x,'boundary search, will change psilim from',/,e16.8,
     1   '  to  ',e16.8,'  and try again')
      itry = itry + 1
      iprint = 1
      if (itry > 20) then
         iprint = 0
         iauto = 0
         go to 1000                              !cant do it,quit
      endif
      go to 5                                    !go back and try again
      end subroutine cntour

