w4kek/WSJT-X
1
0
Fork 0
mirror of https://github.com/saitohirga/WSJT-X.git synced 2024-11-27 06:38:44 -05:00
Code Issues Packages Projects Releases Wiki Activity

Added the source code for morse().

Browse Source 
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@3093 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor 2013-03-25 12:17:21 +00:00
parent 466d7fe2b7
commit 7515725c63
1 changed files with 86 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
lib/morse.f90 Normal file
View File

@ -0,0 +1,86 @@
subroutine morse(msg,idat,n)
! Convert ascii message to a Morse code bit string.
! Dash = 3 dots
! Space between dots, dashes = 1 dot
! Space between letters = 3 dots
! Space between words = 7 dots
character*(*) msg
integer idat(250)
integer*1 ic(21,38)
data ic/ &
1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,20, &
1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,18, &
1,0,1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,16, &
1,0,1,0,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, &
1,0,1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, &
1,0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,1,1,0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,12, &
1,1,1,0,1,1,1,0,1,0,1,0,1,0,0,0,0,0,0,0,14, &
1,1,1,0,1,1,1,0,1,1,1,0,1,0,1,0,0,0,0,0,16, &
1,1,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,0,0,0,18, &
1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, &
1,1,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,1,1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,12, &
1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, &
1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 2, &
1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, &
1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 4, &
1,0,1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, &
1,1,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, &
1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, &
1,1,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, &
1,0,1,1,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,12, &
1,1,1,0,1,1,1,0,1,0,1,1,1,0,0,0,0,0,0,0,14, &
1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, &
1,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 6, &
1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 4, &
1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0, 8, &
1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,10, &
1,1,1,0,1,0,1,0,1,1,1,0,0,0,0,0,0,0,0,0,12, &
1,1,1,0,1,0,1,1,1,0,1,1,1,0,0,0,0,0,0,0,14, &
1,1,1,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,12, &
1,1,1,0,1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,14, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 2/ !Incremental word space
save
msglen=len(msg)
idat=0
n=6
do k=1,msglen
jj=ichar(msg(k:k))
if(jj.ge.97 .and. jj.le.122) jj=jj-32 !Convert lower to upper case
if(jj.ge.48 .and. jj.le.57) j=jj-48 !Numbers
if(jj.ge.65 .and. jj.le.90) j=jj-55 !Letters
if(jj.eq.47) j=36 !Slash (/)
if(jj.eq.32) j=37 !Word space
j=j+1
! Insert this character
nmax=ic(21,j)
do i=1,nmax
n=n+1
idat(n)=ic(i,j)
enddo
! Insert character space of 2 dit lengths:
n=n+1
idat(n)=0
n=n+1
idat(n)=0
enddo
! Insert word space at end of message
do j=1,4
n=n+1
idat(n)=0
enddo
return
end subroutine morse