*****************************************************************
*   MASTER MECHANISM V.3.1 ROUTINE NAME - SETCHROM              *
*   sets the chromophore table for a compound with a known      *
*   bond matrix and group list                                  *
*****************************************************************

      SUBROUTINE setchrom2(rdct,bond,group,chromtab)
      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'organic.h'

*input:
      CHARACTER(LEN=lcf) rdct
      CHARACTER(LEN=lgr) group(mca)
      INTEGER         bond(mca,mca)
*output:
      CHARACTER*1     chromtab(mca,4)
*internal:
      INTEGER         i,j,k
      CHARACTER(LEN=lgr) tgroup(mca)
***********************************************************************
*                            INITIALIZE                               *
***********************************************************************
      DO i=1,mca
        tgroup(i)=group(i)
        DO j=1,4
          chromtab(i,j)=' '
        ENDDO
      ENDDO

***********************************************************************
*                          SET THE CHROMOPHORE TABLE                  *
***********************************************************************
      DO 10 i=1,mca

* carbonyl chromophore
        IF (tgroup(i)(1:6).eq.carboxylic_acid) THEN
           chromtab(i,1)='a'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:7).eq.peroxy_acid) THEN
           chromtab(i,1)='g'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:9).eq.pan) THEN
           chromtab(i,1)='p'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:2).eq.carbonyl .AND.
     &      INDEX(tgroup(i),nitrate).NE.0)THEN
           chromtab(i,1)='q'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:2).eq.carbonyl .AND.
     &      INDEX(tgroup(i),nitro).NE.0)THEN
           chromtab(i,1)='v'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:4).eq.'CHO ') THEN
          DO j=1,mca
            IF (bond(i,j).EQ.3) GOTO 10
          ENDDO
           chromtab(i,1)='d'
           GOTO 10
        ENDIF
        IF (tgroup(i)(1:3).eq.'CO ') THEN
* No photolysis for ester function
          DO j=1,mca
            IF (bond(i,j).EQ.3) GOTO 10
          ENDDO
          chromtab(i,1)='k'
          GOTO 10
        ENDIF
        IF ((tgroup(i)(1:2).eq.'CO').AND.(tgroup(i)(3:3).ne.' ')) THEN
           WRITE(6,'(a)') '--error in setchrom'
           WRITE(6,'(a)') 'carbonyl tgroup found but not identified'
           WRITE(6,'(a)') 'in the tgroup : '
           WRITE(6,'(a)') tgroup(i)
           WRITE(6,'(a)') 'in the molecule :'
           WRITE(6,'(a)') rdct
           STOP
        ENDIF
* other chromophore
        j=0
20      j=j+1

! untreated groups
        k=INDEX(tgroup(i),nitrate)
        IF (k.NE.0) THEN
            chromtab(i,j)='n'
            tgroup(i)(k:k+5)='xxxxxx'
            GOTO 20
        ENDIF

        k=INDEX(tgroup(i),nitro)
        IF (k.NE.0) THEN
            chromtab(i,j)='t'
            tgroup(i)(k:k+2)='xxx'
            GOTO 20
        ENDIF

        k=INDEX(tgroup(i),hydro_peroxide)
        IF (k.NE.0) THEN
            chromtab(i,j)='h'
            tgroup(i)(k:k+4)='xxxxx'
            GOTO 20
        ENDIF

        k=INDEX(tgroup(i),hydroxy)
        IF (k.NE.0) THEN
            chromtab(i,j)='o'
            tgroup(i)(k:k+3)='xxxx'
            GOTO 20
        ENDIF

        IF (INDEX(tgroup(i),peroxy_nitrate).NE.0) THEN
           WRITE(6,'(a)') '--error in setchrom'
           WRITE(6,'(a)') 'peroxy nitrate found in the molecule :'
           WRITE(6,'(a)') trim(rdct)
           WRITE(6,'(a)') 'chromophore not treated in hvdiss2'
           STOP
        ENDIF

! JMLT SENSITIVITY TEST: peroxy nitrates do not kill subroutine
! (should not apply - Non-PAN PNs should not reach this point)
        !k=INDEX(tgroup(i),peroxy_nitrate)
        !IF (k.NE.0) THEN
        !    chromtab(i,j)='_'
        !    tgroup(i)(k:k+6)='xxxxxxx'
        !    GOTO 20
        !ENDIF

10    CONTINUE

      RETURN
      END