      SUBROUTINE CCO2GR(RCO2)

C****************************************************************************
C*                                                                          *
C*                       SUBROUTINE CCO2GR                                  *
C*                                                                          *
C****************************************************************************
C
C  to calculate parameterization coeficients for 15 um CO2 band cooling
C  rate calculation for arbitrary CO2 volume mixing ratio (with height
c  variation as of the basic CO2 profile for 360 ppm) in a range of 150-720ppm.
c  Coefficients are calculated for atmosphere layer from the pressure scale
C   height x=2 up to x=16.5. Irregular vertical grid is used to acconut for
C   internal heat exchange within "LTE layer" (x=0-12.5)
C  ***** Important!!!!!*****
C  From x=2 up to x=13.75 coeficients can be calculated only for a vertical
C  grid with a step of 0.25. Eventually, any vertical step could be used for
C  atmospheric layer atmosphere the level of x=13.75. However, to do it,
C  some modification is needed. No coeficients are needed to calculate
C  cooling rates above x=16.5
C
C                                    May, 1996.  V.I. Fomichev.

C Called by MAMRAD
C Calls A18LIN and A18INT


C input:
C  RCO2 - CO2 volume mixing ration in the troposphere
C  initial data from BLOCK DATA PCO2O3 coming through common blocks

C output: parameterization coefficients for both, the matrix parameterization
C         (is used between x=2 and 12.5) and reccurence formula.
C         Passing to other subroutines through common block CO2CFG.
C  AMAT,BMAT(43,9) - coefficients for the matrix parameterization
C  AL(17) - coeficients for the reccurence formula. Note that starting up
C           from x=13.75, these coefficients are identical to escape functions
C           which could be calculated at any arbitrary vertical grid.
C           So that starting up from this level any arbitrary vertical grid
C           could be used.

      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      COMMON /CO2CFG/ AMAT(43,9),BMAT(43,9),AL(17)

C data from subroutine PCO2O3

      common /PIRCO2/ co2vp(67), co2cl(67)
      common /PIRLTE/ a150(43,9),b150(43,9), a360(43,9),b360(43,9),
     1                a540(43,9),b540(43,9), a720(43,9),b720(43,9),
     2                co2o(4)
      common /PIRMGR/ IG(9)
      common /PIRNE/ uco2ro(51),alo(51),
     1               cor150(6),cor360(6),cor540(6),cor720(6),uco2co(6)


c auxiliary arrays

      real uref(4), co2int(4)

c interplolate coefficients for the matrix paramerization:

      do 1 i = 1,43
      do 1 j = 1,9
      if((i.le.5).and.(j.eq.2)) goto 1
      isgn = int(sign(1.,a150(i,j))+sign(1.,a360(i,j))+
     +           sign(1.,a540(i,j))+sign(1.,a720(i,j)))
      co2int(1)=a150(i,j)/co2o(1)
      co2int(2)=a360(i,j)/co2o(2)
      co2int(3)=a540(i,j)/co2o(3)
      co2int(4)=a720(i,j)/co2o(4)
      if(isgn.eq.-4) then
      co2int(1) = log(-co2int(1))
      co2int(2) = log(-co2int(2))
      co2int(3) = log(-co2int(3))
      co2int(4) = log(-co2int(4))
       a = -exp(a18lin(RCO2,co2o,co2int,1,4))
      else if (isgn.eq.4) then
      co2int(1) = log(co2int(1))
      co2int(2) = log(co2int(2))
      co2int(3) = log(co2int(3))
      co2int(4) = log(co2int(4))
       a = exp(a18lin(RCO2,co2o,co2int,1,4))
      else
      call a18int(co2o,co2int,RCO2,a,4,1)
      end if
       AMAT(i,j)=a*RCO2

      isgn = int(sign(1.,b150(i,j))+sign(1.,b360(i,j))+
     +           sign(1.,b540(i,j))+sign(1.,b720(i,j)))
      co2int(1)=b150(i,j)/co2o(1)
      co2int(2)=b360(i,j)/co2o(2)
      co2int(3)=b540(i,j)/co2o(3)
      co2int(4)=b720(i,j)/co2o(4)
      if(isgn.eq.-4) then
      co2int(1) = log(-co2int(1))
      co2int(2) = log(-co2int(2))
      co2int(3) = log(-co2int(3))
      co2int(4) = log(-co2int(4))
       a = -exp(a18lin(RCO2,co2o,co2int,1,4))
      else if (isgn.eq.4) then
      co2int(1) = log(co2int(1))
      co2int(2) = log(co2int(2))
      co2int(3) = log(co2int(3))
      co2int(4) = log(co2int(4))
       a = exp(a18lin(RCO2,co2o,co2int,1,4))
      else
      call a18int(co2o,co2int,RCO2,a,4,1)
      end if
       BMAT(i,j)=a*RCO2
    1 continue

c calculate coeeficients for the reccurence formula:
c between x=12.5 and 13.75 these coefficients (al) are calculated using
c correction to escape function. Starting up from x=14.00 parameterization
c coeficients equal escape function.

      do 2 i=1,6
      uco2 = uco2co(i)*RCO2/3.6e-4
      a = a18lin(uco2,uco2ro,alo,1,51)
      co2int(1)=cor150(i)
      co2int(2)=cor360(i)
      co2int(3)=cor540(i)
      co2int(4)=cor720(i)
      uref(1) =uco2co(i)*150./360.
      uref(2) =uco2co(i)
      uref(3) =uco2co(i)*540./360.
      uref(4) =uco2co(i)*720./360.
      cor = a18lin(uco2,uref,co2int,1,4)
      AL(i)=exp(cor+a)
    2 continue

      do 3 i=7,17
      uco2 = co2cl(i+50)*RCO2/3.6e-4
      a = a18lin(uco2,uco2ro,alo,1,51)
      AL(i)=exp(a)
    3 continue

      return
      end
