program choose c Program reads output files and produces an object subsample, as c specified by the file choose.in. c c Assumed file formats/groupings ------------------------------------------- c c outMean(5000,15) numObj (1) format line=120 c newID X Y ap wvCor ell FWHM strgl Flgs rad NoOb avFlx avdFl S/N rms/dF Cl c 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 c c outFlux(5000,(n+3)) numObj (2) 140 c newID X Y F1 F2 F3 ... Fn c 1 2 3 4 5 6 (n+3) c c outUncert(5000,(n+3)) numObj (3) 160 c newID X Y dF1 dF2 dF3 ... dFn c 1 2 3 4 5 6 (n+3) c c outSN(5000,(n+3)) numObj (4) 180 c newID X Y F1/dF1 F2/dF2 F3/dF3 ... Fn/dFn c 1 2 3 4 5 6 (n+3) c c outID(10000,12) (** note the extra columns) numObj (8) 170 c X Y newID C M Niter a b Nfit rms/err devSl1 devSl2 c 1 2 3 4 5 6 7 8 9 10 11 12 c c outsigdv(5000,(n+3)) numFit (7) 180 c newID X Y sigdv1 sigdv2 sigdv3 ... sigdvn c 1 2 3 4 5 6 (n+3) c c c c Identical subset files with only the stars (filename prefix 'star'). c c c Additional Output (emission-line samples) ---------------------------- c c elgRed(1000,16) numTotELG c (**NOTE: cols 5 and 10 replaced in outMean format!!**) c ID X Y ap pkWve ell FW strgl Flg pkSl NoOb avFlx avdFl S/N rms/err sigdv Cl c 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 c c elgID(1000,3) (subset of elgRed() catalogue) numTotELG c X Y sigdv c 1 2 3 c c - - - - - - - - - - - - - - - - - - - - - - - - - - - c c elgLine(1000,18) numObj (1) 260 c ID X Y ap ... etc ... avFlx avdFl S/N sigdv Fline dFline Cl c 1 2 3 4 12 13 14 15 16 17 18 c c elgLnFlx(1000,(n+3)) numObj (2) 140 c ID X Y F1 F2 F3 ... Fn c 1 2 3 4 5 6 (n+3) c c elgLnUnc(1000,(n+3)) numObj (3) 160 c ID X Y dF1 dF2 dF3 ... dFn c 1 2 3 4 5 6 (n+3) c c elgsigdv(1000,(n+3)) numObj (4) 180 c newID X Y sigdv1 sigdv2 sigdv3 ... sigdvn c 1 2 3 4 5 6 (n+3) c c elgLnID(1000,12) (subset of elgLine() catalogue) numObj (8) 280 c X Y sigdv C M Niter a b Nfit rms/err devSl1 devSl2 c 1 2 3 4 5 6 7 8 9 10 11 12 c c c c c DHJ 4/8/98 c ------------------------------------------------------------------------ c Max number of objects = 5000 c Max number of slices = 12 (must be > Nsl) implicit none character*40 inFile, inFile2, inFile3, inFile4 character*40 inFile7, inFile8, idFile character*40 outFile, outFile2, outFile3, outFile4 character*40 outFile7, outFile8 character*10 inExtn, outExtn character*2 loSym1, hiSym1, loSym2, hiSym2 character*4 howSelect character*1 fileNo integer col, row, numObj, numSel, flg1, flg2 integer fileSet, Nsl, col1, col2, idrow, numFit real*4 lo1, hi1, lo2, hi2, c1, c2 real input(5000,18), acceptedIDs(5000) real output2(5000,18), output3(5000,18), output4(5000,18) real output7(5000,18), output8(5000,18) integer j1, j2, j3, j4, j7, j8, jj, numIDs, idrow integer idVals(5000) fileNo='2' c --- version number of the files being examined (e.g. outMean2.try) c -------------------------------------------------------------------- c Reading choose.in: c -------------------------------------------------------------------- write (6,*) ' ' write (6,*) 'Reading input data...' open(unit=20, file='choose.in', status='old') read(20,*,end=10,err=10) fileSet read(20,*,end=10,err=10) Nsl read(20,*,end=10,err=10) inExtn read(20,*,end=10,err=10) lo1, loSym1, col1, hiSym1, hi1 read(20,*,end=10,err=10) lo2, loSym2, col2, hiSym2, hi2 read(20,*,end=10,err=10) howSelect read(20,*,end=10,err=10) idFile read(20,*,end=10,err=10) outExtn 10 continue close(unit=20) write (6,*) ' ' if (fileSet.eq.1) then write (6,*) 'File Set: outMean' else if (fileSet.eq.2) then write (6,*) 'File Set: starMean' else if (fileSet.eq.3) then write (6,*) 'File Set: elgLine' else write (6,*) ' ' write (6,*) ' *** Error in fileSet input number *** ' write (6,*) ' ' stop endif if ((howSelect.eq.'file').or.(howSelect.eq.'anti')) then c i.e. read in ID-file if using this for object selection write (6,*) ' ' write (6,*) ' Reading in ID-file...' row=0 open(unit=20, file=idFile, status='old') 15 row=row+1 read(20,*,end=20,err=20) idVals(row) goto 15 20 continue numIDs=row-1 write (6,*) ' ---> Number of IDs: ',numIDs write (6,*) ' ' close(unit=20) else if ((howSelect.ne.'and ').and.(howSelect.ne.'or ')) then write (6,*) ' ' write (6,*) ' *** Error in howSelect input label *** ' write (6,*) ' ' stop endif if ((loSym2.eq.'-').or.(hiSym2.eq.'-')) then if ((howSelect.ne.'file').and.(howSelect.ne.'anti')) then howSelect='n/a' endif endif write (6,*) 'Number of slices: ',Nsl write (6,*) 'Input file extension: ',inExtn write (6,*) 'Select 1: ',lo1,' ',loSym1,col1,' ',hiSym1,hi1 write (6,*) 'Select 2: ',lo2,' ',loSym2,col2,' ',hiSym2,hi2 write (6,*) 'Selection method: ',howSelect write (6,*) 'File of IDs: ',idFile write (6,*) 'Output file extension: ',outExtn write (6,*) ' ' c -------------------------------------------------------------------- c Operating on files in turn: c -------------------------------------------------------------------- c ------------------------------------------ c --- Reading outMean/outStar/elgLine file: if (fileSet.eq.1) then inFile='outMean'//fileNo//'.'//inExtn jj=16 else if (fileSet.eq.2) then inFile='starMean'//fileNo//'.'//inExtn jj=16 else if (fileSet.eq.3) then inFile='elgLine.'//inExtn jj=18 else write (6,*) ' ' write (6,*) ' *** Error in fileSet input number *** ' write (6,*) ' ' stop endif row=0 write (6,*) 'Input: ',inFile open(unit=20, file=inFile, status='old') 25 row=row+1 read(20,*,end=30,err=30) (input(row,col),col=1,jj) goto 25 30 continue numObj=row-1 close(unit=20) c ------------------------------------------------ c --- Selecting those objects that match criteria: numSel=0 idrow=1 do row=1,numObj if ((howSelect.eq.'file').and.(idrow.le.numIDs)) then if (input(row,1).eq.idVals(idrow)) then numSel=numSel+1 acceptedIDs(numSel)=input(row,1) idrow=idrow+1 endif endif if (howSelect.eq.'anti') then if (input(row,1).ne.idVals(idrow)) then numSel=numSel+1 acceptedIDs(numSel)=input(row,1) else c --- IDs in both lists do match; therefore go onto next ID idrow=idrow+1 endif endif if ((howSelect.ne.'file').and.(howSelect.ne.'anti')) then c1=input(row,col1) c --- i.e. 1st column value flg1=0 flg2=0 c --- these flags represent the 1st and 2nd column expressions c --- (being 1 if expn is true; 0 otherwise). if (loSym1.eq.'lt') then if (hiSym1.eq.'lt') then if ((lo1.lt.c1).and.(c1.lt.hi1)) then flg1=1 endif else if (hiSym1.eq.'le') then if ((lo1.lt.c1).and.(c1.le.hi1)) then flg1=1 endif endif else if (loSym1.eq.'le') then if (hiSym1.eq.'lt') then if ((lo1.le.c1).and.(c1.lt.hi1)) then flg1=1 endif else if (hiSym1.eq.'le') then if ((lo1.le.c1).and.(c1.le.hi1)) then flg1=1 endif endif endif if ((howSelect.eq.'n/a ').and.(flg1.eq.1)) then numSel=numSel+1 acceptedIDs(numSel)=input(row,1) endif c --- i.e. case of only one selection criterion if ( ((howSelect.eq.'and ').and.(flg1.eq.1)) $ .or.(howSelect.eq.'or ') ) then c2=input(row,col2) c --- i.e. 2nd column value if (loSym2.eq.'lt') then if (hiSym2.eq.'lt') then if ((lo2.lt.c2).and.(c2.lt.hi2)) then flg2=1 endif else if (hiSym2.eq.'le') then if ((lo2.lt.c2).and.(c2.le.hi2)) then flg2=1 endif endif else if (loSym2.eq.'le') then if (hiSym2.eq.'lt') then if ((lo2.le.c2).and.(c2.lt.hi2)) then flg2=1 endif else if (hiSym2.eq.'le') then if ((lo2.le.c2).and.(c2.le.hi2)) then flg2=1 endif endif endif if ((howSelect.eq.'and ').and.(flg2.eq.1)) then numSel=numSel+1 acceptedIDs(numSel)=input(row,1) endif c --- i.e. case of double 'and' selection criterion if ((howSelect.eq.'or ').and.((flg1+flg2).ge.1)) then numSel=numSel+1 acceptedIDs(numSel)=input(row,1) endif c --- i.e. case of double 'or' selection criterion endif endif enddo c --- i.e. end of main object loop c ---------------------------------------------------- c --- Writing outMean/outStar/elgLine and other files: if (fileSet.eq.1) then inFile='outMean'//fileNo//'.'//inExtn outFile='outMean'//fileNo//'.'//outExtn j1=16 inFile2='outFlux'//fileNo//'.'//inExtn outFile2='outFlux'//fileNo//'.'//outExtn j2=Nsl+3 inFile3='outUncert'//fileNo//'.'//inExtn outFile3='outUncert'//fileNo//'.'//outExtn j3=Nsl+3 inFile4='outSN'//fileNo//'.'//inExtn outFile4='outSN'//fileNo//'.'//outExtn j4=Nsl+3 inFile8='outID'//fileNo//'.'//inExtn outFile8='outID'//fileNo//'.'//outExtn j8=12 inFile7='outsigdv.'//inExtn outFile7='outsigdv.'//outExtn j7=Nsl+3 else if (fileSet.eq.2) then inFile='starMean'//fileNo//'.'//inExtn outFile='starMean'//fileNo//'.'//outExtn j1=16 inFile2='starFlux'//fileNo//'.'//inExtn outFile2='starFlux'//fileNo//'.'//outExtn j2=Nsl+3 inFile3='starUncert'//fileNo//'.'//inExtn outFile3='starUncert'//fileNo//'.'//outExtn j3=Nsl+3 inFile4='starSN'//fileNo//'.'//inExtn outFile4='starSN'//fileNo//'.'//outExtn j4=Nsl+3 inFile8='starID'//fileNo//'.'//inExtn outFile8='starID'//fileNo//'.'//outExtn j8=10 inFile7='starsigdv.'//inExtn outFile7='starsigdv.'//outExtn j7=Nsl+3 else if (fileSet.eq.3) then inFile='elgLine.'//inExtn outFile='elgLine.'//outExtn j1=18 inFile2='elgLnFlx.'//inExtn outFile2='elgLnFlx.'//outExtn j2=Nsl+3 inFile3='elgLnUnc.'//inExtn outFile3='elgLnUnc.'//outExtn j3=Nsl+3 inFile4='elgsigdv.'//inExtn outFile4='elgsigdv.'//outExtn j4=Nsl+3 inFile8='elgLnID.'//inExtn outFile8='elgLnID.'//outExtn j8=12 else write (6,*) ' ' write (6,*) ' *** Error in fileSet input number *** ' write (6,*) ' ' stop endif write (6,*) ' ' write (6,*) 'Output: ',outFile,'(',numSel,' )' write (6,*) ' ',outFile2 write (6,*) ' ',outFile3 write (6,*) ' ',outFile4 write (6,*) ' ',outFile8 if ((fileSet.eq.1).or.(fileSet.eq.2)) then write (6,*) ' ',outFile7 endif write (6,*) ' ' c --- Establishing input/output channels and reading files: c --- (outFile//inextn already opened and contents read into input()) open(unit=22, file=inFile2, status='old') open(unit=23, file=inFile3, status='old') open(unit=24, file=inFile4, status='old') open(unit=28, file=inFile8, status='old') open(unit=11, file=outFile, status='unknown') open(unit=12, file=outFile2, status='unknown') open(unit=13, file=outFile3, status='unknown') open(unit=14, file=outFile4, status='unknown') open(unit=18, file=outFile8, status='unknown') do row=1,numObj read(22,*,end=90,err=81) (output2(row,col),col=1,j2) read(23,*,end=90,err=83) (output3(row,col),col=1,j3) read(24,*,end=90,err=85) (output4(row,col),col=1,j4) read(28,*,end=90,err=87) (output8(row,col),col=1,j8) enddo 81 if (row.le.numObj) then write (6,*) ' *** Problem reading output2: line',row goto 89 else goto 90 endif 83 write (6,*) ' *** Problem reading output3: line',row goto 89 85 write (6,*) ' *** Problem reading output4: line',row goto 89 87 write (6,*) ' *** Problem reading output8: line',row 89 write (6,*) ' ***************************************' 90 continue if ((fileSet.eq.1).or.(fileSet.eq.2)) then open(unit=27, file=inFile7, status='old') open(unit=17, file=outFile7, status='unknown') row=0 92 row=row+1 read(27,*,end=97,err=95) (output7(row,col),col=1,j7) goto 92 93 write (6,*) ' *** Problem reading output5: line',row goto 96 94 write (6,*) ' *** Problem reading output6: line',row goto 96 95 write (6,*) ' *** Problem reading output7: line',row goto 96 96 write (6,*) ' ***************************************' 97 continue numFit=row-1 endif c ----------------------------------- c --- Output loop #1: row=1 idrow=1 do while ((row.le.numObj).and.(idrow.le.numSel)) c --- Checking if current line in head file is a match; c --- writing out contents of secondary files if it is, c --- (assumes that all files have the same ordering of objects): if (input(row,1).eq.acceptedIDs(idrow)) then if ((fileSet.eq.1).or.(fileSet.eq.2)) then write (11,120) (input(row,col),col=1,j1) write (18,170) (output8(row,col),col=1,j8) else write (11,260) (input(row,col),col=1,j1) write (18,280) (output8(row,col),col=1,j8) endif c --- choosing appropriate format depending on the data write (12,140) (output2(row,col),col=1,j2) write (13,160) (output3(row,col),col=1,j3) write (14,180) (output4(row,col),col=1,j4) idrow=idrow+1 endif row=row+1 enddo if (idrow.lt.numSel) then write (6,*) ' ' write (6,*) ' *** Error A: Not all IDs found in 2nd cat ***' write (6,*) ' ' stop endif c --- Checking that all selected objects have been located (Err A) c ----------------------------------- c --- Output loop #2: if ((fileSet.eq.1).or.(fileSet.eq.2)) then row=1 idrow=1 do while ((row.le.numFit).and.(idrow.le.numSel)) if (output7(row,1).eq.acceptedIDs(idrow)) then write (17,180) (output7(row,col),col=1,j7) idrow=idrow+1 endif row=row+1 enddo endif close(unit=11) close(unit=12) close(unit=22) close(unit=13) close(unit=23) close(unit=14) close(unit=24) close(unit=18) close(unit=28) if ((fileSet.eq.1).or.(fileSet.eq.2)) then close(unit=17) close(unit=27) endif write (6,*) ' Input objects: ',numObj write (6,*) ' Input fit objects: ',numFit,' (not applic to elg)' c -------------------------------------------------------------------- c Format lines: c -------------------------------------------------------------------- 120 format (f5.0, f8.2, f8.2, f6.1, f12.8, f7.3, f7.2, f6.2, f14.0, $ f8.2, f5.0, f12.2, f8.2, f8.2, f8.3, f5.0) 140 format (f5.0, f8.2, f8.2, 12(f12.3)) 160 format (f5.0, f8.2, f8.2, 12(f12.3)) 170 format (f8.2, f8.2, f6.0, f14.2, f12.6, f5.0, f14.2, f12.6, $ f5.0, f10.3, f4.0, f4.0) 180 format (f5.0, f8.2, f8.2, 12(f12.3)) c 200 format (f5.0, f8.2, f8.2, f8.4, f8.2, 12(f8.3)) 220 format (f5.0, f8.2, f8.2, f6.1, f9.2, f7.3, f7.2, f6.2, f14.0, $ f5.1, f5.0, f12.2, f8.2, f8.2, f8.2, f8.3, f5.1, f5.0) 240 format (f8.2, f8.2, f10.3) 260 format (f5.0, f8.2, f8.2, f6.1, f12.8, f7.3, f7.2, f6.2, f14.0, $ f6.0, f4.0, f12.2, f8.2, f8.2, f7.2, f12.2, f8.2, f4.0) 280 format (f8.2, f8.2, f6.0, f14.2, f12.6, f5.0, f14.2, f12.6, $ f5.0, f10.3, f4.0, f4.0) c --- N.B.: line numbers (above) match those used in scaleflux.f write (6,*) ' ' write (6,*) 'Done.' write (6,*) ' ' stop end c ===========================================================================