      use dflib
      implicit real*8 (a-h,o-z)
      integer*2 narg
      character*80 buf
      common/pass/w1,w2,cod,xi,abund,ewcrt
      common/fnpass/fnmodel,fnoutput
      character*60 fnmodel,fnoutput
c     w1,w2,cod,fnmodel,xi,abund,fnoutput
      narg=1
      call getarg(narg,buf)
      read(buf,*) w1
      narg=2
      call getarg(narg,buf)
      read(buf,*) w2
      narg=3
      call getarg(narg,buf)
      read(buf,*) cod
      narg=4
      call getarg(narg,buf)
      read(buf,'(a)') fnmodel
      narg=5
      call getarg(narg,buf)
      read(buf,*) xi
      narg=6
      call getarg(narg,buf)
      read(buf,*) abund
      narg=7
      call getarg(narg,buf)
      read(buf,*) ewcrt
      narg=8
      call getarg(narg,buf)
      read(buf,'(a)') fnoutput
      write(*,'(''w1:'',f9.3)') w1
      write(*,'(''w2:'',f9.3)') w2
      write(*,'(''cod:'',f6.2)') cod
      write(*,'(''fnmodel:'',a60)') fnmodel
      write(*,'(''xi:'',f5.2)') xi
      write(*,'(''abund:'',f5.2)') abund
      write(*,'(''fnoutput:'',a60)') fnoutput
      call lineset
      call modelset
      call runwidth
      stop
      end
 
      subroutine runwidth
      use dflib
      use dfport
      implicit real*8 (a-h,o-z)
      common/pass/w1,w2,cod,xi,abund,ewcrt
      common/fnpass/fnmodel,fnoutput
      character*60 fnmodel,fnoutput
      character*80 line,line1(9999),line2(300),line3(20)
      open (unit=11,file='lines.tmp')
      rewind 11
      nn=0
      do n=1,99999
      if(nn.eq.9999) then
      write(*,*) 'Too many lines --> truncated at 9999th'
      go to 19
      end if
      line=''
      read(11,'(a)',end=19) line
      nn=nn+1
      line1(nn)=line
      end do
   19 continue
      n1=nn
      close (11)
      
      open (unit=12,file=fnmodel)
      rewind 12
      nn=0
      do n=1,99999
      line=''
      read(12,'(a)',end=29) line
      nn=nn+1
      line2(nn)=line
      end do
   29 continue
      n2=nn
      close (12)

      open (unit=13,file='winput.in')
      write(13,'(''VTUR'')')
      write(13,'(i5,f5.2)') 1,xi
      write(13,'(''CURV'')')
      write(13,'(i5,2f8.2)') 1,abund,0.
      write(13,'(''LINE'',i4)') n1
      do n=1,n1
      write(13,'(a)') line1(n)
      end do
      write(13,'(''END'')')
      do n=1,n2
      write(13,'(a)') line2(n)
      end do
      write(13,'(''END'')')
      write(13,'(''STOP'')')
      close (13)
      open (unit=14,file='widfiles.lst')
      write(14,'(''f  5 winput.in  '')')
      write(14,'(''f  6            '')')
      write(14,'(''f 13            '')')
      write(14,'(''f 20            '')')
      write(14,'(''f 22            '')')
      write(14,'(''f 44 ewtemp.csv '')')
      close (14)
c---------------------
      result= systemqq('width')
c---------------------
      open (unit=44,file='ewtemp.csv')
      open (unit=45,file=fnoutput)
      nsel=0
      do 198 n=1,99999
      read(44,*,end=199) ncp,xcod,xwla,xchi,xgflog,xgr,xgs,xgw,
     & dum,vt,epsl,ew,taul
      if(ew.lt.ewcrt) go to 198
      nsel=nsel+1
      if(xgflog.le.-10.) then
      write(45,228) xcod,xwla,xchi,xgflog,xgr,xgs,xgw,ew,vt,epsl,
     & fnmodel(1:20)
  228 format(f6.2,f9.3,f6.3,f6.2,3f6.2,f7.1,
     & ' (v=',f5.2,' A=',f6.2,') ',8x,a20)
      else
      write(45,229) xcod,xwla,xchi,xgflog,xgr,xgs,xgw,ew,vt,epsl,
     & fnmodel(1:20)
  229 format(f6.2,f9.3,2f6.3,3f6.2,f7.1
     & ' (v=',f5.2,' A=',f6.2,') ',8x,a20)
      end if
  198 continue
  199 continue
      write(*,'(''n_total ='',i4)') n1
      write(*,'(''nselect ='',i4)') nsel
      write(*,'(''ndiscard='',i4)') n1-nsel
      close (44)
      close (45)
      return
      end

      subroutine modelset
      use dflib
      use dfport
      implicit real*8 (a-h,o-z)
      common/pass/w1,w2,cod,xi,abund,ewcrt
      common/fnpass/fnmodel,fnoutput
      character*60 fnmodel,fnoutput
      character ateff*5,aglog1*3,axlog1*4,amole*1
      character aglog*4,axlog*5
      character line*80,linedir*80
      logical loexthe

        call lablen(fnmodel,60,ns,ne)
        inquire(file=fnmodel,exist=loexthe)
        if((.not.loexthe) .and.
     &  (ne-ns+1.eq.17) .and.
     &  (fnmodel(ns:ns).eq.'t') .and.
     &  (fnmodel(ns+6:ns+6).eq.'g') .and.
     &  (fnmodel(ns+10:ns+10).eq.'x') .and.
     &  (fnmodel(ns+15:ns+15).eq.'m') ) then
          read(fnmodel(2:6),'(a5)') ateff
          read(fnmodel(8:10),'(a3)') aglog1
          read(fnmodel(12:15),'(a4)') axlog1
          read(fnmodel(17:17),'(a1)') amole

c         check if correct numeric numbers are specified
          idumt=-999
          idumg=-999
          idumx=-999
          idumm=-999
          read(ateff,*,err=109) idumt
          if(idumt.lt.03500.or.idumt.gt.50000) go to 109
          read(aglog1,*,err=109) idumg
          if(idumg.lt.000.or.idumg.gt.500) go to 109
          read(axlog1,*,err=109) idumx
          if(idumx.lt.-500.or.idumx.gt.+100) go to 109
          read(amole,*,err=109) idumm
          if(idumm.ne.0.and.idumm.ne.1) go to 109
          go to 110
  109     loexthe=.false.
          write(*,*) 'idumt,idumg,idumx,idumm:',idumt,idumg,idumx,idumm
          write(*,*) 'Sorry, specified model parameters unsupported!'
          stop
  110     continue
c
c          call getenv("SPT_DIR",linedir)
          call retenv("SPT_DIR",linedir)
          call lablen(linedir,80,nsdir,nedir)
c
          aglog=aglog1(1:1)//'.'//aglog1(2:3)
          axlog=axlog1(1:2)//'.'//axlog1(3:4)
          line=linedir(nsdir:nedir)//
     %    '\msearch '//ateff//' '//aglog//' '//axlog
          call lablen(line,80,nsqq,neqq)
c          write(*,'(a)') line(nsqq:neqq)
          result=systemqq(line(nsqq:neqq))
          line=linedir(nsdir:nedir)//'\mprep '//amole
          call lablen(line,80,nsqq,neqq)
c          write(*,'(a)') line(nsqq:neqq)
          result=systemqq(line(nsqq:neqq))
          line=linedir(nsdir:nedir)//
     %    '\mdinterp '//ateff//' '//aglog//' '//axlog//' '//amole
          call lablen(line,80,nsqq,neqq)
c          write(*,'(a)') line(nsqq:neqq)
          result=systemqq(line(nsqq:neqq))

                inquire(file=fnmodel,exist=loexthe)
                if(.not.loexthe) then
                write(*,*) 'failed to create '//fnmodel
                write(*,*) 'program stopped (loexthe) -->!$?'
                stop
                end if
        end if
      return
      end
        
      subroutine lineset
      use dfport
      implicit real*8 (a-h,o-z)
      common/pass/w1,w2,cod,xi,abund,ewcrt
      common/fnpass/fnmodel,fnoutput
      character*60 fnmodel,fnoutput
      character*133 line133
      character*10 label,labelp
      character fnout*12,linedir*80
      character*9 gfname(190)
      character*9 gflab1(50),gflab2(50),gflab3(50),gflab4(40)
c
      logical locx,logx,loex,lowx
      character*1 chrem
c
      dimension wlimit(0:190),wsave(99999)
      data gflab1/
     a'GF0010.10','GF0020.10','GF0030.10','GF0040.10','GF0050.10',
     1'GF0060.10','GF0070.10','GF0080.10','GF0090.10','GF0100.10',
     2'GF0110.10','GF0120.10','GF0130.10','GF0140.10','GF0150.10',
     3'GF0160.10','GF0170.10','GF0180.10','GF0190.10','GF0200.10',
     4'GF0210.10','GF0220.10','GF0230.10','GF0240.10','GF0250.10',
     5'GF0260.10','GF0270.10','GF0280.10','GF0290.10','GF0300.10',
     6'GF0310.10','GF0320.10','GF0330.10','GF0340.10','GF0350.10',
     7'GF0360.10','GF0370.10','GF0380.10','GF0390.10','GF0400.10',
     8'GF0410.10','GF0420.10','GF0430.10','GF0440.10','GF0450.10',
     9'GF0460.10','GF0470.10','GF0480.10','GF0490.10','GF0500.10'/
      data gflab2/
     a'GF0510.10','GF0520.10','GF0530.10','GF0540.10','GF0550.10',
     1'GF0560.10','GF0570.10','GF0580.10','GF0590.10','GF0600.10',
     2'GF0610.10','GF0620.10','GF0630.10','GF0640.10','GF0650.10',
     3'GF0660.10','GF0670.10','GF0680.10','GF0690.10','GF0700.10',
     4'GF0710.10','GF0720.10','GF0730.10','GF0740.10','GF0750.10',
     5'GF0760.10','GF0770.10','GF0780.10','GF0790.10','GF0800.10',
     6'GF0810.10','GF0820.10','GF0830.10','GF0840.10','GF0850.10',
     7'GF0860.10','GF0870.10','GF0880.10','GF0890.10','GF0900.10',
     8'GF0910.10','GF0920.10','GF0930.10','GF0940.10','GF0950.10',
     9'GF0960.10','GF0970.10','GF0980.10','GF0990.10','GF1000.10'/
      data gflab3/
     a'GF1100.10','GF1200.10','GF1300.10','GF1400.10','GF1500.10',
     1'GF1600.10','GF1700.10','GF1800.10','GF1900.10','GF2000.10',
     2'GF2100.10','GF2200.10','GF2300.10','GF2400.10','GF2500.10',
     3'GF2600.10','GF2700.10','GF2800.10','GF2900.10','GF3000.10',
     4'GF3100.10','GF3200.10','GF3300.10','GF3400.10','GF3500.10',
     5'GF3600.10','GF3700.10','GF3800.10','GF3900.10','GF4000.10',
     6'GF4100.10','GF4200.10','GF4300.10','GF4400.10','GF4500.10',
     7'GF4600.10','GF4700.10','GF4800.10','GF4900.10','GF5000.10',
     8'GF5100.10','GF5200.10','GF5300.10','GF5400.10','GF5500.10',
     9'GF5600.10','GF5700.10','GF5800.10','GF5900.10','GF6000.10'/
      data gflab4/
     a'GF6100.10','GF6200.10','GF6300.10','GF6400.10','GF6500.10',
     1'GF6600.10','GF6700.10','GF6800.10','GF6900.10','GF7000.10',
     2'GF7100.10','GF7200.10','GF7300.10','GF7400.10','GF7500.10',
     3'GF7600.10','GF7700.10','GF7800.10','GF7900.10','GF8000.10',
     4'GF8100.10','GF8200.10','GF8300.10','GF8400.10','GF8500.10',
     5'GF8600.10','GF8700.10','GF8800.10','GF8900.10','GF9000.10',
     6'GF9100.10','GF9200.10','GF9300.10','GF9400.10','GF9500.10',
     7'GF9600.10','GF9700.10','GF9800.10','GF9900.10','GFEND.10 '/
      equivalence (gfname(001),gflab1(1))
      equivalence (gfname(051),gflab2(1))
      equivalence (gfname(101),gflab3(1))
      equivalence (gfname(151),gflab4(1))
c      if(fnout(9:12).ne.'.kgf') go to 699
c      do i=1,8
c      if(ifnum(fnout(i:i)).eq.0) go to 699
c      end do
c      go to 700
c  699 write(*,'(a12)') fnout
c      write(*,*) 'file format should be ########.kgf !'
c      stop
c  700 continue
c      read(fnout(1:4),'(i4)') iwla1
c      read(fnout(5:8),'(i4)') iwla2
      wla1=w1
      wla2=w2
c      if(wla1.lt.3000.or.wla1.ge.10000.) then
c      write(*,'(''wla1='',f8.2)') wla1
c      stop
c      end if
c      if(wla1.lt.3000.or.wla1.ge.10000.) then
c      write(*,'(''wla2='',f8.2)') wla2
c      stop
c      end if
c      call getenv("KGF_DIR",linedir)
      call retenv("KGF_DIR",linedir)
      call lablen(linedir,80,nsdir,nedir)
      wlimit(0)=0.
      do i=1,189
      read(gfname(i),'(2x,f5.0,2x)') wlimit(i)
      end do
      wlimit(190)=1.d99
      open (unit=40,file='lines.tmp',form='formatted')
      wln1=wla1/10.
      wln2=wla2/10.
      do 11 k=1,190
      if(wln1.ge.wlimit(k-1).and.wln1.le.wlimit(k)) go to 12
   11 continue
      write(*,*) '!! wla1=',wla1
      stop
   12 ks=k
      do 21 k=190,1,-1
      if(wln2.ge.wlimit(k-1).and.wln2.le.wlimit(k)) go to 22
   21 continue
      write(*,*) '!! wla2=',wla2
      stop
   22 ke=k
      do 100 k=ks,ke
      open (unit=38,file=linedir(nsdir:nedir)//'\'//gfname(k),
     & form='formatted')
c      iline=0
      do 9 i=1,1000000
      read(38,'(a)',err=90,end=90) line133
      call lablen(line133,133,nsln,neln)
      if(ifnum(line133(nsln:nsln)).eq.0) go to 9
      read(line133,2,end=90)wl,gflog,code,e,xj,label,ep,xjp,labelp,
     & gammar,gammas,gammaw
    2 format(f11.4,f7.3,f6.2,f12.3,f5.1,1x,a10,f12.3,f5.1,1X,a10,3f6.2)
      if(wl.lt.wln1.or.wl.gt.wln2) go to 9
      if(abs(code-cod).gt.0.001) go to 9
      ek=e
      if(ep.lt.e) ek=ep
      expot=1.23981e-4*ek
      wla=wl*10.
c
      locx=abs(code-codepre).le.0.001
      lowx=abs(wl-wlpre)*10..le.0.001
      loex=abs(expot-expotpre).le.0.001
      logx=abs(gflog-gflogpre).le.0.001
cc      if(locx.and.lowx.and.loex.and.logx) then
cc        chrem='*'
cc        write(*,223) '!!!! caution !!!',iline,code,wl*10.,expot,gflog
cc 223   format(1h ,a16,i4,':',f9.2,f10.3,f8.3,f8.3)
cc      else
        chrem=' '
cc      end if
      codepre=code
      wlpre=wl
      expotpre=expot
      gflogpre=gflog
c
      if(gflog.le.-10.) then
      write(40,228) code,wla,expot,gflog,gammar,gammas,gammaw,0.
  228 format(f6.2,f9.3,f6.3,f6.2,3f6.2,f7.1)
      else
      write(40,229) code,wla,expot,gflog,gammar,gammas,gammaw,0.
  229 format(f6.2,f9.3,2f6.3,3f6.2,f7.1)
      end if
c      iline=iline+1
c      wsave(iline)=wla
    9 continue
   90 close(38)
c      if(iline.le.0) go to 100
c      write(*,'(''data output to file:'',a40)') fnout
c      write(*,30) k,gfname(k),wsave(1),wsave(iline),iline
c   30 format(1h ,'file no.',i3,1x,'fname:',a9,1x,
c     % 'from ',f10.3,' to ',f10.3,' A',2x,'(',i6,' lines)')
  100 continue
  999 continue
      close(40)
 9999 return
      end
      subroutine lablen(label,nlen,ns,ne)
      implicit real*8 (a-h,o-z)
      character*(*) label
      do n=nlen,1,-1
      if((label(n:n).ne.' ').and.(label(n:n).ne.'')) exit
      end do
      ne=n
      do n=1,nlen
      if((label(n:n).ne.' ').and.(label(n:n).ne.'')) exit
      end do
      ns=n
      return
      end
      function ifnum(ch)
      character*1 ch,num(10)
      data num/'1','2','3','4','5','6','7','8','9','0'/
      do 100 i=1,10
      if(ch.eq.num(i)) go to 99
  100 continue
      ifnum=0
      return
   99 ifnum=1
      return
      end

      subroutine retenv(varname,string)
      use dfport
      character*7 varname
      character*80 sptool,string
      call getenv('SPTOOL',sptool)
      call lablen(sptool,80,is,ie)
      call lablen(varname,7,ivs,ive)
      if(varname(ivs:ive).eq.'SPTOOL') then
          string=sptool(is:ie)
        else if(varname(ivs:ive).eq.'SPT_DIR') then
          string=sptool(is:ie)//'\exefiles'
        else if(varname(ivs:ive).eq.'MOD_DIR') then
          string=sptool(is:ie)//'\k2models'
        else if(varname(ivs:ive).eq.'KGF_DIR') then
c          string=sptool(is:ie)//'\kbgf10'
          string=sptool(is:ie)//'\kbgfdos'
        else if(varname(ivs:ive).eq.'SFX_DIR') then
          string=sptool(is:ie)//'\sflxkpno'
        else if(varname(ivs:ive).eq.'DAT_DIR') then
          string=sptool(is:ie)//'\miscdata'
        else
          write(*,*) 'I do not understand '//varname(ivs:ive)
          stop
      end if
      return
      end

