c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine prtprm  --  output of force field parameters  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "prtprm" writes out a formatted listing of the default
c     set of potential energy parameters for a force field
c
c
      subroutine prtprm (itxt)
      implicit none
      include 'sizes.i'
      include 'angpot.i'
      include 'bndpot.i'
      include 'fields.i'
      include 'kanang.i'
      include 'kangs.i'
      include 'katoms.i'
      include 'kbonds.i'
      include 'kchrge.i'
      include 'kdipol.i'
      include 'kiprop.i'
      include 'kitors.i'
      include 'kmulti.i'
      include 'kopbnd.i'
      include 'korbs.i'
      include 'kpolr.i'
      include 'kstbnd.i'
      include 'ksttor.i'
      include 'ktorsn.i'
      include 'kurybr.i'
      include 'kvdws.i'
      include 'kvdwpr.i'
      integer i,j,k,itxt,number
      integer k1,k2,k3,k4
      integer fold(6)
      real*8 ampli(6),phase(6)
      character*1 formfeed
      logical exist
c
c
c     set the string value of the formfeed character (Ctrl-L)
c
      formfeed = char(12)
c
c     force field atom type definitions
c
      exist = .false.
      do i = 1, maxtyp
         if (symbol(i) .ne. '   ')  exist = .true.
      end do
      if (exist) then
         write (itxt,10)  forcefield
   10    format (//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,20)
   20    format (//,17x,'Force Field Atom Definitions',
     &           //,52x,'Atomic',4x,'Atomic',
     &           /,7x,'Type',3x,'Class',3x,'Symbol',3x,'Description',
     &              10x,'Number',4x,'Weight',3x,'Valence',/)
         do i = 1, maxtyp
            if (symbol(i) .ne. '   ') then
               write (itxt,30)  i,atmcls(i),symbol(i),describe(i),
     &                          atmnum(i),weight(i),ligand(i)
   30          format (5x,i5,3x,i5,5x,a3,5x,a20,i5,f12.3,i7)
            end if
         end do
      end if
c
c     van der Waals parameters for atom types
c
      exist = .false.
      do i = 1, maxclass
         if (rad(i) .ne. 0.0d0)  exist = .true.
      end do
      if (exist) then
         write (itxt,40)  formfeed,forcefield
   40    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,50)
   50    format (//,17x,'Van der Waals Parameters',
     &           ///,22x,'Class',7x,'Radius',6x,'Epsilon',
     &                 4x,'Reduction',/)
         k = 0
         do i = 1, maxclass
            if (rad(i) .ne. 0.0d0) then
               k = k + 1
               write (itxt,60)  k,i,rad(i),eps(i),reduct(i)
   60          format (13x,i5,5x,i3,2x,3f12.3)
            end if
         end do
      end if
C
C hailin
c
c     van der Waals 1-4 parameters for atom types
c
      exist = .false.
      do i = 1, maxclass
         if (rad4(i) .ne. 0.0d0)  exist = .true.
      end do
      if (exist) then
         write (itxt,9980)
 9980    format (//,15x,'Van der Waals Parameters for 1-4 Interactions',
     &           ///,20x,'Class',7x,'Radius',6x,'Epsilon',/)
         k = 0
         do i = 1, maxclass
            if (rad4(i) .ne. 0.0d0) then
               k = k + 1
               write (itxt,9990)  k,i,rad4(i),eps4(i)
 9990          format (10x,i5,5x,i4,2x,2f12.3)
            end if   
         end do
      end if
c
C hailinend
c
c     van der Waals parameters for specific atom pairs
c
      if (kvpr(1) .ne. '      ') then
         write (itxt,70)
   70    format (//,17x,'Van der Waals Parameters for Atom Pairs',
     &           ///,23x,'Classes',7x,'Radii Sum',4x,'Epsilon',/)
         do i = 1, maxnvp
            if (kvpr(i) .eq. '      ')  goto 90
            k1 = number (kvpr(i)(1:3))
            k2 = number (kvpr(i)(4:6))
            write (itxt,80)  i,k1,k2,radpr(i),epspr(i)
   80       format (13x,i5,5x,i3,'-',i3,2x,2f12.3)
         end do
   90    continue
      end if
c
c     bond stretching parameters
c
      if (kb(1) .ne. '      ') then
         write (itxt,100)  formfeed,forcefield
  100    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,110)
  110    format (//,17x,'Bond Stretching Parameters',
     &           ///,23x,'Classes',15x,'KS',7x,'Length',/)
         do i = 1, maxnb
            if (kb(i) .eq. '      ')  goto 130
            k1 = number (kb(i)(1:3))
            k2 = number (kb(i)(4:6))
c jcc       write (itxt,120)  i,k1,k2,fcon(i),blen(i)
            write (itxt,120)  i,k1,k2,fcon(i),blen(i),ebd(i)
  120       format (13x,i5,5x,i3,'-',i3,6x,f12.3,f12.4)
         end do
  130    continue
      end if
c
c     bond stretching parameters for 5-membered rings
c
      if (kb5(1) .ne. '      ') then
         write (itxt,140)
  140    format (//,17x,'5-Membered Ring Stretch Parameters',
     &           ///,23x,'Classes',15x,'KS',7x,'Length',/)
         do i = 1, maxnb5
            if (kb5(i) .eq. '      ')  goto 160
            k1 = number (kb5(i)(1:3))
            k2 = number (kb5(i)(4:6))
c jcc       write (itxt,150)  i,k1,k2,fcon5(i),blen5(i)
            write (itxt,150)  i,k1,k2,fcon5(i),blen5(i),ebd5(i)
  150       format (13x,i5,5x,i3,'-',i3,6x,f12.3,f12.4)
         end do
  160    continue
      end if
c
c     bond stretching parameters for 4-membered rings
c
      if (kb4(1) .ne. '      ') then
         write (itxt,170)
  170    format (//,17x,'4-Membered Ring Stretch Parameters',
     &           ///,23x,'Classes',15x,'KS',7x,'Length',/)
         do i = 1, maxnb4
            if (kb4(i) .eq. '      ')  goto 190
            k1 = number (kb4(i)(1:3))
            k2 = number (kb4(i)(4:6))
c jcc       write (itxt,210)  i,k1,k2,fcon4(i),blen4(i)
            write (itxt,210)  i,k1,k2,fcon4(i),blen4(i),ebd4(i)
  180       format (13x,i5,5x,i3,'-',i3,6x,f12.3,f12.4)
         end do
  190    continue
      end if
c
c     bond stretching parameters for 3-membered rings
c
      if (kb3(1) .ne. '      ') then
         write (itxt,200)
  200    format (//,17x,'3-Membered Ring Stretch Parameters',
     &           ///,23x,'Classes',15x,'KS',7x,'Length',/)
         do i = 1, maxnb3
            if (kb3(i) .eq. '      ')  goto 220
            k1 = number (kb3(i)(1:3))
            k2 = number (kb3(i)(4:6))
c jcc       write (itxt,210)  i,k1,k2,fcon3(i),blen3(i)
            write (itxt,210)  i,k1,k2,fcon3(i),blen3(i),ebd3(i)
  210       format (13x,i5,5x,i3,'-',i3,6x,f12.3,f12.4)
         end do
  220    continue
      end if
c
c     cubic and quartic bond stretching parameters
c
      if (cbnd.ne.0.0d0 .or. qbnd.ne.0.0d0) then
         write (itxt,230)  cbnd,qbnd
  230    format (//,17x,'Higher Order Stretching Constants',
     &           ///,23x,'Cubic',f17.3,/,23x,'Quartic',f15.3)
      end if
c
c     bond angle bending parameters
c
      if (ka(1) .ne. '         ') then
         write (itxt,240)  formfeed,forcefield
  240    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,250)
  250    format (//,17x,'Angle Bending Parameters',
     &           ///,18x,'Classes',10x,'KB',6x,'Value 1',
     &              5x,'Value 2',5x,'Value 3',
     &           /,43x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         do i = 1, maxna
            if (ka(i) .eq. '         ')  goto 280
            k1 = number (ka(i)(1:3))
            k2 = number (ka(i)(4:6))
            k3 = number (ka(i)(7:9))
            if (ang(2,i).eq.0.0d0 .and. ang(3,i).eq.0.0d0) then
               write (itxt,260)  i,k1,k2,k3,con(i),ang(1,i)
  260          format (5x,i5,5x,i3,'-',i3,'-',i3,2f12.3)
            else
               write (itxt,270)  i,k1,k2,k3,con(i),(ang(j,i),j=1,3)
  270          format (5x,i5,5x,i3,'-',i3,'-',i3,4f12.3)
            end if
         end do
  280    continue
      end if
c
c     bond angle bending parameters for 5-membered rings
c
      if (ka5(1) .ne. '         ') then
         write (itxt,290)
  290    format (//,17x,'5-Membered Ring Bend Parameters',
     &           ///,18x,'Classes',10x,'KB',6x,'Value 1',
     &              5x,'Value 2',5x,'Value 3',
     &           /,43x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         do i = 1, maxna5
            if (ka5(i) .eq. '         ')  goto 320
            k1 = number (ka5(i)(1:3))
            k2 = number (ka5(i)(4:6))
            k3 = number (ka5(i)(7:9))
            if (ang5(2,i).eq.0.0d0 .and. ang5(3,i).eq.0.0d0) then
               write (itxt,300)  i,k1,k2,k3,con5(i),ang5(1,i)
  300          format (5x,i5,5x,i3,'-',i3,'-',i3,2f12.3)
            else
               write (itxt,310)  i,k1,k2,k3,con5(i),(ang5(j,i),j=1,3)
  310          format (5x,i5,5x,i3,'-',i3,'-',i3,4f12.3)
            end if
         end do
  320    continue
      end if
c
c     bond angle bending parameters for 4-membered rings
c
      if (ka4(1) .ne. '         ') then
         write (itxt,330)
  330    format (//,17x,'4-Membered Ring Bend Parameters',
     &           ///,18x,'Classes',10x,'KB',6x,'Value 1',
     &              5x,'Value 2',5x,'Value 3',
     &           /,43x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         do i = 1, maxna4
            if (ka4(i) .eq. '         ')  goto 360
            k1 = number (ka4(i)(1:3))
            k2 = number (ka4(i)(4:6))
            k3 = number (ka4(i)(7:9))
            if (ang4(2,i).eq.0.0d0 .and. ang4(3,i).eq.0.0d0) then
               write (itxt,340)  i,k1,k2,k3,con4(i),ang4(1,i)
  340          format (5x,i5,5x,i3,'-',i3,'-',i3,2f12.3)
            else
               write (itxt,350)  i,k1,k2,k3,con4(i),(ang4(j,i),j=1,3)
  350          format (5x,i5,5x,i3,'-',i3,'-',i3,4f12.3)
            end if
         end do
  360    continue
      end if
c
c     bond angle bending parameters for 3-membered rings
c
      if (ka3(1) .ne. '         ') then
         write (itxt,370)
  370    format (//,17x,'3-Membered Ring Bend Parameters',
     &           ///,18x,'Classes',10x,'KB',6x,'Value 1',
     &              5x,'Value 2',5x,'Value 3',
     &           /,43x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         do  i = 1, maxna3
            if (ka3(i) .eq. '         ')  goto 400
            k1 = number (ka3(i)(1:3))
            k2 = number (ka3(i)(4:6))
            k3 = number (ka3(i)(7:9))
            if (ang3(3,i).eq.0.0d0 .and. ang3(3,i).eq.0.0d0) then
               write (itxt,380)  i,k1,k2,k3,con3(i),ang3(1,i)
  380          format (5x,i5,5x,i3,'-',i3,'-',i3,2f12.3)
            else
               write (itxt,390)  i,k1,k2,k3,con3(i),(ang3(j,i),j=1,3)
  390          format (5x,i5,5x,i3,'-',i3,'-',i3,4f12.3)
            end if
         end do
  400    continue
      end if
c
c     cubic through sextic bond angle bending parameters
c
      if (cang.ne.0.0d0 .or. qang.ne.0.0d0 .or.
     &    pang.ne.0.0d0 .or. sang.ne.0.0d0) then
         write (itxt,410)  cang,qang,pang,sang
  410    format (//,17x,'Higher Order Bending Constants',
     &           ///,21x,'Cubic',d17.3,/,21x,'Quartic',d15.3,
     &           /,21x,'Pentic',d16.3,/,21x,'Sextic',d16.3)
      end if
c
c     stretch-bend parameters
c
      exist = .false.
      do i = 1, maxclass
         do k = 1, 3
            if (stbn(k,i) .ne. 0.0d0)  exist = .true.
         end do
      end do
      if (exist) then
         write (itxt,420)  formfeed,forcefield
  420    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,430)
  430    format (//,17x,'Stretch-Bend Parameters',
     &           ///,21x,'Class',9x,'KSB 1',7x,'KSB 2',7x,'KSB 3',
     &           /,34x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         k = 0
         do i = 1, maxclass
            if (stbn(1,i).ne.0.0d0 .or. stbn(2,i).ne.0.0d0
     &               .or. stbn(3,i).ne.0.0d0) then
               k = k + 1
               write (itxt,440)  k,i,(stbn(j,i),j=1,3)
  440          format (10x,i5,7x,i3,3x,3f12.3)
            end if
         end do
      end if
c
c     out-of-plane bending parameters
c
      if (kaopb(1) .ne. '      ') then
         write (itxt,450)  formfeed,forcefield
  450    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,460)
  460    format (//,17x,'Out-of-Plane Bend Parameters',
     &           ///,23x,'Classes',8x,'KOPB',/)
         do i = 1, maxnopb
            if (kaopb(i) .eq. '      ')  goto 480
            k1 = number (kaopb(i)(1:3))
            k2 = number (kaopb(i)(4:6))
            write (itxt,470)  i,k1,k2,copb(i)
  470       format (10x,i5,8x,i3,'-',i3,f12.3)
         end do
  480    continue
      end if
c
c     Urey-Bradley parameters
c
      if (ku(1) .ne. '         ') then
         write (itxt,490)  formfeed,forcefield
  490    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,500)
  500    format (//,17x,'Urey-Bradley Parameters',
     &           ///,18x,'Classes',10x,'KB',6x,'Distance',/)
         do i = 1, maxnu
            if (ku(i) .eq. '         ')  goto 520
            k1 = number (ku(i)(1:3))
            k2 = number (ku(i)(4:6))
            k3 = number (ku(i)(7:9))
            write (itxt,510)  i,k1,k2,k3,ucon(i),dst13(i)
  510       format (5x,i5,5x,i3,'-',i3,'-',i3,f12.3,f12.4)
         end do
  520    continue
      end if
c
c     angle-angle parameters
c
      exist = .false.
      do i = 1, maxclass
         do k = 1, 3
            if (anan(k,i) .ne. 0.0d0)  exist = .true.
         end do
      end do
      if (exist) then
         write (itxt,530)  formfeed,forcefield
  530    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,540)
  540    format (//,17x,'Angle-Angle Parameters',
     &           ///,21x,'Class',9x,'KAA 1',7x,'KAA 2',7x,'KAA 3',
     &           /,34x,'(R-X-R)',5x,'(R-X-H)',5x,'(H-X-H)',/)
         k = 0
         do i = 1, maxclass
            if (anan(1,i).ne.0.0d0 .or. anan(2,i).ne.0.0d0
     &               .or. anan(3,i).ne.0.0d0) then
               k = k + 1
               write (itxt,550)  k,i,(anan(j,i),j=1,3)
  550          format (10x,i5,7x,i3,3x,3f12.3)
            end if
         end do
      end if
c
c     improper dihedral parameters
c
      if (kdi(1) .ne. '            ') then
         write (itxt,560)  formfeed,forcefield
  560    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,570)
  570    format (//,17x,'Improper Dihedral Parameters',
     &           ///,20x,'Classes',11x,'KID',7x,'Target',/)
         do i = 1, maxndi
            if (kdi(i) .eq. '            ')  goto 590
            k1 = number (kdi(i)(1:3))
            k2 = number (kdi(i)(4:6))
            k3 = number (kdi(i)(7:9))
            k4 = number (kdi(i)(10:12))
            write (itxt,580)  i,k1,k2,k3,k4,dcon(i),tdi(i)
  580       format (5x,i5,5x,i3,'-',i3,'-',i3,'-',i3,f12.3,f12.4)
         end do
  590    continue
      end if
c
c     improper torsional parameters
c
      if (kti(1) .ne. '            ') then
         write (itxt,600)  formfeed,forcefield
  600    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,610)
  610    format (//,17x,'Improper Torsion Parameters',
     &           ///,18x,'Classes',15x,'KTI Values',/)
         do i = 1, maxnti
            if (kti(i) .eq. '            ')  goto 630
            k1 = number (kti(i)(1:3))
            k2 = number (kti(i)(4:6))
            k3 = number (kti(i)(7:9))
            k4 = number (kti(i)(10:12))
            j = 0
            if (ti1(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 1
               ampli(j) = ti1(1,i)
               phase(j) = ti1(2,i)
            end if
            if (ti2(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 2
               ampli(j) = ti2(1,i)
               phase(j) = ti2(2,i)
            end if
            if (ti3(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 3
               ampli(j) = ti3(1,i)
               phase(j) = ti3(2,i)
            end if
            write (itxt,620)  i,k1,k2,k3,k4,(ampli(k),
     &                        phase(k),fold(k),k=1,j)
  620       format (3x,i5,5x,i3,'-',i3,'-',i3,'-',i3,2x,3(f8.3,f6.1,i2))
         end do
  630    continue
      end if
c
c     torsional angle parameters
c
      if (kt(1) .ne. '            ') then
         write (itxt,640)  formfeed,forcefield
  640    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,650)
  650    format (//,17x,'Torsional Parameters',
     &           ///,18x,'Classes',15x,'KT Values',/)
         do i = 1, maxnt
            if (kt(i) .eq. '            ')  goto 670
            k1 = number (kt(i)(1:3))
            k2 = number (kt(i)(4:6))
            k3 = number (kt(i)(7:9))
            k4 = number (kt(i)(10:12))
            j = 0
            if (t1(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 1
               ampli(j) = t1(1,i)
               phase(j) = t1(2,i)
            end if
            if (t2(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 2
               ampli(j) = t2(1,i)
               phase(j) = t2(2,i)
            end if
            if (t3(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 3
               ampli(j) = t3(1,i)
               phase(j) = t3(2,i)
            end if
            if (t4(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 4
               ampli(j) = t4(1,i)
               phase(j) = t4(2,i)
            end if
            if (t5(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 5
               ampli(j) = t5(1,i)
               phase(j) = t5(2,i)
            end if
            if (t6(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 6
               ampli(j) = t6(1,i)
               phase(j) = t6(2,i)
            end if
            write (itxt,660)  i,k1,k2,k3,k4,(ampli(k),
     &                        phase(k),fold(k),k=1,j)
  660       format (3x,i5,5x,i3,'-',i3,'-',i3,'-',i3,2x,6(f8.3,f6.1,i2))
         end do
  670    continue
      end if
c
c     torsional angle parameters for 5-membered rings
c
      if (kt5(1) .ne. '            ') then
         write (itxt,680)
  680    format (//,17x,'5-Membered Ring Torsion Parameters',
     &           ///,18x,'Classes',15x,'KT Values',/)
         do i = 1, maxnt5
            if (kt5(i) .eq. '            ')  goto 700
            k1 = number (kt5(i)(1:3))
            k2 = number (kt5(i)(4:6))
            k3 = number (kt5(i)(7:9))
            k4 = number (kt5(i)(10:12))
            j = 0
            if (t15(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 1
               ampli(j) = t15(1,i)
               phase(j) = t15(2,i)
            end if
            if (t25(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 2
               ampli(j) = t25(1,i)
               phase(j) = t25(2,i)
            end if
            if (t35(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 3
               ampli(j) = t35(1,i)
               phase(j) = t35(2,i)
            end if
            if (t45(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 4
               ampli(j) = t45(1,i)
               phase(j) = t45(2,i)
            end if
            if (t55(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 5
               ampli(j) = t55(1,i)
               phase(j) = t55(2,i)
            end if
            if (t65(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 6
               ampli(j) = t65(1,i)
               phase(j) = t65(2,i)
            end if
            write (itxt,690)  i,k1,k2,k3,k4,(ampli(k),
     &                        phase(k),fold(k),k=1,j)
  690       format (3x,i5,5x,i3,'-',i3,'-',i3,'-',i3,2x,6(f8.3,f6.1,i2))
         end do
  700    continue
      end if
c
c     torsional angle parameters for 4-membered rings
c
      if (kt4(1) .ne. '            ') then
         write (itxt,710)
  710    format (//,17x,'4-Membered Ring Torsion Parameters',
     &           ///,18x,'Classes',15x,'KT Values',/)
         do i = 1, maxnt4
            if (kt4(i) .eq. '            ')  goto 730
            k1 = number (kt4(i)(1:3))
            k2 = number (kt4(i)(4:6))
            k3 = number (kt4(i)(7:9))
            k4 = number (kt4(i)(10:12))
            j = 0
            if (t14(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 1
               ampli(j) = t14(1,i)
               phase(j) = t14(2,i)
            end if
            if (t24(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 2
               ampli(j) = t24(1,i)
               phase(j) = t24(2,i)
            end if
            if (t34(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 3
               ampli(j) = t34(1,i)
               phase(j) = t34(2,i)
            end if
            if (t44(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 4
               ampli(j) = t44(1,i)
               phase(j) = t44(2,i)
            end if
            if (t54(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 5
               ampli(j) = t54(1,i)
               phase(j) = t54(2,i)
            end if
            if (t64(1,i) .ne. 0.0d0) then
               j = j + 1
               fold(j) = 6
               ampli(j) = t64(1,i)
               phase(j) = t64(2,i)
            end if
            write (itxt,720)  i,k1,k2,k3,k4,(ampli(k),
     &                        phase(k),fold(k),k=1,j)
  720       format (3x,i5,5x,i3,'-',i3,'-',i3,'-',i3,2x,6(f8.3,f6.1,i2))
         end do
  730    continue
      end if
c
c     stretch-torsion parameters
c
      if (kbt(1) .ne. '      ') then
         write (itxt,740)  formfeed,forcefield
  740    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,750)
  750    format (//,17x,'Stretch-Torsion Parameters',
     &           ///,24x,'Classes',14x,'KST1',8x,'KST2',8x,'KST3',/)
         do i = 1, maxnbt
            if (kbt(i) .eq. '      ')  goto 770
            k1 = number (kbt(i)(1:3))
            k2 = number (kbt(i)(4:6))
            write (itxt,760)  i,k1,k2,(btcon(j,i),j=1,3)
  760       format (14x,i5,5x,i3,'-',i3,6x,3f12.3)
         end do
  770    continue
      end if
c
c     atomic partial charge parameters
c
      exist = .false.
      do i = 1, maxtyp
         if (chg(i) .ne. 0.0d0)  exist = .true.
      end do
      if (exist) then
         write (itxt,780)  formfeed,forcefield
  780    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,790)
  790    format (//,17x,'Atomic Partial Charge Parameters',
     &           ///,28x,'Type',9x,'Partial Chg',/)
         k = 0
         do i = 1, maxtyp
            if (chg(i) .ne. 0.0d0) then
               k = k + 1
               write (itxt,800)  k,i,chg(i)
  800          format (16x,i5,7x,i3,6x,f12.3)
            end if
         end do
      end if
c
c     bond dipole moment parameters
c
      if (kd(1) .ne. '      ') then
         write (itxt,810)  formfeed,forcefield
  810    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,820)
  820    format (//,17x,'Bond Dipole Moment Parameters',
     &           ///,26x,'Types',9x,'Bond Dipole',4x,'Position',/)
         do i = 1, maxnd
            if (kd(i) .eq. '      ')  goto 840
            k1 = number (kd(i)(1:3))
            k2 = number (kd(i)(4:6))
            write (itxt,830)  i,k1,k2,dpl(i),pos(i)
  830       format (14x,i5,5x,i3,'-',i3,6x,2f12.3)
         end do
  840    continue
      end if
c
c     bond dipole moment parameters for 5-membered rings
c
      if (kd5(1) .ne. '      ') then
         write (itxt,850)
  850    format (//,17x,'5-Membered Ring Bond Dipole Parameters',
     &           ///,26x,'Types',9x,'Bond Dipole',4x,'Position',/)
         do i = 1, maxnd5
            if (kd5(i) .eq. '      ')  goto 870
            k1 = number (kd5(i)(1:3))
            k2 = number (kd5(i)(4:6))
            write (itxt,860)  i,k1,k2,dpl5(i),pos5(i)
  860       format (14x,i5,5x,i3,'-',i3,6x,2f12.3)
         end do
  870    continue
      end if
c
c     bond dipole moment parameters for 4-membered rings
c
      if (kd4(1) .ne. '      ') then
         write (itxt,880)
  880    format (//,17x,'4-Membered Ring Bond Dipole Parameters',
     &           ///,26x,'Types',9x,'Bond Dipole',4x,'Position',/)
         do i = 1, maxnd4
            if (kd4(i) .eq. '      ')  goto 900
            k1 = number (kd4(i)(1:3))
            k2 = number (kd4(i)(4:6))
            write (itxt,890)  i,k1,k2,dpl4(i),pos4(i)
  890       format (14x,i5,5x,i3,'-',i3,6x,2f12.3)
         end do
  900    continue
      end if
c
c     bond dipole moment parameters for 3-membered rings
c
      if (kd3(1) .ne. '      ') then
         write (itxt,910)
  910    format (//,17x,'3-Membered Ring Bond Dipole Parameters',
     &           ///,26x,'Types',9x,'Bond Dipole',4x,'Position',/)
         do i = 1, maxnd3
            if (kd3(i) .eq. '      ')  goto 930
            k1 = number (kd3(i)(1:3))
            k2 = number (kd3(i)(4:6))
            write (itxt,920)  i,k1,k2,dpl3(i),pos3(i)
  920       format (14x,i5,5x,i3,'-',i3,6x,2f12.3)
         end do
  930    continue
      end if
c
c     atomic multipole electrostatic parameters
c
      if (kmp(1) .ne. '         ') then
         write (itxt,940)  formfeed,forcefield
  940    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,950)
  950    format (//,17x,'Atomic Multipole Parameters',
     &           ///,17x,'Type',3x,'Axis Types',6x,'Frame',
     &              8x,'Multipoles (M-D-Q)',/)
         do i = 1, maxnmp
            if (kmp(i) .eq. '         ')  goto 970
            k1 = number (kmp(i)(1:3))
            k2 = number (kmp(i)(4:6))
            k3 = number (kmp(i)(7:9))
            write (itxt,960)  i,k1,k2,k3,mpaxis(i),multip(1,i),
     &                        multip(2,i),multip(3,i),multip(4,i),
     &                        multip(5,i),multip(8,i),multip(9,i),
     &                        multip(11,i),multip(12,i),multip(13,i)
  960       format (5x,i5,7x,i3,5x,i3,2x,i3,5x,a8,10x,f10.5,
     &                 /,46x,3f10.5,/,46x,f10.5,
     &                 /,46x,2f10.5,/,46x,3f10.5)
         end do
  970    continue
      end if
c
c     atomic dipole polarizability parameters
c
      exist = .false.
      do i = 1, maxtyp
         if (polr(i) .ne. 0.0d0)  exist = .true.
      end do
      if (exist) then
         write (itxt,980)  formfeed,forcefield
  980    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,990)
  990    format (//,17x,'Dipole Polarizability Parameters',
     &           ///,28x,'Type',14x,'Alpha',/)
         k = 0
         do i = 1, maxtyp
            if (polr(i) .ne. 0.0d0) then
               k = k + 1
               write (itxt,1000)  k,i,polr(i)
 1000          format (16x,i5,7x,i3,6x,f12.3)
            end if
         end do
      end if
c
c     conjugated pisystem atom parameters
c
      exist = .false.
      do i = 1, maxclass
         if (ionize(i) .ne. 0.0d0)  exist = .true.
      end do
      if (exist) then
         write (itxt,1010)  formfeed,forcefield
 1010    format (a1,//,17x,'TINKER Force Field Parameters for ',a20)
         write (itxt,1020)
 1020    format (//,17x,'Conjugated Pisystem Atom Parameters',
     &           ///,21x,'Class',3x,'Electron',3x,
     &                 'Ionization',3x,'Repulsion',/)
         k = 0
         do i = 1, maxclass
            if (ionize(i) .ne. 0.0d0) then
               k = k + 1
               write (itxt,1030)  k,i,electron(i),ionize(i),repulse(i)
 1030          format (10x,i5,7x,i3,f10.1,2x,2f12.3)
            end if
         end do
      end if
c
c     conjugated pisystem bond parameters
c
      if (kpi(1) .ne. '      ') then
         write (itxt,1040)
 1040    format (//,17x,'Conjugated Pisystem Bond Parameters',
     &           ///,20x,'Classes',8x,'d Force',4x,'d Length',/)
         do i = 1, maxnpi
            if (kpi(i) .eq. '      ')  goto 1060
            k1 = number (kpi(i)(1:3))
            k2 = number (kpi(i)(4:6))
            write (itxt,1050)  i,k1,k2,sslope(i),tslope(i)
 1050       format (10x,i5,5x,i3,'-',i3,3x,f12.3,f12.3)
         end do
 1060    continue
      end if
      return
      end
