SUBROUTINE cmprsp (NCHAN, NENERG, MXELEM, MXGRPS, MXTGRP, RSP_MIN, & matrix, rspmat, ngroup, ichanb, nchang, nelem, & ntgrps) INTEGER NCHAN, NENERG, MXELEM, MXGRPS, MXTGRP REAL RSP_MIN REAL matrix (NCHAN, NENERG) REAL rspmat (MXELEM) INTEGER ngroup (NENERG) INTEGER ichanb (MXTGRP) INTEGER nchang (MXTGRP) INTEGER nelem, ntgrps c Example routine to compress a response matrix to the XSPEC format c kaa 3/13/89 c Arguments : c NCHAN i i: Number of channels in response matrix c NENERG i i: Number of energy bins in response matrix c MXELEM i i: Max. number of non-zero response elements c MXGRPS i i: Max. number of groups at a given energy c MXTGRP i i: Max. number of total groups c RSP_MIN r i: Minimum value of response that is stored c matrix r i: Response matrix c rspmat r r: Non-zero response elements c ngroup i r: Number of contiguous channel sets c ichanb i r: Start channel of a group c nchang i r: Number of channels in a group c nelem i r: Number of non-zero response elements c ntgrps i r: Number of groups REAL effic, rsp INTEGER i, j, igroup, iresp LOGICAL counting c create the response matrix - start by looping over energies igroup = 0 iresp = 0 DO i = 1, NENERG c loop over channels effic = 0 ngroup(i) = 0 counting = .FALSE. DO j = 1, NCHAN rsp = matrix (j, i) c if response greater than minimum acceptable then include IF ( rsp .GT. RSP_MIN ) THEN iresp = iresp + 1 IF ( iresp .GT. MXELEM ) THEN WRITE (*,*) 'Too many response elements'// & ' - increase MXELEM' CALL exit(1) ENDIF rspmat(iresp) = rsp effic = effic + rsp c if not currently in a group then start one IF ( .NOT.counting ) THEN igroup = igroup + 1 IF ( igroup .GT. MXTGRP ) THEN WRITE (*,*) 'Too many response groups'// & ' - increase MXTGRP' WRITE (*,*) igroup, 'groups on ', & j, i CALL exit(1) ENDIF ichanb(igroup) = j counting = .TRUE. ngroup(i) = ngroup(i) + 1 IF ( ngroup(i) .GT. MXGRPS ) THEN WRITE (*,*) 'Too many response groups'// & ' - increase MXGRPS' CALL exit(1) ENDIF ENDIF c if response not greater than acceptable minimum and in a group c then end that group ELSE IF ( counting ) THEN counting = .FALSE. nchang(igroup) = j - ichanb(igroup) ENDIF ENDIF ENDDO IF ( counting ) THEN nchang(igroup) = NCHAN - ichanb(igroup) + 1 ENDIF ENDDO nelem = iresp ntgrps = igroup WRITE (*,*) 'Total number of response elements : ', iresp WRITE (*,*) 'in ', igroup, ' groups.' RETURN END