subroutine fixedpoint(funcnleq1,x0min,x0ori,xp,
     &  x0max,fequ,nunknowns,TOLF,stpmax,iwhichsolver)
      implicit none
      include 'nslasystem.h'
!-------- Inputs ---------------------------------------
! nunknowns:          The number of unknowns to be solved
! x0ori(1:nunknowns): initial guess for the unknowns
! x0min(1:nunknowns): lower bound of the solution
! x0max(1:nunknowns): upper bound of the solution
! stpmax: the maximum length of the steps allowed to prevent search into
! undefined region.
! TOLF: Error tolerance
! funcnleq1: the subroutine name for the nonlinear system
      integer nunknowns
      double precision x0min(1:nunknowns),x0ori(1:nunknowns),
     &  x0max(1:nunknowns),TOLF,stpmax
! --------- Outputs -------------------------------------
! fequ(1:nunknowns): function values at the last step of iteration
! xp(1:nunknowns): final solutions or solutions not worse than x0ori   
! iwhichsolver:    =0,1,2,3,4 successful
!                  =-9999 failed, best solution returned
      integer iwhichsolver     
      double precision fequ(1:nunknowns),xp(1:nunknowns)
! ---------Local variables --------------------------------
      integer i,j,k,n,maxiter,notfound,ncount,ierr,
     &        ismallest,iGuCall
      double precision swap,x1,x2,f1,f2,fsqsumold,
     &  fsqsumnew,xpold(nunknowns),fequold(nunknowns),
     &  gfuncsum(nunknowns),deltax(nunknowns),
     &  xpder(nunknowns),fjacob(nunknowns,nunknowns),
     &  fjacobcopy(nunknowns,nunknowns),fsqsum,term
      logical check
      parameter(maxiter=200,notfound=-9999,iGuCall=49)
      integer iselect(300*maxiter)
      logical resetran2
      common /ran2reset/resetran2
      save /ran2reset/
      external funcnleq1
!-----------------------------------------------------------
      resetran2=.true.
      do i=1,nunknowns
        xp(i)=x0ori(i)
      enddo
      iwhichsolver=notfound
      numeval=0
!--------------------------------------------------------------
!Plain fixed-point method. Fixed-point method 1
      do i=1,maxiter
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        if(dabs(fequ(k)).lt.TOLF)then
          iwhichsolver=1
          return
        endif
        do j=1,nunknowns
          xp(j)=xp(j)-fequ(j)
          if(xp(j).lt.x0min(j).or.xp(j).gt.x0max(j))then
            call reinitialization(x0min(j),x0ori(j),
     &        x0max(j),xp(j),50000)
          endif
        enddo
      enddo
!_____________________________________________________________________
!try approximation to the newton method, iwhichsolver=0. this would work
!if the equations are independent
1     do i=1,nunknowns
        xp(i)=x0ori(i)
      enddo
      do i=1,maxiter
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        n=0
        do j=1,nunknowns
          if(dabs(fequ(j)).gt.0.0d0)then
          else
            n=1
            call reinitialization(x0min(j),x0ori(j),
     &        x0max(j),xp(j),50000)
          endif
        enddo
        if(n.ne.0)goto 2
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        if(dabs(fequ(k)).lt.TOLF)then
          iwhichsolver=0
          return
        endif
        do j=1,nunknowns
          xpold(j)=xp(j)
          fequold(j)=fequ(j)
          xp(j)=xp(j)+fequ(j)
        enddo
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        do j=1,nunknowns
          if(dabs(fequ(j)).gt.0.0d0)then
          else
            n=1
            call reinitialization(x0min(j),x0ori(j),
     &        x0max(j),xp(j),50000)
          endif
        enddo
        if(n.ne.0)goto 2
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        do j=1,nunknowns
          if(fequ(j).ne.fequold(j))then
            xpder(j)=fequold(j)/(fequ(j)-fequold(j))
          else
            xpder(j)=0.0d0
          endif
          xp(j)=xpold(j)-xpder(j)*fequold(j)
          if(xp(j).lt.x0min(j).or.xp(j).gt.x0max(j))then
            call reinitialization(x0min(j),x0ori(j),
     &        x0max(j),xp(j),50000)
          endif
        enddo
2       continue
      enddo
!_____________________________________________________________________
!try fixed-point method 2
      do j=1,nunknowns
        call reinitialization(x0min(j),x0ori(j),
     &        x0max(j),xp(j),10000)
      enddo
      call funcnleq1(nunknowns,xp,fequ,fsqsum)
      call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
      do i=1,nunknowns
        xp(i)=xp(i)-fequ(i)
        if(xp(i).lt.x0min(i).or.xp(i).gt.x0max(i))then
          call reinitialization(x0min(i),x0ori(i),
     &      x0max(i),xp(i),2000)
        endif
      enddo
      do i=1,maxiter
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        if(dabs(fequ(k)).lt.TOLF)then
          iwhichsolver=2
          return
        endif
        do j=1,nunknowns
          ierr=0
          x1=xevaluated(numeval-1,j)
          f1=x1-fevaluated(numeval-1,j)
          x2=xevaluated(numeval,j)
          f2=x2-fevaluated(numeval,j)
          if(dabs(f2-f1-x2+x1).gt.1.0d-20)then
            ierr=1
            xp(j)=(x1*(f2-f1)-f1*(x2-x1))/
     &        (f2-f1-x2+x1)
            if(xp(j).le.x0min(j).or.xp(j)
     &                .ge.x0max(j))then
              ierr=0
            endif
          endif
          if(ierr.le.0.and.numeval.ge.3)then
! haven't found a usable new point yet, first try the opposite sign point
            ncount=0
            do k=1,numeval-2
              if((fevaluated(k,j)*fevaluated(numeval,j))
     &             .lt.0.0d0)then
                ncount=ncount+1
                iselect(ncount)=k
              endif
            enddo
            if(ncount.gt.0)then
! there are points at different sides of the zero.
              ismallest=1
              do k=2,ncount
                if(dabs(xevaluated(iselect(k),j)-x2).lt.
     &      dabs(xevaluated(iselect(ismallest),j)-x2))then
                  ismallest=k
                endif
              enddo
              ierr=1
              x1=xevaluated(iselect(ismallest),j)
              f1=x1-fevaluated(iselect(ismallest),j)
              xp(j)=(x1*(f2-f1)-f1*(x2-x1))/
     &            (f2-f1-x2+x1)
            else
! all at the same sides of the zero.
              do k=1,numeval-2
                x1=xevaluated(k,j)
                f1=x1-fevaluated(k,j)
                if(dabs(f2-f1-x2+x1).gt.1.0d-10)then
                  xp(j)=(x1*(f2-f1)-f1*(x2-x1))/
     &            (f2-f1-x2+x1)
                  if(xp(j).gt.x0min(j).and.xp(j).lt.x0max(j))then
                    ierr=1
                  endif
                endif
                if(ierr.eq.1)goto 10
              enddo
10            continue
            endif
          endif
          if(ierr.eq.0)then
            call reinitialization(x0min(j),
     &        xevaluated(numeval,j),x0max(j),xp(j),1000)
          endif
        enddo
        ierr=0
        do k=1,nunknowns
          if(xp(k).ne.xevaluated(numeval,k))ierr=1
        enddo
        if(ierr.eq.0)then
          do k=1,nunknowns
            call reinitialization(x0min(k),
     &        xevaluated(numeval,k),x0max(k),xp(k),25000)   
          enddo
        endif
      enddo
!__________________________________________________________________
!Try fixed-point method 3
      do i=1,nunknowns
        xp(i)=x0ori(i)+1.0d-6
        if(xp(i).lt.x0min(i).or.xp(i).gt.x0max(i))then
          call reinitialization(x0min(i),x0ori(i),
     &        x0max(i),xp(i),250910)
        endif
      enddo
      do j=1,maxiter
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        if(dabs(fequ(k)).lt.TOLF)then
          iwhichsolver=3
          return
        endif
        do i=1,nunknowns
          xp(i)=xp(i)-fequ(i) 
          if(xp(i).lt.x0min(i).or.xp(i).gt.x0max(i))then
            call reinitialization(x0min(i),x0ori(i),
     &        x0max(i),xp(i),25500)
          endif
        enddo
        call funcnleq1(nunknowns,xp,fequ,fsqsum)
        call bookkeeping(nunknowns,xp,fequ,iGuCall,k)
        if(dabs(fequ(k)).lt.TOLF)then
          iwhichsolver=3
          return
        endif
        do i=1,nunknowns
          if(fevaluated(numeval,i).eq.
     &       fevaluated(numeval-1,i))then
            x1=(xevaluated(numeval,i)+
     &        xevaluated(numeval-1,i))/2.0d0
            call reinitialization(x0min(i),x1,
     &        x0max(i),xp(i),35678)
          else
            xp(i)=(xevaluated(numeval,i)*fevaluated(numeval-1,i)
     &         -xevaluated(numeval-1,i)*fevaluated(numeval,i))/
     &         (fevaluated(numeval-1,i)-fevaluated(numeval,i))
            if(xp(i).lt.x0min(i).or.xp(i).gt.x0max(i))then
              call reinitialization(x0min(i),x0ori(i),
     &         x0max(i),xp(i),45678)
            endif
          endif
        enddo
      enddo
!------------------------------------------------------------
!Try fixed-point method 4

!11    call funcnleq1(nunknowns,xp,fequ,fsqsumold)
!      call bookkeeping(nunknowns,xp,fequ,iGuCall,i)

      fsqsumold=0.0d0
      do i=1,nunknowns
        xpold(i)=xevaluated(numeval,i)
        fequold(i)=fevaluated(numeval,i)
        fsqsumold=fsqsumold+fequold(i)*fequold(i)
      enddo
      term=fsqsumold
      do k=1,maxiter/5
        do j=1,nunknowns
          do i=1,nunknowns
            xpder(i)=xpold(i)
          enddo
          if(dabs(fequold(j)).lt.1.0d-10)then
            xpder(j)=xpold(j)+1.0d-5
          else
            xpder(j)=xpold(j)-fequold(j)           
          endif
          if(xpder(j).lt.x0min(j).or.xpder(j).
     &       gt.x0max(j))then
            call reinitialization(x0min(j),xpold(j),
     &         x0max(j),xpder(j),89000)
          endif
          call funcnleq1(nunknowns,xpder,fequ,fsqsumnew)
          call bookkeeping(nunknowns,xpder,fequ,iGuCall,i)
          if(dabs(fequ(i)).lt.TOLF)then
            iwhichsolver=4
            return
          endif
          do i=1,nunknowns
            fjacob(i,j)=(fequ(i)-fequold(i))/
     &        (xpder(j)-xpold(j))
            fjacobcopy(i,j)=fjacob(i,j)
          enddo
          gfuncsum(j)=(fsqsumnew-fsqsumold)/
     &      (xpder(j)-xpold(j))
        enddo
        call xmprove(nunknowns,nunknowns,
     &     fjacob,fequold,deltax,ierr)
!if ierr = 0, matrix is singular. ierr = 1, everything is ok.
        if(ierr.eq.0)then
          call adsor(fjacobcopy,nunknowns,nunknowns,
     &       fequold,deltax,ierr)
          if(ierr.ne.1)ierr=0
        endif
        if(ierr.ne.0)then
          do i=1,nunknowns
            deltax(i)=-deltax(i)
          enddo
          call lnsrch(nunknowns,xpold,fsqsumold,
     &      gfuncsum,deltax,xp,fsqsumnew,stpmax,
     &      check,funcnleq1,fequ)
          if(check.eqv..true..or.check.eqv..TRUE.)then
            do i=1,nunknowns
              call reinitialization(x0min(i),xpold(i),
     &         x0max(i),xp(i),6678)
            enddo
          endif
          do i=1,nunknowns
            if(xp(i).lt.x0min(i).or.xp(i).gt.x0max(i))then
              call reinitialization(x0min(i),x0ori(i),
     &         x0max(i),xp(i),678)
            endif
          enddo
        else
          do i=1,nunknowns
            call reinitialization(x0min(i),x0ori(i),
     &        x0max(i),xp(i),75678)
          enddo
        endif
        call funcnleq1(nunknowns,xp,fequ,fsqsumold)
        call bookkeeping(nunknowns,xp,fequ,iGuCall,i)
        if(dabs(fequ(i)).lt.TOLF)then
          iwhichsolver=4
          return
        endif
        do i=1,nunknowns
          xpold(i)=xp(i)
          fequold(i)=fequ(i)
        enddo
        if(fsqsumold.ge.term)goto 30
        term=fsqsumold
      enddo
!_____________________________________________________________
!If all four methods failed, choose the best xp
30    do i=1,numeval
        do k=i+1,numeval
          if(flargest(k).lt.flargest(i))then
            swap=flargest(k)
            flargest(k)=flargest(i)
            flargest(i)=swap
            do ncount=1,nunknowns
              swap=xevaluated(k,ncount)   
              xevaluated(k,ncount)=xevaluated(i,ncount)
              xevaluated(i,ncount)=swap
              swap=fevaluated(k,ncount)
              fevaluated(k,ncount)=fevaluated(i,ncount)
              fevaluated(i,ncount)=swap
            enddo
          endif
        enddo
      enddo
! Best solution found so far        
      do i=1,nunknowns
        xp(i)=xevaluated(1,i)
        fequ(i)=fevaluated(1,i)
      enddo
      return
      end subroutine fixedpoint