program L1b2L1aSIDEPDS
c level 1b to level 1a in AACII for SIDE, line/SIDE-frame, PDS format
c **23-Aug-18** w/measuremement numbers
	character filen*30,stdy*6,time*21,mno(128,5)*5,kmn(5)*5,tf*1
&	,df(8)*1,cr*1
	integer*2 in(13,128),nin(13,128)
	integer iaw(4),itd(8),ksd(8),in4(13)
	logical newline,evfr
	parameter (cr='0d'x)
	data filen/'a**_side_1975***_l1_arcsav.tab'/,stdy(3:3)/'.'/
&	,time(1:15)/'1975-***T**:**:'/,iaw/15,31,47,56/
	common time,kmn,ksd,tf,df,newline
c
	open(2,file='../sidel1aPDSs/FvsM.txt',status='old')
	read(2,*)
	do i=1,128
	 read(2,*) is,(mno(i,j),j=1,5)
	 end do
	close(2)
	do i=1,4
	 itd(i)=nint((iaw(i)-1)*9.4336)
	 itd(i+4)=itd(i)+604
	 end do
	write(*,"('station: '$)")
	read(*,'(a2)') stdy(1:2)
	filen(2:3)=stdy(1:2)
c
	write(*,"('days: '$)")
	read(*,*) id1,id2
	do id=id1,id2
	 write(stdy(4:6),'(i3)') id
	 if (stdy(4:4).eq.' ') stdy(4:4)='0'
	 open(1,file='../sidel1b'//stdy(1:2)//'s/sidel1b.'//stdy
&	 ,access='direct',form='unformatted',recl=3328,status='old',err=29)
	 write(*,*) stdy
	 filen(14:16)=stdy(4:6)
	 open(7,file='../sidel1aPDSs/'//filen)
	 write(7,"(a30,2(a9,i1,a2),a10,3(a9,i1,a2),10a,a1)")
&	  'year day hr:mn:sc.ms  f WD-1 f',(' Meas WD-',i,' f',i=2,3),
&	  '  WD-4-5 f',(' Meas WD-',i,' f',i=6,8),' WD-9-10 f',cr
	 write(7,'(14xa9,i5,a2,2(i10,a2),i8,a2,3(i10,a2),i8,a2,a1)')
&	  'time+ms |',(itd(i),' |',i=1,8),cr
	 call clearline
	 nfc=0
	 lsf=0
	 nrec=1
10	 read(1,rec=nrec,end=19) in
	 do k=1,128
	  if (in(1,k).eq.0) go to 18
	  do i=9,13
	   if (in(i,k).ne.0) go to 11
	   end do
	  if (lsf.ne.127) go to 18
11	  do i=2,13
	   in4(i)=in(i,k)
	   end do
	  kfc=and(in4(6),'7f'x)
	  evfr=and(kfc,1).eq.0
c find SIDE frame number
	  if (evfr) then
	   if (and(in4(9),'8180'x).ne.0) go to 18
	   ksf=and(in4(9),'7f'x)
	  else
	   if (and(in4(9),'8180'x).ne.'180'x) then
	    if (.not.newline) call output
	    go to 18
	    end if
	   if (kfc.ne.nfc) then
	    if (.not.newline) call output
	    if (k.lt.128) then
	     nin9=in(9,k+1)
	     go to 12
	    else
	     read(1,rec=nrec+1,end=19) nin
	     nin9=nin(9,1)
	     go to 12
	     end if
12	    if (and(nin9,'8180'x).ne.0) go to 18
	    ksf=mod(and(nin9,'7f'x)+127,128)
	    end if
	   end if
c if new line, decode time
	  if (newline) then
	   it=or(or(and(lshift(in4(2),28),'70000000'x)
&	   ,and(lshift(in4(3),12),'ffff000'x))
&	   ,and(rshift(in4(4),4),'fff'x))
	   kd=it/5400000
	   it=mod(it,5400000)
	   kh=it/225000
	   it=mod(it,225000)
	   km=it/3750
	   sec=(mod(it,3750)*16+and(in4(4),15))/1000.
c if odd frame, subtract 604 ms
	   if (.not.evfr) then
	    sec=sec-0.604
	    if (sec.lt.0.) then
	     sec=sec+60.
	     km=km-1
	     if (km.lt.0) then
	      km=km+60
	      kh=kh-1
	      if (kh.lt.0) then
	       kh=kh+24
	       kd=kd-1
	       end if
	      end if
	     end if
	    end if
c write out time
	   write(time(6:8),'(i3)')kd
	   write(time(10:11),'(i2)') kh
	   write(time(13:14),'(i2)') km
	   write(time(16:21),'(f6.3)') sec
	   do i=6,16
	    if (time(i:i).eq.' ') time(i:i)='0'
	    end do
	   if (and(in4(2),'40'x).ne.0.or.iabs(kd-id).gt.1) tf='*'
	   end if
c check frame count
	  if (evfr) then
c even numbered frame
	   if (.not.newline) call output
c decode data
	   ksd(1)=ksf
	   do j=1,2
	    kmn(j)=mno(ksf+1,j)
	    ksd(j+1)=and(in4(j+9),'ff'x)
	    end do
	   ksd(4)=and(in4(12),'3ff'x)*1024+and(in4(13),'3ff'x)
	   if (in4(5).ne.'3890'x.or.and(in4(6),'ff00'x).ne.'ed00'x) then
	    do i=1,4
	     df(i)='*'
	     end do
	    end if
	   do i=1,5
	    if (and(in4(i+8),'f400'x).ne.0) df(max(i,4))='*'
	    end do
	   if (and(in4(9),'180'x).ne.0) df(1)='*'
	   nfc=kfc+1
	   newline=.false.
c odd numbered frame
	  else
	   do j=3,5
	    kmn(j)=mno(ksf+1,j)
	    end do
	   ksd(5)=and(in4(9),'7f'x)
	   ksd(6)=and(in4(10),'ff'x)
	   ksd(7)=and(in4(11),'ff'x)
	   ksd(8)=and(in4(12),'3ff'x)*1024+and(in4(13),'3ff'x)
	   if (in4(5).ne.'3890'x.or.and(in4(6),'ff00'x).ne.'ed00'x) then
	    do i=5,8
	     df(i)='*'
	     end do
	    end if
	   do i=6,10
	    if (and(in4(i+3),'f400'x).ne.0) df(max(i-1,8))='*'
	    end do
	   if (and(in4(9),'180'x).ne.'180'x) df(5)='*'
	   call output
	   end if
18	  end do
	 nrec=nrec+1
	 go to 10
19	 if (.not.newline) call output
	 close(1)
	 close(7)
29	 end do
	stop
	end

	subroutine clearline
	character time*21,kmn(5)*5,tf*1,df(8)*1
	integer ksd(8)
	logical newline
	common time,kmn,ksd,tf,df,newline
c
	tf='-'
	do i=1,5
	 kmn(i)='999  '
	 end do
	do i=1,8
	 ksd(i)=-9
	 df(i)='-'
	 end do
	newline=.true.
	return
	end

	subroutine output
	character time*21,kmn(5)*5,tf*1,df(8)*1,cr*1
	integer ksd(8)
	logical newline
	parameter (cr='0d'x)
	common time,kmn,ksd,tf,df,newline
c
	write(7,1) time,tf,ksd(1),df(1),(kmn(i-1),ksd(i),df(i),i=2,3)
&	,ksd(4),df(4),(kmn(i-2),ksd(i),df(i),i=5,7),ksd(8),df(8),cr
1	format(a21,1xa1,i5,1xa1,2(1xa5,i4,1xa1),i8,1xa1,3(1xa5,i4,1xa1)
&	,i8,1xa1,a1)
	call clearline
	return
	end