      subroutine aprsbt(xlat, iday, lprint, aptmp)
c
c***********************************************************************
c
c     apritm 
c
c     september, 2001  by charlie wellemeyer ssai
c
c     purpose
c        determine a priori temperature profile for a given day and latitude
c
c     modification
c        none
c
c     variables
c       name      type  i/o   description
c       ----      ----  ---   ------------
c
c      arguments
c       xlat       r*4    i    latitude
c       iday       i*4    i    day of year
c       aptmp(13)  r*4    o    a priori temperature profile
c
c      internal
c       l1         i*4         latitude index for lower interpolation node
c       l2         i*4         latitude index for upper interpolation node
c       fracl      r*4         interpolation factor for latitude
c       cntrs(18)  r*4         center latitudes of climatological bands
c       m1         i*4         month index for previous interpolation node
c       m2         i*4         month index for subsequent interpolation node
c       fracm      r*4         interpolation factor for month
c
c***********************************************************************
c
      implicit none
c
c     -- input parameters
c
      real xlat
      integer iday 
      logical lprint(30)
c
c     -- internal parameters
c
      real xmon, fracm, fracl
      integer m1, m2, l1, l2, i, lyr
      real cntrs(18)
      data cntrs/-85.0,-75.0,-65.0,-55.0,-45.0,-35.0,-25.0,
     1     -15.0,-5.0,5.0,15.0,25.0,35.0,45.0,55.0,65.0,75.0,85.0/
c
c     -- output parameters
c
      real aptmp(13)
c
      include 'climat.com'
c
c     -- compute indeces for bracketing months and latitudes
c
      l1 = (xlat + 85.0) / 10.0 + 1.0
      if(l1.le.0) l1 = 1
      if(l1.ge.18) l1 = 17
      l2 = l1 + 1
      fracl = (xlat - cntrs(l1)) / (cntrs(l2) - cntrs(l1))
c
      xmon = (iday + 15.25) / 30.5
      m1 = xmon
      m2 = m1 + 1
      fracm = xmon - m1
      if(m1.eq.0) m1 = 12
      if(m2.eq.13) m2 = 1
c
c  perform bi-linear interpolation in latitude and month
c
      do 100 lyr=1,13
        aptmp(lyr)=(1.0-fracl)*(1.0-fracm)*climtm(lyr,l1,m1) +
     1             fracl*(1.0-fracm)*climtm(lyr,l2,m1) +
     2             fracl*fracm*climtm(lyr,l2,m2) +
     3             (1.0-fracl)*fracm*climtm(lyr,l1,m2)
  100 continue
c
      if (lprint(22)) write (6,1000) xlat,iday,l1,l2,fracl,
     1 m1,m2,fracm,l1,m1,(climtm(i,l1,m1),i=1,13),l2,m1,
     2 (climtm(i,l2,m1),i=1,13),l1,m2,(climtm(i,l1,m2),i=1,13),
     3 l2,m2,(climtm(i,l2,m2),i=1,13),aptmp
c
      return
c
c  format statements
c
1000  format (/'Subroutine aprioz'/'Input: xlat = ',f7.1,
     1 ' iday  =',i7,'  lat ind and frac: ',2i3,f5.2,
     2 '  mnth ind and frac: ',2i3,f5.2,/,
     3 ' bracketting profiles in lat and month: ',
     4 4(/1x,2i3,13f6.1),/,'Output:   Apriori profile:',
     5 /,13f6.1)
c
      end
