mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-26 06:08:42 -05:00
Final conversions from .f to .f90.
git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/map65@7476 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Joe Taylor
parent
c3102ea485
commit
94f76eb22a
@ -118,23 +118,22 @@ set (FSRCS
|
|||||||
setup65.f90
|
setup65.f90
|
||||||
sleep_msec.f90
|
sleep_msec.f90
|
||||||
sort.f90
|
sort.f90
|
||||||
|
sun.f90
|
||||||
symspec.f90
|
symspec.f90
|
||||||
timer.f90
|
timer.f90
|
||||||
timf2.f90
|
timf2.f90
|
||||||
tm2.f90
|
tm2.f90
|
||||||
|
toxyz.f90
|
||||||
|
trimlist.f90
|
||||||
|
twkfreq.f90
|
||||||
|
unpackcall.f90
|
||||||
|
unpackgrid.f90
|
||||||
|
unpackmsg.f90
|
||||||
|
unpacktext.f90
|
||||||
zplot.f90
|
zplot.f90
|
||||||
|
|
||||||
f77_wisdom.f
|
f77_wisdom.f
|
||||||
ssort.f
|
ssort.f
|
||||||
sun.f
|
|
||||||
toxyz.f
|
|
||||||
trimlist.f
|
|
||||||
twkfreq.f
|
|
||||||
unpackcall.f
|
|
||||||
unpackgrid.f
|
|
||||||
unpackmsg.f
|
|
||||||
unpacktext.f
|
|
||||||
)
|
)
|
||||||
|
|
||||||
set (CSRCS
|
set (CSRCS
|
||||||
|
|||||||
88
libm65/sun.f
88
libm65/sun.f
@ -1,88 +0,0 @@
|
|||||||
subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer y !Year
|
|
||||||
integer m !Month
|
|
||||||
integer DD !Day
|
|
||||||
integer mjd !Modified Julian Date
|
|
||||||
real UT !UTC in hours
|
|
||||||
real RA,Dec !RA and Dec of sun
|
|
||||||
|
|
||||||
C NB: Double caps here are single caps in the writeup.
|
|
||||||
|
|
||||||
C Orbital elements of the Sun (also N=0, i=0, a=1):
|
|
||||||
real w !Argument of perihelion
|
|
||||||
real e !Eccentricity
|
|
||||||
real MM !Mean anomaly
|
|
||||||
real Ls !Mean longitude
|
|
||||||
|
|
||||||
C Other standard variables:
|
|
||||||
real v !True anomaly
|
|
||||||
real EE !Eccentric anomaly
|
|
||||||
real ecl !Obliquity of the ecliptic
|
|
||||||
real d !Ephemeris time argument in days
|
|
||||||
real r !Distance to sun, AU
|
|
||||||
real xv,yv !x and y coords in ecliptic
|
|
||||||
real lonsun !Ecliptic long and lat of sun
|
|
||||||
C Ecliptic coords of sun (geocentric)
|
|
||||||
real xs,ys
|
|
||||||
C Equatorial coords of sun (geocentric)
|
|
||||||
real xe,ye,ze
|
|
||||||
real lon,lat
|
|
||||||
real GMST0,LST,HA
|
|
||||||
real xx,yy,zz
|
|
||||||
real xhor,yhor,zhor
|
|
||||||
real Az,El
|
|
||||||
|
|
||||||
real day
|
|
||||||
real rad
|
|
||||||
data rad/57.2957795/
|
|
||||||
|
|
||||||
C Time in days, with Jan 0, 2000 equal to 0.0:
|
|
||||||
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0
|
|
||||||
mjd=d + 51543
|
|
||||||
ecl = 23.4393 - 3.563e-7 * d
|
|
||||||
|
|
||||||
C Compute updated orbital elements for Sun:
|
|
||||||
w = 282.9404 + 4.70935e-5 * d
|
|
||||||
e = 0.016709 - 1.151e-9 * d
|
|
||||||
MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0)
|
|
||||||
Ls = mod(w+MM+720.0,360.0)
|
|
||||||
|
|
||||||
EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad))
|
|
||||||
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad))
|
|
||||||
|
|
||||||
xv = cos(EE/rad) - e
|
|
||||||
yv = sqrt(1.0-e*e) * sin(EE/rad)
|
|
||||||
v = rad*atan2(yv,xv)
|
|
||||||
r = sqrt(xv*xv + yv*yv)
|
|
||||||
lonsun = mod(v + w + 720.0,360.0)
|
|
||||||
C Ecliptic coordinates of sun (rectangular):
|
|
||||||
xs = r * cos(lonsun/rad)
|
|
||||||
ys = r * sin(lonsun/rad)
|
|
||||||
|
|
||||||
C Equatorial coordinates of sun (rectangular):
|
|
||||||
xe = xs
|
|
||||||
ye = ys * cos(ecl/rad)
|
|
||||||
ze = ys * sin(ecl/rad)
|
|
||||||
|
|
||||||
C RA and Dec in degrees:
|
|
||||||
RA = rad*atan2(ye,xe)
|
|
||||||
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
|
|
||||||
|
|
||||||
GMST0 = (Ls + 180.0)/15.0
|
|
||||||
LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours
|
|
||||||
HA = 15.0*LST - RA !HA in degrees
|
|
||||||
xx = cos(HA/rad)*cos(Dec/rad)
|
|
||||||
yy = sin(HA/rad)*cos(Dec/rad)
|
|
||||||
zz = sin(Dec/rad)
|
|
||||||
xhor = xx*sin(lat/rad) - zz*cos(lat/rad)
|
|
||||||
yhor = yy
|
|
||||||
zhor = xx*cos(lat/rad) + zz*sin(lat/rad)
|
|
||||||
Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0)
|
|
||||||
El = rad*asin(zhor)
|
|
||||||
day=d-1.5
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
88
libm65/sun.f90
Normal file
88
libm65/sun.f90
Normal file
@ -0,0 +1,88 @@
|
|||||||
|
subroutine sun(y,m,DD,UT,lon,lat,RA,Dec,LST,Az,El,mjd,day)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer y !Year
|
||||||
|
integer m !Month
|
||||||
|
integer DD !Day
|
||||||
|
integer mjd !Modified Julian Date
|
||||||
|
real UT !UTC in hours
|
||||||
|
real RA,Dec !RA and Dec of sun
|
||||||
|
|
||||||
|
! NB: Double caps here are single caps in the writeup.
|
||||||
|
|
||||||
|
! Orbital elements of the Sun (also N=0, i=0, a=1):
|
||||||
|
real w !Argument of perihelion
|
||||||
|
real e !Eccentricity
|
||||||
|
real MM !Mean anomaly
|
||||||
|
real Ls !Mean longitude
|
||||||
|
|
||||||
|
! Other standard variables:
|
||||||
|
real v !True anomaly
|
||||||
|
real EE !Eccentric anomaly
|
||||||
|
real ecl !Obliquity of the ecliptic
|
||||||
|
real d !Ephemeris time argument in days
|
||||||
|
real r !Distance to sun, AU
|
||||||
|
real xv,yv !x and y coords in ecliptic
|
||||||
|
real lonsun !Ecliptic long and lat of sun
|
||||||
|
! Ecliptic coords of sun (geocentric)
|
||||||
|
real xs,ys
|
||||||
|
! Equatorial coords of sun (geocentric)
|
||||||
|
real xe,ye,ze
|
||||||
|
real lon,lat
|
||||||
|
real GMST0,LST,HA
|
||||||
|
real xx,yy,zz
|
||||||
|
real xhor,yhor,zhor
|
||||||
|
real Az,El
|
||||||
|
|
||||||
|
real day
|
||||||
|
real rad
|
||||||
|
data rad/57.2957795/
|
||||||
|
|
||||||
|
! Time in days, with Jan 0, 2000 equal to 0.0:
|
||||||
|
d=367*y - 7*(y+(m+9)/12)/4 + 275*m/9 + DD - 730530 + UT/24.0
|
||||||
|
mjd=d + 51543
|
||||||
|
ecl = 23.4393 - 3.563e-7 * d
|
||||||
|
|
||||||
|
! Compute updated orbital elements for Sun:
|
||||||
|
w = 282.9404 + 4.70935e-5 * d
|
||||||
|
e = 0.016709 - 1.151e-9 * d
|
||||||
|
MM = mod(356.0470d0 + 0.9856002585d0 * d + 360000.d0,360.d0)
|
||||||
|
Ls = mod(w+MM+720.0,360.0)
|
||||||
|
|
||||||
|
EE = MM + e*rad*sin(MM/rad) * (1.0 + e*cos(M/rad))
|
||||||
|
EE = EE - (EE - e*rad*sin(EE/rad)-MM) / (1.0 - e*cos(EE/rad))
|
||||||
|
|
||||||
|
xv = cos(EE/rad) - e
|
||||||
|
yv = sqrt(1.0-e*e) * sin(EE/rad)
|
||||||
|
v = rad*atan2(yv,xv)
|
||||||
|
r = sqrt(xv*xv + yv*yv)
|
||||||
|
lonsun = mod(v + w + 720.0,360.0)
|
||||||
|
! Ecliptic coordinates of sun (rectangular):
|
||||||
|
xs = r * cos(lonsun/rad)
|
||||||
|
ys = r * sin(lonsun/rad)
|
||||||
|
|
||||||
|
! Equatorial coordinates of sun (rectangular):
|
||||||
|
xe = xs
|
||||||
|
ye = ys * cos(ecl/rad)
|
||||||
|
ze = ys * sin(ecl/rad)
|
||||||
|
|
||||||
|
! RA and Dec in degrees:
|
||||||
|
RA = rad*atan2(ye,xe)
|
||||||
|
Dec = rad*atan2(ze,sqrt(xe*xe + ye*ye))
|
||||||
|
|
||||||
|
GMST0 = (Ls + 180.0)/15.0
|
||||||
|
LST = mod(GMST0+UT+lon/15.0+48.0,24.0) !LST in hours
|
||||||
|
HA = 15.0*LST - RA !HA in degrees
|
||||||
|
xx = cos(HA/rad)*cos(Dec/rad)
|
||||||
|
yy = sin(HA/rad)*cos(Dec/rad)
|
||||||
|
zz = sin(Dec/rad)
|
||||||
|
xhor = xx*sin(lat/rad) - zz*cos(lat/rad)
|
||||||
|
yhor = yy
|
||||||
|
zhor = xx*cos(lat/rad) + zz*sin(lat/rad)
|
||||||
|
Az = mod(rad*atan2(yhor,xhor) + 180.0 + 360.0,360.0)
|
||||||
|
El = rad*asin(zhor)
|
||||||
|
day=d-1.5
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine sun
|
||||||
@ -1,25 +0,0 @@
|
|||||||
subroutine toxyz(alpha,delta,r,vec)
|
|
||||||
|
|
||||||
implicit real*8 (a-h,o-z)
|
|
||||||
real*8 vec(3)
|
|
||||||
|
|
||||||
vec(1)=r*cos(delta)*cos(alpha)
|
|
||||||
vec(2)=r*cos(delta)*sin(alpha)
|
|
||||||
vec(3)=r*sin(delta)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine fromxyz(vec,alpha,delta,r)
|
|
||||||
|
|
||||||
implicit real*8 (a-h,o-z)
|
|
||||||
real*8 vec(3)
|
|
||||||
data twopi/6.283185307d0/
|
|
||||||
|
|
||||||
r=sqrt(vec(1)**2 + vec(2)**2 + vec(3)**2)
|
|
||||||
alpha=atan2(vec(2),vec(1))
|
|
||||||
if(alpha.lt.0.d0) alpha=alpha+twopi
|
|
||||||
delta=asin(vec(3)/r)
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
25
libm65/toxyz.f90
Normal file
25
libm65/toxyz.f90
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
subroutine toxyz(alpha,delta,r,vec)
|
||||||
|
|
||||||
|
implicit real*8 (a-h,o-z)
|
||||||
|
real*8 vec(3)
|
||||||
|
|
||||||
|
vec(1)=r*cos(delta)*cos(alpha)
|
||||||
|
vec(2)=r*cos(delta)*sin(alpha)
|
||||||
|
vec(3)=r*sin(delta)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine toxyz
|
||||||
|
|
||||||
|
subroutine fromxyz(vec,alpha,delta,r)
|
||||||
|
|
||||||
|
implicit real*8 (a-h,o-z)
|
||||||
|
real*8 vec(3)
|
||||||
|
data twopi/6.283185307d0/
|
||||||
|
|
||||||
|
r=sqrt(vec(1)**2 + vec(2)**2 + vec(3)**2)
|
||||||
|
alpha=atan2(vec(2),vec(1))
|
||||||
|
if(alpha.lt.0.d0) alpha=alpha+twopi
|
||||||
|
delta=asin(vec(3)/r)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine fromxyz
|
||||||
@ -1,28 +0,0 @@
|
|||||||
subroutine trimlist(sig,km,ftol,indx,nsiz,nz)
|
|
||||||
|
|
||||||
parameter (MAXMSG=1000) !Size of decoded message list
|
|
||||||
real sig(MAXMSG,30)
|
|
||||||
integer indx(MAXMSG),nsiz(MAXMSG)
|
|
||||||
|
|
||||||
C 1 2 3 4 5 6 7 8
|
|
||||||
C nfile nutc freq snr dt ipol flip sync
|
|
||||||
|
|
||||||
call indexx(km,sig(1,3),indx) !Sort list by frequency
|
|
||||||
|
|
||||||
n=1
|
|
||||||
i0=1
|
|
||||||
do i=2,km
|
|
||||||
j0=indx(i-1)
|
|
||||||
j=indx(i)
|
|
||||||
if(sig(j,3)-sig(j0,3).gt.ftol) then
|
|
||||||
nsiz(n)=i-i0
|
|
||||||
i0=i
|
|
||||||
n=n+1
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
nz=n
|
|
||||||
nsiz(nz)=km+1-i0
|
|
||||||
nsiz(nz+1)=-1
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
28
libm65/trimlist.f90
Normal file
28
libm65/trimlist.f90
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
subroutine trimlist(sig,km,ftol,indx,nsiz,nz)
|
||||||
|
|
||||||
|
parameter (MAXMSG=1000) !Size of decoded message list
|
||||||
|
real sig(MAXMSG,30)
|
||||||
|
integer indx(MAXMSG),nsiz(MAXMSG)
|
||||||
|
|
||||||
|
! 1 2 3 4 5 6 7 8
|
||||||
|
! nfile nutc freq snr dt ipol flip sync
|
||||||
|
|
||||||
|
call indexx(km,sig(1,3),indx) !Sort list by frequency
|
||||||
|
|
||||||
|
n=1
|
||||||
|
i0=1
|
||||||
|
do i=2,km
|
||||||
|
j0=indx(i-1)
|
||||||
|
j=indx(i)
|
||||||
|
if(sig(j,3)-sig(j0,3).gt.ftol) then
|
||||||
|
nsiz(n)=i-i0
|
||||||
|
i0=i
|
||||||
|
n=n+1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
nz=n
|
||||||
|
nsiz(nz)=km+1-i0
|
||||||
|
nsiz(nz+1)=-1
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine trimlist
|
||||||
@ -1,29 +0,0 @@
|
|||||||
subroutine twkfreq(c4aa,c4bb,n5,a)
|
|
||||||
|
|
||||||
complex c4aa(n5)
|
|
||||||
complex c4bb(n5)
|
|
||||||
real a(5)
|
|
||||||
complex w,wstep
|
|
||||||
data twopi/6.283185307/
|
|
||||||
|
|
||||||
C Apply AFC corrections to the c4aa and c4bb data
|
|
||||||
w=1.0
|
|
||||||
wstep=1.0
|
|
||||||
x0=0.5*(n5+1)
|
|
||||||
s=2.0/n5
|
|
||||||
do i=1,n5
|
|
||||||
x=s*(i-x0)
|
|
||||||
if(mod(i,1000).eq.1) then
|
|
||||||
p2=1.5*x*x - 0.5
|
|
||||||
! p3=2.5*(x**3) - 1.5*x
|
|
||||||
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
|
|
||||||
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125)
|
|
||||||
wstep=cmplx(cos(dphi),sin(dphi))
|
|
||||||
endif
|
|
||||||
w=w*wstep
|
|
||||||
c4aa(i)=w*c4aa(i)
|
|
||||||
c4bb(i)=w*c4bb(i)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
return
|
|
||||||
end
|
|
||||||
29
libm65/twkfreq.f90
Normal file
29
libm65/twkfreq.f90
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
subroutine twkfreq(c4aa,c4bb,n5,a)
|
||||||
|
|
||||||
|
complex c4aa(n5)
|
||||||
|
complex c4bb(n5)
|
||||||
|
real a(5)
|
||||||
|
complex w,wstep
|
||||||
|
data twopi/6.283185307/
|
||||||
|
|
||||||
|
! Apply AFC corrections to the c4aa and c4bb data
|
||||||
|
w=1.0
|
||||||
|
wstep=1.0
|
||||||
|
x0=0.5*(n5+1)
|
||||||
|
s=2.0/n5
|
||||||
|
do i=1,n5
|
||||||
|
x=s*(i-x0)
|
||||||
|
if(mod(i,1000).eq.1) then
|
||||||
|
p2=1.5*x*x - 0.5
|
||||||
|
! p3=2.5*(x**3) - 1.5*x
|
||||||
|
! p4=4.375*(x**4) - 3.75*(x**2) + 0.375
|
||||||
|
dphi=(a(1) + x*a(2) + p2*a(3)) * (twopi/1378.125)
|
||||||
|
wstep=cmplx(cos(dphi),sin(dphi))
|
||||||
|
endif
|
||||||
|
w=w*wstep
|
||||||
|
c4aa(i)=w*c4aa(i)
|
||||||
|
c4bb(i)=w*c4bb(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine twkfreq
|
||||||
@ -1,142 +0,0 @@
|
|||||||
subroutine unpackcall(ncall,word,iv2,psfx)
|
|
||||||
|
|
||||||
parameter (NBASE=37*36*10*27*27*27)
|
|
||||||
character word*12,c*37,psfx*4
|
|
||||||
|
|
||||||
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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)
|
|
||||||
endif
|
|
||||||
|
|
||||||
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
|
|
||||||
142
libm65/unpackcall.f90
Normal file
142
libm65/unpackcall.f90
Normal file
@ -0,0 +1,142 @@
|
|||||||
|
subroutine unpackcall(ncall,word,iv2,psfx)
|
||||||
|
|
||||||
|
parameter (NBASE=37*36*10*27*27*27)
|
||||||
|
character word*12,c*37,psfx*4
|
||||||
|
|
||||||
|
data c/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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)
|
||||||
|
endif
|
||||||
|
|
||||||
|
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
|
||||||
@ -1,32 +0,0 @@
|
|||||||
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)
|
|
||||||
go to 100
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
100 return
|
|
||||||
end
|
|
||||||
|
|
||||||
32
libm65/unpackgrid.f90
Normal file
32
libm65/unpackgrid.f90
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
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)
|
||||||
|
go to 100
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
100 return
|
||||||
|
end subroutine unpackgrid
|
||||||
|
|
||||||
@ -1,100 +0,0 @@
|
|||||||
subroutine unpackmsg(dat,msg)
|
|
||||||
|
|
||||||
parameter (NBASE=37*36*10*27*27*27)
|
|
||||||
parameter (NGBASE=180*180)
|
|
||||||
integer dat(12)
|
|
||||||
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4
|
|
||||||
logical cqnnn
|
|
||||||
|
|
||||||
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
|
|
||||||
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) msg='DE '//c2(:n2)//' '//grid
|
|
||||||
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 return
|
|
||||||
end
|
|
||||||
100
libm65/unpackmsg.f90
Normal file
100
libm65/unpackmsg.f90
Normal file
@ -0,0 +1,100 @@
|
|||||||
|
subroutine unpackmsg(dat,msg)
|
||||||
|
|
||||||
|
parameter (NBASE=37*36*10*27*27*27)
|
||||||
|
parameter (NGBASE=180*180)
|
||||||
|
integer dat(12)
|
||||||
|
character c1*12,c2*12,grid*4,msg*22,grid6*6,psfx*4,junk2*4
|
||||||
|
logical cqnnn
|
||||||
|
|
||||||
|
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
|
||||||
|
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) msg='DE '//c2(:n2)//' '//grid
|
||||||
|
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 return
|
||||||
|
end subroutine unpackmsg
|
||||||
@ -1,35 +0,0 @@
|
|||||||
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
|
|
||||||
|
|
||||||
|
|
||||||
33
libm65/unpacktext.f90
Normal file
33
libm65/unpacktext.f90
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
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
|
||||||
Loading…
Reference in New Issue
Block a user