      implicit real*8 (a-h,o-z)
      character*60 fnobspec,fnresult
      character*80 prjname,linput
c
c      character*4 labsyn(20)
      character*80 labsyn
      common/pass/atmass(99),elem(99)
      character*2 elem
      data elem/   2HH , 2HHe,
     1 2HLi, 2HBe, 2HB , 2HC , 2HN , 2HO , 2HF , 2HNe, 2HNa, 2HMg,
     2 2HAl, 2HSi, 2HP , 2HS , 2HCl, 2HAr, 2HK , 2HCa, 2HSc, 2HTi,
     3 2HV , 2HCr, 2HMn, 2HFe, 2HCo, 2HNi, 2HCu, 2HZn, 2HGa, 2HGe,
     4 2HAs, 2HSe, 2HBr, 2HKr, 2HRb, 2HSr, 2HY , 2HZr, 2HNb, 2HMo,
     5 2HTc, 2HRu, 2HRh, 2HPd, 2HAg, 2HCd, 2HIn, 2HSn, 2HSb, 2HTe,
     6 2HI , 2HXe, 2HCs, 2HBa, 2HLa, 2HCe, 2HPr, 2HNd, 2HPm, 2HSm,
     7 2HEu, 2HGd, 2HTb, 2HDy, 2HHo, 2HEr, 2HTm, 2HYb, 2HLu, 2HHf,
     8 2HTa, 2HW , 2HRe, 2HOs, 2HIr, 2HPt, 2HAu, 2HHg, 2HTl, 2HPb,
     9 2HBi, 2HPo, 2HAt, 2HRn, 2HFr, 2HRa, 2HAc, 2HTh, 2HPa, 2HU ,
     T 2HNp, 2HPu, 2HAm, 2HCm, 2HBk, 2HCf, 2HEs/
      DATA ATMASS/ 1.008,4.003,
     1 6.939,9.013,10.81,12.01,14.01,16.00,19.00,20.18,22.99,24.31,
     2 26.98,28.09,30.98,32.07,35.45,39.95,39.10,40.08,44.96,47.90,
     3 50.94,52.00,54.94,55.85,58.94,58.71,63.55,65.37,69.72,72.60,
     4 74.92,78.96,79.91,83.80,85.48,87.63,88.91,91.22,92.91,95.95,
     5 99.00,101.1,102.9,106.4,107.9,112.4,114.8,118.7,121.8,127.6,
     6 126.9,131.3,132.9,137.4,138.9,140.1,140.9,144.3,147.0,150.4,
     7 152.0,157.3,158.9,162.5,164.9,167.3,168.9,173.0,175.0,178.5,
     8 181.0,183.9,186.3,190.2,192.2,195.1,197.0,200.6,204.4,207.2,
     9 209.0,210.0,211.0,222.0,223.0,226.1,227.1,232.0,231.0,238.0,
     T 237.0,244.0,243.0,247.0,247.0,251.0,254.0/
      dimension xablog(99),atmasstt(99),rhox(99),icd(10),ifvar(10)
      dimension t(99),epslog0(10),wms(10),wme(10)
      character*11 labmac(2)
      data labmac/'rotational ','G-macroturb'/
      dimension iza(8)
      character*2 elm
      dimension cm(68)
      data cm/
     a 100.00,101.00,101.01,106.00,106.01,107.00,108.00,108.01,
     b 109.00,112.00,113.00,114.00,114.01,116.00,117.00,600.00,
     c 606.00,607.00,607.01,608.00,613.00,614.00,616.00,707.00,
     d 707.01,708.00,708.01,712.00,713.00,714.00,716.00,800.00,
     e 808.00,808.01,812.00,813.00,814.00,816.00,820.00,822.00,
     f 826.00,900.00,1216.00,1300.00,1316.00,1416.00,1600.00,1616.00,
     g 1620.00,1626.00,1700.00,2600.00,10100.00,10106.00,10107.00,
     h 10108.00,10116.00,10606.00,10607.00,10608.00,10708.00,
     i 10800.00,10808.00,60600.00,60700.00,60808.00,70700.00,
     j 80800.00/
c
      open (unit=1,status='scratch')
      write(6,*) 'title of the calculation? (<=60 chars)'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,'(a)') prjname
      write(6,*) 'file name of the observed spectrum ? (<=60 chars)'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,'(a)') fnobspec

c      open (unit=30,file='kapsave.tmp',form='unformatted')
c      read(30) (labsyn(k),k=1,20)
c      read(30) teff,glog,xscale,vtsbac
c      read(30) (xablog(ie),ie=1,99)
c      read(30) (atmasstt(ie),ie=1,99)
c      read(30) nrhox
c      read(30) (rhox(j),j=1,nrhox)
c      read(30) (t(j),j=1,nrhox)
c      read(30) nelv
c      read(30) (icd(l),l=1,nelv)
c      read(30) nlam
c      read(30) ncon
c      read(30) sstwv,eenwv

      open (unit=30,file='kapsave.tmp',form='formatted')
      read(30,865) labsyn
  865 FORMAT(A80)
      read(30,808) teff,glog,xscale,vtsbac
  808 FORMAT(F8.1,F6.2,F6.3,F6.2)
      read(30,840) (xablog(ie),ie=1,99)
  840 FORMAT(20F6.2)
      read(30,871) (atmasstt(ie),ie=1,99)
  871 FORMAT(10F12.3)
      read(30,872) nrhox
  872 FORMAT(I4)
      read(30,870) (rhox(j),j=1,nrhox)
  870 FORMAT(10E12.5)
      read(30,873) (t(j),j=1,nrhox)
  873 FORMAT(10F12.1)
      read(30,872) nelv
      read(30,860) (icd(l),l=1,nelv)
  860 FORMAT(30I4)
      read(30,872) nlam
      read(30,872) ncon
      read(30,871) sstwv,eenwv

      write(6,'(''Data contained in the present kapsave.tmp file:'')')
c      write(6,'(''Model atmosphere:'',15a4)') (labsyn(k),k=1,15)
      write(6,'(''Model atmosphere:'',a60)') labsyn(1:60)
      write(6,'(''Teff:'',f7.0,3x,''logg:'',f5.2,3x,''xscale:'',f8.4)')
     % teff,glog,xscale
      write(6,'(''Abundances of '',i2,'' elements are variable:'')')
     % nelv
      write(6,'(''Standard (model) abundances are as follows:'')')
      do l=1,nelv
      elog=xablog(icd(l))-xablog(1)+12.00 
      write(6,'(a2,''('',i2,'')'',2x,f6.2)') elem(icd(l)),icd(l),elog
      end do
      write(6,*) 'atomic number, ifvar (0 or 1), starting abundance?'
      write(6,*) '--------------------------------------------------'
      write(6,*) '(one line for each element IN THIS ORDER:)'
      write(6,*) '(Example:)'
      write(6,*) '( 8 0 8.86, if O to be fixed at the value of 8.86)'
      write(6,*) '(26 1 7.60, if Fe to be varied starting from 7.60)' 
      write(6,'(''So, please input '',i2,'' lines of data:'')') nelv
      write(6,*) '--------------------------------------------------'
      do l=1,nelv 
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) iztemp,ifvar(l),epslog0(l)
      if(iztemp.ne.icd(l)) then
      write(6,*) iztemp,icd(l)
      write(6,*) 'element order inconsistent! aborted!'
      stop
      end if
      end do
      write(6,*) 'Spectrum resolution (lambda/FWHM)? (0 for infinity)'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) resol
      write(6,*) 'Starting value of the microturbulence (km/s)? '
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) xi0
 3    write(6,*) 'Type of macrobroadening ?'
      write(6,*) '(pure rotation ... 1, pure Gaussian ... 2):'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) ifmac
      if(ifmac.ne.1.and.ifmac.ne.2) then
      write(6,*) 'ifmac should be 1 or 2'
      go to 3
      end if
      write(6,*) 'Starting value for '//labmac(ifmac)//' velocity?'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) vm0
      if(ifmac.eq.1) then
      write(6,*) 'limb-darkening coefficient ?'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) eps
      end if
      write(6,*) 'Starting value of the wavelength shift (in A)?'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) dela
      write(6,*) 'wla1,wla2 ? (specify wavelength range in A)'
      write(6,'(''(should be within ['',f8.2,'','',f8.2,''])'')')
     % sstwv*10.,eenwv*10.
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) wla1,wla2
c      write(6,*) 'its,ite ? (starting & ending iteration #)'
c      read(5,'(a)') linput
c      write(1,'(a)') linput
c      read(linput,*) its,ite
      write(6,*) 'How many mask regions?'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) nmask
      if(nmask.gt.0) then
      write(6,*) 'OK, then input (wstart,wend) for each mask region.'
      do i=1,nmask
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,*) wms(i),wme(i)
      end do
      end if
      write(6,*) 'output file name to save the results? (<=60 chars)'
      read(5,'(a)') linput
      write(1,'(a)') linput
      read(linput,'(a)') fnresult
      wlamid=(wla1+wla2)/2.
      if(resol.gt.0) then
      vfwhm=2.997925e5/resol
      vhem=vfwhm/1.6651092
      else
      vhem=0.
      end if
      open (unit=10,file='mpffiles.lst')
      write(10,'(a)') 'f  5  minput.in'
      write(10,'(a)') 'f  9  '//fnobspec
      write(10,'(a)') 'f  6  moutput.out'
      write(10,'(a)') 'f 30  kapsave.tmp'
      write(10,'(a)') 'u 33'
      write(10,'(a)') 'f 60  '//fnresult
      close (10)
      open (unit=11,file='minput.in')
      write(11,'(a)') prjname
      write(11,'(2i4,f6.2,i4)') 0,0,0.30,1 
      write(11,'(2f10.2,f10.4,f10.2)') wla1,wla2,vhem,0. 
      write(11,'(i2,i3)') nelv,0
      do l=1,nelv
      if(icd(l).gt.0) then
      write(11,'(i2,i3,1x,a4,2f7.3,f6.2)')
     % ifvar(l),icd(l),'<'//elem(icd(l))//'>',epslog0(l),0.020,99.99
      else
      tcod=cm(iabs(icd(l)))
      ijel=int(tcod+0.5)
      call calzam(ijel,elm,tatmas,mola,iza)
      write(11,'(i2,i3,1x,a4,2f7.3,f6.2)')
     % ifvar(l),icd(l),'<'//elm//'>',epslog0(l),0.020,99.99
      end if
      end do  
      ifxvar=0
      if(xi0.lt.0.) ifxvar=1
      write(11,'(i2,2f7.2,f6.1)') ifxvar,abs(xi0),0.20,999.9
      if(ifmac.eq.1) then
      write(11,'(i2,2f7.2,f6.1)') 0,0.00,0.20,999.9
      write(11,'(i2,2f7.2,f6.1,f6.3)') 1,vm0,0.20,999.9,eps
      else if(ifmac.eq.2) then
      write(11,'(i2,2f7.2,f6.1)') 1,vm0,0.20,999.9
      write(11,'(i2,2f7.2,f6.1,f6.3)') 0,0.00,0.20,999.9,0.00
      else
      write(6,*) 'Why not ifmac=1 or 2?'
      stop
      end if
      write(11,'(i2,2f7.4,f6.3)') 1,dela/10.,0.0010,9.999
      write(11,'(2i4)') 0,nmask
      if(nmask.gt.0) then
      do i=1,nmask
      write(11,'(2f8.2)') wms(i),wme(i)
      end do
      end if
      close(11)
c     now copies the content of temporary file #1 to msetin.bak
      open (unit=2,file='msetin.bak')
      rewind 1
      do k=1,99999
      read(1,'(a)',end=555) linput
      write(2,'(a)') linput
      end do
  555 close(2)
      close(1)
      stop
      end
      subroutine calzam(ijel,elm,tatmas,mola,iza)
      IMPLICIT REAL*8 (A-H,O-Z)
      common/pass/atmass(99),elem(99)
      character*2 elem
      dimension xcode(8),iza(8)
      DATA XCODE/1.E14,1.E12,1.E10,1.E8,1.E6,1.E4,1.E2,1.E0/
      character*2 elm
      character*1 eq(2)
      c=dfloat(ijel)
      do 11 ii=1,8
      if(c.ge.xcode(ii)) go to 12
   11 continue
      call exit
   12 continue
      ia=0
      am=0.
      do 13 i=ii,8
      id=c/xcode(i)
      am=am+atmass(id)
      ia=ia+1
      iza(ia)=id
      c=c-dfloat(id)*xcode(i)
   13 continue
      mola=ia
      tatmas=am
      if(mola.eq.1) elm=elem(iza(1))
      if(mola.eq.2) then
        do j=1,2
          if(iza(j).gt.0) then
            eq(j)=elem(iza(j))
          else
            eq(j)='-'
          end if
        end do
        elm=eq(1)//eq(2)
      end if
      if(mola.eq.3) elm='tt'
      if(mola.eq.4) elm='xx'
      return
      end

