	program L1b2L1aSWSPDS
c Level 1b to level 1a in ASCII for SWS in PDS format
c **9-Oct-17**rev. 5-Nov-17**rev. 8-May-18**rev. 11-Jun-18**&7/19/18**
	character filen*26,mn*5,hdrw(298)*5,hdryz(168)*5,wsm(184,16)*5
&	,recseq(16,186)*5,tf*1,tfw*1,cf*1,dfj*1,dfw(298)*1,dfyz(168)*1
&	,mnm*1,time*21,timew*21,cr*1
	integer*2 in(12,45)
	integer nw(16),ndw(298),ndyz(168),wsc(184,16),inc(12,48)
&	,itd(298),dvw(298),dvyz(168)
	logical first,newcyc,syncer,last,lsgood
	parameter (cr='0d'x)
	data filen/'a12_sws_1975***_l1_arcsav_'/
&	,time(1:15)/'1975-***T**:**:'/,timew(1:15)/'1975-***T**:**:'/
c
c get measurement numbers and number of columns for the headers
	open(2,file='../swsl1aPDSs/seqwd.dw.txt',status='old')
	read(2,*)
	ip=0
	do k=1,87
	 read(2,*) mn,ns,(nw(i),i=1,ns)
	 do i=1,ns
	  ip=ip+1
	  hdrw(ip)=mn
	  ndw(ip)=nw(i)
	  end do
	 end do
	close(2)
	open(2,file='../swsl1aPDSs/seqwd.dyz.txt',status='old')
	read(2,*)
	do k=1,168
	 read(2,*) hdryz(k),ns,ndyz(k)
	 end do
	close(2)
c get SWS word and sqeuence vs. measurment and output column
	open(2,file='../swsl1aPDSs/wsmc.txt',status='old')
	read(2,*)
	do k=1,184
	 read(2,*) iw,(wsm(k,i),wsc(k,i),i=1,16)
c	if (k.eq.1) write(*,'(16(a6,i4))') (wsm(k,i),wsc(k,i),i=1,16)
	 end do
	close(2)
c
	open(2,file='../clockrates/FrameLength.12.txt',status='old') 
	read(2,*) kd,frl
	write(*,"('days: '$)")
	read(*,*) id1,id2
	do id=id1,id2
	 write(filen(13:15),'(i3)') id
	 if (filen(13:13).eq.' ') filen(13:13)='0'
	 open(1,file='../swsl1b12s/swsl1b.'//filen(13:15),access='direct'
&	 ,form='unformatted',recl=1080,status='old',err=49)
	 write(*,*) filen(13:15)
c
c write headers
	 open(7,file='../swsl1aPDSs/'//filen//'w.tab')
	 write(7,"(a29,64(3xa4,1xa1),234(2xa5,1xa1),a1)") 
&	 'year day hr:mn:sc.ms  f cycle',(hdrw(i),'f',i=1,298),cr
	 open(8,file='../swsl1aPDSs/'//filen//'yz.tab')
	 write(8,
&	 "(a34,9(2xa4,1xa1),87(1xa5,1xa1),9(2xa4,1xa1),63(1xa5,1xa1),a1)") 
&	 'year day hr:mn:sc.ms  f cycle sq f',(hdryz(i),'f',i=1,168),cr
	 do while (kd.ne.id)
	  read(2,*) kd,frl
	  end do
	 dt=frl/4.
	 dts=dt/1000.
	 do i=1,298
	  itd(i)=nint(dt*ndw(i))
	  end do
	 write(7,"(14xa15,298(i7,' |'),a1)")
&	 'time+ms |     x',(itd(i),i=1,298),cr
	 do i=1,168
	  itd(i)=nint(dt*ndyz(i))
	  end do
	 write(8,"(14xa20,168(i6,' |'),a1)")
&	 'time+ms |     x  x |',(itd(i),i=1,168),cr
	 open(10,file='../swsl1aPDSs/swsl1alog.'//filen(13:15))
	 first=.true.
	 last=.false.
	 do i=1,298
	  dvw(i)=-9
	  dfw(i)='-'
	  end do
	 do i=1,168
	  dvyz(i)=-9
	  dfyz(i)='-'
	  end do
	 newcyc=.true.
c
c search for SWS words 184 & 185 (EOS)
	 lr=1
	 lf=0
	 ls=4
	 ks=1
	 js=1
	 nr=1
	 kc=0
10	 read(1,rec=nr,end=19) in
11	 do k=ks,45
	  if (in(1,k).eq.0) go to 12
	  kc=kc+1
	  if (kc.le.48) then
	   do j=1,12
	    inc(j,kc)=in(j,k)
	    end do
	   end if
	  do j=js,4
	   kd1=in(j+8,k)
	   if (and(kd1,'7f00'x).eq.'200'x) then
	    j2=j+1
	    k2=k
	    if (j2.gt.4) then
	     j2=1
	     k2=k2+1
	     if (k2.gt.45) then
	      k2=1
	      nr=nr+1
	      read(1,rec=nr,end=19) in
	      end if
	     end if
	    kd2=in(j2+8,k2)
	    if (and(kd2,'7f00'x).eq.'200'x) go to 20
	    end if
 	   end do
	  js=1
12	  end do
	 ks=1
	 nr=nr+1
	 go to 10
c
19	 close(1)
	 kwd=kc*4-ls
	 ksq=ksq+1
	 if (ksq.eq.16) then
	  ksq=0
	  kcy=mod(kcy+1,4096)
	  end if
	 last=.true.
	 go to 22
c get cycle, sequence and number of words
20	 kwd=((nr-lr)*45+k2-lf)*4+j2-ls
	 kcy=or(and(rshift(kd1,4),15),and(lshift(kd2,4),'ff0'x))
	 ksq=and(kd1,15)
	 if (and(kd1,'c000'x).eq.0) then
	  cf='-'
	 else
	  cf='*'
	  end if
22	 if (kwd.ne.186) write(*,*) nr,lr,k2,lf,j2,ls,kcy,ksq,kwd
	 if (kwd.eq.186.or.(first.and.kwd.lt.186).or
&	  .(last.and.kwd.lt.186.and.lsgood)) then
c sequence length correct
	  if (.not.first) then
	   newcyc=kcy.ne.lcy
	   if (newcyc) then
c output dvw
	    write(7,1) timew,tfw,lcy,(dvw(i),dfw(i),i=1,298),cr
1	    format(a21,1xa1,i6,298(i7,1xa1),a1)
	    do i=1,298
	     dvw(i)=-9
	     dfw(i)='-'
	     end do
	    end if
	   end if
c get time for the new sequence
	  in2=inc(2,1)
	  in3=inc(3,1)
	  in4=inc(4,1)
	  it=or(or(and(lshift(in2,28),'70000000'x)
&	  ,and(lshift(in3,12),'ffff000'x)),and(rshift(in4,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,15))/1000.
	  tf='-'
	  if (and(in2,'4008'x).ne.0.or.iabs(kd-id).gt.1) tf='*'
c adjust sequence time
	  if (first) then
	   sec=sec-(185.625-kwd)*dts
	   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
	  else
	   is=mod(ls,4)+1
	   sec=sec+(is-0.625)*dts
	   if (sec.ge.60.) then
	    sec=sec-60.
	    km=km+1
	    if (km.eq.60) then
	     km=0
	     kh=kh+1
	     if (kh.eq.24) then
	      kh=0
	      kd=kd+1
	      end if
	     end if
	    end if
	   end if
c	write(*,*) kd,kh,km,sec,is,dts
c decode sequence time
	  write(time(6:8),'(i3)') kd
	  if (time(6:6).eq.' ') time(6:6)='0'
	  if (time(7:7).eq.' ') time(7:7)='0'
	  write(time(10:11),'(i2)') kh
	  write(time(13:14),'(i2)') km
	  write(time(16:21),'(f6.3)') sec
	  do i=10,16,3
	   if (time(i:i).eq.' ') time(i:i)='0'
	   end do
c	write(*,*) time
	  if (newcyc) then
c get time for new cycle
	   sec=sec-ksq*frl*0.0465
	   do while (sec.lt.0.)
	    sec=sec+60.
	    km=km-1
	    end do
	   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
c	write(*,*) kd,kh,km,sec,is,dts
c decode cycle time
	   write(timew(6:8),'(i3)') kd
	   if (timew(6:6).eq.' ') timew(6:6)='0'
	   if (timew(7:7).eq.' ') timew(7:7)='0'
	   write(timew(10:11),'(i2)') kh
	   write(timew(13:14),'(i2)') km
	   write(timew(16:21),'(f6.3)') sec
	   do i=10,16,3
	    if (timew(i:i).eq.' ') timew(i:i)='0'
	    end do
	   tfw=tf
c	write(*,*) timew
	   end if
c process the saved data for the sequence
	  if (first) then
	   nwd=186-kwd
	   mwd=184
	   js=1
	   first=.false.
	  else
	   nwd=0
	   js=is
	   if (last) then
	    mwd=kwd
	   else
	    mwd=184
	    end if
	   end if
	  do k=1,48
c get sync
	   in5=inc(5,k)
	   in6=inc(6,k)
	   ksyn=or(and(lshift(in5,8),'3fff00'x),and(rshift(in6,8),'ff'x))
c	write(*,'(i2,3z9)') k,in5,in6,ksyn
	   if(ksyn.ne.'3890ed'x) then
	    kxs=xor(ksyn,'3890ed'x)
	    nib=0
	    do i=1,22
	     if (and(kxs,1).ne.0) nib=nib+1
	     if (nib.gt.2) then
	      write(10,"(a12,' sync error',z7)") time(10:21),ksyn
	      syncer=.true.
	      go to 30
	      end if
	     kxs=rshift(kxs,1)
	     end do
	    write(10,"(a12,' sync bit error',z7)") time(10:21),ksyn
	    end if
	   syncer=.false.
c SWS data
30	   do j=js,4
	    kfv=inc(j+8,k)
	    dfj='-'
	    if (and(kfv,'8000'x).ne.0) then
	     dfj='*'
	     kfv=and(kfv,'3ff'x)
	     end if
	    kf=and(rshift(kfv,8),3)
	    kv=and(kfv,'ff'x)
	    mn=wsm(nwd+1,ksq+1)
	    mnm=mn(2:2)
	    if (mnm.eq.'W'.and.kf.eq.0.or.mnm.ne.'W'.and.kf.ne.0) then
	     write(10,*) time(10:21),nr,k,j,ksq,nwd,kfv,kf,kv,' ',mn
	     dfj='*'
	     end if
c save dv values
	    nc=wsc(nwd+1,ksq+1)
c	if (nr.eq.2) write(*,*) nwd,ksq,mn,mnm,nc
	    if (mnm.eq.'W') then
	     dvw(nc)=kv
	     dfw(nc)=dfj
	     if (syncer) dfw(nc)='*'
	    else
	     dvyz(nc)=kv
	     dfyz(nc)=dfj
	     if (syncer) dfyz(nc)='*'
	     end if
	    nwd=nwd+1
c	write(*,*) k,j,nwd
	    if (nwd.eq.mwd) go to 32
	    end do
	   js=1
	   end do
c output dvyz
32	  write(8,2) time,tf,kcy,ksq,cf,(dvyz(i),dfyz(i),i=1,168),cr
2	  format(a21,1xa1,i6,i3,1xa1,168(i6,1xa1),a1)
	  do i=1,168
	   dvyz(i)=-9
	   dfyz(i)='-'
	   end do
	  if (newcyc) lcy=kcy
	  first=.false.
	  lsgood=.true.
	 else
	  lsgood=.false.
	  if (kwd.lt.186) then
	   write(10,*) nr,k,j,kwd,' short sequence'
	  else
	   write(10,*) nr,k,j,kwd,' long sequence'
	   end if
	  end if
	 if (last) go to 39
	 lr=nr
	 lf=k2
	 ls=j2
	 kc=0
	 ks=k2
	 js=j2+1
	 if (js.gt.4) then
	  js=1
	  ks=ks+1
	  if (ks.gt.45) then
	   ks=1
	   nr=nr+1
	   go to 10
	   end if
	  end if
	 go to 11
c
39	 write(7,1) timew,tfw,lcy,(dvw(i),dfw(i),i=1,298),cr
	 close(7)
	 close(8)
	 close(10)
49	 end do
	stop
	end
