C
C PURPOSE: STORES COLLISION RATES BETWEEN BOUND LEVELS ONLY IN C(I,J)
C
C INPUTS:
C
C OUTPUTS:
C     C(I,J)    INELASTIC COLLISION RATES BETWEEN LEVELS I AND J
C               CONVENTION IS C(I,J) IS COLLISION RATE FROM LEVEL J TO I
C               (SAME AS LANDI AND LANDOLFI, OPPOSITE OF MIHALAS)
C     
C COMMON:
C        CATOM COLL CATMOS CATMO2 CCONST CINPUT CLU
C COMMENTS: OCTOBER 6, 1999, P. JUDGE
C
C MODIFICATIONS: PGJ JANUARY 11, 2006. CORRECTED RELATIONSHIP BETWEEN 
C                UPWARD AND DOWNWARD RATES FOR CPMM DATA.
C                PGJ JANUARY 18, 2006, REMOVED CP AND CH KEYWORDS (NOT NEEDED).
C
C COMMENTS:  JULY 26 2019 CONVENTION SWAPPED
C            AUG 19 2019.  CPMM CODE CORRECTED FOR INPUT OF UPWARD COLLISIONS
C	     DEC 20 2022 FIXED BUG IN CMM MP TO M SWITCH -- SG
C*********************************************************************
C
      SUBROUTINE COLCAL
C
C  GENERAL ROUTINE FOR COMPUTING COLLISIONAL RATES 
      INCLUDE 'PREC'
      INCLUDE 'PARAM'
      INCLUDE 'COLL'
      INCLUDE 'CATOM'
      INCLUDE 'CATMOS'
      INCLUDE 'CATMO2'
      INCLUDE 'CCONST'
      INCLUDE 'CINPUT'
      INCLUDE 'CLU'
C
C  LOCAL VARIABLES: UP TO MTGRD POINTS IN TEMPERATURE GRID ALLOWED
C
      DIMENSION TGRID(MTGRD),CGRID(MTGRD)
      CHARACTER *20 KEY
C
C  INITIALIZE COLLISIONAL RATES TO ZERO
C
      DO 300 J=1,NK
         DO 400 I=1,NK
            C(I,J)=0.0
            DO 401 L=-MJMAX,MJMAX
               DO 402 M=-MJMAX,MJMAX
                  CMM(I,J,L,M)=0.0
 402           CONTINUE
 401        CONTINUE
 400     CONTINUE
 300  CONTINUE
C
C  LOOP OVER COLLISIONS
C
      DO 100 ICOL=1,NCOL
C
C  IDENTIFY THE UPPER AND LOWER LEVELS:
C
         KEY=CKEY(ICOL)
         IL=ILC(ICOL)
         IH=IHC(ICOL)
         NTEMP=NTC(ICOL)
         NINTEP=NTEMP
         DO 200 IT=1,NTEMP
            TGRID(IT)=CTEMP(IT,ICOL)
            CGRID(IT)=CDATA(IT,ICOL)
 200     CONTINUE
         NINTEP=MIN(ISPLIN,NINTEP) 
         ILO=MIN( IL, IH )
         IHI=MAX( IL, IH )
C
C  OMEGAS ARE GIVEN (+VE IONS)
C
         IF(KEY(1:3) .EQ. 'OHM') THEN
            CT=SPLIN(TEMP,TGRID,CGRID,NTEMP,NINTEP)
            CDN = 8.63E-06 * CT * ED / ( G(IHI)*SQRT(TEMP) )
            CUP = CDN * PSTAR(IHI) / PSTAR(ILO)
C (Note these were swapped in 6jul22)
            C(ILO,IHI) = CDN + C(IHI,ILO)
            C(IHI,ILO) = CUP + C(ILO,IHI)
C     
C     CPMM VALUES ARE GIVEN (M-M' COLLISIONS WITH PROTONS)
C     
         ELSE IF (KEY(1:4) .EQ. 'CPMM')THEN
            DO 201 IT=1,NTEMP
               CGRID(IT)=CDATA(IT+2,ICOL)
 201        CONTINUE
            M=INT(CDATA(1,ICOL))
            MP=INT(CDATA(2,ICOL))
            TTP=TEMP*TP2TE
            CT=SPLIN(TTP,TGRID,CGRID,NTEMP,NINTEP)
C (note also swapped 7jul22)
            CUP = HD(6) * CT 
            CDN= CUP * (PSTAR(ILO)/G(ILO)) / (PSTAR(IHI)/G(IHI)) 
C (note pre 7jul22 MP,M order reversed in next line
            CMM(IHI,ILO,MP,M) = CDN + CMM(IHI,ILO,MP,M)
C (note should it be swapped here too? asked PGJ)
            CMM(ILO,IHI,M,MP) = CUP + CMM(ILO,IHI,M,MP)
C     
C     RECIPROCAL RELATION (EQ 7A OF LANDMAN 1975 A+A 43, 285)
C     
C (note pre 7jul22 MP,M order reversed in next lines
            CMM(IHI,ILO,-MP,-M) = CDN + CMM(IHI,ILO,-MP,-M)
            CMM(ILO,IHI,-M,-MP) = CUP + CMM(ILO,IHI,-M,-MP)
         ENDIF
 100  CONTINUE
      RETURN
      END
      

