C
C PURPOSE: STORE COLLISIONAL DATA FOR USE WITH COLCAL
C          AND INITIALIZE COLLISIONAL DATA TO ZERO
C INPUTS:
C     (READ FROM FILE 'ATOM')
C OUTPUTS:
C     KEYWORDS AND DATA ARE STORED IN COMMON BLOCK  COLL
C COMMON:
C     CATOM COLL CATMOS CATMO2 CCONST CINPUT CLU
C RESTRICTIONS:  ONLY BOUND-BOUND COLLISIONS ARE TREATED. 
C     ELASTIC COLLISIONS ARE NOT YET INCLUDED BUT CAN 
C     EASILY BE SET USING THE DIAGONAL COMPONENTS
C
C COMMENTS: OCTOBER 6, 1999, P. JUDGE
C
C
C 6 JUNE 2019  ADD FLAG FOR M TO MPRIME COLLISIONS FOR EFFICIENCY IN GAMMA ROUTINES
C
      SUBROUTINE COLRD
C
C  GENERAL ROUTINE FOR READING COLLISIONAL RATES 
      INCLUDE 'PREC'
      INCLUDE 'PARAM'
      INCLUDE 'COLL'
      INCLUDE 'CATOM'
      INCLUDE 'CATMOS'
      INCLUDE 'CATMO2'
      INCLUDE 'CCONST'
      INCLUDE 'CINPUT'
      INCLUDE 'CLU'
      DIMENSION TGRID(MTGRD),CGRID(MTGRD)
      CHARACTER *20 KEY
C
C 6 JUNE 2019 FLAG FOR M TO MPRIME COLLISIONS FOR EFFICIENCY IN GAMMA ROUTINES
C
      DATA IL,IH /0,0/
C     
C     ASSUME INITIALLY THAT DATA ARE GIVEN INDEPENDENT OF TEMPERATURE:
C     I.E. THAT NTEMP IS ORIGINALLY SET = 1
C     
      NCOL=0
      NTEMP=1
C note added 6jul22
      ICOLLMM=0
      IF(IWATOM .GT. 1) WRITE(LOUT,1005)
 1005 FORMAT(' COLLISIONAL DATA')
C     
C     READ THE KEYWORD 'KEY' AND ASSOCIATED PARAMETERS
C     
 50   CONTINUE
      READ(LDUMS,100,END=301)KEY
      NCOL=NCOL+1
 100  FORMAT(A)
      CALL LJUST(KEY)
      IF(KEY(1:1) .EQ. ' ') THEN
         NCOL=NCOL-1
         GOTO 50
      ENDIF
      IF (KEY(1:3) .EQ. 'END') THEN
         NCOL=NCOL-1
         GOTO 300
      ELSE IF (KEY(1:4) .EQ. 'TEMP') THEN
         NCOL=NCOL-1
         READ(LDUMS,*)NTEMP,(TGRID(JT),JT=1,MIN(NTEMP,MTGRD))
         IF(NTEMP .GT. MTGRD)THEN
            CALL STOP(' COLRD: WORK ARRAYS (TGRID) TOO SMALL')
         ENDIF
         IF (IWATOM .GT. 1) THEN
            WRITE(LOUT,803)KEY(1:4),(TGRID(JT),JT=1,NTEMP)
 803        FORMAT(1X,A,8X,10(1P,1X,E10.3))
         ENDIF
         GOTO 50
      ELSE IF (KEY(1:3) .EQ. 'OHM' .OR. KEY(1:3) .EQ. 'CP ' ) THEN
         CKEY(NCOL)=KEY
         READ(LDUMS,*)IL,IH,(CGRID(JT),JT=1,NTEMP)
         ILC(NCOL)=IL
         IHC(NCOL)=IH
         NTC(NCOL)=NTEMP
         DO JT=1,NTEMP
            CTEMP(JT,NCOL)=TGRID(JT)
            CDATA(JT,NCOL)=CGRID(JT)
         ENDDO
         IF(IWATOM .GT. 1)THEN
            WRITE(LOUT,802)KEY(1:4), IL, IH, (CGRID(JT),JT=1,NTEMP)
 802        FORMAT(1X,A,2(2X,I2),10(1P,1X,E10.3))
         ENDIF
      ELSE IF (KEY(1:4) .EQ. 'CPMM') THEN
C note added 6jul22
         ICOLLMM = 1
         CKEY(NCOL)=KEY
         NTEMP=NTEMP
         READ(LDUMS,*)IL,IH,(CGRID(JT),JT=1,NTEMP+2)
         ILC(NCOL)=IL
         IHC(NCOL)=IH
         NTC(NCOL)=NTEMP
         DO JT=1,NTC(NCOL)+2
            CTEMP(JT,NCOL)=TGRID(JT)
            CDATA(JT,NCOL)=CGRID(JT)
         ENDDO
         IF(IWATOM .GT. 1)THEN
            WRITE(LOUT,802)KEY(1:4), IL, IH, (CGRID(JT),JT=1,NTEMP+2)
         ENDIF
      ELSE
         WRITE(LJOBLO,191)KEY(1:4)
 191     FORMAT('  COLRD: KEYWORD(1:4) IS  (',A,')')
         CALL STOP(' COLRD:  UNKNOWN KEYWORD IN ATOMIC DATA')
      ENDIF
C     
C     CHECK TO SEE THAT THE LEVELS ARE BETWEEN 1 AND NK
C     
      ILO=MIN( IL, IH )
      IHI=MAX( IL, IH )
      IF(ILO .LT. 1 .OR. IHI .GT. NK) THEN 
         WRITE(LJOBLO,1003)ILO,IHI,NK
 1003    FORMAT('ILO IHI NK',3(1X,I6))
         CALL STOP(' COLRD:  LEVEL INDEX OUTSIDE RANGE (1,NK)')
      ENDIF
C     
C     CHECK TO SEE IF THERE ARE LEVELS WITH ENERGIES NOT INCREASING WITH
C     THE LEVEL LABEL (THIS AFFECTS CI ETC.)
C     
      IF(EV(IHI) .LT. EV(ILO) )THEN
         WRITE(LJOBLO,1001)KEY(1:4),IHI,ILO
 1001    FORMAT('  COLRD:  WARNING- KEYWORD ',A,2(2X,I2),
     *        ' ENERGY OF UPPER LEVEL IS .LT. LOWER LEVEL'/
     *        '           WARNING- CHECK RESULTS CAREFULLY')
      ENDIF
      GOTO 50
C     
 301  CALL STOP(' COLRD: KEYWORD ''END'' NOT FOUND IN COLLISION FILE')
 300  CONTINUE
C
C  INITIALIZE COLLISIONAL RATES TO ZERO
C
      DO 309 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
 309  CONTINUE
C note added 6jul22
      IF(IWATOM .GT. 1 .AND. ICOLLMM .EQ. 1) WRITE(LOUT,*) " M TO M' COLLISIONS INCLUDED "
      END