
      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


