**********************************************************************
*   MASTER MECHANISM V.3.0 ROUTINE NAME        -     RADCHK          *
*                                                                    *
*            -- OLD COMMENT - NEED UPDATING --                       *
*            -- OLD COMMENT - NEED UPDATING --                       *
*            -- OLD COMMENT - NEED UPDATING --                       *
*                                                                    *
*   PURPOSE         -  Drives radical rearrangement routines MULTIP  *
*                      and SINGLE                                    *
*                                                                    *
*   USAGE           -  CALL RADCHK(CHEM,PROD,COPROD)                 *
*                                                                    *
*   ARGUMENTS CHEM  - input chemical formula                         *
*                     output:                                        *
*             PROD  - products of rearrangements in MULTIP           *
*             COPROD- co-products of rearrangement in MULTIP/SINGLE  *
*                                                                    *
*   If the number of carbons is 1, the driver calls the subroutine   *
*   <SINGLE>, and if it is bigger then the driver calls <MULTIP>.    *
*   At the end the co-products are sorted by decreasing alphabetical *
*   order and afterwards the order of co-products is reversed and    *
*   the co-products are written to the output of RADCHK.             *
*                                                                    *
*   INCLUDE    general.h includes variables: MCA, NUL.               *
*                                                                    *
*   FUNCTION   CNUM (integer) counts number of carbons in CHEM       *
*                                                                    *
*    NIP       number of possible formula in case of delocalisation  *
*                                                                    *
*   LOCAL VARIABLES...                                               *
*                                                                    *
*    MPROD     co-products of MULTIP and RADCHK                      *
*    SPROD     co-products of SINGLE                                 *
*    NC        number of characters in CHEM                          *
*    NCA       number of carbons in CHEM                             *
*    IEND      array size                                            *
*    I         DO-LOOP index                                         *
*                                                                    *
**********************************************************************
      SUBROUTINE radchk(chem,prod,coprod,nip,sc)
      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'

* input
      CHARACTER(LEN=lfo) chem
* output
      CHARACTER(LEN=lfo) prod(mca)
      CHARACTER(LEN=lco) coprod(mca,mca)
      INTEGER         nip
* local
      INTEGER         cnum,onum,nc,nca,iend,i,np,j,ip
      CHARACTER(LEN=lco) mprod(mca),sprod(4),tprod
      CHARACTER(LEN=lfo) tchem(mca)
      REAL            sc(mca)
!$    INTEGER         omp_get_thread_num


      IF (wtflag.NE.0) WRITE(6,*)'*radchk* : input : ',chem
!$   &    ,omp_get_thread_num()


* return if no species:
      nc = INDEX(chem,' ') - 1
      IF (nc.LT.1) RETURN

* return if no radical:
      IF (INDEX(CHEM,'.') .EQ. 0) THEN
        WRITE(6,'(a)') '--warning--, stop'
        WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE : radchk'
        WRITE(6,'(a)') 'subroutine called with non radical species:'
        WRITE(6,'(a)') chem
        WRITE(99,*) 'radchk',chem !STOP
      ENDIF

* initialize:
      DO i=1,mca
        tchem(i) = ' '
      ENDDO

      DO i=1,mca
        prod(i) = ' '
        mprod(i) = ' '
    	sc(i) = 0
    	DO j=1,mca
    	  coprod(i,j) = ' '
    	ENDDO
      ENDDO
      DO i=1,4
        sprod(i) = ' '
      ENDDO

      nip = 1
      sc(1) = 1
      tchem(1) = chem

      IF ((nip.LT.2).AND.(INDEX(chem,'=').NE.0)) THEN
	      CALL deloc(chem,tchem,nip,sc)
      ENDIF

* loop on the differents products formed from delocalisation
      DO ip=1,nip

* number of characters:
      nc=INDEX(tchem(ip),' ') - 1
* number of carbons and '-O-':
      nca=cnum(tchem(ip),nc)+onum(tchem(ip),nc)

* if multiple carbons, call MULTIP:
      IF (nca.GT.1) THEN
         CALL multip(tchem(ip),prod(ip),mprod)

* check if product is substituted alkene and decompose if necessary
         IF(INDEX(prod(ip),'Cd(O').NE.0  .OR.
     &     INDEX(prod(ip),'CdH(O').NE.0) THEN
           CALL alkcheck(prod(ip),tprod)
           DO i=1,mca
             IF (mprod(i).EQ.' ') mprod(i) = tprod
             EXIT
           ENDDO
         ENDIF

	       tchem(ip) = prod(ip)

* update number of Cs:
         nc = INDEX(tchem(ip),' ') - 1
         nca = cnum(tchem(ip),nc)+onum(tchem(ip),nc)
         !IF (wtflag.NE.0) WRITE(6,*)chem
      ENDIF

* if single carbon,call subroutine SINGLE:
      IF (nca.EQ.1) THEN
        CALL single(tchem(ip),prod(ip),sprod)
* collect co-products:
          DO i=1,mca
            IF (mprod(i).EQ.' ') THEN
                np=i
              DO j= 1,min(mca-i,4)
                mprod(np) = sprod(j)
                np = np+1
                IF (wtflag.NE.0) WRITE(6,*)sprod(j)
              ENDDO
              IF ((j.LT.4).AND.(sprod(j+1).NE.' ')) THEN
               WRITE(6,'(a)') '--error--3'
               WRITE(6,'(a)') 'from MASTER MECHANISM ROUTINE: radchk'
               WRITE(6,'(a)')'too many co-products or reactions created'
               WRITE(6,'(a)') chem
               WRITE(99,*) 'radchk',chem
               STOP
              ENDIF
              GOTO 1
            ENDIF
          ENDDO
       ENDIF

1     CONTINUE

      IF (wtflag.NE.0) print*,'output from radchk: ',prod(ip)

* sort the co-products:
      CALL sort(mca,mprod)

      iend = mca + 1
      DO i=1,mca
         coprod(ip,i) = mprod(iend-i)
         IF (wtflag.NE.0.AND.coprod(ip,i)(1:1).NE.' ')
     &       print*, 'coproducts from radchk: ',coprod(ip,i)
      ENDDO

      CALL stdchm(prod(ip))
      ENDDO

* check if the two products are not the same (i.e. symmetrical products)
      IF (nip.GT.1) THEN
        IF (prod(1).EQ.prod(2)) THEN
	  nip = 1
          sc(1)=1
	ENDIF
      ENDIF
* check if 2nd product is produced
      IF (sc(2).EQ.0) nip=1

      RETURN
      END
