      SUBROUTINE CPHO(N,NN,NR,NRS,KS,KSS,NSS,NMA)
      INCLUDE 'garr.h' ! NY,NOE,KBE,KFE
      INCLUDE 'chm.h'
      INCLUDE 'fam.h'  ! MS,NBS,NFS,NUS
      DIMENSION N(2,NR),NN(2,NR),KS(1,NSS),KSS(2,NSS)
      COMMON/MRAZ/M1,M2,M3,M4,M5,M6,M7
      CALL CPHN(NPNR,NDNR,MX,KPNR,KDNR,NY,NBS,NFS,NUS,MS,N,NN,2,NR,1,
     *NRS,M6,M7)
      CALL CPHN(NPS,NDS,MX,KPS,KDS,NY,NBS,NFS,NUS,MS,KS,KSS,1,NSS,
     *1,NSS,M2,M4)
      NRE=1
      NRSS=NRS+1
      IF(NRSS.LE.NR)GOTO3
      DO 5 J=1,NY
   5     KDW(J)=2
      M5=1
      NDW(M5)=0
      GOTO4
   3  DO 1 J=1,MS
         KDW(J)=NRE
         DO 1 I=NRSS,NR
            DO 1 IJ=1,NBS(J)
               IF(N(1,I).NE.NFS(IJ,J))GOTO1
               DO 10 JI=1,NUS(IJ,J)
                  NDW(NRE)=I
  10              NRE=NRE+1
   1           CONTINUE
      CALL CPH(N,2,NR,NDW,MX,KDW,NY,MS+1,NRE,NRSS,NR)
      M5=NRE-1
   4  IF(KBE.GT.KFE)GOTO2
      CALL EXEQ(NPNR,MX,M6,KPNR,NY,N,NN,2,NR,KBE,KFE,NPS,M2,KPS,KSS,NSS)
   2  NV=0
      DO 6 I=1,NSS
         IF(KS(1,I).LE.KFE)GOTO6
         DO 7 J=1,MX
            IF(NPS(J).LT.I-NV)GOTO8
            NPS(J)=NPS(J)-1
   8        IF(NDS(J).LT.I-NV)GOTO7
            NDS(J)=NDS(J)-1
   7        CONTINUE
         NV=NV+1
   6     CONTINUE
      CALL CPHD(NPNR,NDNR,MX,M6,M7,KPNR,KDNR,NY,NPR,NPS,NDR,NDS,
     *M1,M2,M3,M4,M5,KPR,KPS,KDR,KDS,KDW,NOE,NY,NBS,NFS,NUS,MS,NMA)
   9  DO 11 J=1,MS
         DO 11 I=1,NBS(J)
            CALL EXSEM(NPR,KPR,MX,M1,NY,NFS,MS,J,I)
            CALL EXSEM(NPS,KPS,MX,M2,NY,NFS,MS,J,I)
            CALL EXSEM(NDR,KDR,MX,M3,NY,NFS,MS,J,I)
            CALL EXSEM(NDS,KDS,MX,M4,NY,NFS,MS,J,I)
  11        CONTINUE
  12  RETURN
      END

      SUBROUTINE EXSEM(NPR,KPR,MX,M1,NY,NFS,MS,J,I)
      DIMENSION NPR(MX),KPR(NY),NFS(NY,MS)
      NFJ=KPR(J+1)-1
      JJ=NFS(I,J)
      IF(JJ.LT.NY)THEN
         NFJJ=KPR(JJ+1)-1
      ELSE
         NFJJ=M1
      ENDIF
      DO 3 JK=KPR(JJ),NFJJ
         DO 4 JN=KPR(J),NFJ
            IF(NPR(JK).EQ.NPR(JN))GOTO3
   4        CONTINUE
         GOTO5
   3     CONTINUE
      GOTO6
   5  DO 11 IJ=KPR(J),NFJ
         JI=KPR(JJ)
   2     IF(JI.GT.NFJJ)GOTO11
         IF(NPR(JI).NE.NPR(IJ))GOTO1
         CALL KEM(NPR,MX,M1,JI,KPR,NY)
         NFJJ=NFJJ-1
   1     JI=JI+1
         GOTO2
  11     CONTINUE
   6  RETURN
      END

      SUBROUTINE CPHN(NPR,NDR,M,KPR,KDR,NY,NBS,NFS,NUS,MS,
     *N,NN,NS,NR,NRB,NRE,M1,M3)
      DIMENSION KPR(NY),KDR(NY),NBS(MS),NFS(NY,MS),N(NS,NR),
     *NN(2,NR),NPR(M),NDR(M),NUS(NY,MS)
      KPE=1
      KDE=1
      CALL CPHS(N,NS,NR,NN,NPR,NDR,M,KPR,KDR,NBS,NFS,NUS,MS,
     *KPE,KDE,NRB,NRE,NY)
      CALL CPH(N,NS,NR,NDR,M,KDR,NY,MS+1,KDE,NRB,NRE)
      CALL CPH(NN,2,NR,NPR,M,KPR,NY,MS+1,KPE,NRB,NRE)
      M1=KPE-1
      M3=KDE-1
      RETURN
      END
      SUBROUTINE CPHS(N,NS,NR,NN,NPR,NDR,M,KPR,KDR,
     *NBS,NFS,NUS,MS,KPE,KDE,NRB,NRE,NY)
      DIMENSION KPR(MS),KDR(MS),NBS(MS),NFS(NY,MS),N(NS,NR),
     *NN(2,NR),NPR(M),NDR(M),NUS(NY,MS)
      DO 1 J=1,MS
         KPR(J)=KPE
         KDR(J)=KDE
         NB=NBS(J)
         DO 1 I=NRB,NRE
            KD=0
            KP=0
            DO 2 JKR=1,NB
               JK=NFS(JKR,J)
               DO 3 IJ=1,NS
                  IF(N(IJ,I).NE.JK)GOTO3
                  KD=KD+NUS(JKR,J)
   3              CONTINUE
               DO 2 IJ=1,2
                  IF(NN(IJ,I).NE.JK)GOTO2
                  KP=KP+NUS(JKR,J)
   2              CONTINUE
               IF(KD-KP)4,1,5
   4           KF=KP-KD
               DO 6 JK=1,KF
                  NPR(KPE)=I
   6              KPE=KPE+1
               GOTO1
   5           KF=KD-KP
               DO 7 JK=1,KF
                  NDR(KDE)=I
   7              KDE=KDE+1
   1           CONTINUE
      RETURN
      END
      SUBROUTINE CPH(N,NS,NR,NDR,M,KDR,NY,NB,KPE,NRB,NRE)
C
C
      DIMENSION KDR(NY),N(NS,NR),NDR(M)
      DO 1 J=NB,NY
         KDR(J)=KPE
         DO 1 I=NRB,NRE
            DO 1 IJ=1,NS
               IF(N(IJ,I).NE.J)GOTO1
               NDR(KPE)=I
               KPE=KPE+1
   1           CONTINUE
      RETURN
      END
      SUBROUTINE EXEQ(NPR,M,M1,KPR,NY,N,NN,NS,NR,NB,NE,NPS,M2,
     *KPS,KSS,NSS)
CC
C
C
      DIMENSION NPR(M),KPR(NY),N(NS,NR),NN(2,NR),
     *NPS(M),KPS(NY),KSS(2,NSS)
      DO 1 J=NB,NE
         JJ=J
         NRE=1
         NP=0
   2     DO 3 IJ=1,NS
            IF(N(IJ,NRE).NE.J)GOTO3
            NP=1
   3        CONTINUE
         IF(NP.GT.0)GOTO4
         IF(NRE.EQ.NR)GOTO1
         NRE=NRE+1
         GOTO2
   4     CALL ZAM(NPR,M,M1,KPR,NY,NN,NR,NRE,NPS,M2,KPS,KSS,NSS,JJ)
   1     CONTINUE
      RETURN
      END
      SUBROUTINE ZAM(NPR,M,M1,KPR,NY,NN,NR,NRE,NPS,M2,KPS,KSS,NSS,J)
C
C
C
      DIMENSION NPR(M),KPR(NY),NN(2,NR),NPS(M),KPS(NY),KSS(2,NSS)
      DO 1 IJ=1,2
         IF(NN(IJ,NRE).GT.NY)GOTO1
         KR=KPR(NN(IJ,NRE))
   2     IF(NPR(KR).EQ.NRE)GOTO3
         IF(KR.EQ.M1)GOTO1
         KR=KR+1
         GOTO2
   3     CALL KEM(NPR,M,M1,KR,KPR,NY)
         KR=KR-1
         DO 4 II=1,NR
            I=II
            DO 4 JI=1,2
               IF(NN(JI,I).NE.J)GOTO4
               CALL KEP(NPR,M,M1,KR,I,KPR,NY,NN(IJ,NRE))
               KR=KR+1
   4           CONTINUE
         DO 11 I=1,NSS
            II=I
            DO 11 JI=1,2
               IF(KSS(JI,I).NE.J)GOTO11
               CALL KEP(NPS,M,M2,KPS(NN(IJ,NRE))-1,II,KPS,NY,NN(IJ,NRE))
  11           CONTINUE
   1        CONTINUE
      RETURN
      END
      SUBROUTINE KEM(N,M,M1,KM,K,NY)
C
C
C
      DIMENSION N(M),K(NY)
      DO 1 I=KM,M1
   1     N(I)=N(I+1)
      DO 2 J=1,NY
         IF(K(J).LE.KM)GOTO2
         K(J)=K(J)-1
   2     CONTINUE
      M1=M1-1
      RETURN
      END
      SUBROUTINE KEP(N,M,M1,KP,NP,K,NY,JP)
C
C
C
      DIMENSION N(M),K(NY)
      IF(KP.EQ.M1)GOTO3
      KB=KP+1
      DO 1 I=KB,M1
         II=M1+KB-I+1
   1     N(II)=N(II-1)
   3  N(KP+1)=NP
      DO 2 J=1,NY
         IF(J.LE.JP)GOTO2
         K(J)=K(J)+1
   2     CONTINUE
      M1=M1+1
      RETURN
      END

      SUBROUTINE CPHD(NPNR,NDNR,M,M6,M7,KPNR,KDNR,NY,NPR,NPS,NDR,NDS,
     *M1,M2,M3,M4,M5,KPR,KPS,KDR,KDS,KDW,NOE,NFI,NBS,NFS,NUS,MS,NRM)
C
C     Photochemical equilibrium equations adding for Ox equation
C
      DIMENSION NPNR(M),NDNR(M),NPR(M),NPS(M),NDR(M),NDS(M),NOE(NY),
     *KPNR(NY),KDNR(NY),KPR(NY),KPS(NY),KDR(NY),KDS(NY),KDW(NY),
     *NBS(MS),NFS(NY,MS),NUS(NY,MS)
      COMMON/GNAM/NGEN,NGE(8),NOCLO,NCLONO,NNO3,NN2O5,idum1,idum2,idum3,
     *idum4,idum5,idum6,idum7,idum8,idum9,idum10,idum11,idum12,idum13,
     *idum14 
      DO 7 IKM=1,2
         CALL CPEX(NPNR,NPS,NDNR,NDS,M,M6,M2,M7,M4,M5,
     *   KPNR,KPS,KDNR,KDS,KDW,NY,NOE,NFI)
   7     CONTINUE
      DO 1 I=1,M
         NPR(I)=NPNR(I)
   1     NDR(I)=NDNR(I)
      DO 2 J=1,NY
         KPR(J)=KPNR(J)
   2     KDR(J)=KDNR(J)
      M1=M6
      M3=M7
      DO 3 J=1,NY
         JJ=J
   3     CALL CPIS(NPNR,NDNR,M,M6,M7,KPNR,KDNR,NY,JJ)
      DO 5 J=2,MS
         DO 8 I=1,NBS(J)
            DO 4 JI=1,NGEN
               IF(NFS(I,J).EQ.NGE(JI))GOTO8
   4           CONTINUE
            DO 6 IKM=1,NUS(I,J)
               CALL CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NFS(I,J),NRM)
   6           CALL CPHDD(NPS,NDS,M,M2,M4,KPS,KDS,NY,NFS(I,J),NRM)
   8        CONTINUE
         DO 5 IKM=1,2
            CALL CPEX(NPR,NPS,NDR,NDS,M,M1,M2,M3,M4,M5,
     *      KPR,KPS,KDR,KDS,KDW,NY,NOE,NFI)
   5     CONTINUE
      CALL CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NNO3,NRM)
      CALL CPHDD(NPS,NDS,M,M2,M4,KPS,KDS,NY,NNO3,NRM)
      CALL CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NN2O5,NRM)
      CALL CPHDD(NPS,NDS,M,M2,M4,KPS,KDS,NY,NN2O5,NRM)
      CALL CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NOCLO,NRM)
      CALL CPHDD(NPS,NDS,M,M2,M4,KPS,KDS,NY,NOCLO,NRM)
      CALL CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NCLONO,NRM)
      CALL CPHDD(NPS,NDS,M,M2,M4,KPS,KDS,NY,NCLONO,NRM)
      CALL CPEX(NPR,NPS,NDR,NDS,M,M1,M2,M3,M4,M5,
     *KPR,KPS,KDR,KDS,KDW,NY,NOE,NFI)
   9  RETURN
      END
      SUBROUTINE CPHDD(NPR,NDR,M,M1,M3,KPR,KDR,NY,NO2,NRM)
C
C
C
      DIMENSION NPR(M),NDR(M),KPR(NY),KDR(NY)
      IF(NO2.GT.NY)GOTO10
      CALL CPSNO2(NPR,M,M1,KPR,NY,NO2,NRM)
      CALL CPSNO2(NDR,M,M3,KDR,NY,NO2,NRM)
      CALL CPIS(NPR,NDR,M,M1,M3,KPR,KDR,NY,1)
 10   RETURN
      END
      SUBROUTINE CPSNO2(NPR,M,M1,KPR,NY,NO2,NRM)
C
C
C
      DIMENSION NPR(M),KPR(NY)
      NB=KPR(NO2)
      IF(NO2.LT.NY)THEN
         NF=KPR(NO2+1)-1
      ELSE
         NF=M1
      ENDIF
      NR=0
      DO 5 I=NB,NF
         IF(NPR(I).GT.NRM)GOTO5
         NR=NR+1
   5     CONTINUE
      IF(NR.LT.1)GOTO4
      DO 1 I=M1,1,-1
   1     NPR(NR+I)=NPR(I)
      II=0
      DO 2 I=NB,NF
         IF(NPR(I+NR).GT.NRM)GOTO2
         II=II+1
         NPR(II)=NPR(I+NR)
   2     CONTINUE
      M1=M1+NR
      DO 3 J=2,NY
   3     KPR(J)=KPR(J)+NR
   4  RETURN
      END

      SUBROUTINE CPEX(NPR,NPS,NDR,NDS,M,M1,M2,M3,M4,M5,
     *KPR,KPS,KDR,KDS,KDW,NY,NOE,NFI)
C
C
C
      DIMENSION NPR(M),NPS(M),NDR(M),NDS(M),NOE(NY),
     *KPR(NY),KPS(NY),KDR(NY),KDS(NY),KDW(NY)
      DO 21 II=1,NY
         IF(NOE(II).EQ.0)GOTO21
         IF(II.EQ.NY)GOTO2
         IF(KDW(II).NE.KDW(II+1))GOTO21
         IE=KDR(II+1)-1
         ISE=KDS(II+1)-1
         GOTO3
   2     IF(KDW(II).LE.M5)GOTO21
         IE=M3
         ISE=M4
   3     DO 1 JJ=1,NFI
            IF(JJ.EQ.II)GOTO1
            I=KDR(II)
            IS=KDS(II)
            IF(JJ.NE.NY)THEN
               JE=KPR(JJ+1)-1
               JSE=KPS(JJ+1)-1
            ELSE
               JE=M1
               JSE=M2
            ENDIF
   5        IF(I.GT.IE)GOTO8
            J=KPR(JJ)
   6        IF(J.GT.JE)GOTO1
            IF(NPR(J).EQ.NDR(I))GOTO7
            J=J+1
            GOTO6
   7        I=I+1
            GOTO5
   8        IF(IS.GT.ISE)GOTO11
            JS=KPS(JJ)
   9        IF(JS.GT.JSE)GOTO1
            IF(NPS(JS).EQ.NDS(IS))GOTO10
            JS=JS+1
            GOTO9
  10        IS=IS+1
            GOTO8
  11        JJJ=JJ
            III=II
            CALL CPEX1(NPR,NDR,M,M1,M3,KPR,KDR,NY,III,JJJ,IE,JE)
            CALL CPEX1(NPS,NDS,M,M2,M4,KPS,KDS,NY,III,JJJ,ISE,JSE)
   1        CONTINUE
  21        CONTINUE
      DO 12 J=1,NY
         JJ=J
         CALL CPIS(NPR,NDR,M,M1,M3,KPR,KDR,NY,JJ)
  12     CALL CPIS(NPS,NDS,M,M2,M4,KPS,KDS,NY,JJ)
      RETURN
      END
      SUBROUTINE CPEX1(NPR,NDR,M,M1,M3,KPR,KDR,NY,II,JJ,IE,JE)
C
C
C
      DIMENSION NPR(M),NDR(M),KPR(NY),KDR(NY)
            I=KDR(II)
  12        IF(I.GT.IE)GOTO15
            J=KPR(JJ)
  13        IF(J.GT.JE)GOTO1
            IF(NDR(I).EQ.NPR(J))GOTO14
            J=J+1
            GOTO13
  14        CALL KEM(NPR,M,M1,J,KPR,NY)
            JE=JE-1
            I=I+1
            GOTO12
  15        IB=KPR(II)
            IF(II.NE.NY)IFF=KPR(II+1)-1
            IF(II.EQ.NY)IFF=M1
            IF(IB.GT.IFF)GOTO1
            DO 16 JI=IB,IFF
               KPPPPP=KPR(JJ)-1
               NPPP=NPR(JI)
               IF(JI.GT.KPPPPP)NPPP=NPR(2*JI-IB)
  16           CALL KEP(NPR,M,M1,KPPPPP,NPPP,KPR,NY,JJ)
         CALL CPIS(NPR,NDR,M,M1,M3,KPR,KDR,NY,JJ)
   1  RETURN
      END
      SUBROUTINE CPIS(NPR,NDR,M,M1,M3,KPR,KDR,NY,J)
C
C
C
      DIMENSION NPR(M),NDR(M),KPR(NY),KDR(NY)
      I=KPR(J)
      IF(J.EQ.NY)GOTO1
      NF1=KPR(J+1)-1
      NF2=KDR(J+1)-1
      GOTO2
   1  NF1=M1
      NF2=M3
   2  IF(I.GT.NF1)GOTO6
      K=KDR(J)
   4  IF(K.GT.NF2)GOTO3
      IF(NPR(I).NE.NDR(K))GOTO5
      CALL KEM(NPR,M,M1,I,KPR,NY)
      CALL KEM(NDR,M,M3,K,KDR,NY)
      NF1=NF1-1
      NF2=NF2-1
      GOTO2
   5  K=K+1
      GOTO4
   3  I=I+1
      GOTO2
   6  RETURN
      END


