
      implicit real*8 (a-h,o-z)
      parameter (MBUF=32768)
      byte c00,c0a,c1a,c0d,data(MBUF),ldat(120)
      data c00/#00/,c0a/#0A/,c1a/#1A/,c0d/#0D/
      dimension iflux(5),iint(5),idec(5)
      dimension flux(5),wla(5)
      logical logok
      character ch*1,fnout*40,fmt*17,fmt1*17,fmt2*17
      fmt1='(0pf10.5,0pe13.6)'
      fmt2='(0pf10.4,0pe13.6)'
      write(6,*) 'First, set Kurucz''s CD-ROM No.18'
      write(6,*) 'Then, input the drive letter of CD-ROM (1 char)'
      read(5,'(a)') ch
      write(6,*) 'Now loading and converting the CD-ROM. Be patient...'
      open (unit=8,file=ch//':\cdrom18\atlases\solarflx.asc',
     % form='binary')
c     convert cdrom DEC data file to MSDOS file in the current directory 
      open (unit=9,file='file9.tmp',form='binary')
      ip=0
  111 continue
      do 3 i=1,MBUF
    3 data(i)=c00
      read(8,err=99,end=99) (data(i),i=1,MBUF)
   99 continue
      do 20 i=1,MBUF
        if(data(i).eq.c00) then
        write(9) c1a
        close (unit=8)
        close (unit=9)
        go to 88
        end if
      ip=ip+1
      ldat(ip)=data(i)
       if(ldat(ip).eq.c0d) then
       write(9) (ldat(l),l=1,ip),c0a
       ip=0
       end if
   20 continue
      go to 111
   88 continue
c     file convert finished
      open (unit=9,file='file9.tmp',form='formatted',disp='delete')
  777 rewind 9
      write(6,*) 'wla1 & wla2 ?'
      read(5,*) wla1,wla2
      write(6,*) 'output file name?'
      read(5,'(a40)') fnout
      open (unit=10,file=fnout)
      rewind 10
      write(10,18) wla1,wla2
   18 format('# from ',f8.2,'(A) to ',f8.2,'(A) Kurucz et al. (1984)',
     % ' Solar Flux Atlas')
      ndat=0
      logok=.false.
    1 read(9,100) (iflux(k),iint(k),idec(k),k=1,5)
  100 format(5(i6,i5,i5))
      do 50 k=1,5
      flux(k)=dfloat(iflux(k))/1.d5
      wla(k)=dfloat(iint(k))+dfloat(idec(k))/1.d5
   50 continue
      if(logok.eq..true.) go to 66
      if(wla(5).ge.wla1) then
c        first segment operation
         do 6 k=1,5
           if(wla(k).ge.wla1) go to 16
    6    continue
   16    ks=k
         do k=ks,5
           fmt=fmt1
           if(wla(k).ge.10000.) fmt=fmt2
           write(10,fmt) wla(k),flux(k)
         end do
         ndat=ndat+(5-ks+1)
         logok=.true.
         wlabgn=wla(ks)
      end if
      go to 1
   66 continue
c     normal segment
      if(wla(5).le.wla2) then
      do k=1,5
           fmt=fmt1
           if(wla(k).ge.10000.) fmt=fmt2
        write(10,fmt) wla(k),flux(k)
      end do
      ndat=ndat+5
      wlaend=wla(5)
      go to 1
      end if
c     last segment
      do 7 k=5,1,-1
      if(wla(k).le.wla2) go to 17
    7 continue
      go to 34
   17 ke=k
      wlaend=wla(ke)
      do k=1,ke
           fmt=fmt1
           if(wla(k).ge.10000.) fmt=fmt2
        write(10,fmt) wla(k),flux(k)
      end do
      ndat=ndat+(ke-1+1)
   34 continue
      close(10)
      write(6,'(''Finish:'',i6,'' data have been extracted.'')') ndat
      write(6,'(''wla(begin)='',f12.5,5x,''wla(end)='',f12.5)')
     % wlabgn,wlaend
   44 write(6,*) 'continue? (y or n)'
      read(5,'(a1)') ch
      if(ch.eq.'y'.or.ch.eq.'Y') go to 777
      if(ch.eq.'n'.or.ch.eq.'N') go to 999
      go to 44
  999 close(9)
      stop
      end
