program add_akl_head

C 03/11 program to add a header to a CEDAR DB .asc file, changing the 
C  	begin/end times to be correct for the file
C
C       using characters instead of number tripled the size of the file!
C  	pgf77 -o add_akl_head.exe add_akl_head.f      

	character*80 char80
	character*18 char18
	character*56 char56
        character*3 charnam
	character*1 charu,chartyp
	character*9 charmoyr
	character*13 charkyd
c  For counts file
	character*18 rdfile,wrfile
c  For [K] file
c	character*14 rdfile,wrfile
	dimension iprol(16),itimbe(8),jcodval(10),mcodval(4)

	ifnm = 8
        itxt = 9
	ird = 10
	iwr = 55
	ipr = 99

C Tn files
	nf = 8
	open (itxt,file='aklt_head.txt',status='old')
        open (ifnm,file='aklt_files.txt',status='old')
c	open (ird,file='aklt_2003b.asc',status='old')
c	open (iwr,file='akl_t2003b.asc')
	jpar = 10
	mpar = 4

C [K] files
c	open (itxt,file='aklk_head.txt',status='old')
c	open (ifnm,file='aklk_files.txt',status='old')
cc	open (ird,file='aklk_dec03.asc',status='old')
cc	open (iwr,file='akl_kdec03.asc')
c	nf = 42
c	nf = 40
C  Skip over nskp files
c	nskp = 2
c	do 400 n=1,nskp
c	 read (ifnm,"(a3,a1,a1,a9)") charnam,chartyp,charu,charmoyr
400	continue
c	jpar = 9
c	mpar = 4

C photon count files
c	ipr = 2
c	ipr = 7
c	nf = 1
c	open (ird,file='akl_c_K2007022.asc',status='old')
c	open (iwr,file='test07022_aklc.asc')
c	open (ipr,file='c_akl_07022_prologues')
c	open (itxt,file='aklc_head.txt',status='old')
c       open (ifnm,file='list_akl_c',status='old')
c	nf = 20
C  Skip over nskp files
c	nskp = 124
c	do 500 n=1,nskp
c	 read (ifnm,"(a3,a1,a1,a9)") charnam,chartyp,charu,charmoyr
500	continue
c	open (ird,file='akl_c_K2003352.asc',status='old')
c	open (iwr,file='c_akl_03352.asc')
c	open (ipr,file='c_akl_03352_prologues')
c	open (ird,file='akl_c_2006_030_149.asc',status='old')
c	open (iwr,file='c_akl_06_030_149.asc')
c	open (ipr,file='c_akl_06_030_149_prologues')
c	open (ird,file='akl_c_K2009348.asc',status='old')
c	open (iwr,file='c_akl_09348.asc')
c	open (ipr,file='c_akl_09348_prologues')
c	rewind ird
c	jpar = 9
c	mpar = 3

	do 3000 mf=1,nf

      if (mpar .eq. 3 .and. ipr .ne. 7) then
C  Counts nightly files
	ird = ird + 1
	iwr = iwr + 1
	read (ifnm,"(a3,a1,a1,a13)") charnam,charu,chartyp,charkyd
	write (rdfile,"(a3,a1,a1,a13)") charnam,charu,chartyp,charkyd
        write (wrfile,"(a1,a1,a3,a13)") chartyp,charu,charnam,charkyd
	write (6,"(1x,'rd,wrfile =',a18,1x,a18)") rdfile,wrfile
	open (ird,file=rdfile,status='old')
	open (iwr,file=wrfile)
	rewind ird
      endif
      if (mpar .eq. 4) then
C  [K] monthly files and Tn yearly files
	ird = ird + 1
	iwr = iwr + 1
	read (ifnm,"(a3,a1,a1,a9)") charnam,chartyp,charu,charmoyr
	write (rdfile,"(a3,a1,a1,a9)") charnam,chartyp,charu,charmoyr
C the wrfile name fails with the second charu before charmoyr (messed up)
C	charu2 = charu
C     write (wrfile,"(a1,a1,a3,a1,a9)")chartyp,charu,charnam,charu2,charmoyr
        write (wrfile,"(a3,a1,a1,a9)") charnam,charu,chartyp,charmoyr
	write (6,"(1x,'moyr rd,wrfile =',a9,1x,a14,1x,a14)") 
     |    charmoyr,rdfile,wrfile
	open (ird,file=rdfile,status='old')
	open (iwr,file=wrfile)
	rewind ird
      endif

	nrecrd = 0
	nlin = 0
1000    continue
c	write (6,"(1x,'Read nrecrd =',i6)") nrecrd
C Read Prologue
	read (ird,"(16i6)",end=2000) iprol
	nrecrd = nrecrd + 1
	if (ipr .eq. 7) then
	   rec3 = nrecrd/3.
	   write (ipr,"(i5,f7.1,16i6)") nrecrd,rec3,iprol
	endif
C  get begin/end times
	if (nrecrd .eq. 1) then
	itimbe(1) = iprol(5)
	itimbe(2) = iprol(6)
	itimbe(3) = iprol(7)
	itimbe(4) = iprol(8)
	endif
	itimbe(5) = iprol(9)
	itimbe(6) = iprol(10)
	itimbe(7) = iprol(11)
	itimbe(8) = iprol(12)
	   do 1100 n=2,iprol(1)
	      read (ird,"(a80)") char80
1100       continue
	nlin = nlin + iprol(1)
	   go to 1000
2000	continue
	rewind ird
	write (6,"(1x,'nrecrd nlin =',2i8)") nrecrd,nlin
	
	rewind itxt
C Read header
	read (itxt,"(16i6)") iprol
C  Set begin/end times in iprol from data
	do 2050 i=5,12
	iprol(i) = itimbe(i-4)
2050	continue
C  Write out to new file
	write (iwr,"(16i6)") iprol
	   do 2100 n=2,7
	      read (itxt,"(a80)") char80
	      write (iwr,"(a80)") char80
2100       continue
C  Revise the begin/end times in the header text
	do 2150 n=8,15
	  read (itxt,"(a18,i6,a56)") char18,num,char56
	  num = itimbe(n-7)
	  write (iwr,"(a18,i6,a56)") char18,num,char56
2150	continue
	do 2200 n=16,iprol(1)
	      read (itxt,"(a80)") char80
	      write (iwr,"(a80)") char80
2200       continue

C Now add the regular data BUT NOT AS CHAR (which triples the size of the file!)
	rewind ird
	do 2500 n=1,nrecrd

	      read (ird,"(16i6)") iprol
	      write (iwr,"(16i6)") iprol
C  Read jpar 1-d codes and parameters
	do 2250 j=1,2
	   read (ird,"(20i6)") (jcodval(j1),j1=1,jpar)
	   write (iwr,"(20i6)") (jcodval(j1),j1=1,jpar)
2250	continue
C  Read mpar 2-d codes and parameters
	do 2300 m=1,iprol(16)+1
	   read (ird,"(20i6)") (mcodval(j1),j1=1,mpar)
	   write (iwr,"(20i6)") (mcodval(j1),j1=1,mpar)
2300	continue

2500       continue

3000    continue

	stop
	end