      SUBROUTINE DATIN
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
      character NUMBRS(0:9)*1, PARTYP(25)*5, FILES*64, DUMMY*50,
     1          KEYWRD*241, TEXT*50, TXTNEW*50, ELEMNT(107)*2,
     2          GETNAM*80
      common /ATHEAT/ ATHEAT
     1       /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     2                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
     3                NCLOSE,NOPEN,NDUMY,FRACT
      common /ATOMIC/ EISOL(107),EHEAT(107)
      common /KEYWRD/ KEYWRD
      dimension  IJPARS(5,1000), PARSIJ(1000)
      save NUMBRS, PARTYP, ELEMNT
      data NUMBRS/' ','1','2','3','4','5','6','7','8','9'/
      data PARTYP/'USS  ','UPP  ','UDD  ','ZS   ','ZP   ','ZD   ',
     1    'BETAS','BETAP','BETAD','GSS  ','GSP  ','GPP  ','GP2  ',
     2    'HSP  ','AM1  ','EXPC ','GAUSS','ALP  ','GSD  ','GPD  ',
     3    'GDD  ','FN1  ','FN2  ','FN3  ','ORB  '/
      data (ELEMNT(I),I=1,107)/'H ','HE',
     1 'LI','BE','B ','C ','N ','O ','F ','NE',
     2 'NA','MG','AL','SI','P ','S ','CL','AR',
     3 'K ','CA','SC','TI','V ','CR','MN','FE','CO','NI','CU',
     4 'ZN','GA','GE','AS','SE','BR','KR',
     5 'RB','SR','Y ','ZR','NB','MO','TC','RU','RH','PD','AG',
     6 'CD','IN','SN','SB','TE','I ','XE',
     7 'CS','BA','LA','CE','PR','ND','PM','SM','EU','GD','TB','DY',
     8 'HO','ER','TM','YB','LU','HF','TA','W ','RE','OS','IR','PT',
     9 'AU','HG','TL','PB','BI','PO','AT','RN',
     1 'FR','RA','AC','TH','PA','U ','NP','PU','AM','CM','BK','CF','XX',
     2 'FM','MD','CB','++','+','--','-','TV'/
      I=INDEX(KEYWRD,'EXTERNAL=')+9
      J=INDEX(KEYWRD(I:),' ')+I-1
      FILES=GETNAM(KEYWRD(I:J))
      write(MIOB,
     2         '(//5X,'' PARAMETER TYPE      ELEMENT    PARAMETER'')')
c
      open(unit=MIOH,file=FILES,status='UNKNOWN')
c
      I=0
      NPARAS=0
   10 READ(MIOH,'(A40)',ERR=90,IOSTAT=IOS) TEXT
      NPARAS=NPARAS+1
      if (TEXT.EQ.' ') go to 90
      if (INDEX(TEXT,'end').NE.0) go to 90
      ILOWA = ICHAR('a')
      ILOWZ = ICHAR('z')
      ICAPA = ICHAR('A')
************************************************************************
      do 20 I=1,50
         ILINE=ICHAR(TEXT(I:I))
         if (ILINE.GE.ILOWA.AND.ILINE.LE.ILOWZ) then
            TEXT(I:I)=CHAR(ILINE+ICAPA-ILOWA)
         end if
   20 continue
************************************************************************
      if (INDEX(TEXT,'end') .NE. 0) go to 90
      do 30 J=1,25
         if (J.GT.21) then
            IT=INDEX(TEXT,'FN')
            TXTNEW = TEXT(1:IT+2)
            if (INDEX(TXTNEW,PARTYP(J)) .NE. 0) go to 40
         end if
         if (INDEX(TEXT,PARTYP(J)) .NE. 0) go to 40
   30 continue
      write(MIOB,'(''  FAULTY LINE:'',A)') TXTNEW
      write(MIOB,'(''  FAULTY LINE:'',A)') TEXT
      write(MIOB,'(''   NAME NOT FOUND'')')
      call filclo  ! J/M
      stop ' in DATIN -  NAME NOT FOUND'
   40 IPARAM=J
      if (IPARAM.GT.21) then
         I=INDEX(TEXT,'FN')
         KFN = READA(TEXT,I+3)
      else
         KFN=0
         I=INDEX(TEXT,PARTYP(J))
      end if
      K=INDEX(TEXT(I:),' ')+1
      DUMMY=TEXT(K:)
      TEXT=DUMMY
      do 50 J=1,107
   50 if (INDEX(TEXT,' '//ELEMNT(J)) .NE. 0) go to 60
      write(MIOB,'('' ELEMENT NOT FOUND '')')
      write(MIOB,*) ' FAULTY LINE: "'//TEXT//'"'
      call filclo  ! J/M
      stop ' in DATIN - ELEMENT NOT FOUND '
   60 IELMNT=J
      PARAM = READA(TEXT,INDEX(TEXT,ELEMNT(J)))
      do 70 I=1,LPARS
         if (IJPARS(1,I).EQ.KFN.AND.IJPARS(2,I).EQ.IELMNT.AND.
     1      IJPARS(3,I).EQ.IPARAM) go to 80
   70 continue
      LPARS=LPARS+1
      I=LPARS
   80 IJPARS(1,I)=KFN
      IJPARS(2,I)=IELMNT
      IJPARS(3,I)=IPARAM
      PARSIJ(I)=PARAM
      go to 10
   90 continue
      if (NPARAS.EQ.0) then
         write(MIOB,'(//10X,A)')
     1           ' EXTERNAL PARAMETERS FILE MISSING OR EMPTY'
         call filclo  ! J/M
         stop ' in DATIN - Ext. pars. file missing or empty '
      end if
      close(unit=MIOH)
      do 120 J=1,107
         do 110 K=1,25
            do 100 I=1,LPARS
               IPARAM=IJPARS(3,I)
               KFN=IJPARS(1,I)
               IELMNT=IJPARS(2,I)
               if (IPARAM.NE.K) go to 100
               if (IELMNT.NE.J) go to 100
               PARAM=PARSIJ(I)
               if (KFN.NE.0) then
                  write(MIOB,'(10X,A6,11X,A2,F17.6)')
     1                PARTYP(IPARAM) (:3)//NUMBRS(KFN)//'  ',
     2                ELEMNT(IELMNT),PARAM
               else
                  write(MIOB,'(10X,A6,11X,A2,F17.6)')
     1                PARTYP(IPARAM)//NUMBRS(KFN),
     2                ELEMNT(IELMNT),PARAM
               end if
               call UPDATE(IPARAM,IELMNT,PARAM,1,KFN)
  100       continue
  110    continue
  120 continue
      call MOLDAT(1)
      call CALPAR
      ATHEAT=0.D0
      ETH=0.D0
      do 130 I=1,NUMAT
         NI=NAT(I)
         ATHEAT=ATHEAT+EHEAT(NI)
  130 ETH=ETH+EISOL(NI)
      ATHEAT=ATHEAT-ETH*23.061D0
      return
      end
