      PROGRAM A22Vri5
! Part Q5: Iteration 
!
! W.Quapp  2009
! 
!      n = Dimension
! length = Kettenlänge
!    eps = Genauigkeit des RGF-Verfahrens
!  chain = verwendete Ketten - Knoten 
!    dir = Suchrichtung für RGF-Verfahren = rsel
! itermax= no more iterations
!      
! vrisear 5 is this: 
! (6) Wiederhole (3)-(6) hinreichend oft bis:  Agmin < Ageps
!
      INTEGER n,length,itermax
      DOUBLE PRECISION Ageps
      PARAMETER (n=58,length=12,itermax=15,Ageps=1.0001d-17)

      INTEGER Istatus,iter
      DOUBLE PRECISION chain(length+1,n),vri(n)
      DOUBLE PRECISION chainPv(5+1,n),chainPh(5+1,n),eps
      DOUBLE PRECISION xstart(n),xend(n),dir(n),Agmin,Agminx,xx
      Character*5  Zcoor(n+2)
c
      Data Zcoor/'ch2  ','cc3  ','cch3 ','oc4  ','occ4 ','dih4 ',
     1   'hc5  ','hcc5 ','dih5 ','hc6  ','hcc6 ','dih6 ','nc7  ',
     2   'ncc7 ','dih7 ','cn8  ','cnc8 ','dih8 ','cc9  ','ccn9 ',
     3   'dih9 ','oc10 ','occ10','dih10','hc11 ','hcn11','dih11',
     4   'hn12 ','hnc12','dih12','cc13 ','ccn13','dih13','hc14 ',
     5   'hcc14','dih14','hc15 ','hcc15','dih15','hc16 ','hcc16',
     6   'dih16','nc17 ','ncc17','dih17','cn18 ','cnc18','dih18',
     7   'hc19 ','hcn19','dih19','hn20 ','hnc20','dih20','hc21 ',
     8   'hcn21','dih21','hc22 ','hcn22','dih22'/
c                                                          
      OPEN(7,FILE='chain.dat',status='unknown',access='append')
      OPEN(8,FILE='a22Vkette.dat')
      OPEN(9,FILE='a22VketNrj.dat')
      OPEN(11,FILE='a22Vdir.dat')
      OPEN(16,FILE='a22Veps.dat')
      OPEN(17,FILE='a22Viter.dat')      
      OPEN(18,FILE='a22Vistat.dat')
      OPEN(25,FILE='a22Vtold.dat')
      OPEN(26,FILE='a22Vt1old.dat') 
      OPEN(30,FILE='a22Vvri.dat')
      OPEN(33,FILE='a22Vmin.dat')
c protocol file: all interesting output of the vri-search
      OPEN(44,FILE='a22Vprotocol.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 for phi = dih9 and psi= dih17 
        WRITE(7,*)'{'
        DO 6 k=1,length
         Do i=1,N
       If(Zcoor(i).eq.'dih9') WRITE(7,*) '{  ',chain(k,i-1),' ,'
       If(Zcoor(i).eq.'dih17')WRITE(7,*) chain(k,i-1),' }, '
         enddo
6      continue
        k=length+1
          Do i=1,N
       If(Zcoor(i).eq.'dih9') WRITE(7,*) '{  ',chain(k,i-1),' ,'
       If(Zcoor(i).eq.'dih17')WRITE(7,*) chain(k,i-1),' }, '
          enddo
       WRITE(7,*)'}'
c
      rewind 30
      read(30,*) (vri(i),i=1,n)
c replace vriold by vri 
      write(30,2) (vri(i),i=1,n)      
      rewind 11
      Read(11,*) (dir(i),i=1,n)
c make Mma input file
        WRITE(7,*) '(*  vri approx in iter ',iter
         Do i=1,N
       If(Zcoor(i).eq.'dih9') WRITE(7,*) '{  ',vri(i-1),' ,'
       If(Zcoor(i).eq.'dih17')WRITE(7,*) vri(i-1),' } '
         enddo
        WRITE(7,*) ' *) '
ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       iter=iter+1
       k=1
       rewind 17
       Write(17,*) iter,k
       if(iter .lt. 4)    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'
         write(*,2) (vri(i),i=1,5)
         write(*,2) (vri(i),i=6,n)
         write(*,*) 'vridir  '
         write(*,2) (dir(i),i=1,5)
         write(*,2) (dir(i),i=6,n)
         write(44,*)'vripoint'
         write(44,2) (vri(i),i=1,5)
         write(44,2) (vri(i),i=6,n)
         write(44,*)'vridir  '
         write(44,2) (dir(i),i=1,5)
         write(44,2) (dir(i),i=6,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,5)
       WRITE(44,50)(chain(length+1,I),I=6,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)
      rewind 26
      read(26,*)(dir(i),i=1,n)
      rewind 26
      Write(26,*) (-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)
c
44    continue      
      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

