
      program tst
      include "tgcmhdr.h"
      parameter(imx=73,kmx=45,jmx=36,nflds=29)
      parameter(imxp1=imx+1, nwlat=1+imxp1*kmx*nflds)
c
c Acquire timesgcm history and change time in header:
c
      dimension summary(100),mtold(3),mtnew(3),f(nwlat)
      data luin/22/, luout/23/, mtold/0,0,6/, mtnew/0,0,0/
      dimension ihead(512),iheadc(168)
      data ihead/512*0/
      equivalence (iheadc,iter),(iheadc(2),nday),(iheadc(3),nhr),
     +  (iheadc(4),nmin),(iheadc(5),label),(iheadc(45),date),
     +  (iheadc(47),output),(iheadc(107),start),(iheadc(110),stp),
     +  (iheadc(116),hist),(iheadc(122),sav),(iheadc(125),step),
     +  (iheadc(126),mag),(iheadc(130),difhor),(iheadc(131),iuivi),
     +  (iheadc(132),sdtide),(iheadc(142),ipower),(iheadc(143),aurora),
     +  (iheadc(144),dispos),(iheadc(145),data),(iheadc(148),source),
     +  (iheadc(151),sourct),(iheadc(154),dtide),(iheadc(156),dum),
     +  (iheadc(164),rdate),(iheadc(165),naur),(iheadc(166),hp),
     +  (iheadc(167),cp),(iheadc(168),byimf)
      dimension head(512)
      equivalence (ihead,head)
c
      call rdhdr(luin,ieof)
      read(luin) dummy
      do j=1,jmx
        read(luin) dummy
      enddo 
c
      call rdhdr(luin,ieof)
      call printhdr
      nmin = 0
      write(luout) ihead
      read(luin) summary
      write(luout) summary
      do j=1,jmx
        buffer in(luin,1)(f(1),f(nwlat))
        write(luout) f
      enddo 
c
      stop
      end
c
      subroutine rdhdr(lu,ieof)
      include "tgcmhdr.h"
c
      dimension ihead(512),iheadc(168)
      data ihead/512*0/
      equivalence (iheadc,iter),(iheadc(2),nday),(iheadc(3),nhr),
     +  (iheadc(4),nmin),(iheadc(5),label),(iheadc(45),date),
     +  (iheadc(47),output),(iheadc(107),start),(iheadc(110),stp),
     +  (iheadc(116),hist),(iheadc(122),sav),(iheadc(125),step),
     +  (iheadc(126),mag),(iheadc(130),difhor),(iheadc(131),iuivi),
     +  (iheadc(132),sdtide),(iheadc(142),ipower),(iheadc(143),aurora),
     +  (iheadc(144),dispos),(iheadc(145),data),(iheadc(148),source),
     +  (iheadc(151),sourct),(iheadc(154),dtide),(iheadc(156),dum),
     +  (iheadc(164),rdate),(iheadc(165),naur),(iheadc(166),hp),
     +  (iheadc(167),cp),(iheadc(168),byimf)
      dimension head(512)
      equivalence (ihead,head)
c
      ieof = 0
      buffer in(lu,1)(ihead,ihead(512))
      if (unit(lu).eq.0.) then
        ieof = 1
        return
      endif
      do i=1,168
        iheadc(i) = ihead(i)
      enddo
      naurp = naur
      do i=1,60
        aurp(i) = head(165+naurp+i)
      enddo
      do i=1,30
        theta0(i) = aurp(i)
      enddo
      do i=1,30
        rrad(i) = aurp(i+30)
      enddo
      rmodnum = head(165+naurp+60+1)
      colfac = head(165+naurp+60+2)
      f107d = head(165+naurp+60+3)
      f107a = head(165+naurp+60+4)
      return
      end
c
c     subroutine printhdr(vol,mt)
      subroutine printhdr
c     character*(*) vol
c     dimension mt(3)
c
c Print tgcm header info to unit 6:
c
      include "tgcmhdr.h"
c
      write(6,"(' ')")
      write(6,"('------------------------- TGCM HEADER SUMMARY ',
     +          '--------------------------')")
c     write(6,"(' ')")
c     write(6,"('HISTORY VOLUME = ',a)") vol(1:lenstr(vol))
c     write(6,"('MODEL TIME = ',i2,':',i2,':',i2)") mt
c     write(6,"(' ')")
      write(6,"(' iter nday nhr nmin =',4i6)") iter,nday,nhr,nmin
      write(6,"(' label(1-5) = ',5a8)") (label(i),i=1,5)
      write(6,"(' date = ',2i9)") date
      write(6,"(' output(1) = ',3a8)") (output(i,1),i=1,3)
      write(6,"(' output(2) = ',3a8)") (output(i,2),i=1,3)
      write(6,"(' start = ',3i5)") start
      write(6,"(' stp = ',6i5)") stp
      write(6,"(' hist = ',6i5)") hist
      write(6,"(' sav = ',3i5)") sav
      write(6,"(' step = ',i5)") step
      write(6,"(' mag = ',4f10.3)") mag
      write(6,"(' difhor,iuivi = ',2i3)") difhor,iuivi
      write(6,"(' sdtide = ',5e12.4,/10x,5e12.4)") sdtide
      write(6,"(' dtide = ',2e12.4)") dtide
      write(6,"(' ipower,aurora,dispos = ',3i3)") 
     +  ipower,aurora,dispos
      write(6,"(' data = ',3a8)") data
      write(6,"(' source = ',3a8)") source
      write(6,"(' sourct = ',3i5)") sourct
      write(6,"(' rdate = ',a8)") rdate
      write(6,"(' naurp = ',i4)") naurp
      write(6,"(' hp = ',f8.2)") hp
      write(6,"(' cp = ',f8.2)") cp
      write(6,"(' byimf = ',f8.2)") byimf
      write(6,"(' colfac = ',f8.2)") colfac
      write(6,"(' f107d = ',f8.2)") f107d
      write(6,"(' f107a = ',f8.2)") f107a
      write(6,"(' ')")
      write(6,"('----------------------------------------------',
     +          '--------------------------')")
      write(6,"(' ')")
c
      return
      end
