program printsst
C-----------------------------------------------------------------------
C
C Original Purpose:
C
C Time interpolate sea surface temps. to current time, reading in new 
C monthly data if necessary.
C
C The cpp SPMD definition provides for the funnelling of all program i/o
C through the master processor. Processor 0 either reads restart/history
C data from the disk and distributes it to all processors, or collects
C data from all processors and writes it to disk.
C 
C Modified for printing out SST fields
C
C---------------------------Code history--------------------------------
C
C Original version:  L. Bath
C Standardized:      L. Buja, June 1992
C                    T. Acker, March 1996
C Reviewed:          J. Hack, B. Boville, August 1992
C Reviewed:          B. Boville, April 1996
C Modified:          Zong-Liang Yang, April 2000
C
C-----------------------------------------------------------------------
c
c $Id: sstint.F,v 1.1.1.1 1996/05/21 17:47:14 ccm Exp $
c $Author: ccm $
c
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.1.1 1996/05/21 17:46:57 ccm Exp $
c $Author: ccm $
c
      implicit none

C------------------------------Arguments--------------------------------
C
C Input arguments
C
      integer iunit              ! Logical unit number
C
C------------------------------Parameters-------------------------------
c
c $Id: pmgrid.h,v 1.1.1.1 1996/05/21 17:47:28 ccm Exp $
c $Author: ccm $
c
C
C Grid point resolution parameters
C
      integer plon       ! number of longitudes
      integer plev       ! number of vertical levels
      integer plat       ! number of latitudes
      integer pcnst      ! number of constituents (including water vapor)
      integer plevmx     ! number of subsurface levels
C
      integer plevp      ! plev + 1
      integer nxpt       ! no.of pts outside active domain of interpolant
      integer jintmx     ! number of extra latitudes in polar region
      integer plond      ! slt extended domain longitude
      integer platd      ! slt extended domain lat.
C
      integer plevd      ! fold plev,pcnst indices into one
      integer i1         ! model starting longitude index
      integer j1         ! model starting latitude index
      integer numbnd     ! no.of latitudes passed N and S of forecast lat
C
      integer beglat     ! beg. index for latitudes owned by a given proc
      integer endlat     ! end. index for latitudes owned by a given proc
      integer beglatex   ! extended grid beglat
      integer endlatex   ! extended grid endlat
      integer numlats    ! number of latitudes owned by a given proc
C
      logical masterproc ! Flag for (iam eq 0)
C
      parameter(plon   = 128)
      parameter(plev   = 18)
      parameter(plat   = 64)
      parameter(pcnst  = 1)
      parameter(plevmx = 4)
      parameter(plevp  = plev + 1)
      parameter(nxpt   = 1)
      parameter(jintmx = 1)
      parameter(plond  = plon + 1 + 2*nxpt)
      parameter(platd  = plat + 2*nxpt + 2*jintmx)
      parameter(plevd  = plev*(3 + pcnst))
      parameter(i1     = 1 + nxpt)
      parameter(j1     = 1 + nxpt + jintmx)
      parameter(numbnd = nxpt + jintmx)
C

      parameter(beglat   = 1)
      parameter(endlat   = plat)
      parameter(numlats  = plat)
      parameter(beglatex = 1)
      parameter(endlatex = platd)
      parameter(masterproc = .true.)

C

C-----------------------------------------------------------------------
c
c $Id: pagrid.h,v 1.1.1.1 1996/05/21 17:47:28 ccm Exp $
c $Author: ccm $
c
C
C Model grid point resolution parameters.
C
      integer plnlv     ! Length of multilevel field slice
      integer plndlv    ! Length of multilevel 3-d field slice
      integer pbflnb    ! Length of buffer 1
      integer pbflna    ! Length of buffer 2
      integer pbflnm1   ! Length of buffer m1
C
      integer pflenb    ! Length of buffer 1, padded for unblocked I/O
      integer pflena    ! Length of buffer 2, padded for unblocked I/O
      integer plenalcl  ! Length of buffer 2, needed in SPEGRD
      integer ptifld    ! No. of fields on time-invariant bndary dataset
      integer ptvsfld   ! No. of fields on time-variant boundary dataset
C
      integer ptvofld   ! Number of fields on ozone dataset
      integer plenhi    ! Length of integer header record
      integer plenhc    ! Length of character header record
      integer plenhr    ! Length of real header record
      integer plexbuf   ! Len. of communication buffer for flux coupling
C
      integer ptapes    ! Maximum number of history tapes allowed
      integer pflds     ! Number of fields in master field list
      integer ptileni   ! Length of time-invariant integer header
      integer ptilenc   ! Length of time-invariant character header
      integer ptvoleni  ! Length of ozone integer header
C
      integer ptvolenc  ! Length of ozone character header
      integer ptvsleni  ! Length of time-variant integer header
      integer ptvslenc  ! Length of time-variant character header
      integer plenhis   ! Length of integer header scalars
      integer plenhcs   ! Length of character header scalars
C
      integer ptilenis  ! Length of time-invariant integer scalars
      integer ptilencs  ! Length of time-invariant character scalars
      integer ptolenis  ! Length of ozone integer header scalars
      integer ptolencs  ! Length of ozone character header scalars
      integer ptslenis  ! Length of time-variant integer header scalars
      integer ptslencs  ! Length of time-variant character header scalars
C
      parameter(plnlv=plon*plev,plndlv=plond*plev)
C
C In pbflnb, 9 multi-level fields include the plev levels of plol and
C plos. 2 multi-level fields are pcnst-dependent.
C
      parameter(pbflnb=(7 + 2*pcnst)*plndlv + (5+pcnst)*plond)
C
C In pbflna, there are 3 multi-level and 3 single-level fields.
C
      parameter(pbflna = (3 + 3*plev)*plond)
      parameter(pbflnm1 = (1 + 2*plev)*plond)
      parameter(pflenb = ((pbflnb + pbflnm1)/512 + 1)*512)
      parameter(pflena = (pbflna/512 + 1)*512)
C
C plenalcl is the buffer size as required in SPEGRD.  
C Only pflena is read/written.
C
      parameter(plenalcl = ((pbflna + 2*plndlv + plond)/512 + 1)*512)
      parameter(plexbuf = (((1 + 6*plev)*plond)/512+1)*512)
      parameter(ptapes = 6)
C
C 8 fields in master list are pcnst-dependent 2 fields occur only if pcnst > 1.
C Extra "1" is for sea ice thickness (COUP_SOM).  18 BATS fields.
C 90 CCM3 single + multi-level fields.  plevmx sub-surface flds
C
      parameter(pflds=90+8*pcnst+2*(pcnst-1)+plevmx+18+1)
C
C Add 2 extra fields for tvbds     6 April 1995
C
      parameter(ptifld = 11, ptvsfld = 3, ptvofld = 2)
C
C There are 37 scalar words in the integer header and 89 scalar words
C in the character header
C
      parameter(plenhis=37)
      parameter(plenhcs=89)
C
      parameter(plenhi=plenhis+3*pflds)
      parameter(plenhc=plenhcs+2*pflds)
      parameter(plenhr=3*(2*plev + 1) + 2*plat)
      parameter(ptilenis=plenhis) 
      parameter(ptilencs=plenhcs)
C
      parameter(ptileni=ptilenis+3*ptifld) 
      parameter(ptilenc=ptilencs+2*ptifld)
      parameter(ptolenis=plenhis) 
      parameter(ptolencs=plenhcs)
      parameter(ptvoleni=ptolenis+3*ptvofld)
C
      parameter(ptvolenc=ptolencs+2*ptvofld)
      parameter(ptslenis=plenhis) 
      parameter(ptslencs=plenhcs)
      parameter(ptvsleni=ptslenis+3*ptvsfld)
      parameter(ptvslenc=ptslencs+2*ptvsfld)
C

C-----------------------------------------------------------------------
c
c $Id: parsst.h,v 1.1.1.1 1996/05/21 17:47:03 ccm Exp $
c $Author: ccm $
c
      real tsice                  ! Freezing point of sea ice degrees C
      parameter (tsice = -1.7999) ! Use this with new global STR sst data

C-----------------------------------------------------------------------

C------------------------------Commons----------------------------------
c
c $Id: comctl.h,v 1.1.1.1 1996/05/21 17:46:45 ccm Exp $
c $Author: ccm $
c
C
C Model control variables
C
      common/comctc/settrace
      character*4 settrace

      common/comctl/itsst   ,nsrest  ,iradsw  ,iradlw  ,iradae  ,
     $              anncyc  ,nlend   ,nlres   ,nlhst   ,lbrnch  ,
     $              aeres   ,ozncyc  ,sstcyc  ,dodiavg ,aeregen ,
     $              cpuchek ,incorhst,incorbuf,incorrad

      integer itsst    ! Sea surf. temp. update freq. (iters)
      integer nsrest   ! Restart flag
      integer iradsw   ! Iteration frequency for shortwave radiation
      integer iradlw   ! Iteration frequency for longwave radiation
      integer iradae   ! Iteration freq. for absorptivity/emissivity

      logical anncyc   ! Do annual cycle (otherwise perpetual)
      logical nlend    ! Flag for end of run
      logical nlres    ! If true, continuation run
      logical nlhst    ! If true, regeneration run
      logical lbrnch   ! If true, branch run
      logical aeres    ! If true, a/e data will be stored on restart file
      logical ozncyc   ! If true, cycle ozone dataset
      logical sstcyc   ! If true, cycle sst dataset
      logical dodiavg  ! true => diurnal averaging
      logical aeregen  ! true => absor/emis part of regeneration data
      logical cpuchek  ! If true, check remaining cpu time each writeup
      logical incorhst ! true => keep history buffer in-core
      logical incorbuf ! true => keep model buffers in-core
      logical incorrad ! true => keep abs/ems buffer in-core
C

C-----------------------------------------------------------------------
	integer ii
c
c $Id: comsst.h,v 1.1.1.1 1996/05/21 17:46:48 ccm Exp $
c $Author: ccm $
c
C
C Sea-surface temperature values
C
      common/comsst/sst(plond,plat),sstm(plond,plat,2),ldoy,ndoy,nyr
C
      real sst    ! Time interpolated sst values
      real sstm   ! SST values for the two months bracketing current day
      real ldoy   ! Day of year for prior read; incl. year if multi-year dataset
      real ndoy   ! Day of year for next  read; incl. year if multi-year dataset
      integer nyr ! Year number from current date
C

C-----------------------------------------------------------------------

C-----------------------------------------------------------------------
c
c $Id: comtim.h,v 1.1.1.1 1996/05/21 17:46:48 ccm Exp $
c $Author: ccm $
c
C
C Model time variables
C
      common/comtim/calday  ,dtime   ,twodt   ,divdampn,nrstrt  ,
     $              nstep   ,nstepr  ,nestep  ,nelapse ,nstop   ,
     $              mdbase  ,msbase  ,mdcur   ,mscur   ,mbdate  ,
     $              mbsec   ,mcdate  ,mcsec   ,nndbas  ,nnsbas  ,
     $              nnbdat  ,nnbsec  ,doabsems,dosw    ,dolw    
C
      real calday       ! Current calendar day = julian day + fraction
      real dtime        ! Time step in seconds (delta t)
      real twodt        ! 2 * delta t 
      real divdampn     ! Number of days to invoke divergence damper
      integer nrstrt    ! Starting time step of restart run (constant) 
      integer nstep     ! Current time step
      integer nstepr    ! Current time step of restart (updated w/nstep)
      integer nestep    ! Time step on which to stop run
      integer nelapse   ! Requested elapsed time for model run
      integer nstop     ! nestep + 1
      integer mdbase    ! Base day of run
      integer msbase    ! Base seconds of base day
      integer mdcur     ! Current day of run
      integer mscur     ! Current seconds of current day
      integer mbdate    ! Base date of run (yymmdd format)
      integer mbsec     ! Base seconds of base date
      integer mcdate    ! Current date of run (yymmdd format)
      integer mcsec     ! Current seconds of current date
      integer nndbas    ! User input base day
      integer nnsbas    ! User input base seconds of input base day
      integer nnbdat    ! User input base date (yymmdd format)
      integer nnbsec    ! User input base seconds of input base date
      logical doabsems  ! True => abs/emiss calculation this timestep
      logical dosw      ! True => shortwave calculation this timestep
      logical dolw      ! True => longwave calculation this timestep
C

C---------------------------Local variables-----------------------------
C
      real fldsin(ptvsfld*plon)  ! Array for input data record
      real hdr(plenhr)           ! Array for real header record
C
      integer hdi(ptslenis)      ! Array for integer header scalars
      integer mtvfl(3,ptvsfld)   ! Mflds for boundary dataset header
      integer readl              ! Length of data buffer - 2  (local)
      integer nlonwl             ! Number of longitude points (local)
      integer nfldhl             ! Number of fields on header (local)
C
      integer ncdatel            ! Current date               (local)
      integer ncsecl             ! Current seconds            (local)
      integer n,i,j              ! Indices
      integer ier                ! Error flag from rdhdr
      integer lat                ! Latitude index
C
      real flat                  ! Lat, lon pair read from boundary
      real rdum1                 ! Dummy var. for number of longintudes
      real fact                  ! Interpolation factor
      real cday                  ! Calendar day
C
      character*8 hdc(ptslencs)  ! Array for character header scalars
      character*8 mctvfl(2,ptvsfld)  ! mcflds for sst dataset header
C

C
C------------------------------Externals--------------------------------
C
       external rdharr      ! read array from history file 
       external prnthd      ! print header for history file
       external bnddyi      ! convert date/seconds to floating pt. num.
       external rdhdr       ! read header from history file
       external endrun      ! end run
       external mkslic      ! read var. info. from data file
C
C-----------------------------------------------------------------------
C
C     
      character*80 fsurdat      ! surface data file name
C
      iunit   = 77
      fsurdat='tvbds.t42.ccm3'
      open (file=fsurdat,unit=iunit,form='unformatted',
     $      status='unknown')

	do ii=1,12
        call t_startf('oznsst')
        call rdhdr(iunit,ptvsleni ,ptslenis ,ptvslenc ,ptslencs,
     $             plenhr  ,hdi      ,hdc      ,hdr      ,mtvfl   ,
     $             mctvfl  ,ier)
         call t_stopf('oznsst')
         ncdatel = hdi(26)
         ncsecl = hdi(27)
         nyr = ncdatel/10000
         readl = hdi(6) - 2
         nlonwl = hdi(10)
         nfldhl = hdi(16)
c
 	write(6,*) ncdatel,ncsecl,nyr,readl,nlonwl,nfldhl,mtvfl
c	write(6,*) hdi
c	write(6,*) hdc
c	write(6,*) hdr
c
         do n=1,plat
           call rdharr(iunit   ,readl   ,flat    ,rdum1    ,fldsin  )
           lat = nint(flat)
           call mkslic('SST     ',sstm(1,lat,1),1       ,
     $                    mtvfl   ,mctvfl  ,nfldhl  ,
     $                  fldsin  ,ptvsfld*plon ,plon ,nlonwl,plond   ,
     $                  plev    )
        end do
      do j=1,plat
         do i=1,plon
               sst(i,j) = sstm(i,j,1)
         end do
      end do
	write(6,*) 'month = ',ii,' nyr=',nyr
	write(6,*) sst
	enddo

	stop
	end

      subroutine rdhdr(kunit   ,lenhi   ,lenhis  ,lenhc   ,lenhcs  ,
     $                 lenhr   ,hedi    ,hedc    ,hedr    ,mhflds  ,
     $                 mchflds ,kerr    )
C-----------------------------------------------------------------------
C
C Read the history file header.
C
C---------------------------Code history--------------------------------
C
C Original version:  CCM1
C Standardized:      L. Bath, June 1992
C                    T. Acker, March 1996
C
C-----------------------------------------------------------------------
c
c $Id: rdhdr.F,v 1.1.1.1 1996/05/21 17:47:09 ccm Exp $
c $Author: ccm $
c
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.1.1 1996/05/21 17:46:57 ccm Exp $
c $Author: ccm $
c
      implicit none

C------------------------------Parameters-------------------------------
c
c $Id: pmgrid.h,v 1.1.1.1 1996/05/21 17:47:28 ccm Exp $
c $Author: ccm $
c
C
C Grid point resolution parameters
C
      integer plon       ! number of longitudes
      integer plev       ! number of vertical levels
      integer plat       ! number of latitudes
      integer pcnst      ! number of constituents (including water vapor)
      integer plevmx     ! number of subsurface levels
C
      integer plevp      ! plev + 1
      integer nxpt       ! no.of pts outside active domain of interpolant
      integer jintmx     ! number of extra latitudes in polar region
      integer plond      ! slt extended domain longitude
      integer platd      ! slt extended domain lat.
C
      integer plevd      ! fold plev,pcnst indices into one
      integer i1         ! model starting longitude index
      integer j1         ! model starting latitude index
      integer numbnd     ! no.of latitudes passed N and S of forecast lat
C
      integer beglat     ! beg. index for latitudes owned by a given proc
      integer endlat     ! end. index for latitudes owned by a given proc
      integer beglatex   ! extended grid beglat
      integer endlatex   ! extended grid endlat
      integer numlats    ! number of latitudes owned by a given proc
C
      logical masterproc ! Flag for (iam eq 0)
C
      parameter(plon   = 128)
      parameter(plev   = 18)
      parameter(plat   = 64)
      parameter(pcnst  = 1)
      parameter(plevmx = 4)
      parameter(plevp  = plev + 1)
      parameter(nxpt   = 1)
      parameter(jintmx = 1)
      parameter(plond  = plon + 1 + 2*nxpt)
      parameter(platd  = plat + 2*nxpt + 2*jintmx)
      parameter(plevd  = plev*(3 + pcnst))
      parameter(i1     = 1 + nxpt)
      parameter(j1     = 1 + nxpt + jintmx)
      parameter(numbnd = nxpt + jintmx)
C

      parameter(beglat   = 1)
      parameter(endlat   = plat)
      parameter(numlats  = plat)
      parameter(beglatex = 1)
      parameter(endlatex = platd)
      parameter(masterproc = .true.)

C

C-----------------------------------------------------------------------
c
c $Id: pagrid.h,v 1.1.1.1 1996/05/21 17:47:28 ccm Exp $
c $Author: ccm $
c
C
C Model grid point resolution parameters.
C
      integer plnlv     ! Length of multilevel field slice
      integer plndlv    ! Length of multilevel 3-d field slice
      integer pbflnb    ! Length of buffer 1
      integer pbflna    ! Length of buffer 2
      integer pbflnm1   ! Length of buffer m1
C
      integer pflenb    ! Length of buffer 1, padded for unblocked I/O
      integer pflena    ! Length of buffer 2, padded for unblocked I/O
      integer plenalcl  ! Length of buffer 2, needed in SPEGRD
      integer ptifld    ! No. of fields on time-invariant bndary dataset
      integer ptvsfld   ! No. of fields on time-variant boundary dataset
C
      integer ptvofld   ! Number of fields on ozone dataset
      integer plenhi    ! Length of integer header record
      integer plenhc    ! Length of character header record
      integer plenhr    ! Length of real header record
      integer plexbuf   ! Len. of communication buffer for flux coupling
C
      integer ptapes    ! Maximum number of history tapes allowed
      integer pflds     ! Number of fields in master field list
      integer ptileni   ! Length of time-invariant integer header
      integer ptilenc   ! Length of time-invariant character header
      integer ptvoleni  ! Length of ozone integer header
C
      integer ptvolenc  ! Length of ozone character header
      integer ptvsleni  ! Length of time-variant integer header
      integer ptvslenc  ! Length of time-variant character header
      integer plenhis   ! Length of integer header scalars
      integer plenhcs   ! Length of character header scalars
C
      integer ptilenis  ! Length of time-invariant integer scalars
      integer ptilencs  ! Length of time-invariant character scalars
      integer ptolenis  ! Length of ozone integer header scalars
      integer ptolencs  ! Length of ozone character header scalars
      integer ptslenis  ! Length of time-variant integer header scalars
      integer ptslencs  ! Length of time-variant character header scalars
C
      parameter(plnlv=plon*plev,plndlv=plond*plev)
C
C In pbflnb, 9 multi-level fields include the plev levels of plol and
C plos. 2 multi-level fields are pcnst-dependent.
C
      parameter(pbflnb=(7 + 2*pcnst)*plndlv + (5+pcnst)*plond)
C
C In pbflna, there are 3 multi-level and 3 single-level fields.
C
      parameter(pbflna = (3 + 3*plev)*plond)
      parameter(pbflnm1 = (1 + 2*plev)*plond)
      parameter(pflenb = ((pbflnb + pbflnm1)/512 + 1)*512)
      parameter(pflena = (pbflna/512 + 1)*512)
C
C plenalcl is the buffer size as required in SPEGRD.  
C Only pflena is read/written.
C
      parameter(plenalcl = ((pbflna + 2*plndlv + plond)/512 + 1)*512)
      parameter(plexbuf = (((1 + 6*plev)*plond)/512+1)*512)
      parameter(ptapes = 6)
C
C 8 fields in master list are pcnst-dependent 2 fields occur only if pcnst > 1.
C Extra "1" is for sea ice thickness (COUP_SOM).  18 BATS fields.
C 90 CCM3 single + multi-level fields.  plevmx sub-surface flds
C
      parameter(pflds=90+8*pcnst+2*(pcnst-1)+plevmx+18+1)
C
C Add 2 extra fields for tvbds     6 April 1995
C
      parameter(ptifld = 11, ptvsfld = 3, ptvofld = 2)
C
C There are 37 scalar words in the integer header and 89 scalar words
C in the character header
C
      parameter(plenhis=37)
      parameter(plenhcs=89)
C
      parameter(plenhi=plenhis+3*pflds)
      parameter(plenhc=plenhcs+2*pflds)
      parameter(plenhr=3*(2*plev + 1) + 2*plat)
      parameter(ptilenis=plenhis) 
      parameter(ptilencs=plenhcs)
C
      parameter(ptileni=ptilenis+3*ptifld) 
      parameter(ptilenc=ptilencs+2*ptifld)
      parameter(ptolenis=plenhis) 
      parameter(ptolencs=plenhcs)
      parameter(ptvoleni=ptolenis+3*ptvofld)
C
      parameter(ptvolenc=ptolencs+2*ptvofld)
      parameter(ptslenis=plenhis) 
      parameter(ptslencs=plenhcs)
      parameter(ptvsleni=ptslenis+3*ptvsfld)
      parameter(ptvslenc=ptslencs+2*ptvsfld)
C

C------------------------------Arguments--------------------------------
C
C Input arguments
C
      integer kunit           ! History file unit
      integer lenhi           ! Declared length of integer header hedi
      integer lenhis          ! Length of integer scalar portion
      integer lenhc           ! Declared length of character header hedc
      integer lenhcs          ! Length of character scalar portion
      integer lenhr           ! Declared length of real header hedr
C
C Output arguments
C
      integer hedi(*)         ! Array to store integer header record
      character*8 hedc(*)     ! Character header record
      real hedr(*)            ! Real header record
      integer mhflds(*)       ! Kunit portion of mflds array
      character*8 mchflds(*)  ! Kunit portion of mcflds array
      integer kerr            ! Error return
C                                
C---------------------------Local variables-----------------------------
C                                
      integer len             ! Length of integer header record
      integer jend            ! Length of vectors in record
      integer j, i            ! Indices
C
C------------------------------Externals--------------------------------
C
      external endrun         ! Abnormal termination
C
C-----------------------------------------------------------------------
C
      kerr = 0
C
C Check header lengths and then read header
C
      read(kunit,end=99)len
      if (len.gt.lenhi) then
         write(6,*)'RDHDR: integer header record too long.'
         write(6,*)'Allocated space = ',lenhi,', Actual length = ',len
         call endrun
      end if
      backspace(kunit)
C
C Calculate buffer length for integer record
C
      jend = len - lenhis
      read(kunit,end=99) (hedi(i),i=1,lenhis), (mhflds(j),j=1,jend)
      if (hedi(31).gt.lenhc) then
         write(6,*) 'RDHDR: character header record too long.'
         write(6,*) 'Allocated space = ',lenhc,', Actual length = ',
     $                hedi(31)
         call endrun
      else if (hedi(32).gt.lenhr) then
         write(6,*) 'RDHDR: real header record too long.'
         write(6,*) 'Allocated space = ',lenhr,', Actual length = ',
     $               hedi(32)
         call endrun
      end if
C
C Calculate buffer length for character record
C
      jend = 2*hedi(16)
      read(kunit,end=991) (hedc(i),i=1,lenhcs), (mchflds(j),j=1,jend)
      read(kunit,end=992) (hedr(i),i=1,hedi(32))
C
      return
   99 kerr = 1
      return
  991 kerr = 2
      return
  992 kerr = 3
      return
C

      end

      subroutine endrun
C-----------------------------------------------------------------------
C
C Abort the model for abnormal termination
C
C---------------------------Code history--------------------------------
C
C Original version:  L. Bath, Apr 1992
C Standardized:      L. Bath, Jun 1992
C                    L. Buja, Feb 1996
C
C-----------------------------------------------------------------------
c
c $Id: endrun.F,v 1.1.1.1 1996/05/21 17:46:52 ccm Exp $
c $Author: ccm $
c
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.1.1 1996/05/21 17:46:57 ccm Exp $
c $Author: ccm $
c
      implicit none

C-----------------------------------------------------------------------
C

      call abort
C

      end

      subroutine rdharr(iu      ,len     ,flat    ,flon    ,buf)
C-----------------------------------------------------------------------
C
C Array read for boundary datasets
C
C---------------------------Code history--------------------------------
C
C Original version:  L. Bath
C Standardized:      L. Bath, June 1992
C                    L. Buja, Feb 1996
C
C-----------------------------------------------------------------------
c
c $Id: rdharr.F,v 1.1.1.1 1996/05/21 17:47:09 ccm Exp $
c $Author: ccm $
c
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.1.1 1996/05/21 17:46:57 ccm Exp $
c $Author: ccm $
c
      implicit none

C------------------------------Arguments--------------------------------
C
C Input arguments
C
      integer iu           ! Logical unit number
      integer len          ! Length of array read
C
C Output arguments
C
      real flat            ! Latitude index
      real flon            ! Number of longitudes
      real buf(len)        ! Array to read into
C
C------------------------------Externals--------------------------------
C
      external endrun 
C
C-----------------------------------------------------------------------
C
      read(iu,end=99) flat,flon,buf
      return
   99 continue
      write(6,*)'RDHARR:  End of File on unit ',iu
      call endrun          ! Abnormal termination
C

      end

      subroutine mkslic (field   ,slice   ,nlevf   ,mflds   ,mcflds  ,
     $                   nfldh   ,hrec    ,lhrec   ,nlon    ,nlonh   ,
     $                   nlond   ,nlev)
C-----------------------------------------------------------------------
C
C Routine mkslic extracts the data for a specified field from an input
C history file record and returns it as a vertical slice.
C
C The input data record may be packed.
C
C---------------------------Code history--------------------------------
C
C Original version:  B. Boville, October 1990
C Standardized:      L. Bath, June 1992
C                    T. Acker, March 1996
C Reviewed:          B. Boville, August 1992
C Reviewed:          B. Boville, April 1996
C
C-----------------------------------------------------------------------
c
c $Id: mkslic.F,v 1.1.1.1 1996/05/21 17:47:00 ccm Exp $
c $Author: ccm $
c
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.1.1 1996/05/21 17:46:57 ccm Exp $
c $Author: ccm $
c
      implicit none

C------------------------------Arguments--------------------------------
C
C Input arguments
C
      integer lhrec                ! length of input record
      integer nfldh                ! number of fields in input record
      integer nlon                 ! number of longitudes (distinct)
      integer nlond                ! number of longitudes (dimension)
C
      integer nlonh                ! number of longitudes (input record)
      integer nlev                 ! number of levels (multilevel fields)
      integer nlevf                ! number of levels in current field
      integer mflds(3,nfldh)       ! integer field list from input header
C
      character*(*) field          ! Desired field
      character*(*) mcflds(2,nfldh)    ! character field list (header)
C
C Output arguments
C
      real slice(nlond,nlevf)   ! unpacked data (vertical slice)
      real hrec(lhrec)          ! packed data slice read
C
C---------------------------Local storage-------------------------------
C
      integer if, i, k, l       ! counters
      integer ksiz              ! packed size of data per level
      integer ndens             ! packing of current field
      integer nlevfi            ! number of levels in input field
      integer start             ! starting point of current field
C
C------------------------------Externals--------------------------------
C
      external unpkaf           ! unpacker for data (CRAY supplied)
C
C-----------------------------------------------------------------------
C
C Loop through fields on input record until the required field is found.
C The input pointer cannot be used because we allow for packed data.
C
      start = 1
      do 100 if = 1, nfldh
C
C Determine the packing density, and number of words per level for
C current field.
C
         ndens = mflds(3,if)
         if (ndens .gt. 1) then
            ksiz = 3 + (nlonh - 1) / ndens
         else
            ksiz = nlonh
         end if
C
C Determine the number of levels for the current field
C
         if (mod(mflds(1,if),10).lt.1) then
            nlevfi = 1
         else
            nlevfi = nlev
         end if
C
C Is this the required field?
C
         if (field .eq. mcflds(1,if)) then
C
C This is the required field, check the number of levels.
C
            if (nlevf .ne. nlevfi) then
               write(6,*)'MKSLIC:Level mismatch for field: ',field
               if (nlevf .eq. 1) then
                  write(6,*)'The array is single level but the'
     $                 //' data is multilevel'
               else
                  write(6,*)'The array is multilevel but the'
     $                 //' data is single level'
               end if
               write(6,*) 'Bad levels in mkslic'
               call endrun
            end if
C
C Unpack and load the data.
C
C           l = mflds(2,if)
            l = start
            do 20 k=1,nlevfi
               if (ndens.gt.1) then
                  call unpkaf(slice(1,k),nlon    ,hrec(l) ,ndens)
               else
                  do 50 i = 1, nlon
                     slice(i,k) = hrec(l+i-1)
   50             continue
               end if
               l = l + ksiz
   20       continue
            return
         else
C
C Not the required field, skip it.
C
            start = start + ksiz * nlevfi
         end if
  100 continue
C
C The required field was not found in the input record.
C
      write(6,*) 'MKSLIC:The required input field ', field,
     $           ' was not on the initial data file'
      write(6,*) 'The available fields are:'
      write(6,*) (mcflds(1,if), if = 1, nfldh)
      call endrun

      end

c------
      subroutine unpkaf(buff,idim,packsp,ndens)
c
c $Id: unpkaf.F,v 1.1.1.1 1996/05/21 17:47:46 ccm Exp $
c $Author: ccm $
c
      integer idim,ndens
      real buff(idim),packsp(idim)
c
c  Dummy packing routine replacement of NCAR routine
c
      write(6,*)'UNPKAF: This routine should not be called--not',
     $            ' implemented on this machine architecture'
      return

      end
      subroutine t_startf(xxx)
C-----------------------------------------------------------------------
C
C Timing stubs.  Routines t_startf, t_stopf, and t_prf can be replaced by 
C rountines of the same name to initiate, terminate, and print the results of
C timing portions of the CCM3 code.
C
C-------------------------Code History----------------------------------
C
C Original version:  J. Rosinski, Oct 1995
C Standardized:      T. Acker, Feb 1996
C Reviewed:          
C 
C-----------------------------------------------------------------------
c
c $Id $
c
      character *(*) xxx
      return
      end

      subroutine t_stopf(xxx)
      character *(*) xxx
      return
      end

      subroutine t_prf(xxx)
      integer xxx
      return

      end