      SUBROUTINE pchem(nw,wl,nz,tlev,airlev,
     $     j,sq,jlabel)
cgy modified for camx by greg yarwood, see comments below

*-----------------------------------------------------------------------------*
*=  PURPOSE:                                                                 =*
*=  Load various "weighting functions" (products of cross section and        =*
*=  quantum yield at each altitude and for wavelength).  The altitude        =*
*=  dependence is necessary to ensure the consideration of pressure and      =*
*=  temperature dependence of the cross sections or quantum yields.          =*
*=  The actual reading, evaluation and interpolation is done is separate     =*
*=  subroutines for ease of management and manipulation.  Please refer to    =*
*=  the inline documentation of the specific subroutines for detail          =*
*=  information.                                                             =*
*-----------------------------------------------------------------------------*
*=  PARAMETERS:                                                              =*
*=  NW     - INTEGER, number of specified intervals + 1 in working        (I)=*
*=           wavelength grid                                                 =*
*=  WL     - REAL, vector of lower limits of wavelength intervals in      (I)=*
*=           working wavelength grid                                         =*
*=  NZ     - INTEGER, number of altitude levels in working altitude grid  (I)=*
*=  TLEV   - REAL, temperature (K) at each specified altitude level       (I)=*
*=  AIRLEV - REAL, air density (molec/cc) at each altitude level          (I)=*
*=  J      - INTEGER, counter for number of weighting functions defined  (IO)=*
*=  SQ     - REAL, cross section x quantum yield (cm^2) for each          (O)=*
*=           photolysis reaction defined, at each defined wavelength and     =*
*=           at each defined altitude level                                  =*
*=  JLABEL - CHARACTER*40, string identifier for each photolysis reaction (O)=*
*=           defined                                                         =*
*-----------------------------------------------------------------------------*
*=  EDIT HISTORY:                                                            =*
*=  05/98  Original; adapted from the "old" JSPEC1 routine                   =*
*-----------------------------------------------------------------------------*
*= This program is free software;  you can redistribute it and/or modify     =*
*= it under the terms of the GNU General Public License as published by the  =*
*= Free Software Foundation;  either version 2 of the license, or (at your   =*
*= option) any later version.                                                =*
*= The TUV package is distributed in the hope that it will be useful, but    =*
*= WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHANTIBI-  =*
*= LITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public     =*
*= License for more details.                                                 =*
*= To obtain a copy of the GNU General Public License, write to:             =*
*= Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.   =*
*-----------------------------------------------------------------------------*
*= To contact the authors, please mail to:                                   =*
*= Sasha Madronich, NCAR/ACD, P.O.Box 3000, Boulder, CO, 80307-3000, USA  or =*
*= send email to:  sasha@ucar.edu                                            =*
*-----------------------------------------------------------------------------*
*= Copyright (C) 1994,95,96  University Corporation for Atmospheric Research =*
*-----------------------------------------------------------------------------*

      IMPLICIT NONE
      INCLUDE 'params'

* input

      INTEGER nw
      REAL wl(kw)
      
      INTEGER nz

      REAL tlev(kz)
      REAL airlev(kz)

* weighting functions

      CHARACTER*40 jlabel(kj)
      REAL sq(kj,kz,kw)

* input/output:
      INTEGER j

* local:
      REAL wc(kw), wu(kw)
      CHARACTER*8 mchver
      INTEGER iw, irxn, nsap, nsap99, nsap07, nsap22, nracm2,
     &        ncl, nio, nbr, niu, ncb6r4, ncb6r5, ncb7r2,
     &        ncl2, nio2, nbr2
      parameter (nsap=23, nsap99=26, nsap07=33, nracm2=33,
     &           ncl=6, nio=10, nbr=10, niu=11, ncb6r4=23, ncb6r5=6,
     &           ncb7r2=2, ncl2=1,nio2=2, nbr2=1, nsap22=33)
      character*12  iupac04(niu), namsig, namphi
      character*12  saprc97(nsap), saprc99(nsap99), saprc07(nsap07)
      character*12  saprc22(nsap22)
      character*12  clreac(ncl),   ioreac(nio),     brreac(nbr)
      character*12  cb6r4(ncb6r4), cb6r5(ncb6r5),   cb7r2(ncb7r2)
      character*12  clreac2(ncl2), ioreac2(nio2), brreac2(nbr2)
      character*12  racm2(nracm2)

      data saprc99    /'ACETONE.PHF ', 'ACROLEIN.PHF', 'BACL_ADJ.PHF',
     & 'BZCHO.PHF   ', 'C2CHO.PHF   ', 'CCHO_R.PHF  ', 'COOH.PHF    ',
     & 'GLY_ABS.PHF ', 'GLY_R.PHF   ', 'H2O2.PHF    ', 'HCHO_M.PHF  ',
     & 'HCHO_R.PHF  ', 'HNO3.PHF    ', 'HO2NO2.PHF  ', 'HONO-NO.PHF ',
     & 'HONO-NO2.PHF', 'IC3ONO2.PHF ', 'KETONE.PHF  ', 'MGLY_ABS.PHF',
     & 'MGLY_ADJ.PHF', 'NO2.PHF     ', 'NO3NO.PHF   ', 'NO3NO2.PHF  ',
     & 'O3O1D.PHF   ', 'O3O3P.PHF   ', 'ISPD.PHF    '/

      data saprc07    /'ACET-06B.PHF', 'ACRO-09.PHF ', 'AFG1.PHF    ',
     &                 'BACL-07.PHF ', 'BALD-06B.PHF', 'C2CHO.PHF   ',
     &                 'CCHO-R.PHF  ', 'CLONO2-1.PHF', 'CLONO2-2.PHF',
     &                 'COOH.PHF    ', 'GLY-07M.PHF ', 'GLY-07R.PHF ',
     &                 'H2O2.PHF    ', 'HCHOM-06.PHF', 'HCHOR-06.PHF',
     &                 'HNO3.PHF    ', 'HNO4-06.PHF ', 'HOCCHO.PHF  ',
     &                 'HONO-06.PHF ', 'HPALD.PHF   ', 'IC3ONO2.PHF ',
     &                 'MACR-06.PHF ', 'MEK-06B.PHF ', 'MGLY-06.PHF ',
     &                 'MVK-06.PHF  ', 'NO2-06.PHF  ', 'NO3NO-06.PHF',
     &                 'NO3NO2-6.PHF', 'NOA.PHF     ', 'O3O1D-06.PHF',
     &                 'O3O3P-06.PHF', 'PAA.PHF     ', 'PAN.PHF     '/

      data saprc22    /'NO2-06.PHF  ', 'NO3NO-06.PHF', 'NO3NO2-6.PHF',
     &                 'O3O1D-06.PHF', 'O3O3P-06.PHF', 'HONO-06.PHF ',
     &                 'HNO3.PHF    ', 'HNO4-06.PHF ', 'H2O2.PHF    ',
     &                 'HCHOR-13.PHF', 'HCHOM-13.PHF', 'PAN-11.PHF  ',
     &                 'GLY-I13R.PHF', 'GLY-I13M.PHF', 'BALD-11.PHF ',
     &                 'PPN-11.PHF  ', 'BACL-11.PHF ', 'COOH.PHF    ',
     &                 'CCHOR-13.PHF', 'GLALD-14.PHF', 'C2CHOabs.PHF',
     &                 'ACROL-16.PHF', 'ACET-06.PHF ', 'MEK-06.PHF  ',
     &                 'MACR-06.PHF ', 'MVK-16.PHF  ', 'AFGS.PHF    ',
     &                 'PAA.PHF     ', 'MGLY-13.PHF ', 'CRBNIT.PHF  ',
     &                 'IC3ONO2.PHF ', 'DIONO2.PHF  ', 'HPALDS.PHF  '/

      data clreac     /'CL2.PHF     ', 'CLNO2.PHF   ', 'CLN3_CLO.PHF',
     &                 'CLN3_CL.PHF ', 'HCOCL.PHF   ', 'HOCL.PHF    '/

      data clreac2    /'CLAD.PHF    '/

      data brreac     /'BR2.PHF     ', 'HOBR.PHF    ', 'BRO.PHF     ',
     &                 'BRNO2.PHF   ', 'BRNO3.PHF   ', 'CHBR3.PHF   ',
     &                 'CH2BR2.PHF  ', 'CHCL2BR.PHF ', 'CHCLBR2.PHF ',
     &                 'HCOBR.PHF   '/

      data brreac2    /'BRCL.PHF    '/

      data ioreac     /'CH2I2.PHF   ', 'CH2IBR.PHF  ', 'CH2ICL.PHF  ',
     &                 'CH3I.PHF    ', 'HOI.PHF     ', 'I2.PHF      ',
     &                 'INO2.PHF    ', 'INO3.PHF    ', 'IO.PHF      ',
     &                 'OIO.PHF     '/

      data ioreac2    /'ICL.PHF     ', 'IBR.PHF     '/

      data iupac04    /'O3_O1D.phf  ', 'O3_O3P.phf  ', 'HCHO_H.phf  ',
     &                 'HCHO_H2.phf ', 'HONO.phf    ', 'HO2NO2.phf  ',
     &                 'HNO3.phf    ', 'N2O5.phf    ', 'NTR.phf     ',
     &                 'PAN.phf     ', 'MGLY.phf    '/

      data cb6r4      /'NO2.PHF     ', 'O3O3P.PHF   ', 'O3O1D.PHF   ',
     &                 'H2O2.PHF    ', 'NO3_NO2.PHF ', 'NO3_NO.PHF  ',
     &                 'N2O5.PHF    ', 'HONO.PHF    ', 'HNO3.PHF    ',
     &                 'PNA.PHF     ', 'PAN.PHF     ', 'MEPX.PHF    ',
     &                 'NTR.PHF     ', 'FORM_R.PHF  ', 'FORM_M.PHF  ',
     &                 'ALD2_R.PHF  ', 'ALDX_R.PHF  ', 'KET.PHF     ',
     &                 'ACET.PHF    ', 'ISPD.PHF    ', 'GLYD.PHF    ',
     &                 'GLY_R.PHF   ', 'MGLY.PHF    '/

      data cb6r5      /'ALD2_Rr5.PHF', 'ALDX_Rr5.PHF', 'FORM_Rr5.PHF',
     &                 'FORM_Mr5.PHF', 'GLYDr5.PHF  ', 'GLY_Rr5.PHF '/

      data racm2      /'ACT_CO.phf  ', 'ACT_ACO3.phf', 'ALD.phf     ',
     &                 'BALD.phf    ', 'CH3CHO.phf  ',
     &                 'DCB1.phf    ', 'DCB2.phf    ', 'GLYF.phf    ',
     &                 'GLYH2.phf   ', 'GLYHX.phf   ', 'H2O2.phf    ',
     &                 'HCHO_RAD.phf', 'HCHO_MOL.phf', 'HKET.phf    ',
     &                 'HNO3.phf    ', 'HNO4.phf    ', 'HONO.phf    ',
     &                 'KET.phf     ', 'MACR.phf    ', 'MEK.phf     ',
     &                 'MGLY.phf    ', 'MVK.phf     ', 'NO2.phf     ',
     &                 'NO3_NO2.phf ', 'NO3_NO.phf  ', 'O3_O1D.phf  ',
     &                 'O3_O3P.phf  ', 'ONIT.phf    ', 'OP1.phf     ',
     &                 'PAA.phf     ', 'PANA.phf    ', 'PANB.phf    ',
     &                 'UALD.phf    '/

      data cb7r2      /'ALDX_R72.PHF', 'FORM_R72.PHF'/
*_______________________________________________________________________

* complete wavelength grid

      DO 5, iw = 1, nw - 1
         wc(iw) = (wl(iw) + wl(iw+1))/2.
         wu(iw) =  wl(iw+1)
 5    CONTINUE

*____________________________________________________________________________

C O2 + hv -> O + O
* reserve first position.  Cross section parameterization in Schumman-Runge and 
* Lyman-alpha regions are zenith-angle dependent, will be written in 
* subroutine sto2xs(nz,nw,xso2,nj,sj).
 
      j = 1
      jlabel(j) = 'O2 + hv -> O + O'

C O3 + hv ->  (both channels)
      CALL r1(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C NO2 + hv -> NO + O(3P)
      CALL r2(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C NO3 + hv ->  (both channels)
      CALL r3(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)
     
C N2O5 + hv -> (both channels)
      CALL r4(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C N2O + hv -> N2 + O(1D)
      CALL r44(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C HO2 + hv -> OH + O
      CALL r39(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C H2O2 + hv -> 2 OH
      CALL r8(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C HNO2 + hv -> OH + NO
      CALL r5(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C HNO3 + hv -> OH + NO2
      CALL r6(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C HNO4 + hv -> HO2 + NO2
      CALL r7(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH2O + hv -> (both channels)
      CALL r10(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3CHO + hv -> (all three channels)
      CALL r11(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C C2H5CHO + hv -> C2H5 + HCO
      CALL r12(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CHOCHO + hv -> Products
      CALL r13(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3COCHO + hv -> Products
      CALL r14(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3COCH3 + hv -> Products
      CALL r15(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3OOH + hv -> CH3O + OH
      CALL r16(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3ONO2 + hv -> CH3O + NO2
      CALL r17(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C PAN + hv -> Products
      CALL r18(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C ClOO + hv -> Products
      CALL r31(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C ClONO2 + hv -> Products
      CALL r45(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3Cl + hv -> Products
      CALL r30(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CCl2O + hv -> Products
      CALL r19(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CCl4 + hv -> Products
      CALL r20(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CClFO + hv -> Products
      CALL r21(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CCF2O + hv -> Products
      CALL r22(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2ClCFCl2 (CFC-113) + hv -> Products
      CALL r23(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2ClCF2Cl (CFC-114) + hv -> Products
      CALL r24(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF3CF2Cl (CFC-115) + hv -> Products
      CALL r25(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CCl3F (CFC-111) + hv -> Products
      CALL r26(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CCl2F2 (CFC-112) + hv -> Products
      CALL r27(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3CCl3 + hv -> Products
      CALL r29(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF3CHCl2 (HCFC-123) + hv -> Products
      CALL r32(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF3CHFCl (HCFC-124) + hv -> Products
      CALL r33(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3CFCl2 (HCFC-141b) + hv -> Products
      CALL r34(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3CF2Cl (HCFC-142b) + hv -> Products
      CALL r35(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF3CF2CHCl2 (HCFC-225ca) + hv -> Products
      CALL r36(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2ClCF2CHFCl (HCFC-225cb) + hv -> Products
      CALL r37(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CHClF2 (HCFC-22) + hv -> Products
      CALL r38(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C BrONO2 + hv -> Products
      CALL r46(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CH3Br + hv -> Products
      CALL r28(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CHBr3 + hv -> Products
      CALL r9(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF3Br (Halon-1301) + hv -> Products
      CALL r42(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2BrCF2Br (Halon-2402) + hv -> Products
      CALL r43(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2Br2 (Halon-1202) + hv -> Products
      CALL r40(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

C CF2BrCl (Halon-1211) + hv -> Products
      CALL r41(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

cgy
C ISPD + hv -> Products
      CALL r99(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel)

c SAPRC99 mechanism
      mchver = 'SAPRC99'
      do irxn=1,nsap99
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            saprc99(irxn),mchver)
c      write(*,*) 'J =',j, mchver, saprc99(irxn)
      enddo

c IUPAC 2002 data

c use riup to re-bin IUPAC data onto a common grid
c   the Huggins band data need gridw option 6
c

c O3 to O1D
c   Huggins band sigmas are binned (option 2 ==> inter3)
c      namsig = 'O3.sig1'
c      namphi = 'O3_O1D.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,2)
c   Hartley band sigmas are cell cenetered (option 1 ==> inter2)
c      namsig = 'O3.sig2'
c      namphi = 'O3_O1D.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,1)

c O3 to O3P
c   Huggins band sigmas are binned (option 2 ==> inter3)
c      namsig = 'O3.sig1'
c      namphi = 'O3_O3P.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,2)
c   Hartley band sigmas are cell cenetered (option 1 ==> inter2)
c      namsig = 'O3.sig2'
c      namphi = 'O3_O3P.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,1)

c HCHO sigmas are binned to 1 nm intervals
c   use gridw option 6 to get output every nm
c      namsig = 'HCHO.sig'
c      namphi = 'HCHO_H.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,2)
c
c      namsig = 'HCHO.sig'
c      namphi = 'HCHO_H2.phi'
c      call riup(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,namsig,
c     &          namphi,2)
c
c use rsap to calculate rates from re-binned IUPAC data
      mchver = 'IUPAC04'
      do irxn=1,niu
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            iupac04(irxn),mchver)
c      write(*,*) 'J =',j, mchver, iupac04(irxn)
      enddo

c CB6r4 mechanism and earlier
      mchver = 'CBX'
      do irxn=1,ncb6r4
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            cb6r4(irxn),mchver)
c      write(*,*) 'J =',j, mchver, cb6r4(irxn)
      enddo

c Iodine mechanism
      mchver = 'IODINE'
      do irxn=1,nio
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            ioreac(irxn),mchver)
c      write(*,*) 'J =',j, mchver, ioreac(irxn)
      enddo

c Bromine mechanism
      mchver = 'BROMINE'
      do irxn=1,nbr
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            brreac(irxn),mchver)
c      write(*,*) 'J =',j, mchver, brreac(irxn)
      enddo

c Chlorine mechanism
      mchver = 'CHLORINE'
      do irxn=1,ncl
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            clreac(irxn),mchver)
c      write(*,*) 'J =',j, mchver, clreac(irxn)
      enddo

c SAPRC07 mechanism
      mchver = 'SAPRC07'
      do irxn=1,nsap07
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            saprc07(irxn),mchver)
c      write(*,*) 'J =',j, mchver, saprc07(irxn)
      enddo

c CB6r5 and CB7r1 mechanisms
      mchver = 'CBX'
      do irxn=1,ncb6r5
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            cb6r5(irxn),mchver)
c      write(*,*) 'J =',j, mchver, cb6r5(irxn)
      enddo

c Added Iodine mechanism
      mchver = 'IODINE'
      do irxn=1,nio2
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            ioreac2(irxn),mchver)
c      write(*,*) 'J =',j, mchver, ioreac2(irxn)
      enddo

c Added Bromine mechanism
      mchver = 'BROMINE'
      do irxn=1,nbr2
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            brreac2(irxn),mchver)
c      write(*,*) 'J =',j, mchver, brreac2(irxn)
      enddo

c Added Chlorine mechanism
      mchver = 'CHLORINE'
      do irxn=1,ncl2
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            clreac2(irxn),mchver)
c      write(*,*) 'J =',j, mchver, clreac2(irxn)
      enddo

c RACM2 mechanism
      mchver = 'RACM2'
      do irxn=1,nracm2
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            racm2(irxn),mchver)
c      write(*,*) 'J =',j, mchver,  racm2(irxn)
      enddo

c SAPRC22 mechanism
      mchver = 'SAPRC22'
      do irxn=1,nsap22
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            saprc22(irxn),mchver)
c      write(*,*) 'J =',j, mchver, saprc22(irxn)
      enddo

c CB7r2 mechanism
      mchver = 'CBX'
      do irxn=1,ncb7r2
        CALL rsap(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,
     &            cb7r2(irxn),mchver)
c      write(*,*) 'J =',j, mchver, cb7r2(irxn)
      enddo

cgy
************************************************************************

      IF (j .GT. kj) then
        write(*,*) 'In RN j > kj',j, kj
        STOP 
      ENDIF
      RETURN
      END
