C
C PURPOSE: COMPUTE SIMPLE INELASTIC COLLISION RATES BETWEEN BOUND LEVELS ONLY
C
C INPUTS:
C
C OUTPUTS:
C     C(I,J)    INELASTIC COLLISION RATES BETWEEN LEVELS I AND J
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
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'
      COMMON /COLCALC/ ICALL,TOLD,EDOLD,HDOLD(6)
      DATA ICALL,SMALL /0,-1.E-6/
      LOGICAL REDO
C
C  LOCAL VARIABLES: UP TO MTGRD POINTS IN TEMPERATURE GRID ALLOWED
C
      DIMENSION TGRID(MTGRD),CGRID(MTGRD)
      CHARACTER *20 KEY
C
      IF(ICALL .EQ. 0) THEN 
         TOLD=TEMP
         EDOLD=ED
         DO 303 I=1,6 
            HDOLD(I)=HD(I)
 303     CONTINUE
         ICALL=ICALL+1
      ENDIF
C
      REDO=(ABS(TOLD-TEMP)/TEMP .GT. SMALL)
C
C  RE-CALCULATE ALL
C
      IF(REDO) THEN BEGIN 
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)
C            CT=ALIN(TEMP,TGRID,CGRID,NTEMP,NINTEP)
            CDN = 8.63E-06 * CT * ED / ( G(IHI)*SQRT(TEMP) )
            CUP = CDN * PSTAR(IHI) / PSTAR(ILO)
            C(IHI,ILO) = CDN + C(IHI,ILO)
            C(ILO,IHI) = 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            CT=ALIN(TTP,TGRID,CGRID,NTEMP,NINTEP)
            CDN = HD(6) * CT 
            CUP= CDN * PSTAR(IHI)/G(IHI) / (PSTAR(ILO)/G(ILO))
            CMM(IHI,ILO,M,MP) = CDN + CMM(IHI,ILO,M,MP)
            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     
            CMM(IHI,ILO,-M,-MP) = CDN + CMM(IHI,ILO,-M,-MP)
            CMM(ILO,IHI,-M,-MP) = CUP + CMM(ILO,IHI,-M,-MP)
         ENDIF
C     
 100  CONTINUE
C
C  NOT RE-DONE
C
      ELSE 
C         write(*,*)'No re-calculation, just scaling'
      DO 330 J=1,NK
         DO 430 I=1,NK
            C(I,J)=C(I,J)*ED/EDOLD
            DO 431 L=-MJMAX,MJMAX
               DO 432 M=-MJMAX,MJMAX
                  CMM(I,J,L,M)=CMM(I,J,L,M)*HD(6)/HDOLD(6)
 432           CONTINUE
 431        CONTINUE
 430     CONTINUE
 330  CONTINUE
      ENDIF
      TOLD=TEMP
      EDOLD=ED
      DO 304 I=1,6 
         HDOLD(I)=HD(I)
 304  CONTINUE
      RETURN
      END