C *** This program is used in conjunction with "selectbc.data" to set up the
C     BC tables for the photometric system and filter bandpasses of interest,
C     assuming E(B-V) = 0.0, 0.12, 0.24, 0.36, 0.48, 0.60, and 0.72.  The
C     resultant 7 tables are employed by "getbctable.for" to produce the BC
C     tables for the same filter bandpasses and any selected value of E(B-V)
C     in the range from 0.0 to 0.72.
C
C *** Regarding "selectbc.data":
C       1st line: integer is set to a value of 1, 2, 3, or 4 to specify
C                 which variation of [alpha/Fe] with [Fe/H] is to be assumed.
C       2nd line: integer is set to a value of 1, 2, ..., 5 to indicate the
C                 number of filter bandpasses for which BC values will be
C                 defined.  (The maximum value permitted is 5.)
C       next 1, 2, ..., 5 lines: the pairs of integers define the photometric
C                 system and filter for which BC values will be defined: the
C                 menu of possible values are given below the horizontal 
C                 line (e.g., 5 33 selects the sdss photometric system and
C                 the sdss i filter).
C
C *** The output of this program consists of seven data files named
C     inputbc_r00.data, inputbc_r12.data, ..., inputbc_r72.data.  If these
C     files already exist, they will be overwritten.     
C
C *** NOTE that "slash" as defined in the data statement (below) **MUST**
C     be defined to be a forward slash (i.e., "slash/'/'/" if this program
C     is executed on a linux or UNIX computer.  (A backslash is used in the
C     case of a WINDOWS operating system.)
C--------1---------2---------3---------4---------5---------6---------7--
      real*4 bc(31),teff(31),gv(13)
      integer*4 itmm(13)
      character*50 labtab
      character*42 fnme,fzero
      character*26 redden
      character*12 filter(41),xfi(5),finme
      character*11 hdr
      character*9 alpha(4),alnme
      character*8 system(7),xps(5),psnme,outtab
      character*5 ftype
      character*3 ebmv(7),rednme
      character*1 slash
      data alpha/'alpha_std','alpha_p04','alpha_p00','alpha_m04'/,ebmv/
     1  'r00','r12','r24','r36','r48','r60','r72'/,system/'2mass   ',
     2  'hst_ab  ','hst_st  ','hst_vega','sdss    ','ubvri12 ',
     3  'ubvri90 '/,fzero/'                                          '/,
C *** on linux/UNIX machines, slash must be defined as '/' instead of '\' 
     4  slash/'/'/,outtab/'inputbc_'/
      data filter/'2mass_J     ','2mass_H     ','2mass_K     ',
     1  'acs_f435w   ','acs_f475w   ','acs_f555w   ','acs_f606w   ',
     2  'acs_f814w   ','wfc3_f218w  ','wfc3_f225w  ','wfc3_f275w  ',
     3  'wfc3_f336w  ','wfc3_f350lp ','wfc3_f390m  ','wfc3_f390w  ',
     4  'wfc3_f438w  ','wfc3_f475w  ','wfc3_f547m  ','wfc3_f555w  ',
     5  'wfc3_f606w  ','wfc3_f625w  ','wfc3_f775w  ','wfc3_f814w  ',
     6  'wfc3_f850lp ','wfc3ir_f098m','wfc3ir_f110w','wfc3ir_f125w',
     7  'wfc3ir_f140w','wfc3ir_f160w','sdss_u      ','sdss_g      ',
     8  'sdss_r      ','sdss_i      ','sdss_z      ','jc_U        ',
     9  'jc_B        ','jc_V        ','jc_R        ','jc_I        ', 
     *  'jc_UX       ','jc_BX       '/,ftype/'.data'/,hdr/'header.data'/
 1000 format(i3,14x,i2,14x,i2,14x,i2,a26)
 1001 format(13f6.0)
 1002 format(15f4.1)
 1003 format(15i4)
 1004 format(i3,' Teffs',8x,i2,' log gs',7x,i2,' [Fe/H]s',6x,i2,a26)
 1005 format(a50,3x,a8)
 1006 format(10f8.4) 
 1007 format(' files inputbc_r00.data, inputbc_r12.data, etc., have',
     1  1x,'been created for',5(/,10x,a8,': ',a12))
c *** the input file "selectbc.data" is assigned to unit 9 
      fnme(1:13)='selectbc.data'
      call iofile(9,'in',fnme,13)
      read(9,*) ialf
      fnme=fzero
      fnme(1:8)=outtab(1:8)
      fnme(12:16)=ftype(1:5)
c *** the 7 output files (for different reddenings) are assigned to units 10-16 
      nf1=9
      do 10 i=1,7
      nf1=nf1+1
      rednme=ebmv(i)
      fnme(9:11)=rednme(1:3)
      call iofile(nf1,'oo',fnme,16)
   10 continue
c *** the directory relevant to the desired variation of [alpha/Fe] with [Fe/H]
      alnme=alpha(ialf)
c *** the number of filters for which BC tables are requested is read (unit 9)
      read(9,*) numbc
c *** the main DO-loop is over the number of individual system/filter names
      do 40 ll=1,numbc
c *** integers selecting the photometric system and filter are read (unit 9)
      read(9,*) isys,ifil
      psnme=system(isys)
      finme=filter(ifil)
      xps(ll)=psnme
      xfi(ll)=finme
c *** set up the directory portion of the header.data file names
      fnme=fzero
      fnme(1:9)=alnme(1:9)
      fnme(10:10)=slash(1:1)
      fnme(14:14)=slash(1:1)
c *** the header information is written to units 10-16 only when ll=1
      if(ll.ne.1) go to 20
      fnme(15:25)=hdr(1:11)
      nf1=9
      nf2=19
      do 15 j=1,7
      nf1=nf1+1
      nf2=nf2+1      
c *** modify, as appropriate, the reddening part of the header.data file name
      rednme=ebmv(j)
      fnme(11:13)=rednme(1:3)
c *** open the file header.data file for each E(B-V) value in turn 
      call iofile(nf2,'in',fnme,25)
c *** copy over the header.data information into the unit 10-16 data files
      read(nf2,1000) nt,ng,nfe,nbc,redden
      read(nf2,1001) (teff(i),i=1,nt)
      read(nf2,1002) (gv(i),i=1,ng)
      read(nf2,1003) (itmm(i),i=1,ng)
c *** nbc is redefined to be numbc
      nbc=numbc
      write(nf1,1004) nt,ng,nfe,nbc,redden
      write(nf1,1001) (teff(i),i=1,nt)
      write(nf1,1002) (gv(i),i=1,ng)
      write(nf1,1003) (itmm(i),i=1,ng)
   15 continue
c *** select the appropriate directories for the photometric system and filter
   20 call str_trim(8,psnme,nchp)
      fnme(15:14+nchp)=psnme(1:nchp)
      fnme(14+nchp+1:14+nchp+1)=slash
      call str_trim(12,finme,nch)
      fnme(15+nchp+1:15+nchp+nch)=finme(1:nch)
      fnme(16+nchp+nch:15+nchp+nch+5)=ftype(1:5)
      call str_trim(40,fnme,nch)
      nf1=9
      nf2=29
      do 35 j=1,7
      nf1=nf1+1
      nf2=nf2+1
      rednme=ebmv(j)
      fnme(11:13)=rednme(1:3)
c *** files containing the selected BC data are opened
      call iofile(nf2,'in',fnme,nch)
c *** the BC data are copied over to the output files assigned to units 13-16
      do 30 kk=1,nfe
      read(nf2,1005) labtab
      write(nf1,1005) labtab,psnme
      do 25 jj=1,ng
      itm=itmm(jj)
      read(nf2,1006) (bc(i),i=1,itm)
      write(nf1,1006) (bc(i),i=1,itm)
   25 continue
   30 continue
   35 continue
   40 continue
c *** all of the input and output files are kept on disk
      nf1=9
      nf2=19
      nf3=29
      close(unit=9,status='keep')
      do 65 i=1,7
      nf1=nf1+1
      nf2=nf2+1
      nf3=nf3+1
      close(unit=nf1,status='keep')
      close(unit=nf2,status='keep')
      close(unit=nf3,status='keep')
   65 continue
      write(6,1007) (xps(i),xfi(i),i=1,numbc)
      stop
      end
      subroutine str_trim(nl,str,nch)
      character*(*) str
      nch=nl
      do while (str(nch:nch).eq.' '.and.nch.gt.0)
        nch=nch-1
      end do
      return 
      end
      subroutine iofile(nunit,fstat,fnme,nch)
      integer*4 nunit,nch
      character*42 fnme
      character*2 fstat
 1000 format(' input file assigned to unit',i3,' does not exist',/,a42)
      if(fstat.eq.'in') go to 10
c *** the named file is apparently an output file
      open(unit=nunit,iostat=ierr,file=fnme(1:nch),status='new')
      if(ierr.eq.0) go to 15
c *** if the named file already exists it is deleted and opened as a
c *** new file; i.e., the existing file will be overwritten
      open(unit=nunit,file=fnme(1:nch),status='old')
      close(unit=nunit,status='delete')
      open(unit=nunit,file=fnme(1:nch),status='new')
      go to 15
c *** the named file is an input file 
   10 open(unit=nunit,iostat=ierr,file=fnme(1:nch),status='old')
      if(ierr.eq.0) go to 15
c *** the named input file apparently does not exist: execution terminated
      write(6,1000) nunit,fnme
      stop 'specified input file does not exist'
   15 return
      end
