C
C $Id: wrtdiv.F,v 1.4 1998/07/16 16:40:52 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      subroutine wrtdiv(imc)

      implicit double precision(a-h,o-z)
#include "divcon.dim"
#include "divcon.h"

      if (myid.eq.0) then
         call opnfil(4,ierror)
      else
         call opnpfil(14,ierror)
      endif
      if (ierror.ne.0) goto 1000

      do 10 i=1,nkeymc
         ie = i*80
         ib = ie-79
C-RDC          write(irst,'(A80)') keywrdmc(ib:ie)
 10   continue

      if (smartmc) then
         smartaa = (23.061*smarta)/boltzt
C-RDC          write(irst,'("DR=",F15.10," DANGLE=",F15.10,
C-RDC      &        " SMARTMC=",I14," &",/,"SMARTA=",F15.10," &")')
C-RDC      &        drmc, dangle*degree,nmc-imc,smartaa
      else
C-RDC          write(irst,'("DR=",F15.10," DANGLE=",F15.10,
C-RDC      &        " MC=",I14," &")')
C-RDC      &        drmc, dangle*degree,nmc-imc
      endif
      if (iensemb.eq.1) then
C-RDC          write(irst,'("DBOX=",F15.10," &")') drboxmc
      endif
      if (pme) then
         if (setbpme) then
C-RDC             write(irst,'("SEED=",I14," BETAPME=HBOX")') iseed
         else
C-RDC             write(irst,'("SEED=",I14," BETAPME=",F15.10)')
C-RDC      &           iseed,betapme
         endif
      else
C-RDC          write(irst,'("SEED=",I14)') iseed
      endif

C-RDC       write(irst,'(A)') title
      j = 1
      do 20 i=1,natoms
         iai = iatnum(i)
         if (i.eq.irpnt(j)) then
            j = j + 1
C-RDC             write(irst,'(i4,2x,A2,2x,3F20.14,"   RES")')
C-RDC      &           i, symbol(iai), xyzmc(1,i), xyzmc(2,i), xyzmc(3,i)
         else
C-RDC             write(irst,'(i4,2x,A2,2x,3F20.14)')
C-RDC      &           i, symbol(iai), xyzmc(1,i), xyzmc(2,i), xyzmc(3,i)
         endif
 20   continue
C-RDC       write(irst,'("END_COORD")')
      if (pbc) then
C-RDC          write(irst,'("BOX",/"  XBOX=",F15.8," YBOX=",F15.8,
C-RDC      &        " ZBOX=",F15.8,/"END_BOX")')
C-RDC      &        dboxmc(1),dboxmc(2),dboxmc(3)
      endif

      if (clust) then
C-RDC          write(irst,'("CLUSTER")')
         do i=1,ncores
C-RDC             write(irst,'("  NCORE=",I5," ( ")') ncore(i)
C-RDC             write(irst,'(13(1x,i5))')
C-RDC      &           (icorel(j),j=icorel1(i),icorel1(i+1)-1)
C-RDC             write(irst,'("  )")')
         enddo
C-RDC          write(irst,'("  DBUFF1=",F15.8,
C-RDC      &        " DBUFF2=",F15.8,/"END_CLUSTER")')
C-RDC      &        dcbuff1, dcbuff2
      elseif (gridsub) then
C-RDC          write(irst,'("GRID",/"  XCORE=",F15.8," YCORE=",F15.8,
C-RDC      &        " ZCORE=",F15.8,/"  OVERLAP=",F15.8," DBUFF1=",
C-RDC      &        F15.8," DBUFF2=",F15.8,/"END_GRID")')
C-RDC      &        core(1), core(2), core(3), overlap, dgbuff1, dgbuff2
      endif

      if (combsub) then
C-RDC          write(irst,'("COMBSUB",/"  CLUSTER")')
C-RDC          write(irst,'(13(1x,I5))') (iclustl(i),i=1,niclust)
         if (resgr) then
C-RDC             write(irst,'("  RESGRID",/)')
         elseif (atgr) then
C-RDC             write(irst,'("  ATGRID",/)')
         elseif (mixgr) then
C-RDC             write(irst,'("  MIXGRID",/)')
         endif
C-RDC          write(irst,'(13(1x,I5))') (igridlr(i),i=1,nigridlr)
C-RDC          write(irst,'("END_COMBSUB")')
      endif
      if (ngroup.gt.0) then
C-RDC          write(irst,'("GROUP")')
         n = 0
         do 30 i=1,ngroup
C-RDC             write(irst,'("  GROUP ",i4)') i
C-RDC             write(irst,'(13(1x,i5))') (ingroup(n+j), j=1,ingroupn(i))
            n = n + ingroupn(i)
 30      continue
C-RDC          write(irst,'("END_GROUP")')
      endif
      close(irst)

 1000 return
      end