C   12/03/84 504301316  MEMBER NAME  TAGCOL   (S)           FORTRAN
C
C
C
      SUBROUTINE TAGCOL(IM,IP,THETA)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C THIS ROUTINE CALCULATES THE ANGLE BETWEEN A CLUSTER IN - Z TAGGER
C AND ONE IN + Z TAGGER
C
C IM - INPUT - POINTER TO CLUSTER IN - Z PART OF ATAGG2
C IP - INPUT - POINTER TO CLUSTER IN + Z PART OF ATAGG2
C
C THETA - OUTPUT - ANGLE BETWEEN THEM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IMPLICIT INTEGER * 2 (H)
C   12/03/84 412041226  MEMBER NAME  CTAGGO   (S)           FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C HERE ARE THE COMMONS THAT EVENTUALLY BECOME THE TP BANKS ACCLS -
C TAGG/O ,1,2,3
C CONVENTION IN NAMING -
C
C FIRST LETTER -
C         C - NAME OF COMMON
C         H - NAME OF VARIABLES *2 TYPE      INTEGER
C         I -   "       "       *4 TYPE         "
C         A -   "       "                    REAL
C
C REST OF NAME AS FOR TAGG BANKS SEE JADE COMPUTER NOTE 16 FOR MORE DETA
C
C ACTUALLY ALL THIS COULD ALSO GO IN WORKSPACE BUT I CANT BE BOTHERED!
C
C**** IMPORTANT :  IF YOU CHANGE THE SIZE OF THESE COMMONS PLEASE
C                  REMEMBER TO CHANGE 'TAGINT' WHICH CLEARS THEM.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
      COMMON / CACLS  / HID1,HID2,HIPM,HIPZ,HDUM,HIPL,HDUMM1(134)
      DIMENSION HACLS(140)
      EQUIVALENCE ( HACLS(1) , HID1 )
C
      COMMON / CTAGG0 / HID3,HID4,HTRACK,HTRZMI,HTRZPL,HCLST,
     *                  HCLZMI,HCLZPL,HNEUT,HCOL,HTYPE,HER,HCORR,
     *                  HPBLAT,HDUM1,HDUM2,HSCAL(36),HWPCL,HWPTR,
     *                  HDUMM2(14)
      DIMENSION     ATAGG0(34)
      EQUIVALENCE ( HID3 , ATAGG0(1) )
C
      COMMON / CTAGG1 / HMAP(2,20)
C
      COMMON / CTAGG2 / ATAGG2(260)
      DIMENSION         ITAGG2(260)
      INTEGER*2         HTAGG2(520)
      EQUIVALENCE ( HTAGG2(1) , ITAGG2(1) , ATAGG2(1) )
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       DATA NPRNT / 0 /
C
C------------------- C O D E -------------------------------------------
C
C
C                                   CALCULATE POINTERS
C
      IBM = (IM - 1) * HWPCL
      IBP = (IP - 1) * HWPCL
C
C                                   FETCH DIRECTION COSINES
C
      AMDX = ATAGG2(IBM + 11)
      AMDY = ATAGG2(IBM + 12)
      AMDZ = ATAGG2(IBM + 13)
      APDX = ATAGG2(IBP + 11)
      APDY = ATAGG2(IBP + 12)
      APDZ = ATAGG2(IBP + 13)
C
C                                   CHECK FOR ERROR
C
       AAMDX = ABS( AMDX )
       AAMDY = ABS( AMDY )
       AAMDZ = ABS( AMDZ )
       AAPDX = ABS( APDX )
       AAPDY = ABS( APDY )
       AAPDZ = ABS( APDZ )
C
       IF (( AAMDX .GT. 1.0E-20).AND.(AAMDX.LT.1.0E+20).AND.
     *     ( AAMDY .GT. 1.0E-20).AND.(AAMDY.LT.1.0E+20).AND.
     *     ( AAMDZ .GT. 1.0E-20).AND.(AAMDZ.LT.1.0E+20).AND.
     *     ( AAPDX .GT. 1.0E-20).AND.(AAPDX.LT.1.0E+20).AND.
     *     ( AAPDY .GT. 1.0E-20).AND.(AAPDY.LT.1.0E+20).AND.
     *     ( AAPDZ .GT. 1.0E-20).AND.(AAPDZ.LT.1.0E+20)  ) GOTO 10
       NPRNT = NPRNT + 1
       IF ( NPRNT .LT. 100 )
     * WRITE(6,11) IM,IP,IBM,IBP,HWPCL,AMDX,AMDY,AMDZ,APDX,APDY,APDZ
   11  FORMAT(' ++++ TAGCOL ERROR ',4I3,I5,2X,6(E12.4,1X))
       THETA = 0.0
       RETURN
   10  CONTINUE
C
C                                   CALCULATE THETA
C
      ARG1  =     ( AMDX * APDX  +  AMDY * APDY  +  AMDZ * APDZ )
      IF ( ABS(ARG1) .LE. 1.0 ) GOTO 20
       NPRNT = NPRNT + 1
       IF ( NPRNT .LT. 100 )
     * WRITE(6,11) IM,IP,IBM,IBP,HWPCL,AMDX,AMDY,AMDZ,APDX,APDY,APDZ
       THETA = 0.0
       RETURN
   20  CONTINUE
      THETA = ACOS( ARG1 )
      RETURN
      END
