!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     ROUTINE STABILIZED CRIEGEE :
!     performs the reactions of the stabilized criegee intermediate :
!     reactions wit CO, NO, NO2 and H2O
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE stabilized_criegee(rdct,bond,group,nring,brch,
     &                 dbrch,dict,namlst,
     &                 cut_off,
     &                 nhldvoc,holdvoc,nhldrad,holdrad,level,stabl,
     &                 nfn,namfn,chemfn)

      IMPLICIT NONE
      INCLUDE 'general.h'
      INCLUDE 'common.h'
      INCLUDE 'organic.h'

! input:
      CHARACTER(LEN=lcf),INTENT(INOUT) :: rdct ! may need to be changed in a few cases
      CHARACTER(LEN=lgr),INTENT(INOUT) :: group(mca)
      INTEGER,INTENT(INOUT)         :: bond(mca,mca)
      INTEGER,INTENT(IN)         :: nring
      REAL,INTENT(IN)            :: brch
      REAL,INTENT(IN)            :: cut_off

! input/output
      CHARACTER(LEN=ldi),INTENT(INOUT) :: dict(mni)
      REAL,INTENT(INOUT)            :: dbrch(mni)
      CHARACTER(LEN=lco),INTENT(INOUT) :: namlst(mni)
      INTEGER,INTENT(INOUT)         :: level
      INTEGER,INTENT(INOUT)         :: stabl
      CHARACTER(LEN=lst),INTENT(INOUT) :: holdvoc(mlv)
      INTEGER,INTENT(INOUT)         :: nhldvoc
      CHARACTER(LEN=lst),INTENT(INOUT) :: holdrad(mra)
      INTEGER,INTENT(INOUT)         :: nhldrad
      INTEGER,INTENT(INOUT)         :: nfn
      CHARACTER(LEN=lco),INTENT(INOUT) :: namfn(mfn)
      CHARACTER(LEN=lfo),INTENT(INOUT) :: chemfn(mfn)

!  internal
      CHARACTER(LEN=lfo) :: pchem
      CHARACTER(LEN=lgr) :: tgroup(mca), pold, pnew,tempgr
      CHARACTER(LEN=lco) :: coprod(mca)
      INTEGER         :: tbond(mca,mca)
      INTEGER         :: ip,i,j,k,nc,nca,cnum,onum
      REAL            :: brtio
      INTEGER         :: np,rjg(mri,2)

      CHARACTER*1     :: a1, a2, a3, a4
      CHARACTER(LEN=lco) :: p(mnp), r(3)
      REAL            :: s(mnp), ar1,ar2,ar3,f298,fratio
      INTEGER         :: idreac, nlabel
      REAL            :: xlabel,folow(3),fotroe(4)
      CHARACTER(LEN=6)   :: reactant(5),prod(5)
      REAL            :: rate(5)
      LOGICAL         :: internal
      
      CHARACTER(LEN=lsb)  :: progname='*stabilized criegee*   '
      CHARACTER(LEN=ler)  :: mesg

! ----------
! INITIALIZE
! ----------

      IF (wtflag.NE.0) write(6,*) '*stabilized criegee*'

! check if species is allowed in this routine
      IF (INDEX(rdct(lco+1:lcf),'.(OO.)').EQ.0) THEN
        WRITE(6,'(a)') '--error--, in subroutine stabilized criegee'
        WRITE(6,'(a)') 'this routine was called with'
        WRITE(6,'(a)') 'a species with no criegee:'
        WRITE(6,'(a)') rdct(lco+1:lcf)
        STOP
      ENDIF

! IF RINGS EXIST remove ring-join characters from groups,
      IF (nring.gt.0) THEN
        CALL rjgrm(nring,group,rjg)
      ENDIF

      pchem=' '
      tgroup(:) = group(:)
      coprod(:) = ' '
      p(:)=' '
      ip = 0
      tbond(:,:) = bond(:,:)
      internal=.FALSE.

!!

! locate peroxy_acyl group and count number of carbons + '-O-':
      nc = INDEX(rdct(lco+1:lcf),' ') - 1
      nca = cnum(rdct(lco+1:lcf),nc)+onum(rdct(lco+1:lcf),nc)
      DO i=1,mca
         IF (INDEX(group(i),'.(OO.)').NE.0) ip = i
      ENDDO

      IF (INDEX(rdct(lco+1:lcf),'C.(OO.)').NE.0) internal=.TRUE.
!!  different pathways :
! 

      reactant(1)='CO '
      reactant(2)='NO '
      reactant(3)='NO2 '
      reactant(4)='EXTRA '
      reactant(5)='EXTRA '
      prod(1)=' '
      prod(2)='NO2 '
      prod(3)='NO3  '
      prod(4)='H2O2 '
      prod(5)=' '
      rate(1)=1.2E-15
      rate(2)=1.0E-14
      rate(3)=1.0E-15
      rate(4)=6.0E-18
      rate(5)=1.0E-17

      reac : DO i=1,5
        tgroup(:)=group(:)
        tbond(:,:)=bond(:,:)
        
          
! remove * from formula if present
        if (index(group(ip),hot_criegee) .ne. 0) then
          pold = hot_criegee
          pnew = criegee
          tempgr = tgroup(ip)
          CALL swap(tempgr,pold,tgroup(ip),pnew)
          CALL rebond(tbond,tgroup,rdct(lco+1:lcf),nring)
          CALL stdchm(rdct(lco+1:lcf))
!reset
          group = tgroup ! on purpose: we want to keep tgroup
          bond = tbond ! and tbond
        endif



        IF (i.LT.5) THEN
          IF (internal) THEN
            pold='C.(OO.)'
            pnew='CO'
          ELSE
            pold='CH.(OO.)'
            pnew='CHO'
          ENDIF
        ELSE
          IF (.not.internal) THEN
            pold='CH.(OO.)'
            pnew='CO(OH)'
          ELSE
            EXIT reac
          ENDIF
        ENDIF


        tempgr=tgroup(ip)
        CALL swap(tempgr,pold,tgroup(ip),pnew)
        CALL rebond(tbond,tgroup,pchem,nring)
        CALL stdchm(pchem)

        CALL rxinit3(a1,a2,a3,a4,r,s,p,ar1,ar2,ar3,
     &             f298,fratio,idreac,nlabel,xlabel,folow,fotroe)

        brtio=1
        CALL bratio(pchem,brtio,p(1),
     &             dbrch,dict,namlst,
     &             nhldvoc,holdvoc,nhldrad,holdrad,level,stabl,
     &             nfn,namfn,chemfn)

        a1 = rdct(1:1)
        r(1) = rdct(1:lco)
        r(2)= reactant(i)
        s(1) = 1.
        s(2) = 1.
        p(2) = prod(i)
        ar1 = rate(i)
        ar2 = 0
        ar3 = 0
        f298 = ar1*(298.**ar2)*exp(-ar3/298.)
        fratio=1.

        IF (i.GE.4) THEN
          idreac=2
          nlabel=500
        ENDIF

        CALL rxwrit3(17,a1,a2,a3,a4,r,s,p,ar1,ar2,ar3,
     &            f298,fratio,idreac,nlabel,xlabel,folow,fotroe)

      ENDDO reac

      IF (wtflag.NE.0) write(6,*) 'done stabilized criegee'

      RETURN
      END