#include <misc.h>
#include <params.h>

      subroutine trcplk(tint    ,tlayr   ,tplnke  ,emplnk  ,abplnk1 , 1
     $                  abplnk2 )
c----------------------------------------------------------------------
c
c   Calculate Planck factors for absorptivity and emissivity of
c   CH4, N2O, CFC11 and CFC12
c
C   Planck function and derivative evaluated at the band center.
C
C-------------------------Code History----------------------------------
C
C Original version:  J. Kiehl, Nov 1994 
C Standardized:      T. Acker, Feb 1996
C Reviewed:          J. Kiehl, Apr 1996     
C 
c-----------------------------------------------------------------------
c
c $Id: trcplk.F,v 1.1 1998/04/01 07:22:46 ccm Exp $
c
C-----------------------------------------------------------------------
#include <implicit.h>
C------------------------------Parameters-------------------------------
#include <prgrid.h>
C------------------------------Arguments--------------------------------
C
C Input arguments
C
      real tint(plond,plevp)   ! interface temperatures
      real tlayr(plond,plevp)  ! k-1 level temperatures
      real tplnke(plond)       ! Top Layer temperature
c
c output arguments
c
      real emplnk(14,plond)         ! emissivity Planck factor
      real abplnk1(14,plond,plevp)  ! non-nearest layer Plack factor
      real abplnk2(14,plond,plevp)  ! nearest layer factor
c
C--------------------------Local Variables------------------------------
c
      integer wvl                   ! wavelength index
      integer i,k                   ! loop counters
c
      real f1(14)                   ! Planck function factor
      real f2(14)                   !        "
      real f3(14)                   !        "
c
C--------------------------Data Statements------------------------------
c
      data f1 /5.85713e8,7.94950e8,1.47009e9,1.40031e9,1.34853e8,
     $         1.05158e9,3.35370e8,3.99601e8,5.35994e8,8.42955e8,
     $         4.63682e8,5.18944e8,8.83202e8,1.03279e9/
      data f2 /2.02493e11,3.04286e11,6.90698e11,6.47333e11,
     $         2.85744e10,4.41862e11,9.62780e10,1.21618e11,
     $         1.79905e11,3.29029e11,1.48294e11,1.72315e11,
     $         3.50140e11,4.31364e11/
      data f3 /1383.0,1531.0,1879.0,1849.0,848.0,1681.0,
     $         1148.0,1217.0,1343.0,1561.0,1279.0,1328.0,
     $         1586.0,1671.0/
c
C-----------------------------------------------------------------------
c
c Calculate emissivity Planck factor
c
      do wvl = 1,14
         do i = 1,plon
            emplnk(wvl,i) = f1(wvl)/
     $                   (tplnke(i)**4.0*(exp(f3(wvl)/tplnke(i))-1.0))
         end do
      end do
c
c Calculate absorptivity Planck factor for tint and tlayr temperatures
c
      do wvl = 1,14
         do k = 1, plevp
            do i = 1, plon
c
c non-nearlest layer function
c
               abplnk1(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tint(i,k)))
     $              /(tint(i,k)**5.0*(exp(f3(wvl)/tint(i,k))-1.0)**2.0)
c
c nearest layer function
c
               abplnk2(wvl,i,k) = (f2(wvl)*exp(f3(wvl)/tlayr(i,k)))
     $            /(tlayr(i,k)**5.0*(exp(f3(wvl)/tlayr(i,k))-1.0)**2.0)
            end do
         end do
      end do
c
      return
c
      end