c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  program document  --  produce documentation from listing  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "document" generates a formatted description of all the code
c     modules or common blocks, a force field parameter listing, or
c     a listing of all valid keywords
c
c
      program document
      implicit none
      integer maxline,maxunit,maxkey
      parameter (maxline=50)
      parameter (maxunit=1000)
      parameter (maxkey=1000)
      include 'iounit.i'
      integer i,k,idoc,isrc
      integer iunit,nunit,nkey
      integer mode,next,leng,start
      integer freeunit,trimtext,nexttext
      integer link(maxunit),nline(maxunit)
      character*20 module
      character*20 keyword,keylast
      character*20 key(maxkey)
      character*60 docfile,srcfile
      character*80 record,string
      character*80 routine(maxunit)
      character*80 describe(maxline,maxunit)
      logical exist,done
c
c
c     find out what documentation the user wants to generate
c
      call initial
      write (iout,10)
   10 format (/,' The Following Options are Available :',
     &        //,'    (1) List of Routines from a Source File',
     &         /,'    (2) List of Common Blocks from Source',
     &         /,'    (3) List of the TINKER Option Keywords',
     &         /,'    (4) Documentation from a Parameter File')
      mode = 0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=20,end=20)  mode
   20 continue
      dowhile (mode.lt.1 .or. mode.gt.4)
         write (iout,30)
   30    format (/,' Enter the Number of the Desired Choice :  ',$)
         read (input,40,err=20)  mode
   40    format (i10)
      end do
c
c     get the filename and open the input source code file
c
      if (mode .ne. 4) then
         isrc = freeunit ()
         call nextarg (srcfile,exist)
         if (exist) then
            call suffix (srcfile,'txt')
            call version (srcfile,'old')
            inquire (file=srcfile,exist=exist)
         end if
         dowhile (.not. exist)
            write (iout,50)
   50       format (/,' Enter Name of Source Code Listing File :  ',$)
            read (input,60)  srcfile
   60       format (a60)
            call suffix (srcfile,'txt')
            call version (srcfile,'old')
            inquire (file=srcfile,exist=exist)
         end do
         open (unit=isrc,file=srcfile,status='old')
      end if
c
c     get list of routines and descriptions from source code
c
      if (mode .eq. 1) then
         nunit = 0
         dowhile (.true.)
            read (isrc,70,end=100)  record
   70       format (a80)
            if (record(1:9) .eq. 'c     ## ') then
               next = 10
               call getword (record,module,next)
               call lowcase (module)
               call upcase (module(1:1))
               if (module.eq.'Subroutine' .or. module.eq.'Function'
     &                      .or. module.eq.'Program') then
                  nunit = nunit + 1
                  call getword (record,routine(nunit),next)
                  call upcase (routine(nunit))
                  leng = trimtext (routine(nunit))
                  routine(nunit) = routine(nunit)(1:leng)//' '//module
                  read (isrc,80,end=100)
   80             format (///)
                  k = 0
                  done = .false.
                  dowhile (.not. done)
                     read (isrc,90,end=100)  record
   90                format (a80)
                     leng = trimtext (record)
                     if (leng .lt. 7) then
                        done = .true.
                     else if (record(1:1) .eq. ' ') then
                        done = .true.
                     else
                        k = k + 1
                        describe(k,nunit) = record(7:leng)
                     end if
                  end do
                  nline(nunit) = k
               end if
            end if
         end do
  100    continue
         close (unit=isrc)
         call sort7 (nunit,routine,link)
         idoc = freeunit ()
         docfile = 'routine.doc'
         call version (docfile,'new')
         open (unit=idoc,file=docfile,status='new')
         do i = 1, nunit
            string = routine(i)
            write (idoc,110)  string(1:trimtext(string))
  110       format (a,/)
            iunit = link(i)
            do k = 1, nline(iunit)
               string = describe(k,iunit)
               write (idoc,120)  string(1:trimtext(string))
  120          format (a)
            end do
            if (nline(iunit) .ne. 0) then
               write (idoc,130)
  130          format ()
            end if
         end do
         close (unit=idoc)
         write (iout,140)  docfile(1:trimtext(docfile))
  140    format (/,' Source Documentation Written To:  ',a)
      end if
c
c     get list of common blocks and their contents from source code
c
      if (mode .eq. 2) then
         nunit = 0
         dowhile (.true.)
            read (isrc,150,end=180)  record
  150       format (a80)
            if (record(1:9) .eq. 'c     ## ') then
               next = index (record,'.i  --')
               if (next .ne. 0) then
                  nunit = nunit + 1
                  leng = trimtext (record)
                  call upcase (record(11:next-1))
                  string = record(11:next-1)
                  start = 20
c                 start = trimtext(string) + 5
                  string(start:80) = record(next+8:leng-4)
                  routine(nunit) = string
                  read (isrc,160,end=180)
  160             format (///)
                  k = 0
                  done = .false.
                  dowhile (.not. done)
                     read (isrc,170,end=180)  record
  170                format (a80)
                     leng = trimtext (record)
                     if (record(1:1) .eq. ' ') then
                        done = .true.
                     else if (leng .ge. 7) then
                        k = k + 1
                        next = 7
                        call getword (record,string,next)
                        record = record(next:leng)
                        next = nexttext (record)
                        leng = trimtext (record)
                        start = 20
c                       start = trimtext(string) + 5
                        string(start:80) = record(next:leng)
                        describe(k,nunit) = string
                     end if
                  end do
                  nline(nunit) = k
               end if
            end if
         end do
  180    continue
         close (unit=isrc)
         call sort7 (nunit,routine,link)
         idoc = freeunit ()
         docfile = 'common.doc'
         call version (docfile,'new')
         open (unit=idoc,file=docfile,status='new')
         do i = 1, nunit
            string = routine(i)
            write (idoc,190)  string(1:trimtext(string))
  190       format (a,/)
            iunit = link(i)
            do k = 1, nline(iunit)
               string = describe(k,iunit)
               write (idoc,200)  string(1:trimtext(string))
  200          format (a)
            end do
            if (nline(iunit) .ne. 0) then
               write (idoc,210)
  210          format ()
            end if
         end do
         close (unit=idoc)
         write (iout,220)  docfile(1:trimtext(docfile))
  220    format (/,' Source Documentation Written To:  ',a)
      end if
c
c     get the keyword values from the source code listing
c
      if (mode .eq. 3) then
         dowhile (.true.)
            read (isrc,230,end=240)  record
  230       format (a80)
            next = index (record,'if (keyword(')
            if (next .ne. 0) then
               next = index (record,'.eq.')
               if (next .ne. 0) then
                  next = index (record,'''')
                  if (next .ne. 0) then
                     next = next + 1
                     call getword (record,keyword,next)
                     call upcase (keyword)
                     nkey = nkey + 1
                     key(nkey) = keyword
                  end if
               end if
            end if
         end do
  240    continue
         close (unit=isrc)
         call sort6 (nkey,key)
         keylast = '                    '
         idoc = freeunit ()
         docfile = 'keyword.doc'
         call version (docfile,'new')
         open (unit=idoc,file=docfile,status='new')
         do i = 1, nkey
            keyword = key(i)
            if (keyword .ne. keylast) then
               write (idoc,250)  keyword(1:trimtext(keyword))
  250          format (a)
               keylast = keyword
            end if
         end do
         close (unit=idoc)
         write (iout,260)  docfile(1:trimtext(docfile))
  260    format (/,' Keyword Listing Written To:  ',a)
      end if
c
c     read the force field parameter file and write a listing
c
      if (mode .eq. 4) then
         call getprm
         idoc = freeunit ()
         docfile = 'parameter.doc'
         call version (docfile,'new')
         open (unit=idoc,file=docfile,status='new')
         call prtprm (idoc)
         close (unit=idoc)
         write (iout,270)  docfile(1:trimtext(docfile))
  270    format (/,' Parameter Listing Written To:  ',a)
      end if
      end
