      program readmgf
c     based on Dr. Kurucz's RMOLEC.FOR in his CD-ROM 18
c     This program reads molecular line data from the ORIGINAL files
c     contained in ASCLINES directory in KURUCZ CD-ROM 18
c     and write thewm out to a file in an appropriate format
      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/
      character fnin*80,fnout*40
      character*8 label,labelp
      write(6,*)'Input file name (<=80)? (preferably in full path),'
      write(6,*)'(ex. q:\cdrom18\asclines\hydrides.asc [direct cdrom]'
      write(6,*) '   or c:\work\cnax.asc [if copied to a hard disk] )'
      read(5,'(a)') fnin
      call lablen(fnin,80,ns,ne)
      write(6,*) 'Now loading and converting the file. Be patient...'
      open (unit=8,file=fnin(ns:ne),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,*) 'code? (ex. 108.00 for OH  or  607.00 for CN)'
      read(5,*) codem
      write(6,*)'wavelength range ? (blank-separated two values in A)'
      read(5,*) wla1,wla2
      wln1=wla1/10.
      wln2=wla2/10.
      write(6,*) 'output file name ? (<=40 chars)'
      read(5,'(a40)') fnout
      open (unit=10,file=fnout,access='append')
      ndat=0
      DO 200 ILINE=1,9999999
      READ(9,2,END=921)WL,TGFLOG,XJ,E,XJP,EP,ICODE,LABEL,LABELP,ISO
    2 FORMAT(F10.4,F7.3,F5.1,F10.3,F5.1,F11.3,I4,A8,A8,I2)
      CODE=ICODE
      WL=ABS(WL)
      if(abs(code-codem).gt.0.001) go to 200
      if(wl.gt.wln2) go to 921
      if(wl.lt.wln1) go to 200
      GO TO (10,99,99,99,99,99,99,99,99,99,99,120,130,140,150,160,170,
     1 180,99,99,99,99,99,240,250,260,99,280,290,300,99,99,330),ISO
C     H2
   10 NELION=240
      IS01=1
      IS02=1
      X1=0.
      X2=0.
      GO TO 5000
  120 IF(CODE.EQ.606.)GO TO 1200
      IF(CODE.EQ.608.)GO TO 1210
      IF(CODE.EQ.106.)GO TO 1220
C     CN
      NELION=270
      ISO1=12
      ISO2=14
      X1=-.005
      X2=-.002
      GO TO 5000
  130 IF(CODE.EQ.606.)GO TO 1300
      IF(CODE.EQ.608.)GO TO 1310
      IF(CODE.EQ.106.)GO TO 1320
C     CN
      NELION=270
      ISO1=13
      ISO2=14
      X1=-1.955
      X2=-.002
      GO TO 5000
C     NH
  140 NELION=252
      ISO1=1
      ISO2=14
      X1=0.
      X2=-.002
      GO TO 5000
C     NH
  150 IF(CODE.EQ.607.)GO TO 1500
      NELION=252
      ISO1=1
      ISO2=15
      X1=0.
      X2=-2.444
      GO TO 5000
C     OH
  160 NELION=258
      ISO1=1
      ISO2=16
      X1=0.
      X2=-.001
      GO TO 5000
C     CO
  170 NELION=276
      ISO1=12
      ISO2=17
      X1=-.005
      X2=-3.398
      GO TO 5000
  180 IF(CODE.EQ.814.)GO TO 1800
      IF(CODE.EQ.608.)GO TO 1810
C     OH
      NELION=258
      ISO1=1
      ISO2=18
      X1=0.
      X2=-2.690
      GO TO 5000
C     MgH
  240 NELION=300
      ISO1=1
      ISO2=24
      X1=0.
      X2=-.105
      GO TO 5000
C     MgH
  250 NELION=300
      ISO1=1
      ISO2=25
      X1=0.
      X2=-.996
      GO TO 5000
C     MgH
  260 NELION=300
      ISO1=1
      ISO2=26
      X1=0.
      X2=-.947
      GO TO 5000
  280 IF(CODE.EQ.814.)GO TO 2800
C     SiH
      ISO1=1
      ISO2=28
      NELION=312
      X1=0.
      X2=-.035
      GO TO 5000
  290 IF(CODE.EQ.814.)GO TO 2900
C     SiH
      NELION=312
      ISO1=1
      ISO2=29
      X1=0.
      X2=-1.331
      GO TO 5000
  300 IF(CODE.EQ.814.)GO TO 3000
C     SiH
      NELION=312
      ISO1=1
      ISO2=30
      X1=0.
      X2=-1.516
      GO TO 5000
C     C2
  330 NELION=264
      ISO1=13
      ISO2=13
      X1=-1.955
      X2=-1.955
      GO TO 5000
C     C2
 1200 NELION=264
      ISO1=12
      ISO2=12
      X1=-.005
      X2=-.005
      GO TO 5000
C     CO
 1210 NELION=264
      ISO1=12
      ISO2=16
      X1=-.005
      X2=-.001
      GO TO 5000
C     CH
 1220 NELION=246
      ISO1=1
      ISO2=12
      X1=0.
      X2=-.005
      GO TO 5000
C     C2
 1300 NELION=264
      ISO1=12
      ISO2=13
      X1=-.005
      X2=-1.955
      GO TO 5000
C     CO
 1310 NELION=276
      ISO1=13
      ISO2=16
      X1=-1.955
      X2=-.001
      GO TO 5000
C     CH
 1320 NELION=246
      ISO1=1
      ISO2=13
      X1=0.
      X2=-1.955
      GO TO 5000
C     CN
 1500 NELION=270
      ISO1=12
      ISO2=15
      X1=-.005
      X2=-2.444
      GO TO 5000
C     SiO
 1800 NELION=330
      ISO1=28
      ISO2=18
      X1=-.035
      X2=-2.690
      GO TO 1500
C     CO
 1810 NELION=276
      ISO1=12
      ISO2=18
      X1=-.005
      X2=-2.690
      GO TO 5000
C     SiO
 2800 NELION=330
      ISO1=28
      ISO2=16
      X1=-.035
      X2=-.001
      GO TO 5000
C     SiO
 2900 NELION=330
      ISO1=29
      ISO2=16
      X1=-1.328
      X2=-.001
      GO TO 5000
C     SiO
 3000 NELION=330
      ISO1=30
      ISO2=16
      X1=-1.510
      X2=-.001
      GO TO 5000
 5000 GFLOG=TGFLOG+X1+X2
      EXPOT=DMIN1(ABS(E),ABS(EP))*1.23981E-4
      GAMMAR=0.
      IF(LABELP(1:1).EQ.'X')GAMMAR=DLOG10(0.001*2.223E13/WL**2)
      GAMMAS=0.
      GAMMAW=0.
      WRITE(10,222) CODE,WL*10.,EXPOT,GFLOG,GAMMAR,GAMMAS,GAMMAW,ISO
  222 FORMAT(F9.2,F10.3,F8.3,F8.3,3F7.2,I4)
      ndat=ndat+1
  200 CONTINUE
  921 close(10)
      write(6,'(''Finish:'',i6,'' data have been extracted.'')') ndat
   44 write(6,'(''continue for this '',(a),'' file ?'')') fnin(ns:ne)
      write(6,*) 'Answer "y" or "n" , please'
      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
      subroutine lablen(label,nlen,ns,ne)
      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
