cart2int_NH3/tab2genetic.f

      program tab2genetic
      use iso_fortran_env, only: error_unit
      implicit none
      include 'nnparams.incl'
      include 'JTmod.incl'

      integer, parameter :: infile=100,enfile=101
      character(len=2048) line

      real*8 cart(3,4),qint(maxnin)
      real*8 energies(4)
!     useless crap written in table1
      real*8 tmp

      character(len=1024) binary,infile_name
      character(len=3) lfmt,ofmt
      parameter (lfmt='(A)',ofmt='(A)')
      integer, parameter :: uerr=error_unit, uout=6

      integer j,k

      call getarg(0,binary)

      if (iargc().lt.2) then
         write(uerr,ofmt) 'ERROR: Missing madatory argument.'
         write(uerr,ofmt) trim(binary)
     >        // ' CART_FILENAME EN_FILENAME'
         stop
      endif
      call getarg(1,infile_name)
      write(uerr,ofmt) ' Input file: '//trim(infile_name)
      open(infile,file=trim(infile_name),status='old',action='read')
      call getarg(2,infile_name)
      write(uerr,ofmt) ' Energy file: '//trim(infile_name)
      open(enfile,file=trim(infile_name),status='old',action='read')

      do
         read(infile,lfmt,err=403,end=404) line
         cart(:,1)=0
         read(line,*,err=405,end=403)  tmp, cart(1:3,2:4)
         call cart2int(cart,qint)
         do
            read(enfile,lfmt,err=400,end=404) line
            read(line,*,err=400,end=400) tmp,energies
            exit
 400        cycle
         enddo
!        order: E, xs,ys,xb,yb,a,b
         do k=1,4
            write(uout,'(F15.8,6F20.6)')
     >           energies(k),
     >           (qint(pat_index(j)), j=2,5),
     >           qint(pat_index(1)),
     >           qint(pat_index(6))
         enddo
 403     cycle
 404     exit
 405     write(uerr,*) 'WARNING: MALFORMED LINE: "'
     >        //trim(line)//'"'
      enddo

      close(infile)
      close(enfile)
      end program