SUBROUTINE stwght(instrg, lenn, phaobs, varobs, cvrobs, phabkg, & varbkg, cvrbkg, region, brgion, areasc, breasc) REAL phaobs(*), varobs(*), cvrobs(*), phabkg(*) REAL varbkg(*), cvrbkg(*), region(*), brgion(*) REAL areasc(*), breasc(*) CHARACTER*(*) instrg INTEGER lenn c stwght kaa 25 Feb 1995 c XSPEC subroutine to parse the argument of the weight command c and set the statistical weighting method. c c instrg c* i/r: input parse string c lenn i4 i/r: current parse position c phaobs r r: observed count rate per cm**2 s c varobs r r: original variance on observed count rate c cvrobs r r: calculated variance on observed count rate c phabkg r r: background count rate c varbkg r r: variance on background count rate c cvrbkg r r: calculated variance on background count rate c region r i: source BACKSCAL values c brgion r i: background BACKSCAL values c areasc r i: source AREASCAL values c breasc r i: background AREASCAL values INTEGER MAXOPT PARAMETER(MAXOPT=4) INTEGER lenb, lene, iflag, idelim, icom, jcom INTEGER ifile, istr, ierr, ibin INTEGER irnglw, irnghi, irngmn, irngmx CHARACTER*8 options(maxopt) CHARACTER wrtstr*255 LOGICAL qskip, qdone, qfirst REAL cvarnc, dgbtme INTEGER lenact, dgndst, dgdtgr, dgnbnb, dgnbne CHARACTER fgflnm*255, dgwsch*8 LOGICAL dgpois EXTERNAL lenact, dgndst, dgdtgr, fgflnm, dgwsch EXTERNAL cvarnc, dgnbnb, dgnbne, dgpois, dgbtme DATA options/'standard','gehrels ','churazov', 'model '/ DATA qfirst/.TRUE./ DATA jcom/1/ SAVE jcom, irnglw, irnghi, qfirst c If there are no datasets then write out a warning message and return c immediately IF ( dgndst() .EQ. 0 ) THEN wrtstr = 'No datasets read in - command ignored' CALL xwrite(wrtstr, 5) RETURN ENDIF c Set the default file range and limits IF ( qfirst ) THEN irnglw = 1 irnghi = dgndst() qfirst = .FALSE. ENDIF irngmx = dgndst() irngmn = 1 c Get the argument and try to match it to one of the options CALL xgtarg(instrg,lenn,lenb,lene,qskip,iflag,idelim) IF ( qskip .OR. iflag .EQ. -1 ) RETURN icom = jcom CALL xmatch(instrg(lenb:lene),options,maxopt,icom) IF ( icom .LE. 0 .OR. icom .GT. MAXOPT .OR. iflag .NE. 0) THEN wrtstr='WEIGHT options (currently '''// & options(jcom)(:lenact(options(jcom)))//''')' CALL xunids(instrg(lenb:lene),options,MAXOPT,icom, & wrtstr) RETURN ENDIF jcom = icom c If the option chosen is Gehrels and the data may not be Poisson then c write a warning IF ( options(jcom) .EQ. 'gehrels' .AND. .NOT.dgpois() ) THEN CALL xwrite( & 'Warning: this weighting scheme is only valid for Poisson data', & 5) ENDIF c Now loop over any further arguments setting up the data command for c any datasets for which the weighting scheme has changed qdone = .FALSE. istr = 0 CALL xgtrng(instrg, lenn, 1, 'file no.', & '`weight'' specification', irnglw, irnghi, irngmn, & irngmx, 1, .FALSE., iflag, idelim) DO WHILE ( .NOT.qdone ) c Loop over the datasets for this range DO ifile = irnglw, irnghi c Set the weighting scheme in the dataset object CALL dpwsch(ifile, options(jcom), ierr) c Calculate the weighting DO ibin = dgnbnb(ifile), dgnbne(ifile) cvrobs(ibin) = cvarnc(ifile, ibin, phaobs, varobs, & region, brgion, areasc, breasc, & 's') IF ( dgbtme(ifile) .GT. 0. ) THEN cvrbkg(ibin) = cvarnc(ifile, ibin, phabkg, varbkg, & region, brgion, areasc, breasc, & 'b') ELSE cvrbkg(ibin) = 0.0 ENDIF ENDDO ENDDO c Read the next argument in the command CALL xgtrng(instrg, lenn, 1, 'file no.', & '`weight'' specification', irnglw, irnghi, irngmn, & irngmx, 1, .FALSE., iflag, idelim) IF ( iflag .NE. 0 ) qdone = .TRUE. ENDDO RETURN END