mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2025-08-10 01:42:25 -04:00
638b021216
------------------------------------------------------------------------
r8085 | k9an | 2017-09-13 01:46:16 +0100 (Wed, 13 Sep 2017) | 1 line
Open up DT range to +/- 2.5 s for testing.
------------------------------------------------------------------------
r8086 | bsomervi | 2017-09-16 11:12:38 +0100 (Sat, 16 Sep 2017) | 1 line
Do not allow window manager events to close the astronomical data window
------------------------------------------------------------------------
r8087 | bsomervi | 2017-09-16 21:27:05 +0100 (Sat, 16 Sep 2017) | 4 lines
Fix regression in ADIF parser that caused failure with missing header
Improved robustness of the ADIF parser and re-factored to more
idiomatic C++.
------------------------------------------------------------------------
r8088 | bsomervi | 2017-09-16 21:27:13 +0100 (Sat, 16 Sep 2017) | 1 line
Update band limits as per ADIF 3.0.6 specification
------------------------------------------------------------------------
r8089 | bsomervi | 2017-09-16 21:27:20 +0100 (Sat, 16 Sep 2017) | 1 line
Use a single definition of band limits (Bands class)
------------------------------------------------------------------------
r8090 | bsomervi | 2017-09-16 21:27:33 +0100 (Sat, 16 Sep 2017) | 5 lines
Add button to the decoded text window context menu to erase the contents
Right-click either decoded text window to erase its contents. The
"Erase" button on the main UI still operates as before although it is
implemented differently now.
------------------------------------------------------------------------
r8091 | bsomervi | 2017-09-16 23:20:51 +0100 (Sat, 16 Sep 2017) | 1 line
Correct the actions taken when clearing decodes windows
------------------------------------------------------------------------
r8092 | bsomervi | 2017-09-16 23:20:59 +0100 (Sat, 16 Sep 2017) | 8 lines
Restore functionality of sending .WAV playback decodes to UDP
Extended the Decode and WSPRDecode UDP messages with an "off air"
boolean field indicating the decode was derived from a .WAV fle
playback rather than an on air reception.
Extended reference applications to use the new off air decode message
field.
------------------------------------------------------------------------
r8093 | k9an | 2017-09-17 16:34:32 +0100 (Sun, 17 Sep 2017) | 1 line
Experimental tweak to FT8 decoder. Try a second symbol metric if
the first one fails - currently configured to use max-amplitude
and max-log.
------------------------------------------------------------------------
r8094 | k9an | 2017-09-17 21:43:30 +0100 (Sun, 17 Sep 2017) | 1 line
Restore the use of max-amplitude for ap passes.
------------------------------------------------------------------------
r8095 | k1jt | 2017-09-18 16:42:14 +0100 (Mon, 18 Sep 2017) | 2 lines
Allow specialized use of "x2 Tone Spacing" in FT8 mode.
------------------------------------------------------------------------
r8096 | k1jt | 2017-09-18 16:47:29 +0100 (Mon, 18 Sep 2017) | 2 lines
Allow X2 tone spacing also in JT9 (slow) modes.
------------------------------------------------------------------------
r8097 | k1jt | 2017-09-18 21:42:18 +0100 (Mon, 18 Sep 2017) | 2 lines
Change CRLF line endings to *nix style.
------------------------------------------------------------------------
r8098 | k1jt | 2017-09-19 17:04:10 +0100 (Tue, 19 Sep 2017) | 2 lines
Add a missing step to description of the Frequency Calibration procedure.
------------------------------------------------------------------------
r8099 | k1jt | 2017-09-20 17:31:04 +0100 (Wed, 20 Sep 2017) | 1 line
Insert a link to FT8_Operating_Tips.pdf.
------------------------------------------------------------------------
r8100 | k1jt | 2017-09-20 20:11:04 +0100 (Wed, 20 Sep 2017) | 3 lines
As an experiment, move "NA VHF Contest Mode" checkbox to main screen and
query operator if d>10000 km.
------------------------------------------------------------------------
r8101 | k1jt | 2017-09-20 20:19:47 +0100 (Wed, 20 Sep 2017) | 2 lines
Correct a tool-tip typo.
------------------------------------------------------------------------
r8102 | bsomervi | 2017-09-22 13:31:01 +0100 (Fri, 22 Sep 2017) | 1 line
UI tweaks to improve portability between platforms and font size changes
------------------------------------------------------------------------
r8103 | bsomervi | 2017-09-22 16:36:24 +0100 (Fri, 22 Sep 2017) | 5 lines
Extend UDP Reply message with keyboard modifiers
This allows UDP servers to emulate keyboard modified double-clicks on
decoded messages, E.g. ALT+double-click for replying to a CQ or QRZ
call without changing ones Tx frequency offset.
------------------------------------------------------------------------
r8104 | bsomervi | 2017-09-22 16:49:42 +0100 (Fri, 22 Sep 2017) | 1 line
Updated AD1C cty.dat file (21st Sept 2017)
------------------------------------------------------------------------
r8105 | k1jt | 2017-09-22 18:38:51 +0100 (Fri, 22 Sep 2017) | 2 lines
Another attempt at eliminating confusion when NA VHF Contest Mode is in use.
------------------------------------------------------------------------
r8106 | k9an | 2017-09-22 21:36:52 +0100 (Fri, 22 Sep 2017) | 1 line
Make sure that fastGrph is properly initialized.
------------------------------------------------------------------------
r8107 | bsomervi | 2017-09-22 23:08:41 +0100 (Fri, 22 Sep 2017) | 1 line
Improve performance of the UDP reference application message_aggregator
------------------------------------------------------------------------
r8108 | bsomervi | 2017-09-22 23:08:49 +0100 (Fri, 22 Sep 2017) | 1 line
Fix a regression in processing incoming Reply UDP messages
------------------------------------------------------------------------
r8109 | bsomervi | 2017-09-22 23:08:56 +0100 (Fri, 22 Sep 2017) | 4 lines
Better handling of worked before and country name display
Appended text is added at a fixed column unless the message overlaps
in which case the appended information floats to thr right.
------------------------------------------------------------------------
r8110 | bsomervi | 2017-09-22 23:09:04 +0100 (Fri, 22 Sep 2017) | 4 lines
Restore printing of MSK144 decode quality information
Now that a way of dealing with worked before and country information
without losing this information has been found.
------------------------------------------------------------------------
r8111 | bsomervi | 2017-09-22 23:09:11 +0100 (Fri, 22 Sep 2017) | 5 lines
Fix an issue with truncated free text messages being generated
This is an edge case when working a call like RI9F/GM4WJS where it is
not possible to confirm receipt of the full compound callsign in a Tx5
73 message as "RI9F/GM4WJS 73" is 14 characters.
------------------------------------------------------------------------
r8112 | bsomervi | 2017-09-23 19:09:29 +0100 (Sat, 23 Sep 2017) | 1 line
Tidy up some ugly code
------------------------------------------------------------------------
r8113 | bsomervi | 2017-09-23 19:09:37 +0100 (Sat, 23 Sep 2017) | 1 line
Clean up some main window UI layout
------------------------------------------------------------------------
r8114 | k9an | 2017-09-23 20:39:42 +0100 (Sat, 23 Sep 2017) | 1 line
Comment out some diagnostic writes.
------------------------------------------------------------------------
r8115 | k9an | 2017-09-23 20:56:45 +0100 (Sat, 23 Sep 2017) | 1 line
Add some text for section 13.3 of the User Guide.
------------------------------------------------------------------------
r8116 | k9an | 2017-09-23 21:01:31 +0100 (Sat, 23 Sep 2017) | 1 line
Minor change to new_features.adoc.
------------------------------------------------------------------------
r8117 | bsomervi | 2017-09-23 23:02:24 +0100 (Sat, 23 Sep 2017) | 1 line
Minor additions to MSK144 phase eq docs
------------------------------------------------------------------------
r8118 | k9an | 2017-09-23 23:32:06 +0100 (Sat, 23 Sep 2017) | 1 line
Fix up Table 2 caption.
------------------------------------------------------------------------
r8119 | bsomervi | 2017-09-24 22:14:10 +0100 (Sun, 24 Sep 2017) | 1 line
Fix issues processing free text 73 messages
------------------------------------------------------------------------
r8120 | k1jt | 2017-09-25 18:02:52 +0100 (Mon, 25 Sep 2017) | 3 lines
First tests of "RR73 NOW ..." and "NIL NOW ..." (i3bit=1, 2) messages in FT8.
DO NOT USE THIS FEATURE ON THE AIR!
------------------------------------------------------------------------
r8121 | k1jt | 2017-09-25 20:21:25 +0100 (Mon, 25 Sep 2017) | 2 lines
Make bDXped a member variable, default to false.
------------------------------------------------------------------------
r8122 | bsomervi | 2017-09-26 00:38:19 +0100 (Tue, 26 Sep 2017) | 1 line
Fix regression in handling double-clicked CQ and QRZ calls
------------------------------------------------------------------------
r8123 | bsomervi | 2017-09-26 00:38:27 +0100 (Tue, 26 Sep 2017) | 1 line
Fix a regression handling compound calls in 73 messages
------------------------------------------------------------------------
r8124 | k1jt | 2017-09-27 13:26:33 +0100 (Wed, 27 Sep 2017) | 2 lines
Additions to Section 13.3 of WSJT-X User Guide: "Phase Equalkization".
------------------------------------------------------------------------
r8125 | k1jt | 2017-09-27 13:39:50 +0100 (Wed, 27 Sep 2017) | 31 lines
Experimental new behavior for "Lock Tx=Rx" and for clicking on waterfall and decoded text.
1. Checkbox "Lock Tx=Rx" is now labeled "Lock Tx Freq", and its meaning is
quite different. If checked, the audio Tx frequency cannot be changed.
It's like the "Lock" function on some transceivers.
2. Clicking on the Wide Graph waterfall and on lines of decoded text now
behave as follows:
Click on Action
---------------------------------------------------------------------
Waterfall: Click to set Rx frequency
Shift-click to set Tx frequency
Ctrl-click to set Rx and Tx frequencies
If Lock Tx Freq is checked, Tx freq does not move
Double-click to set Rx frequency and decode there
Decoded Text: Double-click to copy transmitting callsign to DX Call
and locator to DX Grid; change Rx frequency to decoded
signal's frequency; generate standard messages.
Tx frequency is not changed unless Ctrl is held down
and Lock Tx Freq not checked.
If this experimental behavior is adopted, some descriptions in the
User Guide and Special Mouse Commands will need to be updated.
3. Starting to implement a new function on the Tools menu,
"Solve for calibration parameters". This is not yet finished;
DO NOT USE in its present form.
------------------------------------------------------------------------
r8126 | k1jt | 2017-09-27 13:50:21 +0100 (Wed, 27 Sep 2017) | 2 lines
Add missing routine.
------------------------------------------------------------------------
r8127 | k1jt | 2017-09-28 02:35:09 +0100 (Thu, 28 Sep 2017) | 1 line
Functional 'Solve for calibration parameters' on Tools menu.
------------------------------------------------------------------------
r8128 | k1jt | 2017-09-28 13:30:52 +0100 (Thu, 28 Sep 2017) | 1 line
dummy
------------------------------------------------------------------------
r8129 | k9an | 2017-09-28 16:00:57 +0100 (Thu, 28 Sep 2017) | 1 line
Correct a typo in the docs.
------------------------------------------------------------------------
r8130 | k1jt | 2017-09-28 16:05:41 +0100 (Thu, 28 Sep 2017) | 1 line
Minor edits in User Guide.
------------------------------------------------------------------------
r8131 | k1jt | 2017-09-28 16:09:46 +0100 (Thu, 28 Sep 2017) | 3 lines
Fix two ways that Loxk Tx Freq could be circumvented; display Echo Graph
automatically when Echo mode is started; clean up display of FreqCal parameters.
------------------------------------------------------------------------
r8132 | k1jt | 2017-09-28 16:46:36 +0100 (Thu, 28 Sep 2017) | 2 lines
Clean up the display of "Controls" checkbox on Wide Graph.
------------------------------------------------------------------------
r8133 | k1jt | 2017-09-28 16:55:24 +0100 (Thu, 28 Sep 2017) | 2 lines
Display "NIL NOW ", etc., only for test cases.
------------------------------------------------------------------------
r8134 | k1jt | 2017-09-28 20:51:04 +0100 (Thu, 28 Sep 2017) | 2 lines
Add some FreqCal info to User Guide.
------------------------------------------------------------------------
r8135 | k1jt | 2017-09-29 00:34:13 +0100 (Fri, 29 Sep 2017) | 1 line
Move 'Controls' checkbox a few pixels to the right.
------------------------------------------------------------------------
r8136 | bsomervi | 2017-09-29 11:46:43 +0100 (Fri, 29 Sep 2017) | 1 line
Fix accidental regression in UDP Reply message handling
------------------------------------------------------------------------
r8137 | bsomervi | 2017-09-29 11:57:22 +0100 (Fri, 29 Sep 2017) | 1 line
Minor clarification for the User Guide waterfall controls description
------------------------------------------------------------------------
r8138 | k1jt | 2017-09-29 14:27:55 +0100 (Fri, 29 Sep 2017) | 2 lines
Minor change to make shift/ctrl double-click logic more consistent.
------------------------------------------------------------------------
r8139 | k1jt | 2017-09-29 14:47:26 +0100 (Fri, 29 Sep 2017) | 1 line
Remove a diagnostic qDebug().
------------------------------------------------------------------------
r8140 | k1jt | 2017-09-29 14:59:16 +0100 (Fri, 29 Sep 2017) | 2 lines
Additional instructions for using the FreqCal procedure.
------------------------------------------------------------------------
r8141 | k1jt | 2017-09-29 17:53:28 +0100 (Fri, 29 Sep 2017) | 2 lines
Many updates to User Guide, mostly to reflect changes in "click behavior".
------------------------------------------------------------------------
r8142 | k1jt | 2017-09-29 17:53:57 +0100 (Fri, 29 Sep 2017) | 1 line
Update mouse_sommands.txt.
------------------------------------------------------------------------
r8143 | k1jt | 2017-09-29 17:58:05 +0100 (Fri, 29 Sep 2017) | 3 lines
Previous commit message should have mentioned a fix to "stdmsg.f90" that was
preventing double-click on a JT65 "OOO" message from populating message fields.
------------------------------------------------------------------------
r8144 | k1jt | 2017-09-29 18:40:30 +0100 (Fri, 29 Sep 2017) | 2 lines
Add an option to enforce simplex operation (moving both Tx and Rx
frequency) when double-clicking on a decoded text line.
------------------------------------------------------------------------
r8145 | k1jt | 2017-09-30 14:56:33 +0100 (Sat, 30 Sep 2017) | 1 line
Fix a regression that prevented double-click on call from working as in r8123.
------------------------------------------------------------------------
r8146 | k1jt | 2017-09-30 18:48:46 +0100 (Sat, 30 Sep 2017) | 21 lines
Another try at optimizing the GUI for simplex and split behavior. Details below:
1. Checkbox "Double-click on call sets Tx and Rx freqs" has been removed
from the Settings -> General tab.
2. Checkbox "Lock Tx Freq" on main window is relabled "Hold Tx Freq".
3. Behavior now defaults to the "simplex" behavior in use up to code
revision r8123. In particular, double-clicking on decoded mesages
that do not contain your own call moves both Rx and Tx frequencies.
If the first callsign is your own call, only Rx freq moves.
4. If "Hold Tx Freq" is checked, double-clicking on decoded messages
moves the Rx frequency; Tx frequency is moved only if CTRL was held
down.
5. Clicking on the waterfall moves Rx and Tx frequencies as before:
Rx only on a simple click, Tx only on SHIFT-click, and both on
CTRL-click. This happens even if "Hold Tx Freq" is checked (which
is why this box is no longer labeled "Lock Tx Freq").
------------------------------------------------------------------------
r8147 | k1jt | 2017-09-30 20:25:01 +0100 (Sat, 30 Sep 2017) | 1 line
Fix behavior with double-click on 'CQ <AA-ZZ> <call> <grid>.'
------------------------------------------------------------------------
r8148 | k1jt | 2017-10-01 13:35:43 +0100 (Sun, 01 Oct 2017) | 1 line
Correct an improper disabling of TxFreqSpinBox.
------------------------------------------------------------------------
r8149 | k1jt | 2017-10-01 15:03:16 +0100 (Sun, 01 Oct 2017) | 1 line
Update mouse_commands.txt and tool tips.
------------------------------------------------------------------------
r8150 | k1jt | 2017-10-01 15:58:10 +0100 (Sun, 01 Oct 2017) | 1 line
Update 'blank line' band ID at 4*TRperiod/5.
------------------------------------------------------------------------
r8151 | bsomervi | 2017-10-01 22:43:59 +0100 (Sun, 01 Oct 2017) | 1 line
Fix an invalid iterator increment when there are no FreqCal frequencies
------------------------------------------------------------------------
r8152 | bsomervi | 2017-10-01 22:44:07 +0100 (Sun, 01 Oct 2017) | 1 line
Fix cty.dat lookups that were not honouring exact match flags
------------------------------------------------------------------------
r8153 | bsomervi | 2017-10-01 22:44:15 +0100 (Sun, 01 Oct 2017) | 6 lines
Add "Apply" button to calibration solution message box
Make calibration solution application iterative so that calibrations
can be applied sequentially if desired.
Tidy up calibration solution messages boxes and make i18n friendly.
------------------------------------------------------------------------
r8154 | k1jt | 2017-10-02 14:49:37 +0100 (Mon, 02 Oct 2017) | 2 lines
Update User Guide and "mouse_commands".
------------------------------------------------------------------------
r8155 | k1jt | 2017-10-02 15:15:15 +0100 (Mon, 02 Oct 2017) | 2 lines
Special DXpedition messages must not have the FreeText bit set.
------------------------------------------------------------------------
r8156 | k1jt | 2017-10-02 19:27:08 +0100 (Mon, 02 Oct 2017) | 2 lines
Add more on Copyright protections.
------------------------------------------------------------------------
r8157 | k1jt | 2017-10-02 19:33:17 +0100 (Mon, 02 Oct 2017) | 2 lines
Update the list of keyboard shortcuts.
------------------------------------------------------------------------
r8158 | k1jt | 2017-10-02 19:35:06 +0100 (Mon, 02 Oct 2017) | 2 lines
Minor edits.
------------------------------------------------------------------------
r8159 | k1jt | 2017-10-03 02:23:24 +0100 (Tue, 03 Oct 2017) | 1 line
Correct a misspelling; add quote marks; push 'About' to bottom of Tools menu.
------------------------------------------------------------------------
r8160 | k1jt | 2017-10-03 16:59:47 +0100 (Tue, 03 Oct 2017) | 2 lines
Add KA9Q to the copyright notice.
------------------------------------------------------------------------
r8161 | k1jt | 2017-10-04 14:14:51 +0100 (Wed, 04 Oct 2017) | 2 lines
Update an image; fix a typo.
------------------------------------------------------------------------
r8162 | k1jt | 2017-10-05 19:27:34 +0100 (Thu, 05 Oct 2017) | 2 lines
Fix a bug involving "firstcall contains mycall" but not equal to mycall.
------------------------------------------------------------------------
r8163 | bsomervi | 2017-10-06 17:18:17 +0100 (Fri, 06 Oct 2017) | 1 line
Add an accessor method to Configuration to get the current calibration parameters
------------------------------------------------------------------------
r8164 | bsomervi | 2017-10-06 17:18:25 +0100 (Fri, 06 Oct 2017) | 5 lines
Rename the fmt.all calibration measurements file after accepting a solution
This allows those who want to keep their calibration measurements
after finding a solution to calibrate their station. The fmt.all file
used to find and accept a solution is renamed to fmt.bak.
------------------------------------------------------------------------
r8165 | k1jt | 2017-10-13 15:36:10 +0100 (Fri, 13 Oct 2017) | 2 lines
Update the Tool Tip displayed for Frequency Calibration parameters.
------------------------------------------------------------------------
r8166 | bsomervi | 2017-10-13 23:34:10 +0100 (Fri, 13 Oct 2017) | 1 line
Fix an issue with editing IARU regions in the working frequencies table
------------------------------------------------------------------------
r8167 | bsomervi | 2017-10-13 23:34:21 +0100 (Fri, 13 Oct 2017) | 32 lines
Improved frequency calibration
Measure check box added to FreqCal mode, check to record to fmt.all
with current calibration correction disabled, uncheck to see the
impact of the current calibration parameters.
The fmt.all file is now optionally renamed to fmt.bak when a
calibration solution is accepted. This allows users to preserve an
fmt.all file that they might have edited for best fit.
A calibration procedure might proceed thus:-
1) select FreqCal mode,
2) step through suggested calibration test frequencies deleting those
that have no usable signal,
3) enable "Menu->Tools->Execute frequency calibration cycle" and check
that suitable signals are present,
4) select a suitable FTol and T/R period,
5) check "Measure" and let the cycle complete a few times to gather
data,
6) uncheck "Measure" to complete the data capture, optionally tidy the
fmt.all file with your favourite editor,
7) push "Menu->Tools->Solve for calibration parameters" and accept if
you like what you see,
8) sit back and admire your accurately frequency calibrated station.
------------------------------------------------------------------------
r8168 | bsomervi | 2017-10-13 23:34:36 +0100 (Fri, 13 Oct 2017) | 4 lines
Generic handling of keyboard modifiers via UDP and double-clicks
This change opens up all keyboard modifier options to UDP Reply
messages as well as double-clicks of decoded messages.
------------------------------------------------------------------------
r8169 | bsomervi | 2017-10-13 23:34:48 +0100 (Fri, 13 Oct 2017) | 3 lines
User guide updates for frequency calibration mode
Also some instances of non-italicized WSJT-X fixed.
------------------------------------------------------------------------
r8170 | k9an | 2017-10-14 02:02:38 +0100 (Sat, 14 Oct 2017) | 1 line
Don't open the false_decodes.txt file.
------------------------------------------------------------------------
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx-1.8@8171 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
1027 lines
24 KiB
Fortran
1027 lines
24 KiB
Fortran
module packjt
|
|
|
|
! These variables are accessible from outside via "use packjt":
|
|
integer jt_itype,jt_nc1,jt_nc2,jt_ng,jt_k1,jt_k2
|
|
character*6 jt_c1,jt_c2,jt_c3
|
|
|
|
contains
|
|
|
|
subroutine packbits(dbits,nsymd,m0,sym)
|
|
|
|
! Pack 0s and 1s from dbits() into sym() with m0 bits per word.
|
|
! NB: nsymd is the number of packed output words.
|
|
|
|
integer sym(:)
|
|
integer*1 dbits(:)
|
|
|
|
k=0
|
|
do i=1,nsymd
|
|
n=0
|
|
do j=1,m0
|
|
k=k+1
|
|
m=dbits(k)
|
|
n=ior(ishft(n,1),m)
|
|
enddo
|
|
sym(i)=n
|
|
enddo
|
|
|
|
return
|
|
end subroutine packbits
|
|
|
|
subroutine unpackbits(sym,nsymd,m0,dbits)
|
|
|
|
! Unpack bits from sym() into dbits(), one bit per byte.
|
|
! NB: nsymd is the number of input words, and m0 their length.
|
|
! there will be m0*nsymd output bytes, each 0 or 1.
|
|
|
|
integer sym(:)
|
|
integer*1 dbits(:)
|
|
|
|
k=0
|
|
do i=1,nsymd
|
|
mask=ishft(1,m0-1)
|
|
do j=1,m0
|
|
k=k+1
|
|
dbits(k)=0
|
|
if(iand(mask,sym(i)).ne.0) dbits(k)=1
|
|
mask=ishft(mask,-1)
|
|
enddo
|
|
enddo
|
|
|
|
return
|
|
end subroutine unpackbits
|
|
|
|
subroutine packcall(callsign,ncall,text)
|
|
|
|
! Pack a valid callsign into a 28-bit integer.
|
|
|
|
parameter (NBASE=37*36*10*27*27*27)
|
|
character callsign*6,c*1,tmp*6
|
|
logical text
|
|
|
|
text=.false.
|
|
|
|
! Work-around for Swaziland prefix:
|
|
if(callsign(1:4).eq.'3DA0') callsign='3D0'//callsign(5:6)
|
|
|
|
if(callsign(1:3).eq.'CQ ') then
|
|
ncall=NBASE + 1
|
|
if(callsign(4:4).ge.'0' .and. callsign(4:4).le.'9' .and. &
|
|
callsign(5:5).ge.'0' .and. callsign(5:5).le.'9' .and. &
|
|
callsign(6:6).ge.'0' .and. callsign(6:6).le.'9') then
|
|
read(callsign(4:6),*) nfreq
|
|
ncall=NBASE + 3 + nfreq
|
|
endif
|
|
return
|
|
else if(callsign(1:4).eq.'QRZ ') then
|
|
ncall=NBASE + 2
|
|
return
|
|
else if(callsign(1:3).eq.'DE ') then
|
|
ncall=267796945
|
|
return
|
|
endif
|
|
|
|
tmp=' '
|
|
if(callsign(3:3).ge.'0' .and. callsign(3:3).le.'9') then
|
|
tmp=callsign
|
|
else if(callsign(2:2).ge.'0' .and. callsign(2:2).le.'9') then
|
|
if(callsign(6:6).ne.' ') then
|
|
text=.true.
|
|
return
|
|
endif
|
|
tmp=' '//callsign(:5)
|
|
else
|
|
text=.true.
|
|
return
|
|
endif
|
|
|
|
do i=1,6
|
|
c=tmp(i:i)
|
|
if(c.ge.'a' .and. c.le.'z') &
|
|
tmp(i:i)=char(ichar(c)-ichar('a')+ichar('A'))
|
|
enddo
|
|
|
|
n1=0
|
|
if((tmp(1:1).ge.'A'.and.tmp(1:1).le.'Z').or.tmp(1:1).eq.' ') n1=1
|
|
if(tmp(1:1).ge.'0' .and. tmp(1:1).le.'9') n1=1
|
|
n2=0
|
|
if(tmp(2:2).ge.'A' .and. tmp(2:2).le.'Z') n2=1
|
|
if(tmp(2:2).ge.'0' .and. tmp(2:2).le.'9') n2=1
|
|
n3=0
|
|
if(tmp(3:3).ge.'0' .and. tmp(3:3).le.'9') n3=1
|
|
n4=0
|
|
if((tmp(4:4).ge.'A'.and.tmp(4:4).le.'Z').or.tmp(4:4).eq.' ') n4=1
|
|
n5=0
|
|
if((tmp(5:5).ge.'A'.and.tmp(5:5).le.'Z').or.tmp(5:5).eq.' ') n5=1
|
|
n6=0
|
|
if((tmp(6:6).ge.'A'.and.tmp(6:6).le.'Z').or.tmp(6:6).eq.' ') n6=1
|
|
|
|
if(n1+n2+n3+n4+n5+n6 .ne. 6) then
|
|
text=.true.
|
|
return
|
|
endif
|
|
|
|
ncall=nchar(tmp(1:1))
|
|
ncall=36*ncall+nchar(tmp(2:2))
|
|
ncall=10*ncall+nchar(tmp(3:3))
|
|
ncall=27*ncall+nchar(tmp(4:4))-10
|
|
ncall=27*ncall+nchar(tmp(5:5))-10
|
|
ncall=27*ncall+nchar(tmp(6:6))-10
|
|
|
|
return
|
|
end subroutine packcall
|
|
|
|
subroutine unpackcall(ncall,word,iv2,psfx)
|
|
|
|
parameter (NBASE=37*36*10*27*27*27)
|
|
character word*12,c*37,psfx*4
|
|
|
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
|
|
|
word='......'
|
|
psfx=' '
|
|
n=ncall
|
|
iv2=0
|
|
if(n.ge.262177560) go to 20
|
|
word='......'
|
|
! if(n.ge.262177560) go to 999 !Plain text message ...
|
|
i=mod(n,27)+11
|
|
word(6:6)=c(i:i)
|
|
n=n/27
|
|
i=mod(n,27)+11
|
|
word(5:5)=c(i:i)
|
|
n=n/27
|
|
i=mod(n,27)+11
|
|
word(4:4)=c(i:i)
|
|
n=n/27
|
|
i=mod(n,10)+1
|
|
word(3:3)=c(i:i)
|
|
n=n/10
|
|
i=mod(n,36)+1
|
|
word(2:2)=c(i:i)
|
|
n=n/36
|
|
i=n+1
|
|
word(1:1)=c(i:i)
|
|
do i=1,4
|
|
if(word(i:i).ne.' ') go to 10
|
|
enddo
|
|
go to 999
|
|
10 word=word(i:)
|
|
go to 999
|
|
|
|
20 if(n.ge.267796946) go to 999
|
|
|
|
! We have a JT65v2 message
|
|
if((n.ge.262178563) .and. (n.le.264002071)) then
|
|
! CQ with prefix
|
|
iv2=1
|
|
n=n-262178563
|
|
i=mod(n,37)+1
|
|
psfx(4:4)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if((n.ge.264002072) .and. (n.le.265825580)) then
|
|
! QRZ with prefix
|
|
iv2=2
|
|
n=n-264002072
|
|
i=mod(n,37)+1
|
|
psfx(4:4)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if((n.ge.265825581) .and. (n.le.267649089)) then
|
|
! DE with prefix
|
|
iv2=3
|
|
n=n-265825581
|
|
i=mod(n,37)+1
|
|
psfx(4:4)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if((n.ge.267649090) .and. (n.le.267698374)) then
|
|
! CQ with suffix
|
|
iv2=4
|
|
n=n-267649090
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if((n.ge.267698375) .and. (n.le.267747659)) then
|
|
! QRZ with suffix
|
|
iv2=5
|
|
n=n-267698375
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if((n.ge.267747660) .and. (n.le.267796944)) then
|
|
! DE with suffix
|
|
iv2=6
|
|
n=n-267747660
|
|
i=mod(n,37)+1
|
|
psfx(3:3)=c(i:i)
|
|
n=n/37
|
|
i=mod(n,37)+1
|
|
psfx(2:2)=c(i:i)
|
|
n=n/37
|
|
i=n+1
|
|
psfx(1:1)=c(i:i)
|
|
|
|
else if(n.eq.267796945) then
|
|
! DE with no prefix or suffix
|
|
iv2=7
|
|
psfx = ' '
|
|
endif
|
|
|
|
999 if(word(1:3).eq.'3D0') word='3DA0'//word(4:)
|
|
|
|
return
|
|
end subroutine unpackcall
|
|
|
|
subroutine packgrid(grid,ng,text)
|
|
|
|
parameter (NGBASE=180*180)
|
|
character*4 grid
|
|
character*1 c1
|
|
logical text
|
|
|
|
text=.false.
|
|
if(grid.eq.' ') go to 90 !Blank grid is OK
|
|
|
|
! First, handle signal reports in the original range, -01 to -30 dB
|
|
if(grid(1:1).eq.'-') then
|
|
read(grid(2:3),*,err=800,end=800) n
|
|
if(n.ge.1 .and. n.le.30) then
|
|
ng=NGBASE+1+n
|
|
go to 900
|
|
endif
|
|
go to 10
|
|
else if(grid(1:2).eq.'R-') then
|
|
read(grid(3:4),*,err=800,end=800) n
|
|
if(n.ge.1 .and. n.le.30) then
|
|
ng=NGBASE+31+n
|
|
go to 900
|
|
endif
|
|
go to 10
|
|
! Now check for RO, RRR, or 73 in the message field normally used for grid
|
|
else if(grid(1:4).eq.'RO ') then
|
|
ng=NGBASE+62
|
|
go to 900
|
|
else if(grid(1:4).eq.'RRR ') then
|
|
ng=NGBASE+63
|
|
go to 900
|
|
else if(grid(1:4).eq.'73 ') then
|
|
ng=NGBASE+64
|
|
go to 900
|
|
endif
|
|
|
|
! Now check for extended-range signal reports: -50 to -31, and 0 to +49.
|
|
10 n=99
|
|
c1=grid(1:1)
|
|
read(grid,*,err=20,end=20) n
|
|
go to 30
|
|
20 read(grid(2:4),*,err=30,end=30) n
|
|
30 if(n.ge.-50 .and. n.le.49) then
|
|
if(c1.eq.'R') then
|
|
write(grid,1002) n+50
|
|
1002 format('LA',i2.2)
|
|
else
|
|
write(grid,1003) n+50
|
|
1003 format('KA',i2.2)
|
|
endif
|
|
go to 40
|
|
endif
|
|
|
|
! Maybe it's free text ?
|
|
if(grid(1:1).lt.'A' .or. grid(1:1).gt.'R') text=.true.
|
|
if(grid(2:2).lt.'A' .or. grid(2:2).gt.'R') text=.true.
|
|
if(grid(3:3).lt.'0' .or. grid(3:3).gt.'9') text=.true.
|
|
if(grid(4:4).lt.'0' .or. grid(4:4).gt.'9') text=.true.
|
|
if(text) go to 900
|
|
|
|
! OK, we have a properly formatted grid locator
|
|
40 call grid2deg(grid//'mm',dlong,dlat)
|
|
long=int(dlong)
|
|
lat=int(dlat+ 90.0)
|
|
ng=((long+180)/2)*180 + lat
|
|
go to 900
|
|
|
|
90 ng=NGBASE + 1
|
|
go to 900
|
|
|
|
800 text=.true.
|
|
900 continue
|
|
|
|
return
|
|
end subroutine packgrid
|
|
|
|
subroutine unpackgrid(ng,grid)
|
|
|
|
parameter (NGBASE=180*180)
|
|
character grid*4,grid6*6
|
|
|
|
grid=' '
|
|
if(ng.ge.32400) go to 10
|
|
dlat=mod(ng,180)-90
|
|
dlong=(ng/180)*2 - 180 + 2
|
|
call deg2grid(dlong,dlat,grid6)
|
|
grid=grid6(:4)
|
|
if(grid(1:2).eq.'KA') then
|
|
read(grid(3:4),*) n
|
|
n=n-50
|
|
write(grid,1001) n
|
|
1001 format(i3.2)
|
|
if(grid(1:1).eq.' ') grid(1:1)='+'
|
|
else if(grid(1:2).eq.'LA') then
|
|
read(grid(3:4),*) n
|
|
n=n-50
|
|
write(grid,1002) n
|
|
1002 format('R',i3.2)
|
|
if(grid(2:2).eq.' ') grid(2:2)='+'
|
|
endif
|
|
go to 900
|
|
|
|
10 n=ng-NGBASE-1
|
|
if(n.ge.1 .and.n.le.30) then
|
|
write(grid,1012) -n
|
|
1012 format(i3.2)
|
|
else if(n.ge.31 .and.n.le.60) then
|
|
n=n-30
|
|
write(grid,1022) -n
|
|
1022 format('R',i3.2)
|
|
else if(n.eq.61) then
|
|
grid='RO'
|
|
else if(n.eq.62) then
|
|
grid='RRR'
|
|
else if(n.eq.63) then
|
|
grid='73'
|
|
endif
|
|
|
|
900 return
|
|
end subroutine unpackgrid
|
|
|
|
subroutine packmsg(msg0,dat,itype,bcontest)
|
|
|
|
! Packs a JT4/JT9/JT65 message into twelve 6-bit symbols
|
|
|
|
! itype Message Type
|
|
!--------------------
|
|
! 1 Standardd message
|
|
! 2 Type 1 prefix
|
|
! 3 Type 1 suffix
|
|
! 4 Type 2 prefix
|
|
! 5 Type 2 suffix
|
|
! 6 Free text
|
|
! -1 Does not decode correctly
|
|
|
|
parameter (NBASE=37*36*10*27*27*27)
|
|
parameter (NBASE2=262178562)
|
|
character*22 msg0,msg
|
|
integer dat(:)
|
|
character*12 c1,c2
|
|
character*4 c3
|
|
character*6 grid6
|
|
logical text1,text2,text3,bcontest
|
|
|
|
itype=1
|
|
if(bcontest) then
|
|
call to_contest_msg(msg0,msg)
|
|
else
|
|
msg=msg0
|
|
end if
|
|
|
|
call fmtmsg(msg,iz)
|
|
|
|
if(msg(1:6).eq.'CQ DX ') msg(3:3)='9'
|
|
if(msg(1:3).eq.'CQ ' .and. &
|
|
msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. &
|
|
msg(5:5).ge.'A' .and. msg(5:5).le.'Z' .and. &
|
|
msg(6:6).eq.' ') msg='E9'//msg(4:)
|
|
|
|
! See if it's a CQ message
|
|
if(msg(1:3).eq.'CQ ') then
|
|
i=3
|
|
! ... and if so, does it have a reply frequency?
|
|
if(msg(4:4).ge.'0' .and. msg(4:4).le.'9' .and. &
|
|
msg(5:5).ge.'0' .and. msg(5:5).le.'9' .and. &
|
|
msg(6:6).ge.'0' .and. msg(6:6).le.'9') i=7
|
|
go to 1
|
|
endif
|
|
|
|
do i=1,22
|
|
if(msg(i:i).eq.' ') go to 1 !Get 1st blank
|
|
enddo
|
|
go to 10 !Consider msg as plain text
|
|
|
|
1 ia=i
|
|
c1=msg(1:ia-1)
|
|
do i=ia+1,22
|
|
if(msg(i:i).eq.' ') go to 2 !Get 2nd blank
|
|
enddo
|
|
go to 10 !Consider msg as plain text
|
|
|
|
2 ib=i
|
|
c2=msg(ia+1:ib-1)
|
|
|
|
do i=ib+1,22
|
|
if(msg(i:i).eq.' ') go to 3 !Get 3rd blank
|
|
enddo
|
|
go to 10 !Consider msg as plain text
|
|
|
|
3 ic=i
|
|
c3=' '
|
|
if(ic.ge.ib+1) c3=msg(ib+1:ic)
|
|
if(c3.eq.'OOO ') c3=' ' !Strip out the OOO flag
|
|
call getpfx1(c1,k1,nv2a)
|
|
if(nv2a.ge.4) go to 10
|
|
call packcall(c1,nc1,text1)
|
|
if(text1) go to 10
|
|
call getpfx1(c2,k2,nv2b)
|
|
call packcall(c2,nc2,text2)
|
|
if(text2) go to 10
|
|
if(nv2a.eq.2 .or. nv2a.eq.3 .or. nv2b.eq.2 .or. nv2b.eq.3) then
|
|
if(k1.lt.0 .or. k2.lt.0 .or. k1*k2.ne.0) go to 10
|
|
if(k2.gt.0) k2=k2+450
|
|
k=max(k1,k2)
|
|
if(k.gt.0) then
|
|
call k2grid(k,grid6)
|
|
c3=grid6(:4)
|
|
endif
|
|
endif
|
|
call packgrid(c3,ng,text3)
|
|
|
|
if(nv2a.lt.4 .and. nv2b.lt.4 .and. (.not.text1) .and. (.not.text2) .and. &
|
|
(.not.text3)) go to 20
|
|
|
|
nc1=0
|
|
if(nv2b.eq.4) then
|
|
if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=262178563 + k2
|
|
if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=264002072 + k2
|
|
if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=265825581 + k2
|
|
else if(nv2b.eq.5) then
|
|
if(c1(1:3).eq.'CQ ' .and. (.not.text3)) nc1=267649090 + k2
|
|
if(c1(1:4).eq.'QRZ ' .and. (.not.text3)) nc1=267698375 + k2
|
|
if(c1(1:3).eq.'DE ' .and. (.not.text3)) nc1=267747660 + k2
|
|
endif
|
|
if(nc1.ne.0) go to 20
|
|
|
|
! The message will be treated as plain text.
|
|
10 itype=6
|
|
call packtext(msg,nc1,nc2,ng)
|
|
ng=ng+32768
|
|
|
|
! Encode data into 6-bit words
|
|
20 continue
|
|
if(itype.ne.6) itype=max(nv2a,nv2b)
|
|
jt_itype=itype
|
|
jt_c1=c1(1:6)
|
|
jt_c2=c2(1:6)
|
|
jt_c3=c3
|
|
jt_k1=k1
|
|
jt_k2=k2
|
|
jt_nc1=nc1
|
|
jt_nc2=nc2
|
|
jt_ng=ng
|
|
dat(1)=iand(ishft(nc1,-22),63) !6 bits
|
|
dat(2)=iand(ishft(nc1,-16),63) !6 bits
|
|
dat(3)=iand(ishft(nc1,-10),63) !6 bits
|
|
dat(4)=iand(ishft(nc1, -4),63) !6 bits
|
|
dat(5)=4*iand(nc1,15)+iand(ishft(nc2,-26),3) !4+2 bits
|
|
dat(6)=iand(ishft(nc2,-20),63) !6 bits
|
|
dat(7)=iand(ishft(nc2,-14),63) !6 bits
|
|
dat(8)=iand(ishft(nc2, -8),63) !6 bits
|
|
dat(9)=iand(ishft(nc2, -2),63) !6 bits
|
|
dat(10)=16*iand(nc2,3)+iand(ishft(ng,-12),15) !2+4 bits
|
|
dat(11)=iand(ishft(ng,-6),63)
|
|
dat(12)=iand(ng,63)
|
|
|
|
return
|
|
end subroutine packmsg
|
|
|
|
subroutine unpackmsg(dat,msg,bcontest,mygrid)
|
|
|
|
parameter (NBASE=37*36*10*27*27*27)
|
|
parameter (NGBASE=180*180)
|
|
integer dat(:)
|
|
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4,mygrid*6
|
|
logical cqnnn,bcontest
|
|
|
|
cqnnn=.false.
|
|
nc1=ishft(dat(1),22) + ishft(dat(2),16) + ishft(dat(3),10)+ &
|
|
ishft(dat(4),4) + iand(ishft(dat(5),-2),15)
|
|
|
|
nc2=ishft(iand(dat(5),3),26) + ishft(dat(6),20) + &
|
|
ishft(dat(7),14) + ishft(dat(8),8) + ishft(dat(9),2) + &
|
|
iand(ishft(dat(10),-4),3)
|
|
|
|
ng=ishft(iand(dat(10),15),12) + ishft(dat(11),6) + dat(12)
|
|
|
|
if(ng.ge.32768) then
|
|
call unpacktext(nc1,nc2,ng,msg)
|
|
go to 100
|
|
endif
|
|
|
|
call unpackcall(nc1,c1,iv2,psfx)
|
|
if(iv2.eq.0) then
|
|
! This is an "original JT65" message
|
|
if(nc1.eq.NBASE+1) c1='CQ '
|
|
if(nc1.eq.NBASE+2) c1='QRZ '
|
|
nfreq=nc1-NBASE-3
|
|
if(nfreq.ge.0 .and. nfreq.le.999) then
|
|
write(c1,1002) nfreq
|
|
1002 format('CQ ',i3.3)
|
|
cqnnn=.true.
|
|
endif
|
|
endif
|
|
|
|
call unpackcall(nc2,c2,junk1,junk2)
|
|
call unpackgrid(ng,grid)
|
|
|
|
if(iv2.gt.0) then
|
|
! This is a JT65v2 message
|
|
do i=1,4
|
|
if(ichar(psfx(i:i)).eq.0) psfx(i:i)=' '
|
|
enddo
|
|
|
|
n1=len_trim(psfx)
|
|
n2=len_trim(c2)
|
|
if(iv2.eq.1) msg='CQ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
|
if(iv2.eq.2) msg='QRZ '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
|
if(iv2.eq.3) msg='DE '//psfx(:n1)//'/'//c2(:n2)//' '//grid
|
|
if(iv2.eq.4) msg='CQ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
|
if(iv2.eq.5) msg='QRZ '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
|
if(iv2.eq.6) msg='DE '//c2(:n2)//'/'//psfx(:n1)//' '//grid
|
|
if(iv2.eq.7) then
|
|
grid6=grid//'ma'
|
|
call grid2k(grid6,k)
|
|
if(k.ge.451 .and. k.le.900) then
|
|
call getpfx2(k,c2)
|
|
n2=len_trim(c2)
|
|
msg='DE '//c2(:n2)
|
|
else
|
|
msg='DE '//c2(:n2)//' '//grid
|
|
endif
|
|
endif
|
|
if(iv2.eq.8) msg=' '
|
|
go to 100
|
|
else
|
|
|
|
endif
|
|
|
|
grid6=grid//'ma'
|
|
call grid2k(grid6,k)
|
|
if(k.ge.1 .and. k.le.450) call getpfx2(k,c1)
|
|
if(k.ge.451 .and. k.le.900) call getpfx2(k,c2)
|
|
|
|
i=index(c1,char(0))
|
|
if(i.ge.3) c1=c1(1:i-1)//' '
|
|
i=index(c2,char(0))
|
|
if(i.ge.3) c2=c2(1:i-1)//' '
|
|
|
|
msg=' '
|
|
j=0
|
|
if(cqnnn) then
|
|
msg=c1//' '
|
|
j=7 !### ??? ###
|
|
go to 10
|
|
endif
|
|
|
|
do i=1,12
|
|
j=j+1
|
|
msg(j:j)=c1(i:i)
|
|
if(c1(i:i).eq.' ') go to 10
|
|
enddo
|
|
j=j+1
|
|
msg(j:j)=' '
|
|
|
|
10 do i=1,12
|
|
if(j.le.21) j=j+1
|
|
msg(j:j)=c2(i:i)
|
|
if(c2(i:i).eq.' ') go to 20
|
|
enddo
|
|
if(j.le.21) j=j+1
|
|
msg(j:j)=' '
|
|
|
|
20 if(k.eq.0) then
|
|
do i=1,4
|
|
if(j.le.21) j=j+1
|
|
msg(j:j)=grid(i:i)
|
|
enddo
|
|
if(j.le.21) j=j+1
|
|
msg(j:j)=' '
|
|
endif
|
|
|
|
100 continue
|
|
if(msg(1:6).eq.'CQ9DX ') msg(3:3)=' '
|
|
if(msg(1:2).eq.'E9' .and. &
|
|
msg(3:3).ge.'A' .and. msg(3:3).le.'Z' .and. &
|
|
msg(4:4).ge.'A' .and. msg(4:4).le.'Z' .and. &
|
|
msg(5:5).eq.' ') msg='CQ '//msg(3:)
|
|
|
|
if(bcontest) call fix_contest_msg(mygrid,msg)
|
|
|
|
return
|
|
end subroutine unpackmsg
|
|
|
|
subroutine packtext(msg,nc1,nc2,nc3)
|
|
|
|
parameter (MASK28=2**28 - 1)
|
|
character*22 msg
|
|
character*42 c
|
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
|
|
|
nc1=0
|
|
nc2=0
|
|
nc3=0
|
|
|
|
do i=1,5 !First 5 characters in nc1
|
|
do j=1,42 !Get character code
|
|
if(msg(i:i).eq.c(j:j)) go to 10
|
|
enddo
|
|
j=37
|
|
10 j=j-1 !Codes should start at zero
|
|
nc1=42*nc1 + j
|
|
enddo
|
|
|
|
do i=6,10 !Characters 6-10 in nc2
|
|
do j=1,42 !Get character code
|
|
if(msg(i:i).eq.c(j:j)) go to 20
|
|
enddo
|
|
j=37
|
|
20 j=j-1 !Codes should start at zero
|
|
nc2=42*nc2 + j
|
|
enddo
|
|
|
|
do i=11,13 !Characters 11-13 in nc3
|
|
do j=1,42 !Get character code
|
|
if(msg(i:i).eq.c(j:j)) go to 30
|
|
enddo
|
|
j=37
|
|
30 j=j-1 !Codes should start at zero
|
|
nc3=42*nc3 + j
|
|
enddo
|
|
|
|
! We now have used 17 bits in nc3. Must move one each to nc1 and nc2.
|
|
nc1=nc1+nc1
|
|
if(iand(nc3,32768).ne.0) nc1=nc1+1
|
|
nc2=nc2+nc2
|
|
if(iand(nc3,65536).ne.0) nc2=nc2+1
|
|
nc3=iand(nc3,32767)
|
|
|
|
return
|
|
end subroutine packtext
|
|
|
|
subroutine unpacktext(nc1,nc2,nc3,msg)
|
|
|
|
character*22 msg
|
|
character*44 c
|
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +-./?'/
|
|
|
|
nc3=iand(nc3,32767) !Remove the "plain text" bit
|
|
if(iand(nc1,1).ne.0) nc3=nc3+32768
|
|
nc1=nc1/2
|
|
if(iand(nc2,1).ne.0) nc3=nc3+65536
|
|
nc2=nc2/2
|
|
|
|
do i=5,1,-1
|
|
j=mod(nc1,42)+1
|
|
msg(i:i)=c(j:j)
|
|
nc1=nc1/42
|
|
enddo
|
|
|
|
do i=10,6,-1
|
|
j=mod(nc2,42)+1
|
|
msg(i:i)=c(j:j)
|
|
nc2=nc2/42
|
|
enddo
|
|
|
|
do i=13,11,-1
|
|
j=mod(nc3,42)+1
|
|
msg(i:i)=c(j:j)
|
|
nc3=nc3/42
|
|
enddo
|
|
msg(14:22) = ' '
|
|
|
|
return
|
|
end subroutine unpacktext
|
|
|
|
subroutine getpfx1(callsign,k,nv2)
|
|
|
|
character*12 callsign0,callsign,lof,rof
|
|
character*8 c
|
|
character addpfx*8,tpfx*4,tsfx*3
|
|
logical ispfx,issfx,invalid
|
|
common/pfxcom/addpfx
|
|
include 'pfx.f90'
|
|
|
|
callsign0=callsign
|
|
nv2=1
|
|
iz=index(callsign,' ') - 1
|
|
if(iz.lt.0) iz=12
|
|
islash=index(callsign(1:iz),'/')
|
|
k=0
|
|
! if(k.eq.0) go to 10 !Tnx to DL9RDZ for reminder:this was for tests only!
|
|
c=' '
|
|
if(islash.gt.0 .and. islash.le.(iz-4)) then
|
|
! Add-on prefix
|
|
c=callsign(1:islash-1)
|
|
callsign=callsign(islash+1:iz)
|
|
do i=1,NZ
|
|
if(pfx(i)(1:4).eq.c) then
|
|
k=i
|
|
nv2=2
|
|
go to 10
|
|
endif
|
|
enddo
|
|
if(addpfx.eq.c) then
|
|
k=449
|
|
nv2=2
|
|
go to 10
|
|
endif
|
|
|
|
else if(islash.eq.(iz-1)) then
|
|
! Add-on suffix
|
|
c=callsign(islash+1:iz)
|
|
callsign=callsign(1:islash-1)
|
|
do i=1,NZ2
|
|
if(sfx(i).eq.c(1:1)) then
|
|
k=400+i
|
|
nv2=3
|
|
go to 10
|
|
endif
|
|
enddo
|
|
endif
|
|
|
|
10 if(islash.ne.0 .and.k.eq.0) then
|
|
! Original JT65 would force this compound callsign to be treated as
|
|
! plain text. In JT65v2, we will encode the prefix or suffix into nc1.
|
|
! The task here is to compute the proper value of k.
|
|
lof=callsign0(:islash-1)
|
|
rof=callsign0(islash+1:)
|
|
llof=len_trim(lof)
|
|
lrof=len_trim(rof)
|
|
ispfx=(llof.gt.0 .and. llof.le.4)
|
|
issfx=(lrof.gt.0 .and. lrof.le.3)
|
|
invalid=.not.(ispfx.or.issfx)
|
|
if(ispfx.and.issfx) then
|
|
if(llof.lt.3) issfx=.false.
|
|
if(lrof.lt.3) ispfx=.false.
|
|
if(ispfx.and.issfx) then
|
|
i=ichar(callsign0(islash-1:islash-1))
|
|
if(i.ge.ichar('0') .and. i.le.ichar('9')) then
|
|
issfx=.false.
|
|
else
|
|
ispfx=.false.
|
|
endif
|
|
endif
|
|
endif
|
|
|
|
if(invalid) then
|
|
k=-1
|
|
else
|
|
if(ispfx) then
|
|
tpfx=lof(1:4)
|
|
k=nchar(tpfx(1:1))
|
|
k=37*k + nchar(tpfx(2:2))
|
|
k=37*k + nchar(tpfx(3:3))
|
|
k=37*k + nchar(tpfx(4:4))
|
|
nv2=4
|
|
i=index(callsign0,'/')
|
|
callsign=callsign0(:i-1)
|
|
callsign=callsign0(i+1:)
|
|
endif
|
|
if(issfx) then
|
|
tsfx=rof(1:3)
|
|
k=nchar(tsfx(1:1))
|
|
k=37*k + nchar(tsfx(2:2))
|
|
k=37*k + nchar(tsfx(3:3))
|
|
nv2=5
|
|
i=index(callsign0,'/')
|
|
callsign=callsign0(:i-1)
|
|
endif
|
|
endif
|
|
endif
|
|
|
|
return
|
|
end subroutine getpfx1
|
|
|
|
subroutine getpfx2(k0,callsign)
|
|
|
|
character callsign*12
|
|
include 'pfx.f90'
|
|
character addpfx*8
|
|
common/pfxcom/addpfx
|
|
|
|
k=k0
|
|
if(k.gt.450) k=k-450
|
|
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.400+NZ2) then
|
|
iz=index(callsign,' ') - 1
|
|
callsign=callsign(1:iz)//'/'//sfx(k-400)
|
|
else if(k.eq.449) then
|
|
iz=index(addpfx,' ') - 1
|
|
if(iz.lt.1) iz=8
|
|
callsign=addpfx(1:iz)//'/'//callsign
|
|
endif
|
|
|
|
return
|
|
end subroutine getpfx2
|
|
|
|
subroutine grid2k(grid,k)
|
|
|
|
character*6 grid
|
|
|
|
call grid2deg(grid,xlong,xlat)
|
|
nlong=nint(xlong)
|
|
nlat=nint(xlat)
|
|
k=0
|
|
if(nlat.ge.85) k=5*(nlong+179)/2 + nlat-84
|
|
|
|
return
|
|
end subroutine grid2k
|
|
|
|
subroutine k2grid(k,grid)
|
|
character grid*6
|
|
|
|
nlong=2*mod((k-1)/5,90)-179
|
|
if(k.gt.450) nlong=nlong+180
|
|
nlat=mod(k-1,5)+ 85
|
|
dlat=nlat
|
|
dlong=nlong
|
|
call deg2grid(dlong,dlat,grid)
|
|
|
|
return
|
|
end subroutine k2grid
|
|
|
|
subroutine grid2n(grid,n)
|
|
character*4 grid
|
|
|
|
i1=ichar(grid(1:1))-ichar('A')
|
|
i2=ichar(grid(3:3))-ichar('0')
|
|
i=10*i1 + i2
|
|
n=-i - 31
|
|
|
|
return
|
|
end subroutine grid2n
|
|
|
|
subroutine n2grid(n,grid)
|
|
character*4 grid
|
|
|
|
if(n.gt.-31 .or. n.lt.-70) stop 'Error in n2grid'
|
|
i=-(n+31) !NB: 0 <= i <= 39
|
|
i1=i/10
|
|
i2=mod(i,10)
|
|
grid(1:1)=char(ichar('A')+i1)
|
|
grid(2:2)='A'
|
|
grid(3:3)=char(ichar('0')+i2)
|
|
grid(4:4)='0'
|
|
|
|
return
|
|
end subroutine n2grid
|
|
|
|
function nchar(c)
|
|
|
|
! Convert ascii number, letter, or space to 0-36 for callsign packing.
|
|
|
|
character c*1
|
|
|
|
n=0 !Silence compiler warning
|
|
if(c.ge.'0' .and. c.le.'9') then
|
|
n=ichar(c)-ichar('0')
|
|
else if(c.ge.'A' .and. c.le.'Z') then
|
|
n=ichar(c)-ichar('A') + 10
|
|
else if(c.ge.'a' .and. c.le.'z') then
|
|
n=ichar(c)-ichar('a') + 10
|
|
else if(c.ge.' ') then
|
|
n=36
|
|
else
|
|
Print*,'Invalid character in callsign ',c,' ',ichar(c)
|
|
stop
|
|
endif
|
|
nchar=n
|
|
|
|
return
|
|
end function nchar
|
|
|
|
subroutine pack50(n1,n2,dat)
|
|
|
|
integer*1 dat(:),i1
|
|
|
|
i1=iand(ishft(n1,-20),255) !8 bits
|
|
dat(1)=i1
|
|
i1=iand(ishft(n1,-12),255) !8 bits
|
|
dat(2)=i1
|
|
i1=iand(ishft(n1, -4),255) !8 bits
|
|
dat(3)=i1
|
|
i1=16*iand(n1,15)+iand(ishft(n2,-18),15) !4+4 bits
|
|
dat(4)=i1
|
|
i1=iand(ishft(n2,-10),255) !8 bits
|
|
dat(5)=i1
|
|
i1=iand(ishft(n2, -2),255) !8 bits
|
|
dat(6)=i1
|
|
i1=64*iand(n2,3) !2 bits
|
|
dat(7)=i1
|
|
dat(8)=0
|
|
dat(9)=0
|
|
dat(10)=0
|
|
dat(11)=0
|
|
|
|
return
|
|
end subroutine pack50
|
|
|
|
subroutine packpfx(call1,n1,ng,nadd)
|
|
|
|
character*12 call1,call0
|
|
character*3 pfx
|
|
logical text
|
|
|
|
i1=index(call1,'/')
|
|
if(call1(i1+2:i1+2).eq.' ') then
|
|
! Single-character add-on suffix (maybe also fourth suffix letter?)
|
|
call0=call1(:i1-1)
|
|
call packcall(call0,n1,text)
|
|
nadd=1
|
|
nc=ichar(call1(i1+1:i1+1))
|
|
if(nc.ge.48 .and. nc.le.57) then
|
|
n=nc-48
|
|
else if(nc.ge.65 .and. nc.le.90) then
|
|
n=nc-65+10
|
|
else
|
|
n=38
|
|
endif
|
|
nadd=1
|
|
ng=60000-32768+n
|
|
else if(call1(i1+3:i1+3).eq.' ') then
|
|
! Two-character numerical suffix, /10 to /99
|
|
call0=call1(:i1-1)
|
|
call packcall(call0,n1,text)
|
|
nadd=1
|
|
n=10*(ichar(call1(i1+1:i1+1))-48) + ichar(call1(i1+2:i1+2)) - 48
|
|
nadd=1
|
|
ng=60000 + 26 + n
|
|
else
|
|
! Prefix of 1 to 3 characters
|
|
pfx=call1(:i1-1)
|
|
if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
|
|
if(pfx(3:3).eq.' ') pfx=' '//pfx(1:2)
|
|
call0=call1(i1+1:)
|
|
call packcall(call0,n1,text)
|
|
|
|
ng=0
|
|
do i=1,3
|
|
nc=ichar(pfx(i:i))
|
|
if(nc.ge.48 .and. nc.le.57) then
|
|
n=nc-48
|
|
else if(nc.ge.65 .and. nc.le.90) then
|
|
n=nc-65+10
|
|
else
|
|
n=36
|
|
endif
|
|
ng=37*ng + n
|
|
enddo
|
|
nadd=0
|
|
if(ng.ge.32768) then
|
|
ng=ng-32768
|
|
nadd=1
|
|
endif
|
|
endif
|
|
|
|
return
|
|
end subroutine packpfx
|
|
|
|
end module packjt
|