set2cc.f

Go to the documentation of this file.

C     ******************************************************************
C
C     ******************************************************************
C     BY J.R. BEENE AT HRIBF - LAST MODIFIED by WT MILNER 02/17/99
C     ******************************************************************
C  
      SUBROUTINE set2cc(ID,IX,IY,IZ)
C
C     ------------------------------------------------------------------
C     COUNT 1 CHECK and COMPRESS (1D and 2D)
C     ROUTINE TO ADD ONE COUNT PER CALL TO MEMORY HISTOGRAMS
C     DIFFERS FROM COUNT1 IN THAT COMPRESSION AND RANGE CHECKING
C     ARE DONE. IX,IY ARE RAW PARAMETER VALUES.
C     !!!NOTE!!! requests to increment nonexistant histograms are
C     igored without comment.
C     ------------------------------------------------------------------
C
      IMPLICIT NONE
C
C     ------------------------------------------------------------------
      common/sc17/ ioff(8000),iofh(8000),ndim(8000),nhpc(8000),
     &             lenx(8000),lenh(8000)
C
      INTEGER*2    LENX,                 NDIM,      NHPC
      INTEGER*4    IOFF,      IOFH
      INTEGER*4               LENH
C     ------------------------------------------------------------------
      common/sc18/ icmp(4,8000),imin(4,8000),imax(4,8000),maxoff
C
      INTEGER*2    ICMP,        IMIN,        IMAX
      INTEGER*4                                           MAXOFF
C     ------------------------------------------------------------------
      INTEGER*4    ID,IX,IY,ICX,ICY,IC,NDX,IZ 
C     ------------------------------------------------------------------
C
      IF(ndim(id).LE.0)RETURN                !Check existance
C
C
C     ICX=RSHIFT(IX,ICMP(1,ID))              !COMPRESS DEC fortran

      icx=ishft(ix,-icmp(1,id))              !COMPRESS ansi fortran
C
C                                            ! CHECK X RANGE
      IF(icx.LT.imin(1,id).OR.icx.GT.imax(1,id))RETURN
      icx=icx-imin(1,id)
      ic=icx
      IF(ndim(id).EQ.2)THEN
C     ICY=RSHIFT(IY,ICMP(2,ID))              !COMPRESS DEC fortran
      icy=ishft(iy,-icmp(2,id))              !COMPRESS ansi fortran
C
C                                            ! CHECK Y RANGE
      IF(icy.LT.imin(2,id).OR.icy.GT.imax(2,id))RETURN
      icy=icy-imin(2,id)
      ic=icy*lenx(id)+icx                    !CHAN-OFF FOR 2-D
      ENDIF
C
      IF(nhpc(id).EQ.2) THEN                 !TST FOR FULL-WD CHAN
      ndx=ioff(id)+ic                        !FULL-WD INDEX
c      CALL MEM_ADD1_FW(NDX)                  !FULL-WD ADD-ONE
      CALL mem_set_value_fw(ndx,iz)               !HALF-WD ADD-ONE
      RETURN
      ELSE
C
      ndx=iofh(id)+ic                        !HALF-WD INDEX
        CALL mem_set_value_hw(ndx,iz)               !HALF-WD ADD-ONE
c      CALL MEM_ADD1_HW(NDX)                  !HALF-WD ADD-ONE
      ENDIF
C
      RETURN
      END

C     ******************************************************************
C
C     ******************************************************************
C     BY J.R. BEENE AT HRIBF - LAST MODIFIED by WT MILNER 02/17/99
C     ******************************************************************
C  
      SUBROUTINE get2cc(ID,IX,IY,IZ)
c     
C
C     ------------------------------------------------------------------
C     COUNT 1 CHECK and COMPRESS (1D and 2D)
C     ROUTINE TO ADD ONE COUNT PER CALL TO MEMORY HISTOGRAMS
C     DIFFERS FROM COUNT1 IN THAT COMPRESSION AND RANGE CHECKING
C     ARE DONE. IX,IY ARE RAW PARAMETER VALUES.
C     !!!NOTE!!! requests to increment nonexistant histograms are
C     igored without comment.
C     ------------------------------------------------------------------
C
      IMPLICIT NONE
C
C     ------------------------------------------------------------------
      common/sc17/ ioff(8000),iofh(8000),ndim(8000),nhpc(8000),
     &             lenx(8000),lenh(8000)
C
      INTEGER*2    LENX,                 NDIM,      NHPC
      INTEGER*4    IOFF,      IOFH
      INTEGER*4               LENH
C     ------------------------------------------------------------------
      common/sc18/ icmp(4,8000),imin(4,8000),imax(4,8000),maxoff
C
      INTEGER*2    ICMP,        IMIN,        IMAX
      INTEGER*4                                           MAXOFF
C     ------------------------------------------------------------------
      INTEGER*4    ID,IX,IY,ICX,ICY,IC,NDX,IZ
C     ------------------------------------------------------------------

      INTEGER*2    MEM_GET_VALUE_HW

      INTEGER*4    MEM_GET_VALUE_FW
C
      IF(ndim(id).LE.0)RETURN                !Check existance
C
C
C     ICX=RSHIFT(IX,ICMP(1,ID))              !COMPRESS DEC fortran

      icx=ishft(ix,-icmp(1,id))              !COMPRESS ansi fortran
C
C                                            ! CHECK X RANGE
      IF(icx.LT.imin(1,id).OR.icx.GT.imax(1,id))RETURN
      icx=icx-imin(1,id)
      ic=icx
      IF(ndim(id).EQ.2)THEN
C     ICY=RSHIFT(IY,ICMP(2,ID))              !COMPRESS DEC fortran
      icy=ishft(iy,-icmp(2,id))              !COMPRESS ansi fortran
C
C                                            ! CHECK Y RANGE
      IF(icy.LT.imin(2,id).OR.icy.GT.imax(2,id))RETURN
      icy=icy-imin(2,id)
      ic=icy*lenx(id)+icx                    !CHAN-OFF FOR 2-D
      ENDIF
C
      IF(nhpc(id).EQ.2) THEN                 !TST FOR FULL-WD CHAN
      ndx=ioff(id)+ic                        !FULL-WD INDEX
c      CALL MEM_ADD1_FW(NDX)                  !FULL-WD ADD-ONE
      iz=mem_get_value_fw(ndx)               !HALF-WD ADD-ONE
c      print *,iz,'fw'
      RETURN
      ELSE
C
      ndx=iofh(id)+ic                        !HALF-WD INDEX
      iz=mem_get_value_hw(ndx)               !HALF-WD ADD-ONE
      print *,iz,'hw'
c      CALL MEM_ADD1_HW(NDX)                  !HALF-WD ADD-ONE
      ENDIF
C
      RETURN
      END

c===============================================================================