diff --git a/CALL3.TXT b/CALL3.TXT index 60d214ba9..4ac774508 100644 --- a/CALL3.TXT +++ b/CALL3.TXT @@ -6,6 +6,7 @@ 3V8BB,JM56ER,EME,,,,,06/02 3V8SS,JM55GX,EME,,Expedition,,144: 16JXX and 1kw,12/05 3Y0X,EC41RE,EME,,Expedition,,144: 4x 9el 350W,02/06 +4F2KWT,PK06,EME,, 4J1FS,KP40,,,Expedition,,,1990 4N7AX,KN05PC,,,,,144: 200 W 2x10el 9BVtx1500/rx3000lpm DSP,08/00 4O4AR,JN94AS,,,=YU4AR,,144: TR9130 250W 10el PA0MS-ant PreampUHER 15,11/02 diff --git a/Makefile.in b/Makefile.in index f5e9fa87d..e29203f00 100644 --- a/Makefile.in +++ b/Makefile.in @@ -107,8 +107,9 @@ wsjt6: @NEEDPORTAUDIO@ Audio.so #wsjt.spec # ${PYTHON} c:\python23\installer\Build.py wsjt.spec # ${RM} wsjt6 -# -# +deep65.o: deep65.F + $(FC) -c -O0 -Wall deep65.F + Audio.so: $(OBJS2C) $(OBJS3C) $(OBJS2F77) $(SRCS2F90) $(AUDIOSRCS) ${F2PY} -c --quiet --opt="-O ${CFLAGS} \ -fno-second-underscore" $(OBJS2C) $(OBJS2F77) -m Audio \ diff --git a/Makefile.win b/Makefile.win index a9158df9c..554e30747 100644 --- a/Makefile.win +++ b/Makefile.win @@ -2,8 +2,10 @@ !include #Some definitions for Compaq Visual Fortran gcc = cl FC = df +#To do bounds checking (with useless reports) put "/check:all" in the +# --opt= line below (line 56, more or less ...) #FFLAGS = /traceback /check:all -FFLAGS = /traceback /fast +FFLAGS = /traceback /fast /nologo all: JT65code.exe WSJT6.EXE @@ -16,7 +18,7 @@ OBJS1 = JT65code.obj nchar.obj grid2deg.obj packmsg.obj packtext.obj \ wrapkarn.obj JT65code.exe: $(OBJS1) - $(FC) /exe:JT65code.exe $(OBJS1) + $(FC) $(FFLAGS) /exe:JT65code.exe $(OBJS1) OBJS2C = init_rs.o encode_rs.o decode_rs.o jtaudio.o @@ -51,7 +53,8 @@ WSJT6.EXE: Audio.pyd wsjt.spec Audio.pyd: $(OBJS2C) $(SRCS2F90) $(SRCS2F77) $(SRCS2C) python f2py.py -c \ --quiet --"fcompiler=compaqv" \ - --opt="/traceback /fast /fpp /define:Win32 /define:USE_PORTAUDIO" \ + --opt="/nologo /traceback /warn:errors /fast /fpp /define:Win32 \ + /define:USE_PORTAUDIO" \ $(OBJS2C) \ -lwinmm -lpa -llibsamplerate \ -m Audio \ @@ -63,31 +66,31 @@ wsjt.spec: wsjt.py astro.py g.py options.py palettes.py smeter.py specjt.py --tk --onefile wsjt.py jtaudio.o: jtaudio.c - cl /c /DWin32 /Fojtaudio.o jtaudio.c + $(CC) /nologo /c /DWin32 /Fojtaudio.o jtaudio.c init_rs.obj: init_rs.c - $(CC) /c /DBIGSYM=1 init_rs.c + $(CC) /nologo /c /DBIGSYM=1 init_rs.c init_rs.o: init_rs.obj - $(CC) /c /DBIGSYM=1 /Foinit_rs.o init_rs.c + $(CC) /nologo /c /DBIGSYM=1 /Foinit_rs.o init_rs.c encode_rs.obj: encode_rs.c - $(CC) /c /DBIGSYM=1 encode_rs.c + $(CC) /nologo /c /DBIGSYM=1 encode_rs.c encode_rs.o: encode_rs.c - $(CC) /c /DBIGSYM=1 /Foencode_rs.o encode_rs.c + $(CC) /nologo /c /DBIGSYM=1 /Foencode_rs.o encode_rs.c decode_rs.obj: decode_rs.c - $(CC) /c /DBIGSYM=1 decode_rs.c + $(CC) /nologo /c /DBIGSYM=1 decode_rs.c decode_rs.o: decode_rs.c - $(CC) /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.o decode_rs.c + $(CC) /nologo /c /DBIGSYM=1 /Ox /Zd /Fodecode_rs.o decode_rs.c wrapkarn.obj: wrapkarn.c - $(CC) /c /DWin32=1 wrapkarn.c + $(CC) /nologo /c /DWin32=1 wrapkarn.c igray.obj: igray.c - $(CC) /c /DWin32=1 igray.c + $(CC) /nologo /c /DWin32=1 igray.c .PHONY : clean diff --git a/abc441.F90 b/abc441.F90 index 73de6e52b..a95789feb 100644 --- a/abc441.F90 +++ b/abc441.F90 @@ -1,33 +1,30 @@ -subroutine abc441(msg,nmsg,itone,ndits) - - character msg*28,msg2*29 - integer itone(84) - integer lookup(0:91) - integer codeword4(4,0:42) - integer codeword7(7,0:42) - character c*1 - character cc*43 - data cc/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.,?/#$'/ - data lookup/13, 15, 17, 46, 47, 45, 44, 12, 11, 14, & - 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & - 16, 48, 18, 19, 20, 21, 22, 23, 24, 25, & - 26, 27, 15, 29, 30, 14, 16, 42, 46, 35, & - 36, 37, 21, 0, 11, 41, 10, 13, 43, 1, & - 2, 3, 4, 5, 6, 7, 8, 9, 49, 56, & - 52, 55, 54, 12, 63, 17, 18, 19, 20, 44, & - 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, & - 45, 63/ - save - - do i=1,nmsg - n=ichar(msg(i:i)) - if(n.lt.0 .or. n.gt.91) n=32 !Replace illegal char with blank - n=lookup(n) - itone(3*i-2)=n/16 + 1 - itone(3*i-1)=mod(n/4,4) + 1 - itone(3*i)=mod(n,4) + 1 - enddo - ndits=3*nmsg - return -end subroutine abc441 +subroutine abc441(msg,nmsg,itone,ndits) + + character msg*28 + integer itone(84) + integer lookup(0:91) + character cc*43 + data cc/' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.,?/#$'/ + data lookup/13, 15, 17, 46, 47, 45, 44, 12, 11, 14, & + 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, & + 16, 48, 18, 19, 20, 21, 22, 23, 24, 25, & + 26, 27, 15, 29, 30, 14, 16, 42, 46, 35, & + 36, 37, 21, 0, 11, 41, 10, 13, 43, 1, & + 2, 3, 4, 5, 6, 7, 8, 9, 49, 56, & + 52, 55, 54, 12, 63, 17, 18, 19, 20, 44, & + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, & + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, & + 45, 63/ + save + + do i=1,nmsg + n=ichar(msg(i:i)) + if(n.lt.0 .or. n.gt.91) n=32 !Replace illegal char with blank + n=lookup(n) + itone(3*i-2)=n/16 + 1 + itone(3*i-1)=mod(n/4,4) + 1 + itone(3*i)=mod(n,4) + 1 + enddo + ndits=3*nmsg + return +end subroutine abc441 diff --git a/astro.F b/astro.F index a6b2ebc61..b548530b0 100644 --- a/astro.F +++ b/astro.F @@ -1,128 +1,124 @@ - subroutine astro(AppDir,nyear,month,nday,uth,nfreq,Mygrid, - + NStation,mode,MoonDX,AzSun,ElSun,AzMoon,ElMoon0, - + ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd, - + poloffset,xnr,auxra,auxdec,azaux,elaux) - -C Computes astronomical quantities for display in JT65, CW, and EME Echo mode. -C NB: may want to smooth the Tsky map to 10 degrees or so. - - character*80 AppDir,fname - character*240 Display - character*14 d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,d11,d12,d13,d14,d15 - character*14 d1a,d2a,d3a - character*2 crlf - character*6 MyGrid,HisGrid - logical first,ltsky - real LST - real lat,lon - real ldeg - integer*1 n1sky(129600) - integer*2 nsky - common/sky/ nsky(360,180) - common/echo/xdop(2),techo,ElMoon,mjd - equivalence (n1sky,nsky) - data first/.true./ - data rad/57.2957795/ - save first - - if(first) then - do i=80,1,-1 - if(ichar(AppDir(i:i)).ne.0 .and. - + ichar(AppDir(i:i)).ne.32) goto 1 - enddo - 1 lenappdir=i - call zero(nsky,180*180) - fname=Appdir(1:lenappdir)//'/TSKY.DAT' -#ifdef Win32 - open(13,file=fname,status='old',form='binary',err=10) - read(13) nsky - close(13) -#else - call rfile2(fname,nsky,129600,nr) - if(nr.ne.129600) go to 10 -#endif - ltsky=.true. - first=.false. - endif - go to 20 - 10 ltsky=.false. - - 20 call grid2deg(MyGrid,elon,lat) - lon=-elon - call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST, - + AzSun,ElSun,mjd) - -! If(NStation.eq.1 .and. ElSun.gt.-2.0) then -! arg=ElSun + 8.6/(ElSun+4.4) -! refraction=0.0167/tan(arg/rad) !Refraction in degrees -! ElSun=ElSun+refraction -! endif - - mjd2=mjd - freq=nfreq*1.e6 - - call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon, - + LST,HA,AzMoon,ElMoon,ldeg,bdeg,vr,dist) - -C Compute spatial polarization offset - xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* - + cos(AzMoon/rad)*sin(ElMoon/rad) - yy=cos(lat/rad)*sin(AzMoon/rad) - if(NStation.eq.1) poloffset1=rad*atan2(yy,xx) - if(NStation.eq.2) poloffset2=rad*atan2(yy,xx) - -! If(NStation.eq.1 .and. ElMoon.gt.-2.0) then -! arg=ElMoon + 8.6/(ElMoon+4.4) -! refraction=0.0167/tan(arg/rad) !Refraction in degrees -! ElMoon=ElMoon+refraction -! endif - - techo=2.0 * dist/2.99792458e5 !Echo delay time - doppler=-freq*vr/2.99792458e5 !One-way Doppler - t408=ftsky(ldeg,bdeg) !Read sky map - tsky=t408*(408.0/nfreq)**2.6 !Tsky for obs freq - if(ltsky.and.(tsky.lt.3.0)) tsky=3.0 !Minimum = 3 Kelvin - - xdop(NStation)=doppler - if(NStation.eq.2) then - HisGrid=MyGrid - go to 900 - endif - - doppler00=2.0*xdop(1) - if(mode.eq.2 .or. mode.eq.5) doppler=xdop(1)+xdop(2) - if(mode.eq.3) doppler=2.0*xdop(1) - dBMoon=-40.0*log10(dist/356903.) - sd=16.23*370152.0/dist - -! if(NStation.eq.1 .and. MoonDX.ne.0 .and. -! + (mode.eq.2 .or. mode.eq.5)) then - if(NStation.eq.1 .and. MoonDX.ne.0) then - poloffset=mod(poloffset2-poloffset1+720.0,180.0) - if(poloffset.gt.90.0) poloffset=poloffset-180.0 - x1=abs(cos(2*poloffset/rad)) - if(x1.lt.0.056234) x1=0.056234 - xnr=-20.0*log10(x1) - if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'Z') xnr=0 - endif - - tr=80.0 !Good preamp - tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature - tsysmin=tskymin+tr - tsys=tsky+tr - dgrd=-10.0*log10(tsys/tsysmin) + dbMoon - - 900 ElMoon0=Elmoon - ntsky=nint(tsky) - - auxHA = 15.0*(LST-auxra) !HA in degrees - pi=3.14159265 - pio2=0.5*pi - call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0, - + auxdec/rad,azaux,elaux) - AzAux=azaux*rad - ElAux=ElAux*rad - - return - - end + subroutine astro(AppDir,nyear,month,nday,uth,nfreq,Mygrid, + + NStation,mode,MoonDX,AzSun,ElSun,AzMoon,ElMoon0, + + ntsky,doppler00,doppler,dbMoon,RAMoon,DecMoon,HA,Dgrd,sd, + + poloffset,xnr,auxra,auxdec,azaux,elaux) + +C Computes astronomical quantities for display in JT65, CW, and EME Echo mode. +C NB: may want to smooth the Tsky map to 10 degrees or so. + + character*80 AppDir,fname + character*6 MyGrid,HisGrid + logical first,ltsky + real LST + real lat,lon + real ldeg + integer*1 n1sky(129600) + integer*2 nsky + common/sky/ nsky(360,180) + common/echo/xdop(2),techo,ElMoon,mjd + equivalence (n1sky,nsky) + data first/.true./ + data rad/57.2957795/ + save first + + if(first) then + do i=80,1,-1 + if(ichar(AppDir(i:i)).ne.0 .and. + + ichar(AppDir(i:i)).ne.32) goto 1 + enddo + 1 lenappdir=i + call zero(nsky,180*180) + fname=Appdir(1:lenappdir)//'/TSKY.DAT' +#ifdef Win32 + open(13,file=fname,status='old',form='binary',err=10) + read(13) nsky + close(13) +#else + call rfile2(fname,nsky,129600,nr) + if(nr.ne.129600) go to 10 +#endif + ltsky=.true. + first=.false. + endif + go to 20 + 10 ltsky=.false. + + 20 call grid2deg(MyGrid,elon,lat) + lon=-elon + call sun(nyear,month,nday,uth,lon,lat,RASun,DecSun,LST, + + AzSun,ElSun,mjd) + +! If(NStation.eq.1 .and. ElSun.gt.-2.0) then +! arg=ElSun + 8.6/(ElSun+4.4) +! refraction=0.0167/tan(arg/rad) !Refraction in degrees +! ElSun=ElSun+refraction +! endif + + mjd2=mjd + freq=nfreq*1.e6 + + call MoonDop(nyear,month,nday,uth,lon,lat,RAMoon,DecMoon, + + LST,HA,AzMoon,ElMoon,ldeg,bdeg,vr,dist) + +C Compute spatial polarization offset + xx=sin(lat/rad)*cos(ElMoon/rad) - cos(lat/rad)* + + cos(AzMoon/rad)*sin(ElMoon/rad) + yy=cos(lat/rad)*sin(AzMoon/rad) + if(NStation.eq.1) poloffset1=rad*atan2(yy,xx) + if(NStation.eq.2) poloffset2=rad*atan2(yy,xx) + +! If(NStation.eq.1 .and. ElMoon.gt.-2.0) then +! arg=ElMoon + 8.6/(ElMoon+4.4) +! refraction=0.0167/tan(arg/rad) !Refraction in degrees +! ElMoon=ElMoon+refraction +! endif + + techo=2.0 * dist/2.99792458e5 !Echo delay time + doppler=-freq*vr/2.99792458e5 !One-way Doppler + t408=ftsky(ldeg,bdeg) !Read sky map + tsky=t408*(408.0/nfreq)**2.6 !Tsky for obs freq + if(ltsky.and.(tsky.lt.3.0)) tsky=3.0 !Minimum = 3 Kelvin + + xdop(NStation)=doppler + if(NStation.eq.2) then + HisGrid=MyGrid + go to 900 + endif + + doppler00=2.0*xdop(1) + if(mode.eq.2 .or. mode.eq.5) doppler=xdop(1)+xdop(2) + if(mode.eq.3) doppler=2.0*xdop(1) + dBMoon=-40.0*log10(dist/356903.) + sd=16.23*370152.0/dist + +! if(NStation.eq.1 .and. MoonDX.ne.0 .and. +! + (mode.eq.2 .or. mode.eq.5)) then + if(NStation.eq.1 .and. MoonDX.ne.0) then + poloffset=mod(poloffset2-poloffset1+720.0,180.0) + if(poloffset.gt.90.0) poloffset=poloffset-180.0 + x1=abs(cos(2*poloffset/rad)) + if(x1.lt.0.056234) x1=0.056234 + xnr=-20.0*log10(x1) + if(HisGrid(1:1).lt.'A' .or. HisGrid(1:1).gt.'Z') xnr=0 + endif + + tr=80.0 !Good preamp + tskymin=13.0*(408.0/nfreq)**2.6 !Cold sky temperature + tsysmin=tskymin+tr + tsys=tsky+tr + dgrd=-10.0*log10(tsys/tsysmin) + dbMoon + + 900 ElMoon0=Elmoon + ntsky=nint(tsky) + + auxHA = 15.0*(LST-auxra) !HA in degrees + pi=3.14159265 + pio2=0.5*pi + call coord(pi,pio2-lat/rad,0.0,lat/rad,auxha*pi/180.0, + + auxdec/rad,azaux,elaux) + AzAux=azaux*rad + ElAux=ElAux*rad + + return + + end diff --git a/astro0.F90 b/astro0.F90 index a529331b6..c240344e1 100644 --- a/astro0.F90 +++ b/astro0.F90 @@ -10,7 +10,6 @@ subroutine astro0(nyear,month,nday,uth8,nfreq,grid,cauxra,cauxdec, & character grid*6 character*9 cauxra,cauxdec - real*8 utch8 real*8 AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,AzAux8,ElAux8 real*8 dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,xnr8,dfdt,dfdt0 real*8 sd8,poloffset8 diff --git a/audio_init.F90 b/audio_init.F90 index 92bbb7c1e..eef9a50f7 100644 --- a/audio_init.F90 +++ b/audio_init.F90 @@ -1,78 +1,77 @@ -!------------------------------------------------ audio_init -subroutine audio_init(ndin,ndout) - -#ifdef Win32 - use dfmt - integer Thread1,Thread2 - external a2d,decode1 -#endif - - integer*2 a(225000) !Pixel values for 750 x 300 array - integer brightness,contrast - include 'gcom1.f90' - include 'gcom2.f90' - - nmode=1 - if(mode(1:4).eq.'JT65') then - nmode=2 - if(mode(5:5).eq.'A') mode65=1 - if(mode(5:5).eq.'B') mode65=2 - if(mode(5:5).eq.'C') mode65=4 - endif - if(mode.eq.'Echo') nmode=3 - if(mode.eq.'JT6M') nmode=4 - ndevin=ndin - ndevout=ndout - TxOK=0 - Transmitting=0 - nfsample=11025 - nspb=1024 - nbufs=2048 - nmax=nbufs*nspb - nwave=60*nfsample - ngo=1 - brightness=0 - contrast=0 - nsec=1 - df=11025.0/4096 - f0=800.0 - do i=1,nwave - iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample)) - enddo - -#ifdef Win32 -! Priority classes (for processes): -! IDLE_PRIORITY_CLASS 64 -! NORMAL_PRIORITY_CLASS 32 -! HIGH_PRIORITY_CLASS 128 - -! Priority definitions (for threads): -! THREAD_PRIORITY_IDLE -15 -! THREAD_PRIORITY_LOWEST -2 -! THREAD_PRIORITY_BELOW_NORMAL -1 -! THREAD_PRIORITY_NORMAL 0 -! THREAD_PRIORITY_ABOVE_NORMAL 1 -! THREAD_PRIORITY_HIGHEST 2 -! THREAD_PRIORITY_TIME_CRITICAL 15 - - m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS) - -! Start a thread for doing A/D and D/A with sound card. - Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1) - m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL) - m2=ResumeThread(Thread1) - -! Start a thread for background decoding. - Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2) - m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL) - m4=ResumeThread(Thread2) -#else -! print*,'Audio INIT called.' - ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, & - 11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, & - Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name) - -#endif - - return -end subroutine audio_init +!------------------------------------------------ audio_init +subroutine audio_init(ndin,ndout) + +#ifdef Win32 + use dfmt + integer Thread1,Thread2 + external a2d,decode1 +#endif + + integer brightness,contrast + include 'gcom1.f90' + include 'gcom2.f90' + + nmode=1 + if(mode(1:4).eq.'JT65') then + nmode=2 + if(mode(5:5).eq.'A') mode65=1 + if(mode(5:5).eq.'B') mode65=2 + if(mode(5:5).eq.'C') mode65=4 + endif + if(mode.eq.'Echo') nmode=3 + if(mode.eq.'JT6M') nmode=4 + ndevin=ndin + ndevout=ndout + TxOK=0 + Transmitting=0 + nfsample=11025 + nspb=1024 + nbufs=2048 + nmax=nbufs*nspb + nwave=60*nfsample + ngo=1 + brightness=0 + contrast=0 + nsec=1 + df=11025.0/4096 + f0=800.0 + do i=1,nwave + iwave(i)=nint(32767.0*sin(6.283185307*i*f0/nfsample)) + enddo + +#ifdef Win32 +! Priority classes (for processes): +! IDLE_PRIORITY_CLASS 64 +! NORMAL_PRIORITY_CLASS 32 +! HIGH_PRIORITY_CLASS 128 + +! Priority definitions (for threads): +! THREAD_PRIORITY_IDLE -15 +! THREAD_PRIORITY_LOWEST -2 +! THREAD_PRIORITY_BELOW_NORMAL -1 +! THREAD_PRIORITY_NORMAL 0 +! THREAD_PRIORITY_ABOVE_NORMAL 1 +! THREAD_PRIORITY_HIGHEST 2 +! THREAD_PRIORITY_TIME_CRITICAL 15 + + m0=SetPriorityClass(GetCurrentProcess(),NORMAL_PRIORITY_CLASS) + +! Start a thread for doing A/D and D/A with sound card. + Thread1=CreateThread(0,0,a2d,0,CREATE_SUSPENDED,id1) + m1=SetThreadPriority(Thread1,THREAD_PRIORITY_ABOVE_NORMAL) + m2=ResumeThread(Thread1) + +! Start a thread for background decoding. + Thread2=CreateThread(0,0,decode1,0,CREATE_SUSPENDED,id2) + m3=SetThreadPriority(Thread2,THREAD_PRIORITY_BELOW_NORMAL) + m4=ResumeThread(Thread2) +#else +! print*,'Audio INIT called.' + ierr=start_threads(ndevin,ndevout,y1,y2,nmax,iwrite,iwave,nwave, & + 11025,NSPB,TRPeriod,TxOK,ndebug,Transmitting, & + Tsec,ngo,nmode,tbuf,ibuf,ndsec,PttPort,devin_name,devout_name) + +#endif + + return +end subroutine audio_init diff --git a/avemsg65.f b/avemsg65.f index 8372cb7c0..d37bf3bed 100644 --- a/avemsg65.f +++ b/avemsg65.f @@ -1,60 +1,63 @@ - subroutine avemsg65(mseg,mode65,ndepth,decoded,nused, - + nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual, - + ns,ncount) - -C Decodes averaged JT65 data for the specified segment (mseg=1 or 2). - - parameter (MAXAVE=120) !Max avg count is 120 - character decoded*22,deepmsg*22 - character mycall*12,hiscall*12,hisgrid*6 - real s3(64,63) - common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE) - -C Count the available spectra for this Monitor segment (mseg=1 or 2), -C and the number of spectra flagged as good. - - nused=0 - ns=0 - nqual=0 - deepmsg=' ' - do i=1,nsave - if(iseg(i).eq.mseg) then - ns=ns+1 - if(nflag(i).eq.1) nused=nused+1 - endif - enddo - if(nused.lt.1) go to 100 - -C Compute the average of all flagged spectra for this segment. - do j=1,63 - call zero(s3(1,j),64) - do n=1,nsave - if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then - call add(s3(1,j),ppsave(1,j,n),s3(1,j),64) - endif - enddo - enddo - - nadd=nused*mode65 - call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message - if(ncount.lt.0) decoded=' ' - - nqual=0 -C Possibly should pass nadd=nused, also: - if(ndepth.ge.3) then - flipx=1.0 !Normal flip not relevant for ave msg - call deep65(s3,mode65,neme,nsked,flipx, - + mycall,hiscall,hisgrid,deepmsg,qual) - nqual=qual - if(nqual.lt.nq1) deepmsg=' ' - if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?' - endif - if(ncount.lt.0) decoded=deepmsg - -C Suppress "birdie messages": - if(decoded(1:7).eq.'000AAA ') decoded=' ' - if(decoded(1:7).eq.'0L6MWK ') decoded=' ' - - 100 if(nused.lt.1) decoded=' ' - return - end + subroutine avemsg65(mseg,mode65,ndepth,decoded,nused, + + nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual, + + ns,ncount) + +C Decodes averaged JT65 data for the specified segment (mseg=1 or 2). + + parameter (MAXAVE=120) !Max avg count is 120 + character decoded*22,deepmsg*22 + character mycall*12,hiscall*12,hisgrid*6 + real s3(64,63) + common/ave/ppsave(64,63,MAXAVE),nflag(MAXAVE),nsave,iseg(MAXAVE) + +C Count the available spectra for this Monitor segment (mseg=1 or 2), +C and the number of spectra flagged as good. + + nused=0 + ns=0 + nqual=0 + deepmsg=' ' + do i=1,nsave + if(iseg(i).eq.mseg) then + ns=ns+1 + if(nflag(i).eq.1) nused=nused+1 + endif + enddo + if(nused.lt.1) go to 100 + +C Compute the average of all flagged spectra for this segment. + do j=1,63 + call zero(s3(1,j),64) + do n=1,nsave + if(nflag(n).eq.1 .and. iseg(n).eq.mseg) then + call add(s3(1,j),ppsave(1,j,n),s3(1,j),64) + endif + enddo + enddo + + nadd=nused*mode65 + call extract(s3,nadd,ncount,decoded) !Extract the message + if(ncount.lt.0) decoded=' ' + + nqual=0 +C Possibly should pass nadd=nused, also: + if(ndepth.ge.3) then + flipx=1.0 !Normal flip not relevant for ave msg + call deep65(s3,mode65,neme,nsked,flipx, + + mycall,hiscall,hisgrid,deepmsg,qual) + nqual=qual + if(nqual.lt.nq1) deepmsg=' ' + if(nqual.ge.nq1 .and. nqual.lt.nq2) deepmsg(19:19)='?' + else + deepmsg=' ' + qual=0. + endif + if(ncount.lt.0) decoded=deepmsg + +C Suppress "birdie messages": + if(decoded(1:7).eq.'000AAA ') decoded=' ' + if(decoded(1:7).eq.'0L6MWK ') decoded=' ' + + 100 if(nused.lt.1) decoded=' ' + return + end diff --git a/avesp2.f b/avesp2.f index 2bb635614..0f1ab1be3 100644 --- a/avesp2.f +++ b/avesp2.f @@ -1,52 +1,52 @@ - subroutine avesp2(dat,jza,nadd,f0,mode,NFreeze,MouseDF, - + DFTolerance,fzap) - - real dat(jza) - integer DFTolerance - real psa(1024) !Ave ps, flattened and rolled off - real ref(557) !Ref spectrum, lines excised - real birdie(557) !Birdie spectrum (ave-ref) - real variance(557) - real s2(557,323) - real fzap(200) - - iz=557 !Compute the 2d spectrum - df=11025.0/2048.0 - nfft=nadd*1024 - jz=jza/nfft - do j=1,jz - k=(j-1)*nfft + 1 - call ps(dat(k),nfft,psa) - call move(psa,s2(1,j),iz) - enddo - -C Flatten s2 and get psa, ref, and birdie - call flatten(s2,557,jz,psa,ref,birdie,variance) - - call zero(fzap,200) - ia=300/df - ib=2700/df - n=0 - fmouse=0. - if(mode.eq.2) fmouse=1270.46+MouseDF - if(mode.eq.4) fmouse=1076.66+MouseDF - - do i=ia,ib - if(birdie(i)-ref(i).gt.3.0) then - f=i*df - -C Don't zap unless Freeze is OFF or birdie is outside the "Tol" range. - if(NFreeze.eq.0 .or. - + abs(f-fmouse).gt.float(DFTolerance)) then - if(n.lt.200 .and. variance(i-1).lt.2.5 .and. - + variance(i).lt.2.5.and.variance(i+1).lt.2.5) then - n=n+1 - fzap(n)=f - endif - endif - - endif - enddo - - return - end + subroutine avesp2(dat,jza,nadd,mode,NFreeze,MouseDF, + + DFTolerance,fzap) + + real dat(jza) + integer DFTolerance + real psa(1024) !Ave ps, flattened and rolled off + real ref(557) !Ref spectrum, lines excised + real birdie(557) !Birdie spectrum (ave-ref) + real variance(557) + real s2(557,323) + real fzap(200) + + iz=557 !Compute the 2d spectrum + df=11025.0/2048.0 + nfft=nadd*1024 + jz=jza/nfft + do j=1,jz + k=(j-1)*nfft + 1 + call ps(dat(k),nfft,psa) + call move(psa,s2(1,j),iz) + enddo + +C Flatten s2 and get psa, ref, and birdie + call flatten(s2,557,jz,psa,ref,birdie,variance) + + call zero(fzap,200) + ia=300/df + ib=2700/df + n=0 + fmouse=0. + if(mode.eq.2) fmouse=1270.46+MouseDF + if(mode.eq.4) fmouse=1076.66+MouseDF + + do i=ia,ib + if(birdie(i)-ref(i).gt.3.0) then + f=i*df + +C Don't zap unless Freeze is OFF or birdie is outside the "Tol" range. + if(NFreeze.eq.0 .or. + + abs(f-fmouse).gt.float(DFTolerance)) then + if(n.lt.200 .and. variance(i-1).lt.2.5 .and. + + variance(i).lt.2.5.and.variance(i+1).lt.2.5) then + n=n+1 + fzap(n)=f + endif + endif + + endif + enddo + + return + end diff --git a/decode1.F90 b/decode1.F90 index bac214973..4a95e7cce 100644 --- a/decode1.F90 +++ b/decode1.F90 @@ -9,7 +9,7 @@ subroutine decode1(iarg) use dflib #endif - character sending0*28,fcum*80,mode0*6,cshort*11 + character sending0*28,mode0*6,cshort*11 integer sendingsh0 include 'gcom1.f90' diff --git a/decode2.f90 b/decode2.f90 index 2ba8dd9e7..720afa111 100644 --- a/decode2.f90 +++ b/decode2.f90 @@ -5,7 +5,6 @@ subroutine decode2 ! Get data and parameters from gcom, then call the decoders character fnamex*24 - integer*2 d2d(30*11025) include 'gcom1.f90' include 'gcom2.f90' diff --git a/decode3.F90 b/decode3.F90 index deab3a777..647393390 100644 --- a/decode3.F90 +++ b/decode3.F90 @@ -5,12 +5,9 @@ subroutine decode3(d2,jz,istart,filename) use dfport #endif - integer*2 d2(jz),d2d(60*11025) - real*8 sq + integer*2 d2(jz),d2d(65*11025) character*24 filename character FileID*40 - character mycall0*12,hiscall0*12,hisgrid0*6 - logical savefile include 'gcom1.f90' include 'gcom2.f90' @@ -51,10 +48,20 @@ subroutine decode3(d2,jz,istart,filename) endif open(23,file=appdir(:lenappdir)//'/CALL3.TXT',status='unknown') + if(nadd5.eq.1) then + nzero=5*11025 + do i=jz,nzero+1,-1 + d2d(i)=d2d(i-nzero) + enddo + do i=1,nzero + d2d(i)=0 + enddo + jz=min(60*11025,jz+nzero) + endif call wsjt1(d2d,jz,istart,samfacin,FileID,ndepth,MinSigdB, & - NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve, & - nMode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65, & - MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2, & + NQRN,DFTolerance,MouseButton,NClearAve, & + nMode,NFreeze,NAFC,NZap,mode65, & + MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2, & ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, & MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2) close(23) diff --git a/decode65.f b/decode65.f index 7d4811114..8986dbfe1 100644 --- a/decode65.f +++ b/decode65.f @@ -1,53 +1,53 @@ - subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked, - + nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount, - + deepmsg,qual) - -C Decodes JT65 data, assuming that DT and DF have already been determined. - - real dat(npts) !Raw data - real s2(77,126) - real s3(64,63) - real ftrack(126) - character decoded*22,deepmsg*22 - character mycall*12,hiscall*12,hisgrid*6 - include 'avecom.h' - include 'prcom.h' - save - - dt=2.0/11025.0 !Sample interval (2x downsampled data) - istart=nint(dtx/dt) !Start index for synced FFTs - nsym=126 - -C Compute spectra of the channel symbols - f0=1270.46 + dfx - call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2) - - do j=1,63 - k=mdat(j) !Points to data symbol - if(flip.lt.0.0) k=mdat2(j) - do i=1,64 - s3(i,j)=s2(i+7,k) - enddo - enddo - nadd=mode65 - - call extract(s3,nadd,ndepth,ncount,decoded) !Extract the message - qual=0. - if(ndepth.ge.1) call deep65(s3,mode65,neme, - + nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual) - - if(ncount.lt.0) decoded=' ' - -C Suppress "birdie messages": - if(decoded(1:7).eq.'000AAA ') decoded=' ' - if(decoded(1:7).eq.'0L6MWK ') decoded=' ' - -C Save symbol spectra for possible decoding of average. - do j=1,63 - k=mdat(j) - if(flip.lt.0.0) k=mdat2(j) - call move(s2(8,k),ppsave(1,j,nsave),64) - enddo - - return - end + subroutine decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked, + + mycall,hiscall,hisgrid,mode65,nafc,decoded,ncount, + + deepmsg,qual) + +C Decodes JT65 data, assuming that DT and DF have already been determined. + + real dat(npts) !Raw data + real s2(77,126) + real s3(64,63) + real ftrack(126) + character decoded*22,deepmsg*22 + character mycall*12,hiscall*12,hisgrid*6 + include 'avecom.h' + include 'prcom.h' + save + + dt=2.0/11025.0 !Sample interval (2x downsampled data) + istart=nint(dtx/dt) !Start index for synced FFTs + nsym=126 + +C Compute spectra of the channel symbols + f0=1270.46 + dfx + call spec2d65(dat,npts,nsym,flip,istart,f0,ftrack,nafc,mode65,s2) + + do j=1,63 + k=mdat(j) !Points to data symbol + if(flip.lt.0.0) k=mdat2(j) + do i=1,64 + s3(i,j)=s2(i+7,k) + enddo + enddo + nadd=mode65 + + call extract(s3,nadd,ncount,decoded) !Extract the message + qual=0. + if(ndepth.ge.1) call deep65(s3,mode65,neme, + + nsked,flip,mycall,hiscall,hisgrid,deepmsg,qual) + + if(ncount.lt.0) decoded=' ' + +C Suppress "birdie messages": + if(decoded(1:7).eq.'000AAA ') decoded=' ' + if(decoded(1:7).eq.'0L6MWK ') decoded=' ' + +C Save symbol spectra for possible decoding of average. + do j=1,63 + k=mdat(j) + if(flip.lt.0.0) k=mdat2(j) + call move(s2(8,k),ppsave(1,j,nsave),64) + enddo + + return + end diff --git a/deep65.F b/deep65.F index 0229c2435..7231e9c9d 100644 --- a/deep65.F +++ b/deep65.F @@ -1,158 +1,155 @@ - subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall, - + hisgrid,decoded,qual) - - parameter (MAXCALLS=7000,MAXRPT=63) - real s3(64,63) - character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3 - character*12 mycall,hiscall - character*22 decoded - character*22 testmsg(2*MAXCALLS + 2 + MAXRPT) - character*15 callgrid(MAXCALLS) - character*180 line - character*4 rpt(MAXRPT) - integer ncode(63,2*MAXCALLS + 2 + MAXRPT) - real pp(2*MAXCALLS + 2 + MAXRPT) - common/tmp9/ mrs(63),mrs2(63) - - data neme0/-99/ - data rpt/'-01','-02','-03','-04','-05', - + '-06','-07','-08','-09','-10', - + '-11','-12','-13','-14','-15', - + '-16','-17','-18','-19','-20', - + '-21','-22','-23','-24','-25', - + '-26','-27','-28','-29','-30', - + 'R-01','R-02','R-03','R-04','R-05', - + 'R-06','R-07','R-08','R-09','R-10', - + 'R-11','R-12','R-13','R-14','R-15', - + 'R-16','R-17','R-18','R-19','R-20', - + 'R-21','R-22','R-23','R-24','R-25', - + 'R-26','R-27','R-28','R-29','R-30', - + 'RO','RRR','73'/ - - rewind 23 - k=0 - icall=0 - do n=1,MAXCALLS - if(n.eq.1) then - callsign=hiscall - do i=4,12 - if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' ' - enddo - grid=hisgrid(1:4) - if(ichar(grid(3:3)).eq.0) grid(3:3)=' ' - if(ichar(grid(4:4)).eq.0) grid(4:4)=' ' - else - read(23,1002,end=20) line - 1002 format (A80) - if(line(1:4).eq.'ZZZZ') go to 20 - if(line(1:2).eq.'//') go to 10 - i1=index(line,',') - if(i1.lt.4) go to 10 - i2=index(line(i1+1:),',') - if(i2.lt.5) go to 10 - i2=i2+i1 - i3=index(line(i2+1:),',') - if(i3.lt.1) i3=index(line(i2+1:),' ') - i3=i2+i3 - callsign=line(1:i1-1) - grid=line(i1+1:i2-1) - ceme=line(i2+1:i3-1) - if(neme.eq.1 .and. ceme.ne.'EME') go to 10 - endif - - icall=icall+1 - j1=index(mycall,' ') - 1 - if(j1.le.-1) j1=12 - if(j1.lt.3) j1=6 - j2=index(callsign,' ') - 1 - if(j2.le.-1) j2=12 - if(j2.lt.3) j2=6 - j3=index(mycall,'/') - j4=index(callsign,'/') - callgrid(icall)=callsign(1:j2) - - mz=1 - if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and. - + flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1 -C Test for messages with MyCall + HisCall + report - do m=1,mz - if(m.gt.1) grid=rpt(m-1) - if(j3.lt.1 .and.j4.lt.1) - + callgrid(icall)=callsign(1:j2)//' '//grid - message=mycall(1:j1)//' '//callgrid(icall) - k=k+1 - testmsg(k)=message - call encode65(message,ncode(1,k)) -C Insert CQ message unless sync=OOO (flip=-1). - if(m.eq.1 .and. flip.gt.0.0) then - message='CQ '//callgrid(icall) - k=k+1 - testmsg(k)=message - call encode65(message,ncode(1,k)) - endif - enddo - if(nsked.eq.1) go to 20 - 10 enddo - 20 ntot=k - neme0=neme - - ref0=0. - do j=1,63 - ref0=ref0 + s3(mrs(j),j) - enddo - - p1=-1.e30 - p2=-1.e30 - do k=1,ntot - sum=0. - ref=ref0 - do j=1,63 - i=ncode(j,k)+1 - sum=sum + s3(i,j) - if(i.eq.mrs(j)) then - ref=ref - s3(i,j) + s3(mrs2(j),j) - endif - enddo - p=sum/ref - pp(k)=p - if(p.gt.p1) then - p1=p - ip1=k - endif - enddo - - p2=-1.e30 - do i=1,ntot - if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i) - enddo - - if(mode65.eq.1) bias=max(1.12*p2,0.335) - if(mode65.eq.2) bias=max(1.08*p2,0.405) - if(mode65.ge.4) bias=max(1.04*p2,0.505) - - -C This is really weird, but do not remove the following statements! -! write(77,*) mode65,bias,p1,p2 -! rewind 77 -! rewind 23 - call sleepqqq(1) - - qual=100.0*(p1-bias) - decoded=' ' - c=' ' - - if(qual.gt.1.0) then - if(qual.lt.6.0) c='?' - decoded=testmsg(ip1) - else - qual=0. - endif - decoded(22:22)=c -C Make sure everything is upper case. - do i=1,22 - if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z') - + decoded(i:i)=char(ichar(decoded(i:i))-32) - enddo - - return - end + subroutine deep65(s3,mode65,neme,nsked,flip,mycall,hiscall, + + hisgrid,decoded,qual) + + parameter (MAXCALLS=7000,MAXRPT=63) + real s3(64,63) + character callsign*12,grid*4,message*22,hisgrid*6,c*1,ceme*3 + character*12 mycall,hiscall + character*22 decoded + character*22 testmsg(2*MAXCALLS + 2 + MAXRPT) + character*15 callgrid(MAXCALLS) + character*180 line + character*4 rpt(MAXRPT) + integer ncode(63,2*MAXCALLS + 2 + MAXRPT) + real pp(2*MAXCALLS + 2 + MAXRPT) + common/tmp9/ mrs(63),mrs2(63) +#ifdef Win32 +C This prevents some optimizations that break this subroutine. + volatile p1,p2,bias +#endif + + data neme0/-99/ + data rpt/'-01','-02','-03','-04','-05', + + '-06','-07','-08','-09','-10', + + '-11','-12','-13','-14','-15', + + '-16','-17','-18','-19','-20', + + '-21','-22','-23','-24','-25', + + '-26','-27','-28','-29','-30', + + 'R-01','R-02','R-03','R-04','R-05', + + 'R-06','R-07','R-08','R-09','R-10', + + 'R-11','R-12','R-13','R-14','R-15', + + 'R-16','R-17','R-18','R-19','R-20', + + 'R-21','R-22','R-23','R-24','R-25', + + 'R-26','R-27','R-28','R-29','R-30', + + 'RO','RRR','73'/ + + rewind 23 + k=0 + icall=0 + do n=1,MAXCALLS + if(n.eq.1) then + callsign=hiscall + do i=4,12 + if(ichar(callsign(i:i)).eq.0) callsign(i:i)=' ' + enddo + grid=hisgrid(1:4) + if(ichar(grid(3:3)).eq.0) grid(3:3)=' ' + if(ichar(grid(4:4)).eq.0) grid(4:4)=' ' + else + read(23,1002,end=20) line + 1002 format (A80) + if(line(1:4).eq.'ZZZZ') go to 20 + if(line(1:2).eq.'//') go to 10 + i1=index(line,',') + if(i1.lt.4) go to 10 + i2=index(line(i1+1:),',') + if(i2.lt.5) go to 10 + i2=i2+i1 + i3=index(line(i2+1:),',') + if(i3.lt.1) i3=index(line(i2+1:),' ') + i3=i2+i3 + callsign=line(1:i1-1) + grid=line(i1+1:i2-1) + ceme=line(i2+1:i3-1) + if(neme.eq.1 .and. ceme.ne.'EME') go to 10 + endif + + icall=icall+1 + j1=index(mycall,' ') - 1 + if(j1.le.-1) j1=12 + if(j1.lt.3) j1=6 + j2=index(callsign,' ') - 1 + if(j2.le.-1) j2=12 + if(j2.lt.3) j2=6 + j3=index(mycall,'/') + j4=index(callsign,'/') + callgrid(icall)=callsign(1:j2) + + mz=1 + if(n.eq.1 .and. j3.lt.1 .and. j4.lt.1 .and. + + flip.gt.0.0 .and. callsign(1:6).ne.' ') mz=MAXRPT+1 +C Test for messages with MyCall + HisCall + report + do m=1,mz + if(m.gt.1) grid=rpt(m-1) + if(j3.lt.1 .and.j4.lt.1) + + callgrid(icall)=callsign(1:j2)//' '//grid + message=mycall(1:j1)//' '//callgrid(icall) + k=k+1 + testmsg(k)=message + call encode65(message,ncode(1,k)) +C Insert CQ message unless sync=OOO (flip=-1). + if(m.eq.1 .and. flip.gt.0.0) then + message='CQ '//callgrid(icall) + k=k+1 + testmsg(k)=message + call encode65(message,ncode(1,k)) + endif + enddo + if(nsked.eq.1) go to 20 + 10 continue + enddo + 20 ntot=k + neme0=neme + + ref0=0. + do j=1,63 + ref0=ref0 + s3(mrs(j),j) + enddo + + p1=-1.e30 + p2=-1.e30 + do k=1,ntot + sum=0. + ref=ref0 + do j=1,63 + i=ncode(j,k)+1 + sum=sum + s3(i,j) + if(i.eq.mrs(j)) then + ref=ref - s3(i,j) + s3(mrs2(j),j) + endif + enddo + p=sum/ref + pp(k)=p + if(p.gt.p1) then + p1=p + ip1=k + endif + enddo + + p2=-1.e30 + do i=1,ntot + if(pp(i).gt.p2 .and. pp(i).ne.p1) p2=pp(i) + enddo + + if(mode65.eq.1) bias=max(1.12*p2,0.335) + if(mode65.eq.2) bias=max(1.08*p2,0.405) + if(mode65.ge.4) bias=max(1.04*p2,0.505) + qual=100.0*(p1-bias) + decoded=' ' + c=' ' + + if(qual.gt.1.0) then + if(qual.lt.6.0) c='?' + decoded=testmsg(ip1) + else + qual=0. + endif + decoded(22:22)=c +C Make sure everything is upper case. + do i=1,22 + if(decoded(i:i).ge.'a' .and. decoded(i:i).le.'z') + + decoded(i:i)=char(ichar(decoded(i:i))-32) + enddo + + return + end diff --git a/extract.f b/extract.f index 1bebeca9d..4a06c326a 100644 --- a/extract.f +++ b/extract.f @@ -1,77 +1,73 @@ - subroutine extract(s3,nadd,ndepth,ncount,decoded) - - real s3(64,63) - character decoded*22 - integer*1 dat1(12) - integer dat(63),era(51),dat4(12),indx(63) - integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63) - logical first - data first/.true./,nsec1/0/ - save - - call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) - - if(ntest.lt.50 .or. nlow.gt.20) then - ncount=-999 !Flag bad data - go to 900 - endif - - call graycode(mrsym,63,-1) - call interleave63(mrsym,-1) - call interleave63(mrprob,-1) - - ndec=1 - nemax=30 - maxe=8 -! if(ndepth.ge.2) ndec=1 -! if(ndepth.eq.2) xlambda=13.0 -! if(ndepth.eq.3) xlambda=15.0 - xlambda=15.0 - - if(ndec.eq.1) then - call graycode(mr2sym,63,-1) - call interleave63(mr2sym,-1) - call interleave63(mr2prob,-1) - - nsec1=nsec1+1 - write(22,rec=1) nsec1,xlambda,maxe,200, - + mrsym,mrprob,mr2sym,mr2prob - call flushqqq(22) - call runqqq('kvasd.exe','-q',iret) - if(iret.ne.0) then - if(first) write(*,1000) - 1000 format('Error in KV decoder, or no KV decoder present.'/ - + 'Using BM algorithm.') - ndec=0 - first=.false. - go to 20 - endif - read(22,rec=2) nsec2,ncount,dat4 - decoded=' ' - if(ncount.ge.0) then - call unpackmsg(dat4,decoded) !Unpack the user message - endif - endif - 20 if(ndec.eq.0) then - call indexx(63,mrprob,indx) - do i=1,nemax - j=indx(i) - if(mrprob(j).gt.120) then - ne2=i-1 - go to 2 - endif - era(i)=j-1 - enddo - ne2=nemax - 2 decoded=' ' - do nerase=0,ne2,2 - call rs_decode(mrsym,era,nerase,dat4,ncount) - if(ncount.ge.0) then - call unpackmsg(dat4,decoded) - go to 900 - endif - enddo - endif - - 900 return - end + subroutine extract(s3,nadd,ncount,decoded) + + real s3(64,63) + character decoded*22 + integer era(51),dat4(12),indx(63) + integer mrsym(63),mr2sym(63),mrprob(63),mr2prob(63) + logical first + data first/.true./,nsec1/0/ + save + + call demod64a(s3,nadd,mrsym,mrprob,mr2sym,mr2prob,ntest,nlow) + + if(ntest.lt.50 .or. nlow.gt.20) then + ncount=-999 !Flag bad data + go to 900 + endif + + call graycode(mrsym,63,-1) + call interleave63(mrsym,-1) + call interleave63(mrprob,-1) + + ndec=1 + nemax=30 + maxe=8 + xlambda=15.0 + + if(ndec.eq.1) then + call graycode(mr2sym,63,-1) + call interleave63(mr2sym,-1) + call interleave63(mr2prob,-1) + + nsec1=nsec1+1 + write(22,rec=1) nsec1,xlambda,maxe,200, + + mrsym,mrprob,mr2sym,mr2prob + call flushqqq(22) + call runqqq('kvasd.exe','-q',iret) + if(iret.ne.0) then + if(first) write(*,1000) + 1000 format('Error in KV decoder, or no KV decoder present.'/ + + 'Using BM algorithm.') + ndec=0 + first=.false. + go to 20 + endif + read(22,rec=2) nsec2,ncount,dat4 + decoded=' ' + if(ncount.ge.0) then + call unpackmsg(dat4,decoded) !Unpack the user message + endif + endif + 20 if(ndec.eq.0) then + call indexx(63,mrprob,indx) + do i=1,nemax + j=indx(i) + if(mrprob(j).gt.120) then + ne2=i-1 + go to 2 + endif + era(i)=j-1 + enddo + ne2=nemax + 2 decoded=' ' + do nerase=0,ne2,2 + call rs_decode(mrsym,era,nerase,dat4,ncount) + if(ncount.ge.0) then + call unpackmsg(dat4,decoded) + go to 900 + endif + enddo + endif + + 900 return + end diff --git a/fivehz.F90 b/fivehz.F90 index a4672cf1c..1c3c595df 100644 --- a/fivehz.F90 +++ b/fivehz.F90 @@ -14,8 +14,10 @@ subroutine fivehz use dfport #endif + parameter (NTRING=64) + real*8 tt1(0:NTRING-1) real*8 tstart,tstop,t60 - logical first,txtime,debug + logical first,txtime,debug,filled integer ptt integer TxOKz real*8 fs,fsample,tt,tt0,u @@ -40,22 +42,36 @@ subroutine fivehz ibuf00=-99 ncall=-1 tt0=tt - u=0.1d0 + u=0.05d0 fsample=11025.d0 maxms=0 mfsample=110250 + filled=.false. endif if(txdelay.lt.0.2d0) txdelay=0.2d0 ! Measure average sampling frequency over a recent interval - ncall=ncall+1 - if(ncall.eq.9) tt0=tt - if(ncall.ge.10 .and. mod(ncall,2).eq.1) then - fs=(ncall-9)*2048.d0/(tt-tt0) - fsample=u*fs + (1.d0-u)*fsample - mfsample=nint(10.d0*fsample) + if(ncall.eq.9) then + tt0=tt + ntt0=0 + ntt1=0 + tt1(ntt1)=tt + endif +! if(ncall.ge.10 .and. mod(ncall,2).eq.1) then + if(ncall.ge.10) then + ntt1=iand(ntt1+1,NTRING-1) + tt1(ntt1)=tt + if(ntt1.eq.NTRING-1) filled=.true. + if(filled) ntt0=iand(ntt1+1,NTRING-1) + if(mod(ncall,2).eq.1) then + nd=ntt1-ntt0 + if(nd.lt.0) nd=nd+NTRING + fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0)) + fsample=u*fs + (1.d0-u)*fsample + mfsample=nint(10.d0*fsample) + endif endif if(trperiod.le.0) trperiod=30 @@ -180,7 +196,9 @@ subroutine fivehztx use dfport #endif - logical first + parameter (NTRING=64) + real*8 tt1(0:NTRING-1) + logical first,filled real*8 fs,fsample,tt,tt0,u include 'gcom1.f90' data first/.true./ @@ -195,18 +213,34 @@ subroutine fivehztx ncall=-1 fsample=11025.d0 nsec0=-999 - u=0.1d0 + u=0.05d0 mfsample2=110250 tt0=tt + filled=.false. endif +! Measure average sampling frequency over a recent interval ncall=ncall+1 - if(ncall.eq.9) tt0=tt - if(ncall.ge.10 .and. mod(ncall,2).eq.1) then - fs=(ncall-9)*2048.d0/(tt-tt0) - fsample=u*fs + (1.d0-u)*fsample - mfsample2=nint(10.d0*fsample) + if(ncall.eq.9) then + tt0=tt + ntt0=0 + ntt1=0 + tt1(ntt1)=tt endif + if(ncall.ge.10) then + ntt1=iand(ntt1+1,NTRING-1) + tt1(ntt1)=tt + if(ntt1.eq.NTRING-1) filled=.true. + if(filled) ntt0=iand(ntt1+1,NTRING-1) + if(mod(ncall,2).eq.1) then + nd=ntt1-ntt0 + if(nd.lt.0) nd=nd+NTRING + fs=nd*2048.d0/(tt1(ntt1)-tt1(ntt0)) + fsample=u*fs + (1.d0-u)*fsample + mfsample2=nint(10.d0*fsample) + endif + endif + return end subroutine fivehztx diff --git a/gcom2.f90 b/gcom2.f90 index 66a18aefd..1d3cc6ee4 100644 --- a/gcom2.f90 +++ b/gcom2.f90 @@ -20,6 +20,7 @@ integer nrestart !True if transmission should restart GUI,SoundIn integer ntr !Are we in 2nd sequence? SoundIn integer nmsg !Length of Tx message SoundIn integer nsave !Which files to save? GUI +integer nadd5 !Prepend 5 sec of 0's before decoding? GUI integer dftolerance !DF tolerance (Hz) GUI logical LDecoded !Was a message decoded? Decoder logical rxdone !Has the Rx sequence finished? SoundIn,Decoder @@ -85,7 +86,7 @@ character*12 pttport common/gcom2/ps0(431),psavg(450),s2(64,3100),ccf(-5:540), & green(500),ngreen,dgain,iter,ndecoding,ndecoding0,mousebutton, & - ndecdone,npingtime,ierr,lauto,mantx,nrestart,ntr,nmsg,nsave, & + ndecdone,npingtime,ierr,lauto,mantx,nrestart,ntr,nmsg,nsave,nadd5, & dftolerance,LDecoded,rxdone,monitoring,nzap,nsavecum,minsigdb, & nclearave,nfreeze,nafc,nmode,mode65,nclip,ndebug,nblank,nport, & mousedf,neme,nsked,naggressive,ntx2,nslim2,nagain,nsavelast, & diff --git a/gencw.f b/gencw.f index de4d04961..2c119456d 100644 --- a/gencw.f +++ b/gencw.f @@ -1,80 +1,80 @@ - subroutine gencw(msg,wpm,freqcw,samfac,TRPeriod,iwave,nwave) - - parameter (NMAX=150*11025) - character msg*22,word12*22,word3*22 - integer*2 iwave(NMAX) - integer TRPeriod - - integer*1 idat(5000),idat1(460),idat2(200),i1 - real*8 dt,t,twopi,pha,dpha,tdit,samfac - data twopi/6.283185307d0/ - - nwords=0 - do i=2,22 - if(msg(i-1:i).eq.' ') go to 10 - if(msg(i:i).eq.' ') then - nwords=nwords+1 - j=j0 - j0=i+1 - endif - enddo - 10 ntype=1 !Call1+Call2, CQ+Call - word12=msg - if(nwords.eq.3) then - word3=msg(j:j0-1) - word12(j-1:)=' ' - ntype=3 !BC+RO, BC+RRR, BC+73 - if(word3.eq.'OOO') ntype=2 !BC+OOO - endif - - tdit=1.2d0/wpm !Key-down dit time, seconds - call morse(word12,idat1,nmax1) !Encode part 1 of msg - t1=tdit*nmax1 !Time for part1, once - nrpt1=TRPeriod/t1 !Repetitions of part 1 - if(ntype.eq.2) nrpt1=0.75*TRPeriod/t1 - if(ntype.eq.3) nrpt1=1 - t1=nrpt1*t1 !Total time for part 1 - nrpt2=0 - t2=0. - if(ntype.ge.2) then - call morse(word3,idat2,nmax2) !Encode part 2 - t2=tdit*nmax2 !Time for part 2, once - nrpt2=(TRPeriod-t1)/t2 !Repetitions of part 2 - t2=nrpt2*t2 !Total time for part 2 - endif - - j=0 - do n=1,nrpt1 - do i=1,nmax1 - j=j+1 - idat(j)=idat1(i) - enddo - enddo - do n=1,nrpt2 - do i=1,nmax2 - j=j+1 - idat(j)=idat2(i) - enddo - enddo - - dt=1.d0/(11025.d0*samfac) - nwave=j*tdit/dt - pha=0. - dpha=twopi*freqcw*dt - t=0. - s=0. - u=wpm/(11025*0.03) - do i=1,nwave - t=t+dt - pha=pha+dpha - j=t/tdit + 1 -! iwave(i)=0 -! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha)) - s=s + u*(idat(j)-s) - iwave(i)=nint(s*32767.d0*sin(pha)) - enddo - - return - end - - include 'gencwid.f' + subroutine gencw(msg,wpm,freqcw,samfac,TRPeriod,iwave,nwave) + + parameter (NMAX=150*11025) + character msg*22,word12*22,word3*22 + integer*2 iwave(NMAX) + integer TRPeriod + + integer*1 idat(5000),idat1(460),idat2(200) + real*8 dt,t,twopi,pha,dpha,tdit,samfac + data twopi/6.283185307d0/ + + nwords=0 + do i=2,22 + if(msg(i-1:i).eq.' ') go to 10 + if(msg(i:i).eq.' ') then + nwords=nwords+1 + j=j0 + j0=i+1 + endif + enddo + 10 ntype=1 !Call1+Call2, CQ+Call + word12=msg + if(nwords.eq.3) then + word3=msg(j:j0-1) + word12(j-1:)=' ' + ntype=3 !BC+RO, BC+RRR, BC+73 + if(word3.eq.'OOO') ntype=2 !BC+OOO + endif + + tdit=1.2d0/wpm !Key-down dit time, seconds + call morse(word12,idat1,nmax1) !Encode part 1 of msg + t1=tdit*nmax1 !Time for part1, once + nrpt1=TRPeriod/t1 !Repetitions of part 1 + if(ntype.eq.2) nrpt1=0.75*TRPeriod/t1 + if(ntype.eq.3) nrpt1=1 + t1=nrpt1*t1 !Total time for part 1 + nrpt2=0 + t2=0. + if(ntype.ge.2) then + call morse(word3,idat2,nmax2) !Encode part 2 + t2=tdit*nmax2 !Time for part 2, once + nrpt2=(TRPeriod-t1)/t2 !Repetitions of part 2 + t2=nrpt2*t2 !Total time for part 2 + endif + + j=0 + do n=1,nrpt1 + do i=1,nmax1 + j=j+1 + idat(j)=idat1(i) + enddo + enddo + do n=1,nrpt2 + do i=1,nmax2 + j=j+1 + idat(j)=idat2(i) + enddo + enddo + + dt=1.d0/(11025.d0*samfac) + nwave=j*tdit/dt + pha=0. + dpha=twopi*freqcw*dt + t=0. + s=0. + u=wpm/(11025*0.03) + do i=1,nwave + t=t+dt + pha=pha+dpha + j=t/tdit + 1 +! iwave(i)=0 +! if(idat(j).ne.0) iwave(i)=nint(32767.d0*sin(pha)) + s=s + u*(idat(j)-s) + iwave(i)=nint(s*32767.d0*sin(pha)) + enddo + + return + end + + include 'gencwid.f' diff --git a/getpfx2.f b/getpfx2.f index 11d630159..fc7a20c53 100644 --- a/getpfx2.f +++ b/getpfx2.f @@ -10,7 +10,7 @@ if(k.ge.1 .and. k.le.NZ) then iz=index(pfx(k),' ') - 1 callsign=pfx(k)(1:iz)//'/'//callsign - else if(k.ge.401 .and. k.le.411) then + else if(k.ge.401 .and. k.le.400+NZ2) then iz=index(callsign,' ') - 1 callsign=callsign(1:iz)//'/'//sfx(k-400) else if(k.eq.449) then diff --git a/jtaudio.c b/jtaudio.c index 832c8392c..73ee1a438 100644 --- a/jtaudio.c +++ b/jtaudio.c @@ -1,5 +1,10 @@ #include #include +#include + +void fivehz_(); +void fivehztx_(); +void addnoise_(short int *n); // Definition of structure pointing to the audio data typedef struct @@ -66,7 +71,6 @@ static int SoundIn( void *inputBuffer, void *outputBuffer, { paTestData *data = (paTestData*)userData; short *in = (short*)inputBuffer; - short *wptr = (short*)outputBuffer; unsigned int i; static int n0; static int ia=0; @@ -99,8 +103,8 @@ static int SoundIn( void *inputBuffer, void *outputBuffer, // if((inputBuffer==NULL) & (ncall>2) & (stime>stime0)) { if((statusFlags!=0) & (ncall>2) & (stime>stime0)) { if(*data->ndebug) - printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n",stime, - stime-stime0); + printf("Status flags %d at Tsec = %7.1f s, DT = %7.1f\n", + statusFlags,stime,stime-stime0); stime0=stime; } @@ -134,7 +138,6 @@ static int SoundOut( void *inputBuffer, void *outputBuffer, void *userData ) { paTestData *data = (paTestData*)userData; - short *in = (short*)inputBuffer; short *wptr = (short*)outputBuffer; unsigned int i,n; static short int n2; @@ -202,9 +205,9 @@ int jtaudio_(int *ndevin, int *ndevout, short y1[], short y2[], PaStream *outstream; PaStreamParameters inputParameters; PaStreamParameters outputParameters; - PaStreamInfo *streamInfo; + // PaStreamInfo *streamInfo; - int i,nfs,ndin,ndout; + int nfs,ndin,ndout; PaError err1,err2,err2a,err3,err3a; double dnfs; @@ -318,11 +321,11 @@ error: int padevsub_(int *numdev, int *ndefin, int *ndefout, int nchin[], int nchout[]) { - int i,j,n; + int i; int numDevices; const PaDeviceInfo *pdi; PaError err; - PaHostApiInfo *hostapi; + // PaHostApiInfo *hostapi; Pa_Initialize(); diff --git a/longx.f b/longx.f index 844f814af..c45e07d79 100644 --- a/longx.f +++ b/longx.f @@ -1,128 +1,128 @@ - subroutine longx(dat,npts0,ps,DFTolerance,noffset, - + msg,msglen,bauderr,MouseButton) - -C Look for 441-baud modulation, synchronize to it, and decode message. -C Longest allowed data analysis is 1 second. - - parameter (NMAX=11025) - parameter (NDMAX=NMAX/25) - real dat(npts0) - real ps(128),psmo(20) - integer DFTolerance - real y1(NMAX) - real y2(NMAX) - real y3(NMAX) - real y4(NMAX) - real wgt(-2:2) - integer dit(NDMAX) - integer n4(0:2) - character msg*40 - character c*48 - common/acom/a1,a2,a3,a4 - data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/ - data wgt/1.0,4.0,6.0,4.0,1.0/ - - NSPD=25 !Change if FSK110 is implemented - LTone=2 - NBaud=11025/NSPD - npts=min(NMAX,npts0) - df=11025.0/256.0 - smax=0. - -C Find the frequency offset of this ping. -C NB: this might be improved by including a bandpass correction to ps. - - ia=nint((LTone*NBaud-DFTolerance)/df) - ib=nint((LTone*NBaud+DFTolerance)/df) - - do i=ia,ib !Search for correct DF - sum=0. - do j=1,4 !Sum over the 4 tones - m=nint((i*df+(j-1)*NBaud)/df) - do k=-2,2 !Weighted averages over 5 bins - sum=sum+wgt(k)*ps(m+k) - enddo - enddo - k=i-ia+1 - psmo(k)=sum - kpk=0 - if(sum.gt.smax) then - smax=sum - noffset=nint(i*df-LTone*NBaud) - kpk=k - endif - enddo - - - if(kpk.gt.1 .and. kpk.lt.20) then - call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx) - noffset=nint(noffset+dx*df) - endif - -C Do square-law detection in each of four filters. - f1=LTone*NBaud+noffset - f2=(LTone+1)*NBaud+noffset - f3=(LTone+2)*NBaud+noffset - f4=(LTone+3)*NBaud+noffset - call detect(dat,npts,f1,y1) - call detect(dat,npts,f2,y2) - call detect(dat,npts,f3,y3) - call detect(dat,npts,f4,y4) - -C Bandpass correction: - npts=npts-(NSPD-1) - do i=1,npts - y1(i)=y1(i)*a1 - y2(i)=y2(i)*a2 - y3(i)=y3(i)*a3 - y4(i)=y4(i)*a4 - enddo - - call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr) - -C Decimate y arrays by NSPD - ndits=npts/NSPD - 1 - do i=1,ndits - y1(i)=y1(jpk+(i-1)*NSPD) - y2(i)=y2(jpk+(i-1)*NSPD) - y3(i)=y3(jpk+(i-1)*NSPD) - y4(i)=y4(jpk+(i-1)*NSPD) - enddo - -C Now find the mod3 phase that has no tone 3's - n4(0)=0 - n4(1)=0 - n4(2)=0 - do i=1,ndits - ymax=max(y1(i),y2(i),y3(i),y4(i)) - if(y1(i).eq.ymax) dit(i)=0 - if(y2(i).eq.ymax) dit(i)=1 - if(y3(i).eq.ymax) dit(i)=2 - if(y4(i).eq.ymax) then - dit(i)=3 - k=mod(i,3) - n4(k)=n4(k)+1 - endif - enddo - - n4min=min(n4(0),n4(1),n4(2)) - if(n4min.eq.n4(0)) jsync=3 - if(n4min.eq.n4(1)) jsync=1 - if(n4min.eq.n4(2)) jsync=2 -C Might want to notify if n4min>0 or if one of the others is equal -C to n4min. In both cases, could then decode 2 or 3 times, using -C other starting phases. - -C Finally, decode the message. - msg=' ' - msglen=ndits/3 - msglen=min(msglen,40) - do i=1,msglen - j=(i-1)*3+jsync - nc=16*dit(j) + 4*dit(j+1) +dit(j+2) - msg(i:i)=' ' - if(nc.le.47) msg(i:i)=c(nc+1:nc+1) - enddo - - return - end + subroutine longx(dat,npts0,ps,DFTolerance,noffset, + + msg,msglen,bauderr) + +C Look for 441-baud modulation, synchronize to it, and decode message. +C Longest allowed data analysis is 1 second. + + parameter (NMAX=11025) + parameter (NDMAX=NMAX/25) + real dat(npts0) + real ps(128),psmo(20) + integer DFTolerance + real y1(NMAX) + real y2(NMAX) + real y3(NMAX) + real y4(NMAX) + real wgt(-2:2) + integer dit(NDMAX) + integer n4(0:2) + character msg*40 + character c*48 + common/acom/a1,a2,a3,a4 + data c/' 123456789.,?/# $ABCD FGHIJKLMNOPQRSTUVWXY 0EZ '/ + data wgt/1.0,4.0,6.0,4.0,1.0/ + + NSPD=25 !Change if FSK110 is implemented + LTone=2 + NBaud=11025/NSPD + npts=min(NMAX,npts0) + df=11025.0/256.0 + smax=0. + +C Find the frequency offset of this ping. +C NB: this might be improved by including a bandpass correction to ps. + + ia=nint((LTone*NBaud-DFTolerance)/df) + ib=nint((LTone*NBaud+DFTolerance)/df) + + do i=ia,ib !Search for correct DF + sum=0. + do j=1,4 !Sum over the 4 tones + m=nint((i*df+(j-1)*NBaud)/df) + do k=-2,2 !Weighted averages over 5 bins + sum=sum+wgt(k)*ps(m+k) + enddo + enddo + k=i-ia+1 + psmo(k)=sum + kpk=0 + if(sum.gt.smax) then + smax=sum + noffset=nint(i*df-LTone*NBaud) + kpk=k + endif + enddo + + + if(kpk.gt.1 .and. kpk.lt.20) then + call peakup(psmo(kpk-1),psmo(kpk),psmo(kpk+1),dx) + noffset=nint(noffset+dx*df) + endif + +C Do square-law detection in each of four filters. + f1=LTone*NBaud+noffset + f2=(LTone+1)*NBaud+noffset + f3=(LTone+2)*NBaud+noffset + f4=(LTone+3)*NBaud+noffset + call detect(dat,npts,f1,y1) + call detect(dat,npts,f2,y2) + call detect(dat,npts,f3,y3) + call detect(dat,npts,f4,y4) + +C Bandpass correction: + npts=npts-(NSPD-1) + do i=1,npts + y1(i)=y1(i)*a1 + y2(i)=y2(i)*a2 + y3(i)=y3(i)*a3 + y4(i)=y4(i)*a4 + enddo + + call sync(y1,y2,y3,y4,npts,jpk,baud,bauderr) + +C Decimate y arrays by NSPD + ndits=npts/NSPD - 1 + do i=1,ndits + y1(i)=y1(jpk+(i-1)*NSPD) + y2(i)=y2(jpk+(i-1)*NSPD) + y3(i)=y3(jpk+(i-1)*NSPD) + y4(i)=y4(jpk+(i-1)*NSPD) + enddo + +C Now find the mod3 phase that has no tone 3's + n4(0)=0 + n4(1)=0 + n4(2)=0 + do i=1,ndits + ymax=max(y1(i),y2(i),y3(i),y4(i)) + if(y1(i).eq.ymax) dit(i)=0 + if(y2(i).eq.ymax) dit(i)=1 + if(y3(i).eq.ymax) dit(i)=2 + if(y4(i).eq.ymax) then + dit(i)=3 + k=mod(i,3) + n4(k)=n4(k)+1 + endif + enddo + + n4min=min(n4(0),n4(1),n4(2)) + if(n4min.eq.n4(0)) jsync=3 + if(n4min.eq.n4(1)) jsync=1 + if(n4min.eq.n4(2)) jsync=2 +C Might want to notify if n4min>0 or if one of the others is equal +C to n4min. In both cases, could then decode 2 or 3 times, using +C other starting phases. + +C Finally, decode the message. + msg=' ' + msglen=ndits/3 + msglen=min(msglen,40) + do i=1,msglen + j=(i-1)*3+jsync + nc=16*dit(j) + 4*dit(j+1) +dit(j+2) + msg(i:i)=' ' + if(nc.le.47) msg(i:i)=c(nc+1:nc+1) + enddo + + return + end diff --git a/mtdecode.f b/mtdecode.f index 338d1aae6..08b047398 100644 --- a/mtdecode.f +++ b/mtdecode.f @@ -1,149 +1,147 @@ - subroutine mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth, - + NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum, - + cfile6,ps0) - -C Decode Multi-Tone FSK441 mesages. - - real dat(jz) !Raw audio data - real s2(nchan,nz) !2d spectrum of data - integer NQRN - integer DFTolerance - logical pick - character*6 cfile6,cf*1 - - real sigdb(3100) !Detected signal in dB, sampled at 20 ms - real work(3100) - integer indx(3100) - real pingdat(3,100) - real ps(128) - real ps0(128) - character msg*40,msg3*3 - character*90 line - common/ccom/nline,tping(100),line(100) - - slim=MinSigdB - wmin=0.001*MinWidth * (19.95/20.0) - nf1=-DFTolerance - nf2=DFTolerance - msg3=' ' - nq=64 - dt=1.0/11025.0 - df=11025.0/256.0 - -C Find signal power at suitable intervals to search for pings. - istep=221 - dtbuf=istep/11025. - do n=1,nz - s=0. - ib=n*istep - ia=ib-istep+1 - do i=ia,ib - s=s+dat(i)**2 - enddo - sigdb(n)=s/istep - enddo - -!##################################################################### - if(.not.pick) then -! Remove initial transient from sigdb - call indexx(nz,sigdb,indx) - imax=0 - do i=1,50 - if(indx(i).gt.50) go to 10 - imax=max(imax,indx(i)) - enddo - 10 do i=1,50 - if(indx(nz+1-i).gt.50) go to 20 - imax=max(imax,indx(nz+1-i)) - enddo - 20 imax=imax+6 !Safety margin - base1=sigdb(indx(nz/2)) - do i=1,imax - sigdb(i)=base1 - enddo - endif -!################################################################## - - call smooth(sigdb,nz) - -C Remove baseline and one dB for good measure. - call pctile (sigdb,work,nz,50,base1) - do i=1,nz - sigdb(i)=dB(sigdb(i)/base1) - 1.0 - enddo - - call ping(sigdb,nz,dtbuf,slim,wmin,pingdat,nping) - -C If this is a "mouse pick" and no ping was found, force a pseudo-ping -C at center of data. - if(pick.and.nping.eq.0) then - if(nping.le.99) nping=nping+1 - pingdat(1,nping)=0.5*jz*dt - pingdat(2,nping)=0.16 - pingdat(3,nping)=1.0 - endif - - bigpeak=0. - do iping=1,nping -C Find starting place and length of data to be analyzed: - tstart=pingdat(1,iping) - width=pingdat(2,iping) - peak=pingdat(3,iping) - mswidth=10*nint(100.0*width) - jj=(tstart-0.02)/dt - if(jj.lt.1) jj=1 - jjz=nint((width+0.02)/dt)+1 - jjz=min(jjz,jz+1-jj) - -C Compute average spectrum of this ping. - call spec441(dat(jj),jjz,ps,f0) - -C Decode the message. - msg=' ' - call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg, - + msglen,bauderr,MouseButton) - qrnlimit=4.4*1.5**(5.0-NQRN) - if(NQRN.eq.0) qrnlimit=99. - if(msglen.eq.0) go to 100 - -C Assemble a signal report: - nwidth=0 - if(width.ge.0.04) nwidth=1 !These might depend on NSPD - if(width.ge.0.12) nwidth=2 - if(width.gt.1.00) nwidth=3 - nstrength=6 - if(peak.ge.11.0) nstrength=7 - if(peak.ge.17.0) nstrength=8 - if(peak.ge.23.0) nstrength=9 - -! if(peak.gt.5.0 .and.mswidth.ge.100) then -! call specsq(dat(jj),jjz,DFTolerance,0,noffset2) -! noffset=noffset2 -! endif - -C Discard this ping if DF outside tolerance limits or bauderr too big. -C (However, if the ping was mouse-picked, proceed anyway.) - - if(.not.pick .and. ((noffset.lt.nf1 .or. noffset.gt.nf2) .or. - + (abs(bauderr).gt.qrnlimit))) goto 100 - -C If it's the best ping yet, save the spectrum: - if(peak.gt.bigpeak) then - bigpeak=peak - do i=1,128 - ps0(i)=ps(i) - enddo - endif - - tstart=tstart + dt*(istart-1) - cf=' ' - if(nline.le.99) nline=nline+1 - tping(nline)=tstart - snr=10.0*log10(10.0**(0.1*peak)-1.0) - write(line(nline),1050) cfile6,tstart,mswidth,int(peak), - + nwidth,nstrength,noffset,msg3,msg,cf - 1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1) - 100 enddo - - return - end + subroutine mtdecode(dat,jz,nz,MinSigdB,MinWidth, + + NQRN,DFTolerance,istart,pick,cfile6,ps0) + +C Decode Multi-Tone FSK441 mesages. + + real dat(jz) !Raw audio data + integer NQRN + integer DFTolerance + logical pick + character*6 cfile6,cf*1 + + real sigdb(3100) !Detected signal in dB, sampled at 20 ms + real work(3100) + integer indx(3100) + real pingdat(3,100) + real ps(128) + real ps0(128) + character msg*40,msg3*3 + character*90 line + common/ccom/nline,tping(100),line(100) + + slim=MinSigdB + wmin=0.001*MinWidth * (19.95/20.0) + nf1=-DFTolerance + nf2=DFTolerance + msg3=' ' + nq=64 + dt=1.0/11025.0 + df=11025.0/256.0 + +C Find signal power at suitable intervals to search for pings. + istep=221 + dtbuf=istep/11025. + do n=1,nz + s=0. + ib=n*istep + ia=ib-istep+1 + do i=ia,ib + s=s+dat(i)**2 + enddo + sigdb(n)=s/istep + enddo + +!##################################################################### + if(.not.pick) then +! Remove initial transient from sigdb + call indexx(nz,sigdb,indx) + imax=0 + do i=1,50 + if(indx(i).gt.50) go to 10 + imax=max(imax,indx(i)) + enddo + 10 do i=1,50 + if(indx(nz+1-i).gt.50) go to 20 + imax=max(imax,indx(nz+1-i)) + enddo + 20 imax=imax+6 !Safety margin + base1=sigdb(indx(nz/2)) + do i=1,imax + sigdb(i)=base1 + enddo + endif +!################################################################## + + call smooth(sigdb,nz) + +C Remove baseline and one dB for good measure. + call pctile (sigdb,work,nz,50,base1) + do i=1,nz + sigdb(i)=dB(sigdb(i)/base1) - 1.0 + enddo + + call ping(sigdb,nz,dtbuf,slim,wmin,pingdat,nping) + +C If this is a "mouse pick" and no ping was found, force a pseudo-ping +C at center of data. + if(pick.and.nping.eq.0) then + if(nping.le.99) nping=nping+1 + pingdat(1,nping)=0.5*jz*dt + pingdat(2,nping)=0.16 + pingdat(3,nping)=1.0 + endif + + bigpeak=0. + do iping=1,nping +C Find starting place and length of data to be analyzed: + tstart=pingdat(1,iping) + width=pingdat(2,iping) + peak=pingdat(3,iping) + mswidth=10*nint(100.0*width) + jj=(tstart-0.02)/dt + if(jj.lt.1) jj=1 + jjz=nint((width+0.02)/dt)+1 + jjz=min(jjz,jz+1-jj) + +C Compute average spectrum of this ping. + call spec441(dat(jj),jjz,ps,f0) + +C Decode the message. + msg=' ' + call longx(dat(jj),jjz,ps,DFTolerance,noffset,msg, + + msglen,bauderr) + qrnlimit=4.4*1.5**(5.0-NQRN) + if(NQRN.eq.0) qrnlimit=99. + if(msglen.eq.0) go to 100 + +C Assemble a signal report: + nwidth=0 + if(width.ge.0.04) nwidth=1 !These might depend on NSPD + if(width.ge.0.12) nwidth=2 + if(width.gt.1.00) nwidth=3 + nstrength=6 + if(peak.ge.11.0) nstrength=7 + if(peak.ge.17.0) nstrength=8 + if(peak.ge.23.0) nstrength=9 + +! if(peak.gt.5.0 .and.mswidth.ge.100) then +! call specsq(dat(jj),jjz,DFTolerance,0,noffset2) +! noffset=noffset2 +! endif + +C Discard this ping if DF outside tolerance limits or bauderr too big. +C (However, if the ping was mouse-picked, proceed anyway.) + + if(.not.pick .and. ((noffset.lt.nf1 .or. noffset.gt.nf2) .or. + + (abs(bauderr).gt.qrnlimit))) goto 100 + +C If it's the best ping yet, save the spectrum: + if(peak.gt.bigpeak) then + bigpeak=peak + do i=1,128 + ps0(i)=ps(i) + enddo + endif + + tstart=tstart + dt*(istart-1) + cf=' ' + if(nline.le.99) nline=nline+1 + tping(nline)=tstart + snr=10.0*log10(10.0**(0.1*peak)-1.0) + write(line(nline),1050) cfile6,tstart,mswidth,int(peak), + + nwidth,nstrength,noffset,msg3,msg,cf + 1050 format(a6,f5.1,i5,i3,1x,2i1,i5,1x,a3,1x,a40,1x,a1) + 100 enddo + + return + end diff --git a/pfx.f b/pfx.f index 5ba5dd5c1..34efb37f5 100644 --- a/pfx.f +++ b/pfx.f @@ -1,9 +1,9 @@ parameter (NZ=338) !Total number of prefixes - parameter (NZ2=11) !Total number of suffixes + parameter (NZ2=12) !Total number of suffixes character*1 sfx(NZ2) character*5 pfx(NZ) - data sfx/'P','0','1','2','3','4','5','6','7','8','9'/ + data sfx/'P','0','1','2','3','4','5','6','7','8','9','A'/ data pfx/ + '1A ','1S ','3A ','3B6 ','3B8 ','3B9 ','3C ','3C0 ', + '3D2 ','3D2C ','3D2R ','3DA ','3V ','3W ','3X ','3Y ', diff --git a/spec.f90 b/spec.f90 index 3327c296d..9ae824e00 100644 --- a/spec.f90 +++ b/spec.f90 @@ -11,13 +11,7 @@ subroutine spec(brightness,contrast,logmap,ngain,nspeed,a) ! Output: integer*2 a(225000) !Pixel values for 750 x 300 array - real psa(750) !Grand average spectrum - real ref(750) !Ref spect: smoothed ave of lower half - real birdie(750) !Spec (with birdies) for plot, in dB - real variance(750) !Variance in each spectral channel - real a0(225000) !Save the last 300 spectra - integer*2 idat(11025) !Sound data, read from file integer nstep(5) integer b0,c0 real x(4096) !Data for FFT diff --git a/sync65.f b/sync65.f index d5220c2b7..594e1d594 100644 --- a/sync65.f +++ b/sync65.f @@ -1,176 +1,175 @@ - subroutine sync65(dat,jz,DFTolerance,NFreeze,NAFC,MouseDF, - + mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width) - -C Synchronizes JT65 data, finding the best-fit DT and DF. -C NB: at this stage, submodes ABC are processed in the same way. - - parameter (NP2=60*11025) !Size of data array - parameter (NFFTMAX=2048) !Max length of FFTs - parameter (NHMAX=NFFTMAX/2) !Max length of power spectra - parameter (NSMAX=320) !Max number of half-symbol steps - integer DFTolerance !Range of DF search - real dat(jz) - real psavg(NHMAX) !Average spectrum of whole record - real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols - real ccfblue(-5:540) !CCF with pseudorandom sequence - real ccfred(-224:224) !Peak of ccfblue, as function of freq - real tmp(450) - integer itry(100) - save - -C Do FFTs of symbol length, stepped by half symbols. Note that we have -C already downsampled the data by factor of 2. - nsym=126 - nfft=2048 - nsteps=2*jz/nfft - 1 - nh=nfft/2 - - df=0.5*11025.0/nfft -C Compute power spectrum for each step and get average - call zero(psavg,nh) - do j=1,nsteps - k=(j-1)*nh + 1 - call limit(dat(k),nfft) - call ps(dat(k),nfft,s2(1,j)) - if(mode65.eq.4) call smooth(s2(1,j),nh) - call add(psavg,s2(1,j),psavg,nh) - enddo - - call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra - -C Find the best frequency channel for CCF - famin= 670.46 - fbmax=1870.46 -! famin=200 -! fbmax=3800 - fa=famin - fb=fbmax - if(NFreeze.eq.1) then - fa=max(famin,1270.46+MouseDF-DFTolerance) - fb=min(fbmax,1270.46+MouseDF+DFTolerance) - endif - ia=fa/df - ib=fb/df - - i0=nint(1270.46/df) - ired0=ia-i0 - ired1=ib-i0 - - lag1=-5 - lag2=59 - syncbest=-1.e30 - syncbest2=-1.e30 - - call zero(ccfred,449) - do i=ia,ib - call xcor(s2,i,nsteps,nsym,lag1,lag2, - + ccfblue,ccf0,lagpk0,flip,0.0) - j=i-i0 - if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0 - -C Find rms of the CCF, without the main peak - call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0) - sync=abs(ccfblue(lagpk0)) - ppmax=psavg(i)-1.0 - -C Find the best sync value - if(sync.gt.syncbest2) then - ipk2=i - lagpk2=lagpk0 - syncbest2=sync - flippk2=flip - endif - -C We are most interested if snrx will be more than -30 dB. - if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0 - if(sync.gt.syncbest) then - ipk=i - lagpk=lagpk0 - syncbest=sync - flippk=flip - endif - endif - enddo - -C If we found nothing with snrx > -30 dB, take the best sync that *was* found. - if(syncbest.lt.-10.) then - ipk=ipk2 - lagpk=lagpk2 - syncbest=syncbest2 - flippk=flippk2 - endif - -C Peak up in frequency to fraction of channel - base=0.25*(psavg(ipk-3)+psavg(ipk-2)+psavg(ipk+2)+psavg(ipk+3)) -! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx) -! if(dx.lt.-1.0) dx=-1.0 -! if(dx.gt.1.0) dx=1.0 - dx=0. - dfx=(ipk+dx-i0)*df - -C Peak up in time, at best whole-channel frequency - call xcor(s2,ipk,nsteps,nsym,lag1,lag2, - + ccfblue,ccfmax,lagpk,flip,0.0) - xlag=lagpk - if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then - call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) - xlag=lagpk+dx2 - endif - -C Find rms of the CCF, without the main peak - call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0) - sq=0. - nsq=0 - do lag=lag1,lag2 - if(abs(lag-xlag).gt.2.0) then - sq=sq+ccfblue(lag)**2 - nsq=nsq+1 - endif - enddo - rms=sqrt(sq/nsq) - snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical - - dt=2.0/11025.0 - istart=xlag*nh - dtx=istart*dt - snrx=-99.0 -! ppmax=psavg(ipk)/base-1.0 - ppmax=psavg(ipk)-1.0 -C Plus 3 dB because sync tone is on half the time. (Don't understand -C why an additional +2 dB is needed ...) - if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !### - if(mode65.eq.4) snrx=snrx + 2.0 - if(snrx.lt.-33.0) snrx=-33.0 - -C Compute width of sync tone to outermost -3 dB points - call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base) - - jpk=ipk-i0 - stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB - do i=-10,0 - if(jpk+i.ge.-223) then - if(ccfred(jpk+i).gt.stest) go to 30 - endif - enddo - i=0 - 30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1)) - - do i=10,0,-1 - if(jpk+i.le.223) then - if(ccfred(jpk+i).gt.stest) go to 32 - endif - enddo - i=0 - 32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1)) - width=x2-x1 - if(width.gt.1.2) width=sqrt(width**2 - 1.44) - width=df*width - width=max(0.0,min(99.0,width)) - - ic=600/df - nn=1800/df - nred=448 - - return - end - + subroutine sync65(dat,jz,DFTolerance,NFreeze,MouseDF, + + mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width) + +C Synchronizes JT65 data, finding the best-fit DT and DF. +C NB: at this stage, submodes ABC are processed in the same way. + + parameter (NP2=60*11025) !Size of data array + parameter (NFFTMAX=2048) !Max length of FFTs + parameter (NHMAX=NFFTMAX/2) !Max length of power spectra + parameter (NSMAX=320) !Max number of half-symbol steps + integer DFTolerance !Range of DF search + real dat(jz) + real psavg(NHMAX) !Average spectrum of whole record + real s2(NHMAX,NSMAX) !2d spectrum, stepped by half-symbols + real ccfblue(-5:540) !CCF with pseudorandom sequence + real ccfred(-224:224) !Peak of ccfblue, as function of freq + real tmp(450) + save + +C Do FFTs of symbol length, stepped by half symbols. Note that we have +C already downsampled the data by factor of 2. + nsym=126 + nfft=2048 + nsteps=2*jz/nfft - 1 + nh=nfft/2 + + df=0.5*11025.0/nfft +C Compute power spectrum for each step and get average + call zero(psavg,nh) + do j=1,nsteps + k=(j-1)*nh + 1 + call limit(dat(k),nfft) + call ps(dat(k),nfft,s2(1,j)) + if(mode65.eq.4) call smooth(s2(1,j),nh) + call add(psavg,s2(1,j),psavg,nh) + enddo + + call flat1(psavg,s2,nh,nsteps,NHMAX,NSMAX) !Flatten the spectra + +C Find the best frequency channel for CCF + famin= 670.46 + fbmax=1870.46 +! famin=200 +! fbmax=3800 + fa=famin + fb=fbmax + if(NFreeze.eq.1) then + fa=max(famin,1270.46+MouseDF-DFTolerance) + fb=min(fbmax,1270.46+MouseDF+DFTolerance) + endif + ia=fa/df + ib=fb/df + + i0=nint(1270.46/df) + ired0=ia-i0 + ired1=ib-i0 + + lag1=-5 + lag2=59 + syncbest=-1.e30 + syncbest2=-1.e30 + + call zero(ccfred,449) + do i=ia,ib + call xcor(s2,i,nsteps,nsym,lag1,lag2, + + ccfblue,ccf0,lagpk0,flip,0.0) + j=i-i0 + if(j.ge.-224 .and. j.le.224) ccfred(j)=ccf0 + +C Find rms of the CCF, without the main peak + call slope(ccfblue(lag1),lag2-lag1+1,lagpk0-lag1+1.0) + sync=abs(ccfblue(lagpk0)) + ppmax=psavg(i)-1.0 + +C Find the best sync value + if(sync.gt.syncbest2) then + ipk2=i + lagpk2=lagpk0 + syncbest2=sync + flippk2=flip + endif + +C We are most interested if snrx will be more than -30 dB. + if(ppmax.gt.0.2938) then !Corresponds to snrx.gt.-30.0 + if(sync.gt.syncbest) then + ipk=i + lagpk=lagpk0 + syncbest=sync + flippk=flip + endif + endif + enddo + +C If we found nothing with snrx > -30 dB, take the best sync that *was* found. + if(syncbest.lt.-10.) then + ipk=ipk2 + lagpk=lagpk2 + syncbest=syncbest2 + flippk=flippk2 + endif + +C Peak up in frequency to fraction of channel + base=0.25*(psavg(ipk-3)+psavg(ipk-2)+psavg(ipk+2)+psavg(ipk+3)) +! call peakup(psavg(ipk-1),psavg(ipk),psavg(ipk+1),dx) +! if(dx.lt.-1.0) dx=-1.0 +! if(dx.gt.1.0) dx=1.0 + dx=0. + dfx=(ipk+dx-i0)*df + +C Peak up in time, at best whole-channel frequency + call xcor(s2,ipk,nsteps,nsym,lag1,lag2, + + ccfblue,ccfmax,lagpk,flip,0.0) + xlag=lagpk + if(lagpk.gt.lag1 .and. lagpk.lt.lag2) then + call peakup(ccfblue(lagpk-1),ccfmax,ccfblue(lagpk+1),dx2) + xlag=lagpk+dx2 + endif + +C Find rms of the CCF, without the main peak + call slope(ccfblue(lag1),lag2-lag1+1,xlag-lag1+1.0) + sq=0. + nsq=0 + do lag=lag1,lag2 + if(abs(lag-xlag).gt.2.0) then + sq=sq+ccfblue(lag)**2 + nsq=nsq+1 + endif + enddo + rms=sqrt(sq/nsq) + snrsync=abs(ccfblue(lagpk))/rms - 1.1 !Empirical + + dt=2.0/11025.0 + istart=xlag*nh + dtx=istart*dt + snrx=-99.0 +! ppmax=psavg(ipk)/base-1.0 + ppmax=psavg(ipk)-1.0 +C Plus 3 dB because sync tone is on half the time. (Don't understand +C why an additional +2 dB is needed ...) + if(ppmax.gt.0.0001) snrx=db(ppmax*df/2500.0) + 5.0 !### + if(mode65.eq.4) snrx=snrx + 2.0 + if(snrx.lt.-33.0) snrx=-33.0 + +C Compute width of sync tone to outermost -3 dB points + call pctile(ccfred(ia-i0),tmp,ib-ia+1,45,base) + + jpk=ipk-i0 + stest=base + 0.5*(ccfred(jpk)-base) ! -3 dB + do i=-10,0 + if(jpk+i.ge.-223) then + if(ccfred(jpk+i).gt.stest) go to 30 + endif + enddo + i=0 + 30 x1=i-1+(stest-ccfred(jpk+i-1))/(ccfred(jpk+i)-ccfred(jpk+i-1)) + + do i=10,0,-1 + if(jpk+i.le.223) then + if(ccfred(jpk+i).gt.stest) go to 32 + endif + enddo + i=0 + 32 x2=i+1-(stest-ccfred(jpk+i+1))/(ccfred(jpk+i)-ccfred(jpk+i+1)) + width=x2-x1 + if(width.gt.1.2) width=sqrt(width**2 - 1.44) + width=df*width + width=max(0.0,min(99.0,width)) + + ic=600/df + nn=1800/df + nred=448 + + return + end + diff --git a/wsjt.py b/wsjt.py index 33b7ad32f..ea746cb9c 100644 --- a/wsjt.py +++ b/wsjt.py @@ -884,22 +884,16 @@ def decdsec(event): ldsec.configure(text='Dsec '+str(0.1*idsec),bg=bg) Audio.gcom1.ndsec=idsec -###------------------------------------------------------ incrdsec -##def incrdsec(event): -## global irdsec -## irdsec=irdsec+5 -## bg='red' -## if irdsec==0: bg='white' -## lrdsec.configure(text='RDsec '+str(0.1*irdsec),bg=bg) -## -###------------------------------------------------------ decrdsec -##def decrdsec(event): -## global irdsec -## irdsec=irdsec-5 -## bg='red' -## if irdsec==0: bg='white' -## lrdsec.configure(text='RDsec '+str(0.1*irdsec),bg=bg) -## +#------------------------------------------------------ toggle_shift +def toggle_shift(event): + Audio.gcom2.nadd5=1-Audio.gcom2.nadd5 + if Audio.gcom2.nadd5: + bg='red' + lshift.configure(text='Shift 5.0',bg=bg) + else: + bg='white' + lshift.configure(text='Shift 0.0',bg=bg) + #------------------------------------------------------ inctrperiod def inctrperiod(event): global ncwtrperiod @@ -1874,14 +1868,11 @@ Button(f5b,text='Defaults',command=defaults,padx=1,pady=1).grid(column=0, row=3,sticky='EW') ldsec=Label(f5b, bg='white', fg='black', text='Dsec 0.0', width=8, relief=RIDGE) ldsec.grid(column=0,row=4,ipadx=3,padx=2,pady=5,sticky='EW') -#lrdsec=Label(f5b, bg='white', fg='black', text='RDsec 0.0', width=8, relief=RIDGE) -#lrdsec.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW') +lshift=Label(f5b, bg='white', fg='black', text='Shift 0.0', width=8, relief=RIDGE) +lshift.grid(column=1,row=4,ipadx=3,padx=2,pady=5,sticky='EW') Widget.bind(ldsec,'',incdsec) Widget.bind(ldsec,'',decdsec) -#Widget.bind(lrdsec,'',incrdsec) -#Widget.bind(lrdsec,'',decrdsec) -#Widget.bind(lrdsec,'',stub) -#Widget.bind(lrdsec,'',stub) +Widget.bind(lshift,'',toggle_shift) f5b.pack(side=LEFT,expand=0,fill=BOTH) diff --git a/wsjt1.F b/wsjt1.F index b0e32d499..f8929872c 100644 --- a/wsjt1.F +++ b/wsjt1.F @@ -1,335 +1,325 @@ - subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB, - + NQRN,DFTolerance,NSaveCum,MouseButton,NClearAve, - + Mode,NFreeze,NAFC,NZap,AppDir,utcdate,mode441,mode65, - + MyCall,HisCall,HisGrid,neme,nsked,naggressive,ntx2,s2, - + ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, - + MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2) - - parameter (NP2=1024*1024) - - integer*2 d(jz0) !Buffer for raw one-byte data - integer istart !Starting location in original d() array - character FileID*40 !Name of file being processed - integer MinSigdB !Minimum ping strength, dB - integer NQRN !QRN rejection parameter - integer DFTolerance !Defines DF search range - integer NSaveCum !Set to 1 if cumulative file is to be saved - integer NSyncOK !Set to 1 if JT65 file synchronized OK - character AppDir*80 !Installation directory for WSJT - character*12 utcdate - character*12 mycall - character*12 hiscall - character*6 hisgrid - real ps0(431) !Spectrum of best ping - integer npkept !Number of pings kept and decoded - integer lumsg !Logical unit for decoded.txt - real basevb !Baseline signal level, dB - integer nslim2 !Minimum strength for single-tone pings, dB - real psavg(450) !Average spectrum of the whole file - integer Nseg !First or second Tx sequence? - integer MouseDF !Freeze position for DF - logical pick !True if this is a mouse-picked ping - logical stbest !True if the best decode was Single-Tone - logical STfound !True if at least one ST decode - logical LDecoded !True if anything was decoded - real s2(64,3100) !2D spectral array - real ccf(-5:540) !X-cor function in JT65 mode (blue line) - real red(512) - real ss1(-224:224) !Magenta curve (for JT65 shorthands) - real ss2(-224:224) !Orange curve (for JT65 shorthands) - real yellow(216) - real yellow0(216) - real fzap(200) - - integer resample - real*8 samfacin,samratio - real dat2(NP2) - - integer*1 dtmp - character msg3*3 - character cfile6*6 - character fname*99,fcum*99 - logical lcum - integer indx(100) - character*90 line - character*24 today - - common/avecom/dat(NP2),labdat,jza,modea - common/avecom2/f0a - common/ccom/nline,tping(100),line(100) - common/limcom/ nslim2a - common/clipcom/ nclip - equivalence (dtmp,ntmp) - save - - lcum=.true. - jz=jz0 - modea=Mode - nclip=NQRN-5 - nslim2a=nclip - MinWidth=40 !Minimum width of pings, ms - call zero(psavg,450) - rewind 11 - rewind 12 - - do i=1,40 - if(FileID(i:i).eq.'.') go to 3 - enddo - i=4 - 3 ia=max(1,i-6) - cfile6=FileID(ia:i-1) - - nline=0 - ndiag=0 -! If file "/wsjt.reg" exists, set ndiag=1 - open(16,file='/wsjt.reg',status='old',err=4) - ndiag=1 - close(16) - - 4 if(jz.gt.655360) jz=655360 - if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this! - - sum=0. - do j=1,jz !Convert raw data from i*2 to real, remove DC - dat(j)=0.1*d(j) - sum=sum + dat(j) - enddo - ave=sum/jz - samratio=1.d0/samfacin - if(samratio.eq.1.d0) then - do j=1,jz - dat(j)=dat(j)-ave - enddo - else - do j=1,jz - dat2(j)=dat(j)-ave - enddo - -#if (USE_PORTAUDIO==1) || defined(Win32) - ierr=resample(dat2,dat,samratio,jz) - if(ierr.ne.0) print*,'Resample error.',samratio -#endif - - endif - - if(ndiag.ne.0 .and. nclip.lt.0) then -C Intentionally degrade SNR by -nclip dB. - sq=0. - do i=1,jz - sq=sq + dat(i)**2 - enddo - p0=sq/jz - p1=p0*10.0**(-0.1*nclip) - dnoise=sqrt(4*(p1-p0)) - idum=-1 - do i=1,jz - dat(i)=dat(i) + dnoise*gran(idum) - enddo - endif - - if(mode.ne.2 .and. nzap.ne.0) then - nfrz=NFreeze - if(mode.eq.1) nfrz=0 - if(jz.gt.100000) call avesp2(dat,jz,2,f0a,mode,nfrz,MouseDF, - + DFTolerance,fzap) - nadd=1 - call bzap(dat,jz,nadd,mode,fzap) - endif - - sq=0. - do j=1,jz !Compute power level for whole array - sq=sq + dat(j)**2 - enddo - avesq=sq/jz - basevb=dB(avesq) - 44 !Base power level to send back to GUI - if(avesq.eq.0) go to 900 - - nz=600 - nstep=jz/nz - sq=0. - k=0 - do j=1,nz - sum=0. - do n=1,nstep - k=k+1 - sum=sum+dat(k)**2 - enddo - sum=sum/nstep - sq=sq + (sum-avesq)**2 - enddo - rmspower=sqrt(sq/nz) - - pick=.false. - if(istart.gt.1) pick=.true. !This is a mouse-picked decoding - if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900 - nchan=64 !Save 64 spectral channels - nstep=221 !Set step size to ~20 ms - nz=jz/nstep - 1 !# of spectra to compute - if(.not.pick) then - MouseButton=0 - jza=jz - labdat=labdat+1 - endif - tbest=0. - NsyncOK=0 - -! If we're in JT65 mode, call the decode65 routines. - if(mode.eq.2) then -! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data -! Check for a JT65 shorthand message - nstest=0 - if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF, - + DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh, - + idriftsh,snrsh,ss1,ss2,nwsh) -! Lowpass filter and decimate by 2 - call lpf1(dat,jz,jz2) - jz=jz2 - nadd=1 - fzap(1)=0. - if(nzap.eq.1) call avesp2(dat,jz,nadd,f0a,mode,NFreeze,MouseDF, - + DFTolerance,fzap) - if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap) - - i=index(MyCall,char(0)) - if(i.le.0) i=index(MyCall,' ') - mycall=MyCall(1:i-1)//' ' - i=index(HisCall,char(0)) - if(i.le.0) i=index(HisCall,' ') - hiscall=HisCall(1:i-1)//' ' - -! Offset data by about 1 s. - if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6, - + NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg, - + MouseDF,NAgain,ndepth,neme,nsked, - + mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf, - + nstest,dfsh,iderrsh,idriftsh,snrsh, - + NSyncOK,ccf,psavg,ndiag,nwsh) - goto 900 - endif - -! If we're in JT6M mode, call the 6M decoding routines. - if(mode.eq.4) then - do i=1,jz !### Why is it level-sensitive? - dat(i)=dat(i)/25.0 - enddo -! For waterfall plot - call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma) - if(sigma.lt.0.0) basevb=-99.0 - if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900 - - f0=1076.66 - if(NFreeze.eq.1) f0=1076.66 + MouseDF - f00=f0 - call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax) - call synct(dat,jz,jstart,f0,smax) - call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red) - - f0a=f0 - do i=1,512 - ccf(i-6)=dB(red(i)) - enddo - df=11025./256. - do i=1,64 - sum=0. - do k=8*i-7,8*i - sum=sum+red(k) - enddo - psavg(i)=5.0*sum - fac=1.0 - freq=i*df - if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0) - psavg(i)=fac*psavg(i) - psavg(i+64)=0.001 - enddo - - jz=jz-jstart+1 - nslim=MinSigdB - NFixLen=0 - -C Call the decoder if DF is in range or Freeze is off. - if(NFreeze.eq.0 .or. - + abs(f0-f00).lt.float(DFTolerance)) then - call decode6m(dat(jstart),jz,cfile6,nslim,istart, - + NFixLen,lcum,f0,lumsg,npkept,yellow) - endif - - if(npkept.eq.0) f0a=0. - - if(pick) then - do i=1,216 - ps0(i)=yellow0(i) - enddo - else - ps0(216)=yellow(216) - yellow0(216)=yellow(216) - do i=1,215 - ps0(i)=2*yellow(i) - yellow0(i)=ps0(i) - enddo - endif - goto 800 - endif - -! We're in FSK441 mode. Compute the 2D spectrum. - df=11025.0/256.0 !FFT resolution ~43 Hz - dtbuf=nstep/11025.0 - stlim=nslim2 !Single-tone threshold - call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma) - if(sigma.lt.0.0) basevb=-99.0 - if(sigma.lt.0.0) go to 900 - nline0=nline - STfound=.false. - npkept=0 - -C Look for single-tone messages - if((.not.pick) .or. MouseButton.eq.1) then - call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim, - + DFTolerance,cfile6,pick,istart) - endif - if(nline.gt.nline0) STfound=.true. !ST message(s) found - -C Now the multi-tone decoding - call mtdecode(dat,jz,s2,nchan,nz,MinSigdB,MinWidth, - + NQRN,DFTolerance,istart,pick,MouseButton,NSaveCum, - + cfile6,ps0) - - npkept=nline !Number of pings that were kept - smax=0. - stbest=.false. - if(npkept.gt.0) then - call indexx(npkept,tping,indx) !Merge the ST and MT decodes - do i=1,npkept - j=indx(i) - if(pick .and. STFound .and. - + line(j)(29:31).eq.' ') goto 10 - write(lumsg,1050) line(j) !Write to decoded.txt - 1050 format(a79) - if(lcum) write(21,1050) line(j) !Write to ALL.TXT - read(line(j),1060) sig,msg3 - 1060 format(16x,f3.0,9x,a3) - if(sig.gt.smax) then - smax=sig - tbest=tping(j) - stbest = (msg3.ne.' ') - endif - 10 enddo - endif - - dt=1.0/11025.0 !Compute spectrum for pink curve - if(stbest) then - jj=nint(tbest/dt) - call spec441(dat(jj),1102,ps0,f0) - endif - - 800 continue - call s2shape(s2,nchan,nz,tbest) - - 900 LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0) - end file 11 - call flushqqq(11) - call flushqqq(12) - call flushqqq(21) - - return - end - + subroutine wsjt1(d,jz0,istart,samfacin,FileID,ndepth,MinSigdB, + + NQRN,DFTolerance,MouseButton,NClearAve, + + Mode,NFreeze,NAFC,NZap,mode65, + + MyCall,HisCall,HisGrid,neme,nsked,ntx2,s2, + + ps0,npkept,lumsg,basevb,rmspower,nslim2,psavg,ccf,Nseg, + + MouseDF,NAgain,LDecoded,nspecial,ndf,ss1,ss2) + + parameter (NP2=1024*1024) + + integer*2 d(jz0) !Buffer for raw one-byte data + integer istart !Starting location in original d() array + character FileID*40 !Name of file being processed + integer MinSigdB !Minimum ping strength, dB + integer NQRN !QRN rejection parameter + integer DFTolerance !Defines DF search range + integer NSyncOK !Set to 1 if JT65 file synchronized OK + character*12 mycall + character*12 hiscall + character*6 hisgrid + real ps0(431) !Spectrum of best ping + integer npkept !Number of pings kept and decoded + integer lumsg !Logical unit for decoded.txt + real basevb !Baseline signal level, dB + integer nslim2 !Minimum strength for single-tone pings, dB + real psavg(450) !Average spectrum of the whole file + integer Nseg !First or second Tx sequence? + integer MouseDF !Freeze position for DF + logical pick !True if this is a mouse-picked ping + logical stbest !True if the best decode was Single-Tone + logical STfound !True if at least one ST decode + logical LDecoded !True if anything was decoded + real s2(64,3100) !2D spectral array + real ccf(-5:540) !X-cor function in JT65 mode (blue line) + real red(512) + real ss1(-224:224) !Magenta curve (for JT65 shorthands) + real ss2(-224:224) !Orange curve (for JT65 shorthands) + real yellow(216) + real yellow0(216) + real fzap(200) + + integer resample + real*8 samfacin,samratio + real dat2(NP2) + + integer*1 dtmp + character msg3*3 + character cfile6*6 + logical lcum + integer indx(100) + character*90 line + + common/avecom/dat(NP2),labdat,jza,modea + common/ccom/nline,tping(100),line(100) + common/limcom/ nslim2a + common/clipcom/ nclip + equivalence (dtmp,ntmp) + save + + lcum=.true. + jz=jz0 + modea=Mode + nclip=NQRN-5 + nslim2a=nclip + MinWidth=40 !Minimum width of pings, ms + call zero(psavg,450) + rewind 11 + rewind 12 + + do i=1,40 + if(FileID(i:i).eq.'.') go to 3 + enddo + i=4 + 3 ia=max(1,i-6) + cfile6=FileID(ia:i-1) + + nline=0 + ndiag=0 +! If file "/wsjt.reg" exists, set ndiag=1 + open(16,file='/wsjt.reg',status='old',err=4) + ndiag=1 + close(16) + + 4 if(jz.gt.655360) jz=655360 + if(mode.eq.4 .and. jz.gt.330750) jz=330750 !### Fix this! + + sum=0. + do j=1,jz !Convert raw data from i*2 to real, remove DC + dat(j)=0.1*d(j) + sum=sum + dat(j) + enddo + ave=sum/jz + samratio=1.d0/samfacin + if(samratio.eq.1.d0) then + do j=1,jz + dat(j)=dat(j)-ave + enddo + else + do j=1,jz + dat2(j)=dat(j)-ave + enddo + +#if (USE_PORTAUDIO==1) || defined(Win32) + ierr=resample(dat2,dat,samratio,jz) + if(ierr.ne.0) print*,'Resample error.',samratio +#endif + + endif + + if(ndiag.ne.0 .and. nclip.lt.0) then +C Intentionally degrade SNR by -nclip dB. + sq=0. + do i=1,jz + sq=sq + dat(i)**2 + enddo + p0=sq/jz + p1=p0*10.0**(-0.1*nclip) + dnoise=sqrt(4*(p1-p0)) + idum=-1 + do i=1,jz + dat(i)=dat(i) + dnoise*gran(idum) + enddo + endif + + if(mode.ne.2 .and. nzap.ne.0) then + nfrz=NFreeze + if(mode.eq.1) nfrz=0 + if(jz.gt.100000) call avesp2(dat,jz,2,mode,nfrz,MouseDF, + + DFTolerance,fzap) + nadd=1 + call bzap(dat,jz,nadd,mode,fzap) + endif + + sq=0. + do j=1,jz !Compute power level for whole array + sq=sq + dat(j)**2 + enddo + avesq=sq/jz + basevb=dB(avesq) - 44 !Base power level to send back to GUI + if(avesq.eq.0) go to 900 + + nz=600 + nstep=jz/nz + sq=0. + k=0 + do j=1,nz + sum=0. + do n=1,nstep + k=k+1 + sum=sum+dat(k)**2 + enddo + sum=sum/nstep + sq=sq + (sum-avesq)**2 + enddo + rmspower=sqrt(sq/nz) + + pick=.false. + if(istart.gt.1) pick=.true. !This is a mouse-picked decoding + if(.not.pick .and. (basevb.lt.-15.0 .or. basevb.gt.20.0)) goto 900 + nchan=64 !Save 64 spectral channels + nstep=221 !Set step size to ~20 ms + nz=jz/nstep - 1 !# of spectra to compute + if(.not.pick) then + MouseButton=0 + jza=jz + labdat=labdat+1 + endif + tbest=0. + NsyncOK=0 + +! If we're in JT65 mode, call the decode65 routines. + if(mode.eq.2) then +! if(rmspower.gt.34000.0) go to 900 !Reject very noisy data +! Check for a JT65 shorthand message + nstest=0 + if(ntx2.ne.1) call short65(dat,jz,NFreeze,MouseDF, + + DFTolerance,mode65,nspecial,nstest,dfsh,iderrsh, + + idriftsh,snrsh,ss1,ss2,nwsh) +! Lowpass filter and decimate by 2 + call lpf1(dat,jz,jz2) + jz=jz2 + nadd=1 + fzap(1)=0. + if(nzap.eq.1) call avesp2(dat,jz,nadd,mode,NFreeze,MouseDF, + + DFTolerance,fzap) + if(nzap.eq.1.and.nstest.eq.0) call bzap(dat,jz,nadd,mode,fzap) + + i=index(MyCall,char(0)) + if(i.le.0) i=index(MyCall,' ') + mycall=MyCall(1:i-1)//' ' + i=index(HisCall,char(0)) + if(i.le.0) i=index(HisCall,' ') + hiscall=HisCall(1:i-1)//' ' + +! Offset data by about 1 s. + if(jz.ge.126*2048) call wsjt65(dat(4097),jz-4096,cfile6, + + NClearAve,MinSigdB,DFTolerance,NFreeze,NAFC,mode65,Nseg, + + MouseDF,NAgain,ndepth,neme,nsked, + + mycall,hiscall,hisgrid,lumsg,lcum,nspecial,ndf, + + nstest,dfsh,snrsh, + + NSyncOK,ccf,psavg,ndiag,nwsh) + goto 900 + endif + +! If we're in JT6M mode, call the 6M decoding routines. + if(mode.eq.4) then + do i=1,jz !### Why is it level-sensitive? + dat(i)=dat(i)/25.0 + enddo +! For waterfall plot + call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma) + if(sigma.lt.0.0) basevb=-99.0 + if(jz/11025.0.lt.3.9 .or. sigma.lt.0.0) go to 900 + + f0=1076.66 + if(NFreeze.eq.1) f0=1076.66 + MouseDF + f00=f0 + call syncf0(dat,jz,NFreeze,DFTolerance,jstart,f0,smax) + call synct(dat,jz,jstart,f0,smax) + call syncf1(dat,jz,jstart,f0,NFreeze,DFTolerance,smax,red) + + do i=1,512 + ccf(i-6)=dB(red(i)) + enddo + df=11025./256. + do i=1,64 + sum=0. + do k=8*i-7,8*i + sum=sum+red(k) + enddo + psavg(i)=5.0*sum + fac=1.0 + freq=i*df + if(freq.gt.2500.0) fac=((freq-2500.)/20.0)**(-1.0) + psavg(i)=fac*psavg(i) + psavg(i+64)=0.001 + enddo + + jz=jz-jstart+1 + nslim=MinSigdB + NFixLen=0 + +C Call the decoder if DF is in range or Freeze is off. + if(NFreeze.eq.0 .or. + + abs(f0-f00).lt.float(DFTolerance)) then + call decode6m(dat(jstart),jz,cfile6,nslim,istart, + + NFixLen,lcum,f0,lumsg,npkept,yellow) + endif + + if(pick) then + do i=1,216 + ps0(i)=yellow0(i) + enddo + else + ps0(216)=yellow(216) + yellow0(216)=yellow(216) + do i=1,215 + ps0(i)=2*yellow(i) + yellow0(i)=ps0(i) + enddo + endif + goto 800 + endif + +! We're in FSK441 mode. Compute the 2D spectrum. + df=11025.0/256.0 !FFT resolution ~43 Hz + dtbuf=nstep/11025.0 + stlim=nslim2 !Single-tone threshold + call spec2d(dat,jz,nstep,s2,nchan,nz,psavg,sigma) + if(sigma.lt.0.0) basevb=-99.0 + if(sigma.lt.0.0) go to 900 + nline0=nline + STfound=.false. + npkept=0 + +C Look for single-tone messages + if((.not.pick) .or. MouseButton.eq.1) then + call stdecode(s2,nchan,nz,sigma,dtbuf,df,stlim, + + DFTolerance,cfile6,pick,istart) + endif + if(nline.gt.nline0) STfound=.true. !ST message(s) found + +C Now the multi-tone decoding + call mtdecode(dat,jz,nz,MinSigdB,MinWidth, + + NQRN,DFTolerance,istart,pick,cfile6,ps0) + + npkept=nline !Number of pings that were kept + smax=0. + stbest=.false. + if(npkept.gt.0) then + call indexx(npkept,tping,indx) !Merge the ST and MT decodes + do i=1,npkept + j=indx(i) + if(pick .and. STFound .and. + + line(j)(29:31).eq.' ') goto 10 + write(lumsg,1050) line(j) !Write to decoded.txt + 1050 format(a79) + if(lcum) write(21,1050) line(j) !Write to ALL.TXT + read(line(j),1060) sig,msg3 + 1060 format(16x,f3.0,9x,a3) + if(sig.gt.smax) then + smax=sig + tbest=tping(j) + stbest = (msg3.ne.' ') + endif + 10 enddo + endif + + dt=1.0/11025.0 !Compute spectrum for pink curve + if(stbest) then + jj=nint(tbest/dt) + call spec441(dat(jj),1102,ps0,f0) + endif + + 800 continue + call s2shape(s2,nchan,nz,tbest) + + 900 LDecoded = ((NSyncOK.gt.0) .or. npkept.gt.0) + end file 11 + call flushqqq(11) + call flushqqq(12) + call flushqqq(21) + + return + end + diff --git a/wsjt65.f b/wsjt65.f index 885b59492..439c6b36b 100644 --- a/wsjt65.f +++ b/wsjt65.f @@ -1,216 +1,212 @@ - subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB, - + DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain, - + ndepth,neme,nsked,mycall,hiscall,hisgrid, - + lumsg,lcum,nspecial,ndf,nstest,dfsh,iderrsh,idriftsh, - + snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh) - -C Orchestrates the process of decoding JT65 messages, using data that -C have been 2x downsampled. The search for shorthand messages has -C already been done. - - real dat(npts) !Raw data - integer DFTolerance - logical first - logical lcum - character decoded*22,cfile6*6,special*5,cooo*3 - character*22 avemsg1,avemsg2,deepmsg,deepbest - character*67 line,ave1,ave2 - character*1 csync,c1 - character*12 mycall - character*12 hiscall - character*6 hisgrid - real ccfblue(-5:540),ccfred(-224:224) - real ftrack(126) - logical lmid - integer itf(2,9) - include 'avecom.h' - common/avecom2/f0a - data first/.true./,ns10/0/,ns20/0/ - data itf/0,0, 1,0, -1,0, 0,-1, 0,1, 1,-1, 1,1, -1,-1, -1,1/ - save - - if(first) then - call setup65 !Initialize pseudo-random arrays - nsave=0 - first=.false. - ave1=' ' - ave2=' ' - endif - - naggressive=0 - if(ndepth.ge.2) naggressive=1 - nq1=3 - nq2=6 - if(naggressive.eq.1) nq1=1 - - if(NClearAve.ne.0) then - nsave=0 !Clear the averaging accumulators - ns10=0 - ns20=0 - ave1=' ' - ave2=' ' - endif - if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then - ns10=0 !For Include/Exclude ? - ns20=0 - endif - -C Attempt to synchronize: look for sync tone, get DF and DT. - call sync65(dat,npts,DFTolerance,NFreeze,NAFC,MouseDF, - + mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width) - f0=1270.46 + dfx - csync=' ' - decoded=' ' - deepmsg=' ' - special=' ' - cooo=' ' - itry=0 - ncount=-1 !Flag for RS decode of current record - ncount1=-1 !Flag for RS Decode of ave1 - ncount2=-1 !Flag for RS Decode of ave2 - NSyncOK=0 - nqual1=0 - nqual2=0 - - if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1)) - + nsave=nsave+1 - if(nsave.le.0) go to 900 !Prevent bounds error - - nflag(nsave)=0 !Clear the "good sync" flag - iseg(nsave)=Nseg !Set the RX segment to 1 or 2 - nsync=nint(snrsync-3.0) - nsnr=nint(snrx) - if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0 - nsnrlim=-32 - -C Good Sync takes precedence over a shorthand message: - if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and. - + nsync.gt.nstest) nstest=0 - - if(nstest.gt.0) then - dfx=dfsh - nsync=nstest - nsnr=snrsh - dtx=1. - ccfblue(-5)=-999.0 - if(nspecial.eq.1) special='ATT ' - if(nspecial.eq.2) special='RO ' - if(nspecial.eq.3) special='RRR ' - if(nspecial.eq.4) special='73 ' - NSyncOK=1 !Mark this RX file as good (for "Save Decoded") - if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?' - width=nwsh - go to 200 - endif - - if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200 - -C If we get here, we have achieved sync! - NSyncOK=1 - nflag(nsave)=1 !Mark this RX file as good - csync='*' - if(flip.lt.0.0) then - csync='#' - cooo='O ?' - endif - - call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked, - + nsnr,mycall,hiscall,hisgrid,mode65,nafc,decoded, - + ncount,deepmsg,qual) - if(ncount.eq.-999) qual=0 !Bad data - 200 kvqual=0 - if(ncount.ge.0) kvqual=1 - nqual=qual - if(ndiag.eq.0 .and. nqual.gt.10) nqual=10 - if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg - - ndf=nint(dfx) - if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO' - if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?' - if(decoded.eq.' ') cooo=' ' - do i=1,22 - c1=decoded(i:i) - if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32) - enddo - write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf, - + nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual - 1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4) - -C Blank all end-of-line stuff if no decode - if(line(31:40).eq.' ') line=line(:30) - -C Blank DT if shorthand message (### wrong logic? ###) - if(special.ne.' ') then - line(15:19)=' ' - line=line(:35) - ccfblue(-5)=-9999.0 -! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh -! 1012 format(i3,i4) - else - nspecial=0 - endif - - if(lcum) write(21,1011) line - 1011 format(a67) -C Write decoded msg unless this is an "Exclude" request: - if(MinSigdB.lt.99) write(lumsg,1011) line - - if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1, - + nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual1, - + ns1,ncount1) - if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2, - + nq1,nq2,neme,nsked,flip,mycall,hiscall,hisgrid,qual2, - + ns2,ncount2) - nqual1=qual1 - nqual2=qual2 - if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10 - if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10 - nc1=0 - nc2=0 - if(ncount1.ge.0) nc1=1 - if(ncount2.ge.0) nc2=1 - -C Write the average line -! if(ns1.ge.1 .and. ns1.ne.ns10) then - if(ns1.ge.1) then - if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1, - + nc1,nqual1 - 1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4) - if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6, - + 1,nused1,ns1,avemsg1,nc1,nqual1 - 1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4) - if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1, - + avemsg1,nc1,nqual1 - 1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4) - if(lcum .and. (avemsg1.ne.' ')) - + write(21,1011) ave1 - ns10=ns1 - endif - -C If Monitor segment #2 is available, write that line also -! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? *** - if(ns2.ge.1) then - if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2, - + nc2,nqual2 - if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6, - + 2,nused2,ns2,avemsg2,nc2,nqual2 - if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2, - + nc2,nqual2 - if(lcum .and. (avemsg2.ne.' ')) - + write(21,1011) ave2 - ns20=ns2 - endif - - if(ave1(31:40).eq.' ') ave1=ave1(:30) - if(ave2(31:40).eq.' ') ave2=ave2(:30) - write(12,1011) ave1 - write(12,1011) ave2 - call flushqqq(12) - - 800 if(lumsg.ne.6) end file 11 - f0a=f0 - - 900 continue - - return - end + subroutine wsjt65(dat,npts,cfile6,NClearAve,MinSigdB, + + DFTolerance,NFreeze,NAFC,mode65,Nseg,MouseDF,NAgain, + + ndepth,neme,nsked,mycall,hiscall,hisgrid, + + lumsg,lcum,nspecial,ndf,nstest,dfsh, + + snrsh,NSyncOK,ccfblue,ccfred,ndiag,nwsh) + +C Orchestrates the process of decoding JT65 messages, using data that +C have been 2x downsampled. The search for shorthand messages has +C already been done. + + real dat(npts) !Raw data + integer DFTolerance + logical first + logical lcum + character decoded*22,cfile6*6,special*5,cooo*3 + character*22 avemsg1,avemsg2,deepmsg + character*67 line,ave1,ave2 + character*1 csync,c1 + character*12 mycall + character*12 hiscall + character*6 hisgrid + real ccfblue(-5:540),ccfred(-224:224) + integer itf(2,9) + include 'avecom.h' + data first/.true./,ns10/0/,ns20/0/ + data itf/0,0, 1,0, -1,0, 0,-1, 0,1, 1,-1, 1,1, -1,-1, -1,1/ + save + + if(first) then + call setup65 !Initialize pseudo-random arrays + nsave=0 + first=.false. + ave1=' ' + ave2=' ' + endif + + naggressive=0 + if(ndepth.ge.2) naggressive=1 + nq1=3 + nq2=6 + if(naggressive.eq.1) nq1=1 + + if(NClearAve.ne.0) then + nsave=0 !Clear the averaging accumulators + ns10=0 + ns20=0 + ave1=' ' + ave2=' ' + endif + if(MinSigdB.eq.99 .or. MinSigdB.eq.-99) then + ns10=0 !For Include/Exclude ? + ns20=0 + endif + +C Attempt to synchronize: look for sync tone, get DF and DT. + call sync65(dat,npts,DFTolerance,NFreeze,MouseDF, + + mode65,dtx,dfx,snrx,snrsync,ccfblue,ccfred,flip,width) + f0=1270.46 + dfx + csync=' ' + decoded=' ' + deepmsg=' ' + special=' ' + cooo=' ' + itry=0 + ncount=-1 !Flag for RS decode of current record + ncount1=-1 !Flag for RS Decode of ave1 + ncount2=-1 !Flag for RS Decode of ave2 + NSyncOK=0 + nqual1=0 + nqual2=0 + + if(nsave.lt.MAXAVE .and. (NAgain.eq.0 .or. NClearAve.eq.1)) + + nsave=nsave+1 + if(nsave.le.0) go to 900 !Prevent bounds error + + nflag(nsave)=0 !Clear the "good sync" flag + iseg(nsave)=Nseg !Set the RX segment to 1 or 2 + nsync=nint(snrsync-3.0) + nsnr=nint(snrx) + if(nsnr.lt.-30 .or. nsync.lt.0) nsync=0 + nsnrlim=-32 + +C Good Sync takes precedence over a shorthand message: + if(nsync.ge.MinSigdB .and. nsnr.ge.nsnrlim .and. + + nsync.gt.nstest) nstest=0 + + if(nstest.gt.0) then + dfx=dfsh + nsync=nstest + nsnr=snrsh + dtx=1. + ccfblue(-5)=-999.0 + if(nspecial.eq.1) special='ATT ' + if(nspecial.eq.2) special='RO ' + if(nspecial.eq.3) special='RRR ' + if(nspecial.eq.4) special='73 ' + NSyncOK=1 !Mark this RX file as good (for "Save Decoded") + if(NFreeze.eq.0 .or. DFTolerance.ge.200) special(5:5)='?' + width=nwsh + go to 200 + endif + + if(nsync.lt.MinSigdB .or. nsnr.lt.nsnrlim) go to 200 + +C If we get here, we have achieved sync! + NSyncOK=1 + nflag(nsave)=1 !Mark this RX file as good + csync='*' + if(flip.lt.0.0) then + csync='#' + cooo='O ?' + endif + + call decode65(dat,npts,dtx,dfx,flip,ndepth,neme,nsked, + + mycall,hiscall,hisgrid,mode65,nafc,decoded, + + ncount,deepmsg,qual) + if(ncount.eq.-999) qual=0 !Bad data + 200 kvqual=0 + if(ncount.ge.0) kvqual=1 + nqual=qual + if(ndiag.eq.0 .and. nqual.gt.10) nqual=10 + if(nqual.ge.nq1 .and.kvqual.eq.0) decoded=deepmsg + + ndf=nint(dfx) + if(flip.lt.0.0 .and. (kvqual.eq.1 .or. nqual.ge.nq2)) cooo='OOO' + if(kvqual.eq.0.and.nqual.ge.nq1.and.nqual.lt.nq2) cooo(2:3)=' ?' + if(decoded.eq.' ') cooo=' ' + do i=1,22 + c1=decoded(i:i) + if(c1.ge.'a' .and. c1.le.'z') decoded(i:i)=char(ichar(c1)-32) + enddo + write(line,1010) cfile6,nsync,nsnr,dtx-1.0,ndf, + + nint(width),csync,special,decoded(1:19),cooo,kvqual,nqual + 1010 format(a6,i3,i5,f5.1,i5,i3,1x,a1,1x,a5,a19,1x,a3,i4,i4) + +C Blank all end-of-line stuff if no decode + if(line(31:40).eq.' ') line=line(:30) + +C Blank DT if shorthand message (### wrong logic? ###) + if(special.ne.' ') then + line(15:19)=' ' + line=line(:35) + ccfblue(-5)=-9999.0 +! if(ndiag.gt.0) write(line(51:57),1012) iderrsh,idriftsh +! 1012 format(i3,i4) + else + nspecial=0 + endif + + if(lcum) write(21,1011) line + 1011 format(a67) +C Write decoded msg unless this is an "Exclude" request: + if(MinSigdB.lt.99) write(lumsg,1011) line + + if(nsave.ge.1) call avemsg65(1,mode65,ndepth,avemsg1,nused1, + + nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual1, + + ns1,ncount1) + if(nsave.ge.1) call avemsg65(2,mode65,ndepth,avemsg2,nused2, + + nq1,nq2,neme,nsked,mycall,hiscall,hisgrid,qual2, + + ns2,ncount2) + nqual1=qual1 + nqual2=qual2 + if(ndiag.eq.0 .and. nqual1.gt.10) nqual1=10 + if(ndiag.eq.0 .and. nqual2.gt.10) nqual2=10 + nc1=0 + nc2=0 + if(ncount1.ge.0) nc1=1 + if(ncount2.ge.0) nc2=1 + +C Write the average line +! if(ns1.ge.1 .and. ns1.ne.ns10) then + if(ns1.ge.1) then + if(ns1.lt.10) write(ave1,1021) cfile6,1,nused1,ns1,avemsg1, + + nc1,nqual1 + 1021 format(a6,i3,i4,'/',i1,20x,a19,i8,i4) + if(ns1.ge.10 .and. nsave.le.99) write(ave1,1022) cfile6, + + 1,nused1,ns1,avemsg1,nc1,nqual1 + 1022 format(a6,i3,i4,'/',i2,19x,a19,i8,i4) + if(ns1.ge.100) write(ave1,1023) cfile6,1,nused1,ns1, + + avemsg1,nc1,nqual1 + 1023 format(a6,i3,i4,'/',i3,18x,a19,i8,i4) + if(lcum .and. (avemsg1.ne.' ')) + + write(21,1011) ave1 + ns10=ns1 + endif + +C If Monitor segment #2 is available, write that line also +! if(ns2.ge.1 .and. ns2.ne.ns20) then !***Why the 2nd part?? *** + if(ns2.ge.1) then + if(ns2.lt.10) write(ave2,1021) cfile6,2,nused2,ns2,avemsg2, + + nc2,nqual2 + if(ns2.ge.10 .and. nsave.le.99) write(ave2,1022) cfile6, + + 2,nused2,ns2,avemsg2,nc2,nqual2 + if(ns2.ge.100) write(ave2,1023) cfile6,2,nused2,ns2,avemsg2, + + nc2,nqual2 + if(lcum .and. (avemsg2.ne.' ')) + + write(21,1011) ave2 + ns20=ns2 + endif + + if(ave1(31:40).eq.' ') ave1=ave1(:30) + if(ave2(31:40).eq.' ') ave2=ave2(:30) + write(12,1011) ave1 + write(12,1011) ave2 + call flushqqq(12) + + 800 if(lumsg.ne.6) end file 11 + + 900 continue + + return + end