From 94f76eb22ad419e911adec7804878267a9d5fb02 Mon Sep 17 00:00:00 2001 From: Joe Taylor Date: Tue, 10 Jan 2017 16:59:30 +0000 Subject: [PATCH] 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 --- libm65/CMakeLists.txt | 19 +++--- libm65/sun.f | 88 -------------------------- libm65/sun.f90 | 88 ++++++++++++++++++++++++++ libm65/toxyz.f | 25 -------- libm65/toxyz.f90 | 25 ++++++++ libm65/trimlist.f | 28 --------- libm65/trimlist.f90 | 28 +++++++++ libm65/twkfreq.f | 29 --------- libm65/twkfreq.f90 | 29 +++++++++ libm65/unpackcall.f | 142 ------------------------------------------ libm65/unpackcall.f90 | 142 ++++++++++++++++++++++++++++++++++++++++++ libm65/unpackgrid.f | 32 ---------- libm65/unpackgrid.f90 | 32 ++++++++++ libm65/unpackmsg.f | 100 ----------------------------- libm65/unpackmsg.f90 | 100 +++++++++++++++++++++++++++++ libm65/unpacktext.f | 35 ----------- libm65/unpacktext.f90 | 33 ++++++++++ 17 files changed, 486 insertions(+), 489 deletions(-) delete mode 100644 libm65/sun.f create mode 100644 libm65/sun.f90 delete mode 100644 libm65/toxyz.f create mode 100644 libm65/toxyz.f90 delete mode 100644 libm65/trimlist.f create mode 100644 libm65/trimlist.f90 delete mode 100644 libm65/twkfreq.f create mode 100644 libm65/twkfreq.f90 delete mode 100644 libm65/unpackcall.f create mode 100644 libm65/unpackcall.f90 delete mode 100644 libm65/unpackgrid.f create mode 100644 libm65/unpackgrid.f90 delete mode 100644 libm65/unpackmsg.f create mode 100644 libm65/unpackmsg.f90 delete mode 100644 libm65/unpacktext.f create mode 100644 libm65/unpacktext.f90 diff --git a/libm65/CMakeLists.txt b/libm65/CMakeLists.txt index d5f9cca70..a887e6a7e 100644 --- a/libm65/CMakeLists.txt +++ b/libm65/CMakeLists.txt @@ -118,23 +118,22 @@ set (FSRCS setup65.f90 sleep_msec.f90 sort.f90 - -symspec.f90 + sun.f90 + symspec.f90 timer.f90 timf2.f90 tm2.f90 + toxyz.f90 + trimlist.f90 + twkfreq.f90 + unpackcall.f90 + unpackgrid.f90 + unpackmsg.f90 + unpacktext.f90 zplot.f90 f77_wisdom.f ssort.f - sun.f - toxyz.f - trimlist.f - twkfreq.f - unpackcall.f - unpackgrid.f - unpackmsg.f - unpacktext.f ) set (CSRCS diff --git a/libm65/sun.f b/libm65/sun.f deleted file mode 100644 index a3f326e7f..000000000 --- a/libm65/sun.f +++ /dev/null @@ -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 diff --git a/libm65/sun.f90 b/libm65/sun.f90 new file mode 100644 index 000000000..ec011b66c --- /dev/null +++ b/libm65/sun.f90 @@ -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 diff --git a/libm65/toxyz.f b/libm65/toxyz.f deleted file mode 100644 index 9f75d5de1..000000000 --- a/libm65/toxyz.f +++ /dev/null @@ -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 diff --git a/libm65/toxyz.f90 b/libm65/toxyz.f90 new file mode 100644 index 000000000..aef160c9d --- /dev/null +++ b/libm65/toxyz.f90 @@ -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 diff --git a/libm65/trimlist.f b/libm65/trimlist.f deleted file mode 100644 index a28c0446a..000000000 --- a/libm65/trimlist.f +++ /dev/null @@ -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 diff --git a/libm65/trimlist.f90 b/libm65/trimlist.f90 new file mode 100644 index 000000000..e0843cb25 --- /dev/null +++ b/libm65/trimlist.f90 @@ -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 diff --git a/libm65/twkfreq.f b/libm65/twkfreq.f deleted file mode 100644 index 364e17c02..000000000 --- a/libm65/twkfreq.f +++ /dev/null @@ -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 diff --git a/libm65/twkfreq.f90 b/libm65/twkfreq.f90 new file mode 100644 index 000000000..7fc8ea0ff --- /dev/null +++ b/libm65/twkfreq.f90 @@ -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 diff --git a/libm65/unpackcall.f b/libm65/unpackcall.f deleted file mode 100644 index 9a5a218c3..000000000 --- a/libm65/unpackcall.f +++ /dev/null @@ -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 diff --git a/libm65/unpackcall.f90 b/libm65/unpackcall.f90 new file mode 100644 index 000000000..f738926ca --- /dev/null +++ b/libm65/unpackcall.f90 @@ -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 diff --git a/libm65/unpackgrid.f b/libm65/unpackgrid.f deleted file mode 100644 index bc4ea1eb2..000000000 --- a/libm65/unpackgrid.f +++ /dev/null @@ -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 - diff --git a/libm65/unpackgrid.f90 b/libm65/unpackgrid.f90 new file mode 100644 index 000000000..39387cfde --- /dev/null +++ b/libm65/unpackgrid.f90 @@ -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 + diff --git a/libm65/unpackmsg.f b/libm65/unpackmsg.f deleted file mode 100644 index 8162bd582..000000000 --- a/libm65/unpackmsg.f +++ /dev/null @@ -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 diff --git a/libm65/unpackmsg.f90 b/libm65/unpackmsg.f90 new file mode 100644 index 000000000..944f1dbc1 --- /dev/null +++ b/libm65/unpackmsg.f90 @@ -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 diff --git a/libm65/unpacktext.f b/libm65/unpacktext.f deleted file mode 100644 index 0923e7eb1..000000000 --- a/libm65/unpacktext.f +++ /dev/null @@ -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 - - diff --git a/libm65/unpacktext.f90 b/libm65/unpacktext.f90 new file mode 100644 index 000000000..9337ccdcd --- /dev/null +++ b/libm65/unpacktext.f90 @@ -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