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