program double c Program reads input files and checks for double objects; c for double objects, rejects the one with the higher ID no. c c c Additional Output (emission-line samples) ---------------------------- c c elgRed(1000,16) numTotELG 620 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 640 c X Y sigdv c 1 2 3 c c - - - - - - - - - - - - - - - - - - - - - - - - - - - c c elgLine(1000,18) numObj (1) 660 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) 540 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) 560 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) 580 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) 680 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 12/1/99 c ------------------------------------------------------------------------ c Max number of objects = 5000 c Max number of slices = 12 (must be > Nsl) implicit none character*40 INelgRed, INelgID, INelgLine character*40 INelgLnFlx, INelgLnUnc, INelgsigdv, INelgLnID character*40 OUTelgRed, OUTelgID, OUTelgLine character*40 OUTelgLnFlx, OUTelgLnUnc, OUTelgsigdv, OUTelgLnID character*10 inExtn, outExtn integer col, row, Nsl real elgRed(5000,19), elgID(5000,19), elgLine(5000,19) real elgLnFlx(5000,19), elgLnUnc(5000,19), elgsigdv(5000,19) real elgLnID(5000,19) integer j1, j2, j3, j4, j5, j6, j7 integer numINred, numINline, numOUTred, numOUTline integer checkRow, matchFlag, numNoCon real matchRad, id1, id2, x1, y1, x2, y2, class1, class2, dist c -------------------------------------------------------------------- c Reading choose.in: c -------------------------------------------------------------------- write (6,*) ' ' write (6,*) 'Reading input data...' open(unit=20, file='double.in', status='old') read(20,*,end=10,err=10) inExtn read(20,*,end=10,err=10) Nsl read(20,*,end=10,err=10) matchRad read(20,*,end=10,err=10) outExtn 10 continue close(unit=20) write (6,*) 'Input file extension: ',inExtn write (6,*) 'Number of slices: ',Nsl write (6,*) 'Max. Match Radius: ',matchRad write (6,*) 'Output file extension: ',outExtn write (6,*) ' ' c --- File names: INelgRed='elgRed.'//inExtn OUTelgRed='elgRed.'//outExtn j1=17 INelgID='elgID.'//inExtn OUTelgID='elgID.'//outExtn j2=3 INelgLine='elgLine.'//inExtn OUTelgLine='elgLine.'//outExtn j3=18 INelgLnFlx='elgLnFlx.'//inExtn OUTelgLnFlx='elgLnFlx.'//outExtn j4=Nsl+3 INelgLnUnc='elgLnUnc.'//inExtn OUTelgLnUnc='elgLnUnc.'//outExtn j5=Nsl+3 INelgsigdv='elgsigdv.'//inExtn OUTelgsigdv='elgsigdv.'//outExtn j6=Nsl+3 INelgLnID='elgLnID.'//inExtn OUTelgLnID='elgLnID.'//outExtn j7=12 c --- Establishing input/output channels and reading files: open(unit=21, file=INelgRed, status='old') open(unit=22, file=INelgID, status='old') open(unit=23, file=INelgLine, status='old') open(unit=24, file=INelgLnFlx, status='old') open(unit=25, file=INelgLnUnc, status='old') open(unit=26, file=INelgsigdv, status='old') open(unit=27, file=INelgLnID, status='old') open(unit=11, file=OUTelgRed, status='unknown') open(unit=12, file=OUTelgID, status='unknown') open(unit=13, file=OUTelgLine, status='unknown') open(unit=14, file=OUTelgLnFlx, status='unknown') open(unit=15, file=OUTelgLnUnc, status='unknown') open(unit=16, file=OUTelgsigdv, status='unknown') open(unit=17, file=OUTelgLnID, status='unknown') open(unit=18, file='double.out', status='unknown') c ------------------------------------------------------------------------- c --- Reading elgRed and elgLine files separately to obtain file lengths: row=0 25 row=row+1 read(21,*,end=35,err=30) (elgRed(row,col),col=1,j1) goto 25 30 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgRed,' Line: ',row 35 continue numINred=row-1 row=0 45 row=row+1 read(23,*,end=55,err=50) (elgLine(row,col),col=1,j3) goto 45 50 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgLine,' Line: ',row 55 continue numINline=row-1 numNoCon=numINred-numINline c --- i.e. number of non-continuum objects (excess in elgRed over elgLine) c ------------------------------------------------------------------------- c --- Reading remaining files: do row=1,numINred read(22,*,end=70,err=60) (elgID(row,col),col=1,j2) enddo goto 75 60 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgID,' Line: ',row goto 75 70 write (6,*) ' ' write (6,*) ' *** Reached end of ',INelgID,' prematurely' write (6,*) ' Line: ',row 75 continue do row=1,numINline read(24,*,end=110,err=100) (elgLnFlx(row,col),col=1,j4) read(25,*,end=130,err=120) (elgLnUnc(row,col),col=1,j5) read(26,*,end=150,err=140) (elgsigdv(row,col),col=1,j6) read(27,*,end=170,err=160) (elgLnID(row,col),col=1,j7) enddo goto 200 100 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgLnFlx,' Line: ',row goto 200 110 write (6,*) ' ' write (6,*) ' *** Reached end of ',INelgLnFlx,' prematurely' write (6,*) ' Line: ',row goto 200 120 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgLnUnc,' Line: ',row goto 200 130 write (6,*) ' ' write (6,*) ' *** Reached end of ',INelgLnUnc,' prematurely' write (6,*) ' Line: ',row goto 200 140 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgsigdv,' Line: ',row goto 200 150 write (6,*) ' ' write (6,*) ' *** Reached end of ',INelgsigdv,' prematurely' write (6,*) ' Line: ',row goto 200 160 write (6,*) ' ' write (6,*) ' *** ERROR: Reading ',INelgLnID,' Line: ',row goto 200 170 write (6,*) ' ' write (6,*) ' *** Reached end of ',INelgLnID,' prematurely' write (6,*) ' Line: ',row goto 200 200 continue write (6,*) ' ' write (6,*) ' Input: ',INelgRed,'(',numINred,' )' write (6,*) ' ',INelgID,'(',numINred,' )' write (6,*) ' ' write (6,*) ' ',INelgLine,'(',numINline,' )' write (6,*) ' ',INelgLnFlx,'(',numINline,' )' write (6,*) ' ',INelgLnUnc,'(',numINline,' )' write (6,*) ' ',INelgsigdv,'(',numINline,' )' write (6,*) ' ',INelgLnID,'(',numINline,' )' write (6,*) ' ' write (6,*) ' ' write (6,*) '----------------------------------------------------' write (6,*) ' ID X Y Dist Class' write (6,*) ' ' c ----------------------------------- c --- Object checking: numOUTred=0 numOUTline=0 row=1 do while (row.le.numINred) c --- i.e. main loop through elgRed catalogue id1=elgRed(row,1) x1=elgRed(row,2) y1=elgRed(row,3) class1=elgRed(row,17) checkRow=row+1 matchFlag=0 do while ((checkRow.le.numINred).and.(matchFlag.eq.0)) c --- i.e. second loop through elgRed, for everything below c --- the current line, searching for positional matches c --- and flagging them id2=elgRed(checkRow,1) x2=elgRed(checkRow,2) y2=elgRed(checkRow,3) class2=elgRed(checkRow,17) dist=sqrt((x1-x2)**2 + (y1-y2)**2) if (dist.le.matchRad) then matchFlag=1 endif checkRow=checkRow+1 enddo if (matchFlag.eq.0) then write (11,620) (elgRed(row,col),col=1,j1) write (12,640) (elgID(row,col),col=1,j2) numOUTred=numOUTred+1 c --- i.e. writing elgRed data if (class1.ne.5.0) then write (13,660) (elgLine(row-numNoCon,col),col=1,j3) write (14,540) (elgLnFlx(row-numNoCon,col),col=1,j4) write (15,560) (elgLnUnc(row-numNoCon,col),col=1,j5) write (16,580) (elgsigdv(row-numNoCon,col),col=1,j6) write (17,680) (elgLnID(row-numNoCon,col),col=1,j7) numOUTline=numOUTline+1 c --- i.e. writing elgLine data, if object in those cats too c --- (minus the number of non-continuum objects) endif else if (matchFlag.eq.1) then write (6,*) id1, x1, y1, dist, class1,' discard' write (6,*) id2, x2, y2, dist, class2,' keep' write (18,*) id1, x1, y1, dist, class1,' discard' write (18,*) id2, x2, y2, dist, class2,' keep' c --- i.e. writing rejects to screen and to file (double.out) endif row=row+1 enddo write (6,*) ' ' write (6,*) '----------------------------------------------------' c ---------------------------------------------------- c --- Writing sizes of output files: write (6,*) ' ' write (6,*) ' ' write (6,*) 'Output: ',OUTelgRed,'(',numOUTred,' )' write (6,*) ' ',OUTelgID,'(',numOUTred,' )' write (6,*) ' ' write (6,*) ' ',OUTelgLine,'(',numOUTline,' )' write (6,*) ' ',OUTelgLnFlx,'(',numOUTline,' )' write (6,*) ' ',OUTelgLnUnc,'(',numOUTline,' )' write (6,*) ' ',OUTelgsigdv,'(',numOUTline,' )' write (6,*) ' ',OUTelgLnID,'(',numOUTline,' )' write (6,*) ' ' c ----------------------------------- c --- Closing files: close(unit=21) close(unit=22) close(unit=23) close(unit=24) close(unit=25) close(unit=26) close(unit=26) close(unit=11) close(unit=12) close(unit=13) close(unit=14) close(unit=15) close(unit=16) close(unit=17) close(unit=18) c -------------------------------------------------------------------- c Format lines: c -------------------------------------------------------------------- 520 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) 540 format (f5.0, f8.2, f8.2, 12(f12.3)) 560 format (f5.0, f8.2, f8.2, 12(f12.3)) 570 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) 580 format (f5.0, f8.2, f8.2, 12(f12.3)) c 500 format (f5.0, f8.2, f8.2, f8.4, f8.2, 12(f8.3)) 620 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) 640 format (f8.2, f8.2, f10.3) 660 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) 680 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 scalefluxTwo.f, c --- except that 400 has been added in each case write (6,*) ' ' write (6,*) 'Record of rejected candidates in double.out' write (6,*) ' ' write (6,*) 'Done.' write (6,*) ' ' stop end c ===========================================================================