      PROGRAM HCNvri5
! Part Q5: Iteration control 
!
! W.Quapp, Benjamin Schmidt,  2009
! 
!      n = Dimension
! length = Kettenlänge
!  chain = Kette of nodes of an NT
!      
! part (5) is this: 
! Organize Iterations up to convergence of VRI: Agmin < Ageps
!          by repeating of (2)-(4)
! 
      INTEGER n,length,itermax
      DOUBLE PRECISION Ageps
      PARAMETER (n=3,length=50,itermax=9,Ageps=0.0000001d0)

      INTEGER Istatus,iter,k1,k3
      DOUBLE PRECISION chain(length+1,n),vri(n),pk(n),pk1(n)
      DOUBLE PRECISION chainPv(5+1,n),chainPh(5+1,n),eps
      DOUBLE PRECISION xstart(n),xend(n),dir(n),Agmin,Agminx,xx

      OPEN(7,FILE='chain.dat',status='unknown',access='append')
      OPEN(8,FILE='hcnVkette.dat')
      OPEN(9,FILE='hcnVketNrj.dat')
      OPEN(11,FILE='hcnVdir.dat')
      OPEN(16,FILE='hcnVeps.dat')
      OPEN(17,FILE='hcnViter.dat')      
      OPEN(18,FILE='hcnVistat.dat')
      OPEN(25,FILE='hcnVtold.dat')
      OPEN(30,FILE='hcnVvri.dat')
      OPEN(33,FILE='hcnVmin.dat')
c protocol file: all interesting output of the vri-search
      OPEN(44,FILE='hcnVprotocol.txt',status='unknown',access='append')
cccccccccccccccccccccccccccc
2     FORMAT(3F20.14)
       Read(16,*) eps       
       Read(17,*) iter 
       write(*,*) 'iter in Q5 ',iter
       Read(18,*) istatus
       write(*,*) 'istatus Q5 ',istatus
       Read(33,*) Agmin, Agminx, xx
       write(*,*) 'Agmin, Agminx, AgNT = ', Agmin, Agminx, xx
       write(44,*)'Agmin, Agminx, AgNT = ', Agmin, Agminx, xx
c
       rewind 8
       Do 1 k=1,length+1
        Read(8,*) (chain(k,i),i=1,n)
1     CONTINUE
c make Mma input file  !! CH and CN coordinates interchanged 
c
      rewind 30
      read(30,*) (vri(i),i=1,n)
c replace vriold by vri 
      write(30,2) (vri(i),i=1,n)      
c 
      rewind 11
      Read(11,*) (dir(i),i=1,n)
c write vri also to Mma input file
        WRITE(7,*) '(*  vri approx in iter ',iter 
        WRITE(7,34) vri(2), vri(1), vri(3)
        WRITE(7,*) ' *) '
34    FORMAT('Point[{',F20.14,' , ',F20.14,'  , ',F20.14,'/90.0}],')
ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       iter=iter+1
       k=1
       rewind 17
       Write(17,*) iter,k
       if(iter .eq. 1)    goto 20
       if( (iter.eq.itermax) .or. (Agmin .lt. Ageps) 
     1                       .or. (Agmin .eq. Agminx)) then 
         if(iter .eq. itermax) write(*,*) 'iter  =  itermax' 
         if(Agmin .lt. Ageps)  write(*,*) 'Agmin <  Ageps'
         if(Agmin .eq. Agminx) write(*,*) 'Agmin =  Agminx'
         if(iter .eq. itermax) write(44,*) 'iter  =  itermax'
         if(Agmin .lt. Ageps)  write(44,*) 'Agmin <  Ageps'
         if(Agmin .eq. Agminx) write(44,*) 'Agmin =  Agminx'
         write(*,*) 'vripoint', (vri(i),i=1,n)
         write(*,*) 'vridir  ', (dir(i),i=1,n)
         write(44,*)'vripoint', (vri(i),i=1,n)
         write(44,*)'vridir  ', (dir(i),i=1,n)
         istatus=10
         rewind 9
         k=1
         Write(9,*) k
         goto 10
       endif
20     continue          
       istatus=3
c or if any criterium is o.k., set istatus=10 !
ccccccccccccccccccccccccccccccccccccccccccccccc
       write(44,*)' new xstart is'
       WRITE(44,50)(chain(length+1,I),I=1,N)
c turn tangent for turned chain:
      rewind 25
      read(25,*)(dir(i),i=1,n)
      rewind 25
      Write(25,*) (-1.0d0*dir(i),i=1,n)
50    FORMAT(1X,3F20.10)
      rewind 8
      DO 3 k=1,length+1
         WRITE(8,2) (chain(length+2-k,i),i=1,n)
3     CONTINUE
      j=1
      rewind 9
      write(9,*) j
      goto 44
10    CONTINUE
      rewind 8
      Do 5 k=1,length+1
5     Write(8,2) (chain(length+2-k,i),i=1,n)
ccc
44    continue      
ccc
      Agminx=Agmin
      xx=0.1d0
      rewind 33
      write(33,*) Agmin, Agminx,xx 
      Write(*,*)'iteration ',iter
      Write(*,*)'Ag minimum',Agmin
      Write(44,*)
      Write(44,*)'iteration ',iter
      Write(44,*)'Ag minimum',Agmin 
      rewind 18 
      write(18,*)istatus
      call exit(istatus)
      END 
!
! Legt gerade "kette" der Länge "le" zwischen die Punkte "x" und  "y"
!
      SUBROUTINE straight_chain(kette,x,y,nn,le)
      DOUBLE PRECISION kette(le+1,nn),x(nn),y(nn)
      DO 20 j=1,le+1
        DO 10 i=1,nn
                kette(j,i)=x(i)+((j-1)*(y(i)-x(i)))/le
10      CONTINUE
20    CONTINUE
      END
ccc 