      subroutine runjob(imod,iqopt,ihaszm)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      common /xyzopt/ ixyz,ichx,icrtp,ipdbwh,iambch
      character*80 glin1,glin2,gtitl,rungam
      character*15 jname,qname
      common /gauopt/ ito,imo,ibo,itotc,imult,ibatch,ihess,itime,
     &                iwxyz,ichh,ichm,ichl,imh,imm,iml,
     &                glin1,glin2,gtitl,jname,qname,rungam
      character*80 tnknm
      integer tnkbg,tnkit,tnkarc,tnkarf,tnkprg
      common /tnkopt/ rmsgrd,tnkbg,tnkit,tnkarc,tnkarf,tnkprg,tnknm
      common /types/ iff
      integer dolabs,fancy,persp,shade,atcol
      logical fyesno,backb
      common /displ/ fancy,shade,atcol,dolabs,persp,irtcel,
     &               ifd,fyesno,backb,logo
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character*80 taroot
      character*80 pwd
      character*11 ename
      character*80 outfil
      character*137 line
      logical mapxyz,opfil,domap
      
      izmtmp = ihaszm

      jlen = linlen(jname)
      iqlen = linlen(qname)
      itnkln = linlen(tnknm)

      ename = 'PWD'
      call getenv(ename,pwd)

      ig94 = 1
      itnk = 0
      if (imod.eq.1) then
         ename = 'TA_ROOT'
      elseif (imod.eq.2) then
         ename = 'QNT_ROOT'
      elseif (imod.eq.3) then
         ename = 'TNK_ROOT'
      elseif (imod.eq.4) then
         ename = 'GAMESS_ROOT'
      elseif (imod.eq.5) then
         ename = 'g94root'
      elseif (imod.eq.6) then
         ename = 'MOPAC_ROOT'
      elseif (imod.eq.7) then
         ename = 'XTINKER'
      elseif (imod.eq.8) then
         ename = 'AMBFOR'
      endif

      call getenv(ename,taroot)
      if (taroot(1:1).eq.' ') then
          if (imod.eq.1) then
            call inferr('Environment variable TA_ROOT not set !',0)
            call zmterr('Environment variable TA_ROOT not set !',1,0,1)
          elseif (imod.eq.2) then
            call inferr('Environment variable QNT_ROOT not set !',0)
            call zmterr('Environment variable QNT_ROOT not set !',1,0,1)
          elseif (imod.eq.3) then
            call inferr('Environment variable TNK_ROOT not set !',0)
            call zmterr('Environment variable TNK_ROOT not set !',1,0,1)
          elseif (imod.eq.4) then
            call inferr('Environment variable GAMESS_ROOT not set !',0)
            call zmterr('Environment variable GAMESS_ROOT not set !',1,
     &                  0,1)
          elseif (imod.eq.5) then
            ename = 'g92root'
            call getenv(ename,taroot)
            if (taroot(1:1).eq.' ') then
               ename = 'g98root'
               call getenv(ename,taroot)
            else
               ig94 = 0
            endif
            if (taroot(1:1).eq.' ') then
               ename = 'g03root'
               call getenv(ename,taroot)
            else
               ig94 = 2
               goto 10
            endif
            if (taroot(1:1).eq.' ') then
               call inferr(
     &         'Environment variable g92/g94/g98/g03root not set !',0)
               call zmterr(
     &     'Environment variable g92/g94/g98/g03root not set !',1,0,1)
               goto 10
            else
               ig94 = 3
               goto 10
            endif
          elseif (imod.eq.6) then
            call inferr('Environment variable MOPAC_ROOT not set !',0)
            call zmterr('Environment variable MOPAC_ROOT not set !',1,
     &                   0,1)
          elseif (imod.eq.7) then
            ename = 'TNK_ROOT'
            call getenv(ename,taroot)
            if (taroot(1:1).eq.' ') then
               call inferr(
     &         'Environment variable TNK_ROOT/XTINKER not set !',0)
            else
               itnk = 1
               goto 10
            endif
          elseif (imod.eq.8) then
            taroot = '/usr/local/bin/'
            goto 10
          endif
          return
      endif
10    itlen = linlen(taroot)

      iun = 50
      iuncln = 51

      if (imod.eq.1) then
         ixyz = 1
         call wrpnt('molin.mol2',10,4,0,0,0,0,1,.false.)
      elseif (imod.eq.2) then
         ixyz = 2
         call wrpnt('molin.msf',9,4,0,0,0,0,1,.false.)
      elseif (imod.eq.3) then
         ixyz = 3
         call wrpnt(tnknm(1:itnkln)//'.xyz',itnkln+4,4,0,0,0,
     &      0,1,.false.)
      elseif (imod.eq.4) then
         call wrpnt(jname(1:jlen)//'.in',1,19,0,0,0,
     &              0,1,.false.)
      elseif (imod.eq.5) then
         call wrpnt(jname(1:jlen)//'.com',1,20,0,0,0,
     &              0,1,.false.)
      elseif (imod.eq.6) then
         call wrpnt(jname(1:jlen)//'.dat',1,21,0,0,0,
     &              0,1,.false.)
      elseif (imod.eq.7) then
         if (iff.ne.1) then
             iff = 1
             call dotyp(1)
         endif
         ixyz = 5
         call wrpnt(tnknm(1:itnkln)//'.cssr',itnkln+5,4,0,0,
     &               0,0,1,.false.)
         if (iqopt.eq.0) then
            call fdat(16,0,0,0,0,0)
         else
            call fdat(17,0,0,0,0,0)
         endif
         call fdat(ifd,0,0,0,0,0)
      elseif (imod.eq.8) then
         ixyz = 11
         call wrpnt(tnknm(1:itnkln)//'.xyz',itnkln+4,4,0,0,0,
     &      0,1,.false.)
      endif

      if (imod.ne.8) then
         if (imod.ge.3) then
            if (imod.eq.3.or.imod.eq.7) then
               open(unit=iun,form='formatted',
     &           file=tnknm(1:itnkln)//'.run',
     &           status='unknown',err=100)
               open(unit=iuncln,form='formatted',file='clnjob',
     &           status='unknown',err=100)
            else
               open(unit=iun,form='formatted',
     &           file=jname(1:jlen)//'.run',
     &           status='unknown',err=100)
            endif
         else
            open(unit=iun,form='formatted',file='runjob',
     &           status='unknown',err=100)
         endif
      endif

      if (imod.eq.1) then
      write(iun,'(''#!/bin/sh'')')
      write(iun,*) 'rm molout.mol2'
      write(iun,*) '. $TA_ROOT/lib/.profile'
      write(iun,*) '$TA_ROOT/bin/sybyl << EOF > molout.log'
      write(iun,*) 'tailor set mol file_format mol2 | |'
      write(iun,*) 'set autosave off'
      write(iun,*) 'mol in M1 molin.mol2'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!MINIMIZATION_METHOD POWELL'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!TERMINATION_OPTION GRADIENT'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!MIN_ENERGY_CHANGE  0.050'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!RMS_GRADIENT  0.050'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!RMS_DISPLACEMENT  0.001'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!MAXIMUM_ITERATIONS 1000'
      write(iun,*) 'SETVAR TAILOR!FORCE_FIELD!PARAMETER_SET Tripos'
      write(iun,*) 'SETVAR TAILOR!FORCE_FIELD!NON_BONDED_CUTOFF 8.0'
      write(iun,*) 'SETVAR TAILOR!FORCE_FIELD!DIELECTRIC_CONSTANT 1.0'
      write(iun,*) 
     &  'SETVAR TAILOR!FORCE_FIELD!DIELECTRIC_FUNCTION distance'
      write(iun,*) 
     &  'SETVAR TAILOR!FORCE_FIELD!REVIEW_HS_AND_LPS DO_NOT_CHANGE'
      write(iun,*) 'SETVAR TAILOR!MAXIMIN2!LIST_TERMS NO'
      write(iun,*) 'SETVAR TAILOR!FORCE_FIELD!ONE_FOUR_SCALING 1.0'
      write(iun,*) 'SETVAR TAILOR!FORCE_FIELD!HBOND_RAD_SCALING 0.7'
      write(iun,*) 'MAXIMIN2 M1 Electrostatics IGNORE_ELECTROSTATICS ',
     &             char(92)
      write(iun,*) 'Interesting M1(*-(0)) Boundary_Conditions ',char(92)
      write(iun,*) 'IGNORE_PBCS List DONE INTERACTIVE'
      write(iun,*) 'mol out M1 molout.mol2'
      write(iun,'(''EOF'')')
      elseif (imod.eq.2) then
      write(iun,'(''#!/bin/csh'')')
      write(iun,*) 'unalias mv'
      write(iun,*) 'unalias rm'
      write(iun,*) 'source /compchem/1/msi/quanta96/.setquanta'
      write(iun,*) 'mkdir qnt$$'
      write(iun,*) 'cd qnt$$'
      write(iun,*) 'cat <<EOF > quanta.scr'
      write(iun,*) 'mole init molin.msf'
      write(iun,*) 'charm init'
      write(iun,*) 'charm writ psf'
      write(iun,*) 'charm set mini nstep 1000'
      write(iun,*) 'charm do mini'
      write(iun,*) 'msf save over'
      write(iun,*) 'end'
      write(iun,'(''EOF'')')
      write(iun,*) 'cp $HYD_LIB/default.cst .cst'
      write(iun,*) 'mv ../molin.msf .'
      write(iun,*) 'chmod u+rwx .cst'
      write(iun,*) 'quanta -n -i quanta.scr -l quanta >& /dev/null'
      write(iun,*) 'mv molin.msf ..'
      write(iun,*) 'mv quanta.log ..'
      write(iun,*) 'cd ..'
      write(iun,*) 'unalias rm'
      write(iun,*) 'rm -rf qnt$$'
      elseif (imod.eq.3.or.imod.eq.7) then
      write(iuncln,'(''#!/bin/csh -f'')')
      write(iuncln,*) 'unalias rm'
      write(iuncln,*) 'if ( -e '//tnknm(1:itnkln)//
     &                ' ) mv '//tnknm(1:itnkln)//' '//
     &                tnknm(1:itnkln)//'.bck'

      if (imod.eq.3) then
         write(iuncln,*) 'rm '//tnknm(1:itnkln)//'.xyz_*'
      else
         write(iuncln,*) 'rm '//tnknm(1:itnkln)//'.cssr_*'
      endif
      write(iuncln,*) 'rm '//tnknm(1:itnkln)//'.[0-9]*'
      write(iuncln,*) 'rm '//tnknm(1:itnkln)//'.arc*'
      close(iuncln)
      write(iun,'(''#!/bin/csh'')')
      write(iun,*) 'unalias rm'
      write(iun,*) 'rm clnjob'
      write(iun,*) 'setenv AMBER amber'
      write(iun,*) 'setenv CHARMM charmm'
      write(iun,*) 
     &  'if ( -f $TNK_ROOT/params/amber99.prm ) setenv AMBER amber99'
      write(iun,*) 
     &  'if ( -f $TNK_ROOT/params/charmm27.prm ) setenv CHARMM charmm27'
      if (imod.eq.3) then
        write(iun,*) 'cat <<EOF > '//tnknm(1:itnkln)//'.key'
        if (iff.le.1) then
         write(iun,*) 'parameters $TNK_ROOT/params/mm3'
         write(iun,*) 'torsion       5   2   3   6       '//
     &                '0.000 +1     8.000 -2     0.000 +3'
         write(iun,*) 'torsion       2   3   6  24       '//
     &                '0.000 +1     0.500 -2     0.000 +3'
         write(iun,*) 'angle         1    3    77    '//
     &                '0.850    123.500    123.500      0.000'
         write(iun,*) 'angle         1    3    78    '//
     &                '0.850    123.500    123.500      0.000'
         write(iun,*) 'angle         5    1    75    '//
     &                '0.820    110.000    108.900    108.700'
         write(iun,*) 'opbend        3    77         0.650'
         write(iun,*) 'opbend        3    78         0.650'
        elseif (iff.eq.2) then
         write(iun,*) 'parameters $TNK_ROOT/params/$CHARMM'
        elseif (iff.eq.3) then
         write(iun,*) 'parameters $TNK_ROOT/params/$AMBER'
        elseif (iff.eq.4) then
         write(iun,*) 'parameters $TNK_ROOT/params/amoebapro.prm'
        endif
        if (.not.(tnkbg.eq.1.and.tnkarc.eq.0)) 
     &     write(iun,*) 'save-cycle'
        write(iun,*) 'maxiter ',tnkit
        write(iun,'(''EOF'')')
      else
        write(iun,*) 'cat < tnk.key > '//tnknm(1:itnkln)//'.key'
        write(iun,*) 'rm tnk.key'
        write(iun,*) 'cat <<EOF >>'//tnknm(1:itnkln)//'.key'
        if (.not.(tnkbg.eq.1.and.tnkarc.eq.0)) 
     &     write(iun,*) 'save-cycle'
        write(iun,*) 'maxiter ',tnkit
        write(iun,*) 'writeout 1'
        write(iun,'(''EOF'')')
      endif

      if (tnkprg.eq.0) then
         write(iun,*) '$TNK_ROOT/bin/minimize '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
      elseif (tnkprg.eq.1) then
         write(iun,*) '$TNK_ROOT/bin/optimize '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
      elseif (tnkprg.eq.2) then
         write(iun,*) '$TNK_ROOT/bin/newton '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
         write(iun,*) ' '
         write(iun,*) ' '
      elseif (tnkprg.eq.3) then
         write(iun,*) '$TNK_ROOT/bin/dynamic '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
         write(iun,*) '10000'
         write(iun,*) ' '
         write(iun,*) ' '
         write(iun,*) ' '
         write(iun,'(''EOF'')')
      elseif (tnkprg.eq.4) then
         if (itnk.eq.1) then
            write(iun,*) '$TNK_ROOT/bin/xxtalmins c '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
         else
            write(iun,*) '$XTINKER/bin/xxtalmins c '//tnknm(1:itnkln)
     &                //' <<EOF >& '//tnknm(1:itnkln)//'.log'
         endif
      endif

      if (tnkprg.lt.3.or.tnkprg.eq.4) then
         write(iun,'(f12.8)') rmsgrd
         write(iun,'(''EOF'')')
      endif

      if (tnkbg.eq.1.and.tnkarc.eq.1) then
         if (imod.eq.3) then
            write(iun,*) '$TNK_ROOT/bin/archive '//tnknm(1:itnkln)
     &                   //' <<EOF >>& '//tnknm(1:itnkln)//'.log'
            write(iun,*) ' '
            write(iun,*) ' '
            write(iun,*) '1 1000 ',tnkarf
            write(iun,'(''EOF'')')
         else
            write(iun,*) 'cat '//tnknm(1:itnkln)//'.[0-9]* > '//
     &                    tnknm(1:itnkln)//'.arc'
         endif
         write(iun,*) 'rm '//tnknm(1:itnkln)//'.[0-9]*'
      endif

      elseif (imod.eq.4) then
         write(iun,'(''#!/bin/csh'')')
         write(iun,'(a)') rungam(1:linlen(rungam))
      elseif (imod.eq.5) then
         write(iun,'(''#!/bin/csh'')')
         if (ig94.eq.1) then
            write(iun,*) 'source $g94root/g94/bsd/g94.login'
            if (ibatch.eq.1) then
               write(iun,*) 'g94 '//jname(1:jlen)
            else
               write(iun,*) 'subg94 '//qname(1:iqlen)//' '
     &                      //jname(1:jlen)
            endif
         elseif (ig94.eq.2) then
            write(iun,*) 'source $g98root/g98/bsd/g98.login'
            if (ibatch.eq.1) then
               write(iun,*) 'g98 '//jname(1:jlen)
            else
               write(iun,*) 'subg98 '//qname(1:iqlen)//' '
     &                      //jname(1:jlen)
            endif
         elseif (ig94.eq.3) then
            write(iun,*) 'source $g03root/g03/bsd/g03.login'
            if (ibatch.eq.1) then
               write(iun,*) 'g03 '//jname(1:jlen)
            else
               write(iun,*) 'subg03 '//qname(1:iqlen)//' '
     &                      //jname(1:jlen)
            endif
         else
            write(iun,*) 'source $g92root/g92/bsd/g92.login'
            if (ibatch.eq.1) then
               write(iun,*) 'g92 '//jname(1:jlen)
            else
               write(iun,*) 'subg92 '//qname(1:iqlen)//' '//
     &                       jname(1:jlen)
            endif
         endif
         write(iun,*) ' '
         write(iun,*) ' '
         write(iun,*) ' '
      elseif (imod.eq.6) then
         write(iun,'(''#!/bin/csh'')')
         if (ibatch.eq.0) write(iun,*) 'cd '//pwd(1:linlen(pwd))
         write(iun,*) taroot(1:itlen)//'/bin/mopac.csh '//
     &                jname(1:jlen)//
     &                ' >& /dev/null'
      endif

      if (imod.ne.8) close(iun)

c make jobscript executable

      if (imod.ge.3) then
         if (imod.eq.3.or.imod.eq.7) then
            taroot = 'chmod u+x '//tnknm(1:itnkln)//'.run'
            nstr = itnkln+14
         else
            taroot = 'chmod u+x '//jname(1:jlen)//'.run'
            nstr = jlen+14
         endif
      else
         taroot = 'chmod u+x runjob'
         nstr = 16
      endif

      iextmp = 0
      if (imod.ne.8) call exstr(taroot,nstr,iextmp)

c prepare cleaning up

      if (imod.eq.3.or.imod.eq.7) then
         taroot = 'chmod u+x clnjob'
         nstr = 16
         iextmp = 0
         call exstr(taroot,nstr,iextmp)
         taroot = '.'//char(47)//'clnjob'
         nstr = 8
         iextmp = 0
         call exstr(taroot,nstr,iextmp)
      endif

c are you ready ?

      if (imod.ne.3.and.imod.ne.7.and.imod.ne.8) call curs(1)
      call confrm(0,istat)
      if (istat.ne.1) then
          call curs(0)
          return
      endif

      if (imod.ge.3.and.imod.ne.8) then
         if (imod.eq.6.and.ibatch.eq.0) then
            taroot = 'qsub -eo -q '//qname(1:iqlen)//' '//
     &               jname(1:jlen)//'.run'
            nstr = jlen+iqlen+17
         else
            if (imod.eq.3.or.imod.eq.7) then
               taroot = '.'//char(47)//tnknm(1:itnkln)//'.run'
               nstr = itnkln+6
               if (tnkbg.eq.0) then
                   taroot = tnknm(1:itnkln)
                   nstr = itnkln
               endif
            else
               taroot = '.'//char(47)//jname(1:jlen)//'.run'
               nstr = jlen+6
            endif
         endif
      elseif (imod.eq.8) then
         taroot = 
     &      'ambfor '//tnknm(1:itnkln)//'.xyz'
         nstr = 7 + itnkln + 4
      else
        
         taroot = '.'//char(47)//'runjob'
         nstr = 8
      endif

c execute or batching of jobscript

      iextmp = 0
      if (imod.lt.3.or.(imod.ge.4.and.ibatch.eq.0).or.
     &    ((imod.eq.3.or.imod.eq.7).and.tnkbg.eq.0).or.
     &    (imod.eq.8.and.tnkbg.eq.0)) then

         if ((imod.eq.3.or.imod.eq.7.or.imod.eq.8).and.
     &        tnkbg.eq.0) then

c    tinker in the background updating screen; also fork

            if (imod.eq.8) then
               taroot = tnknm(1:itnkln)
               nstr = itnkln
               iextmp = 3
               call exstr(taroot,nstr,iextmp)
            else
               iextmp = 2
               call exstr(taroot,nstr,iextmp)
            endif
         else

c    system

            iextmp = 0
            call exstr(taroot,nstr,iextmp)
         endif

      else

c    fork

         if (imod.eq.8) then
            taroot = tnknm(1:itnkln)
            nstr = itnkln
            iextmp = 4
         else
            iextmp = 1
         endif
         call exstr(taroot,nstr,iextmp)

      endif

      iexst = iextmp

c clean up tinker cycle files of a non detached job

      if ((imod.eq.3.or.imod.eq.7).and.tnkbg.eq.0) then
         open(unit=iuncln,form='formatted',file='clnjob',
     &     status='unknown',err=100)
         write(iuncln,'(''#!/bin/csh -f'')')
         if (tnkarc.eq.1) then
          if (imod.eq.3) then
            write(iuncln,*) '$TNK_ROOT/bin/archive '//tnknm(1:itnkln)
     &                     //' <<EOF >>& '//tnknm(1:itnkln)//'.log'
            write(iuncln,*) ' '
            write(iuncln,*) ' '
            write(iuncln,*) '1 1000 ',tnkarf
            write(iuncln,'(''EOF'')')
          else
            write(iuncln,*) 'cat '//tnknm(1:itnkln)//'.[0-9]* > '//
     &                    tnknm(1:itnkln)//'.arc'
          endif
         endif
         write(iuncln,*) 'unalias rm'
         write(iuncln,*) 'rm '//tnknm(1:itnkln)//'.[0-9]*'
         write(iuncln,*) 'rm clnjob'
         close(iuncln)
         iextmp = 0
         taroot = 'chmod u+x clnjob'
         nstr = 16
         call exstr(taroot,nstr,iextmp)
         taroot = '.'//char(47)//'clnjob'
         nstr = 8
         call exstr(taroot,nstr,iextmp)
      endif

c open to be mapped file

      ierr = 0
      iform = 1
      domap = .true.
      if (imod.eq.1) then
         nstr = 11
         outfil = 'molout.mol2'
      elseif (imod.eq.2) then
         iform = 0
         nstr = 9
         outfil = 'molin.msf'
      elseif (imod.eq.3.and.tnkbg.eq.0.and.iexst.ne.-1) then
         nstr = itnkln+6
         outfil = tnknm(1:itnkln)//'.xyz_2'
      elseif (imod.eq.7.and.tnkbg.eq.0.and.iexst.ne.-1) then
         nstr = itnkln+7
         outfil = tnknm(1:itnkln)//'.cssr_2'
c      elseif (imod.eq.8.and.tnkbg.eq.0.and.iexst.ne.-1) then
      elseif (imod.eq.8.and.tnkbg.eq.0) then
         nstr = itnkln+8
         outfil = tnknm(1:itnkln)//'_opt.xyz'
      else
         domap = .false.
      endif
      if (domap) then
         if (opfil(iun,outfil,nstr,iform,1,0)) then
             rewind(iun)
         else
             ierr = 1
             goto 50
         endif
      endif

c map the file onto the z-matrix, or just read it in

      if (imod.ne.4.and..not.
     &    ((imod.eq.3.or.imod.eq.7.or.imod.eq.8)
     &      .and.tnkbg.eq.1)) then
         ierr = 1
         if (iexst.ne.-1) iexst = imod
         if (mapxyz(iun,iexst,iff,izmtmp)) ierr = 0
         if (iexst.eq.-1) then
            ierr = 20
            call dohcon(0)
         else
            if (imod.eq.7) call fdat(ifd,0,0,0,0,0)
         endif
      endif
      if (domap) close(iun)

c check for tinker error conditions (non detached job)

50    if ((imod.eq.3.or.imod.eq.7)
     &   .and.tnkbg.eq.0.and.iexst.ne.-1) then
         if (opfil(iun,tnknm(1:itnkln)//'.log',itnkln+4,1,1,0)) then
             iuntmp = iun2
             iun2 = iun
             call searcht(line,'MECHANIC','Incomplete Convergence',
     &                'Too many Parameters',istat)
             if (istat.ne.0) then
                if (index(line,'MECHANIC').ne.0) then
                   ierr = 2
                elseif (index(line,'Incomplete Convergence').ne.0) then
                   ierr = 3
                elseif (index(line,'Too many Parameters').ne.0) then
                   ierr = 4
                endif
             endif
             close(iun)
             iun2 = iuntmp
         endif
      endif
      if ((imod.eq.3.or.imod.eq.7).and.iexst.eq.-1) ierr = 5

      if ((imod.ge.4.and.imod.lt.7).or.
     &   ((imod.eq.3.or.imod.eq.7.or.imod.eq.8).and.tnkbg.eq.1)) 
     &   ierr = 6
 
      if (imod.ne.3.and.imod.ne.7.and.imod.ne.8) call curs(0)

c popup status message

      call messg(ierr)

      return

100   call inferr('Error opening file !',0)
      return
      end

      subroutine tnkpnt(ipnt,iret)
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      character*80 tnknm
      integer tnkbg,tnkit,tnkarc,tnkarf,tnkprg
      common /tnkopt/ rmsgrd,tnkbg,tnkit,tnkarc,tnkarf,tnkprg,tnknm
      common /types/ iff
      integer dolabs,fancy,persp,shade,atcol
      logical fyesno,backb
      common /displ/ fancy,shade,atcol,dolabs,persp,irtcel,
     &               ifd,fyesno,backb,logo
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character*20 tnkfil
      character*3 tstr
      character*4 ttstr
      character*5 tttstr
      logical opfil

      iret = 0
      idummy = 0
      
      jlen = linlen(tnknm)

      if (ipnt.eq.-1) then
         tnkfil = tnknm(1:jlen)//'.tmp'
         jlen = jlen + 1 + 3
      elseif (ipnt.lt.1000) then
         call zerstr(ipnt,tstr,3)
         tnkfil = tnknm(1:jlen)//'.'//tstr
         jlen = jlen + 1 + 3
      elseif (ipnt.lt.10000) then
         write(ttstr,'(i4)') ipnt
         tnkfil = tnknm(1:jlen)//'.'//ttstr
         jlen = jlen + 1 + 4
      elseif (ipnt.lt.100000) then
         write(ttstr,'(i5)') ipnt
         tnkfil = tnknm(1:jlen)//'.'//tttstr
         jlen = jlen + 1 + 5
      endif

      if (opfil(52,tnkfil,jlen,1,1,0)) then
          iuntmp = iun2
          iun2 = 52
          if (tnkprg.eq.4) then
             call rdchx(0,3,0,0,0,istat,icrtp,1)
             if (istat.gt.0) then
                iret = 1
                call fdat(ifd,0,0,0,0,0)
             endif
          else
             call gettnk(igttnk,0,idummy,iff,iheat,heat)
             if (igttnk.eq.1) iret = 1
          endif
          close(52)
          iun2 = iuntmp
      endif

      return
      end

      subroutine wrtsng
      implicit double precision (a-h,p-z),integer (i-n),logical (o)
      common /xyzopt/ ixyz,ichx,icrtp,ipdbwh,iambch
      character*80 tnknm
      integer tnkbg,tnkit,tnkarc,tnkarf,tnkprg
      common /tnkopt/ rmsgrd,tnkbg,tnkit,tnkarc,tnkarf,tnkprg,tnknm

      itnkln = linlen(tnknm)

      ixyz = 11
      call wrpnt(tnknm(1:itnkln)//'.xyz',itnkln+4,4,0,0,0,
     &           0,1,.false.)

      return
      end
