mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-12-23 19:25:37 -05:00
Modernize Fortran interfaces that are called from C/C++
Making Fortran interfaces called from other languages fully portable avoids issues with newer Fortran compilers.
This commit is contained in:
Bill Somerville
parent
7d14602b07
commit
f346d37fd6
134
lib/astrosub.f90
134
lib/astrosub.f90
@ -1,55 +1,97 @@
|
||||
subroutine astrosub(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
|
||||
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
|
||||
RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8,techo8,width1,width2,bTx, &
|
||||
AzElFileName,jpleph)
|
||||
module astro_module
|
||||
use, intrinsic :: iso_c_binding, only : c_int, c_double, c_bool, c_char, c_ptr, c_size_t, c_f_pointer
|
||||
implicit none
|
||||
|
||||
implicit real*8 (a-h,o-z)
|
||||
character*6 mygrid,hisgrid,c1*1
|
||||
character*6 AzElFileName*(*),jpleph*(*)
|
||||
character*256 jpleph_file_name
|
||||
logical*1 bTx
|
||||
common/jplcom/jpleph_file_name
|
||||
private
|
||||
public :: astrosub
|
||||
|
||||
jpleph_file_name=jpleph
|
||||
contains
|
||||
|
||||
call astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
|
||||
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
|
||||
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
|
||||
width1,width2,xlst8,techo8)
|
||||
subroutine astrosub(nyear,month,nday,uth8,freq8,mygrid_cp,mygrid_len, &
|
||||
hisgrid_cp,hisgrid_len,AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8, &
|
||||
ntsky,ndop,ndop00,RAMoon8,DecMoon8,Dgrd8,poloffset8,xnr8,techo8,width1, &
|
||||
width2,bTx,AzElFileName_cp,AzElFileName_len,jpleph_cp,jpleph_len) &
|
||||
bind (C, name="astrosub")
|
||||
|
||||
if (len_trim(AzElFileName) .eq. 0) go to 999
|
||||
imin=60*uth8
|
||||
isec=3600*uth8
|
||||
ih=uth8
|
||||
im=mod(imin,60)
|
||||
is=mod(isec,60)
|
||||
open(15,file=AzElFileName,status='unknown',err=900)
|
||||
c1='R'
|
||||
nRx=1
|
||||
if(bTx) then
|
||||
c1='T'
|
||||
nRx=0
|
||||
endif
|
||||
AzAux=0.
|
||||
ElAux=0.
|
||||
nfreq=freq8/1000000
|
||||
doppler=ndop
|
||||
doppler00=ndop00
|
||||
write(15,1010,err=10) ih,im,is,AzMoon8,ElMoon8, &
|
||||
ih,im,is,AzSun8,ElSun8, &
|
||||
ih,im,is,AzAux,ElAux, &
|
||||
nfreq,doppler,dfdt,doppler00,dfdt0,c1
|
||||
! TXFirst,TRPeriod,poloffset,Dgrd,xnr,ave,rms,nRx
|
||||
integer, parameter :: dp = selected_real_kind(15, 50)
|
||||
|
||||
integer(c_int), intent(in), value :: nyear, month, nday
|
||||
real(c_double), intent(in), value :: uth8, freq8
|
||||
real(c_double), intent(out) :: AzSun8, ElSun8, AzMoon8, ElMoon8, AzMoonB8, &
|
||||
ElMoonB8, Ramoon8, DecMoon8, Dgrd8, poloffset8, xnr8, techo8, width1, &
|
||||
width2
|
||||
integer(c_int), intent(out) :: ntsky, ndop, ndop00
|
||||
logical(c_bool), intent(in), value :: bTx
|
||||
type(c_ptr), intent(in), value :: mygrid_cp, hisgrid_cp, AzElFileName_cp, jpleph_cp
|
||||
integer(c_size_t), intent(in), value :: mygrid_len, hisgrid_len, AzElFileName_len, jpleph_len
|
||||
|
||||
character(len=6) :: mygrid, hisgrid
|
||||
character(kind=c_char, len=:), allocatable :: AzElFileName
|
||||
character(len=1) :: c1
|
||||
integer :: ih, im, imin, is, isec, nfreq, nRx
|
||||
real(dp) :: AzAux, ElAux, dbMoon8, dfdt, dfdt0, doppler, doppler00, HA8, sd8, xlst8
|
||||
character*256 jpleph_file_name
|
||||
common/jplcom/jpleph_file_name
|
||||
|
||||
block
|
||||
character(kind=c_char, len=mygrid_len), pointer :: mygrid_fp
|
||||
character(kind=c_char, len=hisgrid_len), pointer :: hisgrid_fp
|
||||
character(kind=c_char, len=AzElFileName_len), pointer :: AzElFileName_fp
|
||||
character(kind=c_char, len=jpleph_len), pointer :: jpleph_fp
|
||||
call c_f_pointer(cptr=mygrid_cp, fptr=mygrid_fp)
|
||||
mygrid = mygrid_fp
|
||||
mygrid_fp => null()
|
||||
call c_f_pointer(cptr=hisgrid_cp, fptr=hisgrid_fp)
|
||||
hisgrid = hisgrid_fp
|
||||
hisgrid_fp => null()
|
||||
call c_f_pointer(cptr=AzElFileName_cp, fptr=AzElFileName_fp)
|
||||
AzElFileName = AzElFileName_fp
|
||||
AzElFileName_fp => null()
|
||||
call c_f_pointer(cptr=jpleph_cp, fptr=jpleph_fp)
|
||||
jpleph_file_name = jpleph_fp
|
||||
jpleph_fp => null()
|
||||
end block
|
||||
|
||||
call astro0(nyear,month,nday,uth8,freq8,mygrid,hisgrid, &
|
||||
AzSun8,ElSun8,AzMoon8,ElMoon8,AzMoonB8,ElMoonB8,ntsky,ndop,ndop00, &
|
||||
dbMoon8,RAMoon8,DecMoon8,HA8,Dgrd8,sd8,poloffset8,xnr8,dfdt,dfdt0, &
|
||||
width1,width2,xlst8,techo8)
|
||||
|
||||
if (len_trim(AzElFileName) .eq. 0) go to 999
|
||||
imin=60*uth8
|
||||
isec=3600*uth8
|
||||
ih=uth8
|
||||
im=mod(imin,60)
|
||||
is=mod(isec,60)
|
||||
open(15,file=AzElFileName,status='unknown',err=900)
|
||||
c1='R'
|
||||
nRx=1
|
||||
if(bTx) then
|
||||
c1='T'
|
||||
nRx=0
|
||||
endif
|
||||
AzAux=0.
|
||||
ElAux=0.
|
||||
nfreq=freq8/1000000
|
||||
doppler=ndop
|
||||
doppler00=ndop00
|
||||
write(15,1010,err=10) ih,im,is,AzMoon8,ElMoon8, &
|
||||
ih,im,is,AzSun8,ElSun8, &
|
||||
ih,im,is,AzAux,ElAux, &
|
||||
nfreq,doppler,dfdt,doppler00,dfdt0,c1
|
||||
! TXFirst,TRPeriod,poloffset,Dgrd,xnr,ave,rms,nRx
|
||||
1010 format( &
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Moon'/ &
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Sun'/ &
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Source'/ &
|
||||
i5,',',f8.1,',',f8.2,',',f8.1,',',f8.2,',Doppler, ',a1)
|
||||
! i1,',',i3,',',f8.1,','f8.1,',',f8.1,',',f12.3,',',f12.3,',',i1,',RPol')
|
||||
10 close(15)
|
||||
go to 999
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Moon'/ &
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Sun'/ &
|
||||
i2.2,':',i2.2,':',i2.2,',',f5.1,',',f5.1,',Source'/ &
|
||||
i5,',',f8.1,',',f8.2,',',f8.1,',',f8.2,',Doppler, ',a1)
|
||||
! i1,',',i3,',',f8.1,','f8.1,',',f8.1,',',f12.3,',',f12.3,',',i1,',RPol')
|
||||
10 close(15)
|
||||
go to 999
|
||||
|
||||
900 print*,'Error opening azel.dat'
|
||||
|
||||
999 return
|
||||
end subroutine astrosub
|
||||
end subroutine astrosub
|
||||
|
||||
end module astro_module
|
||||
|
||||
@ -24,14 +24,14 @@
|
||||
|
||||
|
||||
extern "C" {
|
||||
void astrosub_(int* nyear, int* month, int* nday, double* uth, double* freqMoon,
|
||||
const char* mygrid, const char* hisgrid, double* azsun,
|
||||
double* elsun, double* azmoon, double* elmoon, double* azmoondx,
|
||||
double* elmoondx, int* ntsky, int* ndop, int* ndop00,
|
||||
double* ramoon, double* decmoon, double* dgrd, double* poloffset,
|
||||
double* xnr, double* techo, double* width1, double* width2,
|
||||
bool* bTx, const char* AzElFileName, const char* jpleph,
|
||||
fortran_charlen_t, fortran_charlen_t, fortran_charlen_t, fortran_charlen_t);
|
||||
void astrosub(int nyear, int month, int nday, double uth, double freqMoon,
|
||||
const char * mygrid, size_t mygrid_len, const char * hisgrid,
|
||||
size_t hisgrid_len, double * azsun, double * elsun, double * azmoon,
|
||||
double * elmoon, double * azmoondx, double * elmoondx, int * ntsky,
|
||||
int * ndop, int * ndop00, double * ramoon, double * decmoon, double * dgrd,
|
||||
double * poloffset, double * xnr, double * techo, double * width1,
|
||||
double * width2, bool bTx, const char * AzElFileName, size_t AzElFileName_len,
|
||||
const char * jpleph, size_t jpleph_len);
|
||||
}
|
||||
|
||||
Astro::Astro(QSettings * settings, Configuration const * configuration, QWidget * parent)
|
||||
@ -76,8 +76,8 @@ void Astro::read_settings ()
|
||||
case 1: ui_->rbFullTrack->setChecked (true); break;
|
||||
case 2: ui_->rbConstFreqOnMoon->setChecked (true); break;
|
||||
case 3: ui_->rbOwnEcho->setChecked (true); break;
|
||||
case 4: ui_->rbOnDxEcho->setChecked (true); break;
|
||||
case 5: ui_->rbCallDx->setChecked (true); break;
|
||||
case 4: ui_->rbOnDxEcho->setChecked (true); break;
|
||||
case 5: ui_->rbCallDx->setChecked (true); break;
|
||||
}
|
||||
move (settings_->value ("window/pos", pos ()).toPoint ());
|
||||
}
|
||||
@ -107,24 +107,20 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
|
||||
double sec {t.time().second() + 0.001*t.time().msec()};
|
||||
double uth {nhr + nmin/60.0 + sec/3600.0};
|
||||
if(freq_moon < 1) freq_moon = 144000000;
|
||||
int nfreq {static_cast<int> (freq_moon / 1000000u)};
|
||||
double freq8 {static_cast<double> (freq_moon)};
|
||||
auto const& AzElFileName = QDir::toNativeSeparators (configuration_->azel_directory ().absoluteFilePath ("azel.dat"));
|
||||
auto const& jpleph = configuration_->data_dir ().absoluteFilePath ("JPLEPH");
|
||||
|
||||
|
||||
|
||||
|
||||
QString mygrid_padded {(mygrid + " ").left (6)};
|
||||
QString hisgrid_padded {(hisgrid + " ").left (6)};
|
||||
astrosub_(&nyear, &month, &nday, &uth, &freq8, mygrid_padded.toLatin1().constData(),
|
||||
hisgrid_padded.toLatin1().constData(), &azsun, &elsun, &azmoon, &elmoon,
|
||||
&azmoondx, &elmoondx, &ntsky, &m_dop, &m_dop00, &ramoon, &decmoon,
|
||||
&dgrd, &poloffset, &xnr, &techo, &width1, &width2, &bTx,
|
||||
AzElFileName.toLatin1().constData(), jpleph.toLatin1().constData(), 6, 6,
|
||||
AzElFileName.length(), jpleph.length());
|
||||
astrosub(nyear, month, nday, uth, static_cast<double> (freq_moon),
|
||||
mygrid.toLatin1 ().constData (), mygrid.size (),
|
||||
hisgrid.toLatin1().constData(), hisgrid.size (),
|
||||
&azsun, &elsun, &azmoon, &elmoon,
|
||||
&azmoondx, &elmoondx, &ntsky, &m_dop, &m_dop00, &ramoon, &decmoon,
|
||||
&dgrd, &poloffset, &xnr, &techo, &width1, &width2,
|
||||
bTx,
|
||||
AzElFileName.toLatin1().constData(), AzElFileName.size (),
|
||||
jpleph.toLatin1().constData(), jpleph.size ());
|
||||
|
||||
if(hisgrid_padded==" ") {
|
||||
if(!hisgrid.size ()) {
|
||||
azmoondx=0.0;
|
||||
elmoondx=0.0;
|
||||
m_dop=0;
|
||||
@ -152,8 +148,8 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
|
||||
"Dec: " << decmoon << "\n"
|
||||
"SunAz: " << azsun << "\n"
|
||||
"SunEl: " << elsun << "\n"
|
||||
"Freq: " << nfreq << "\n";
|
||||
if(nfreq>=50) { //Suppress data not relevant below VHF
|
||||
"Freq: " << freq / 1.e6 << "\n";
|
||||
if(freq>=5000000ull) { //Suppress data not relevant below VHF
|
||||
out << "Tsky: " << ntsky << "\n"
|
||||
"Dpol: " << poloffset << "\n"
|
||||
"MNR: " << xnr << "\n"
|
||||
@ -215,8 +211,6 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
|
||||
auto sec_since_epoch = t.toMSecsSinceEpoch ()/1000 + 2;
|
||||
auto target_sec = sec_since_epoch - fmod(double(sec_since_epoch),TR_period) + 0.5*TR_period;
|
||||
auto target_date_time = QDateTime::fromMSecsSinceEpoch (target_sec * 1000, Qt::UTC);
|
||||
QString date {target_date_time.date().toString("yyyy MMM dd").trimmed ()};
|
||||
QString utc {target_date_time.time().toString().trimmed ()};
|
||||
int nyear {target_date_time.date().year()};
|
||||
int month {target_date_time.date().month()};
|
||||
int nday {target_date_time.date().day()};
|
||||
@ -224,12 +218,15 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
|
||||
int nmin {target_date_time.time().minute()};
|
||||
double sec {target_date_time.time().second() + 0.001*target_date_time.time().msec()};
|
||||
double uth {nhr + nmin/60.0 + sec/3600.0};
|
||||
astrosub_(&nyear, &month, &nday, &uth, &freq8, mygrid_padded.toLatin1().constData(),
|
||||
hisgrid_padded.toLatin1().constData(), &azsun, &elsun, &azmoon, &elmoon,
|
||||
astrosub(nyear, month, nday, uth, static_cast<double> (freq_moon),
|
||||
mygrid.toLatin1 ().constData (), mygrid.size (),
|
||||
hisgrid.toLatin1().constData(), hisgrid.size (),
|
||||
&azsun, &elsun, &azmoon, &elmoon,
|
||||
&azmoondx, &elmoondx, &ntsky, &m_dop, &m_dop00, &ramoon, &decmoon,
|
||||
&dgrd, &poloffset, &xnr, &techo, &width1, &width2, &bTx,
|
||||
"", jpleph.toLatin1().constData(), 6, 6,
|
||||
0, jpleph.length());
|
||||
&dgrd, &poloffset, &xnr, &techo, &width1, &width2,
|
||||
bTx,
|
||||
AzElFileName.toLatin1().constData(), AzElFileName.size (),
|
||||
jpleph.toLatin1().constData(), jpleph.size ());
|
||||
FrequencyDelta offset {0};
|
||||
switch (m_DopplerMethod)
|
||||
{
|
||||
@ -255,7 +252,7 @@ auto Astro::astroUpdate(QDateTime const& t, QString const& mygrid, QString const
|
||||
|
||||
}
|
||||
correction.tx = -offset;
|
||||
qDebug () << "correction.tx (no tx qsy):" << correction.tx;
|
||||
qDebug () << "correction.tx (no tx qsy):" << correction.tx;
|
||||
}
|
||||
}
|
||||
return correction;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user