From f346d37fd6575ede541c0c5d8c07b83e03979458 Mon Sep 17 00:00:00 2001 From: Bill Somerville Date: Thu, 6 Jun 2019 15:00:47 +0100 Subject: [PATCH] Modernize Fortran interfaces that are called from C/C++ Making Fortran interfaces called from other languages fully portable avoids issues with newer Fortran compilers. --- lib/astrosub.f90 | 134 ++++++++++++++++++++++++++++++---------------- widgets/astro.cpp | 65 +++++++++++----------- 2 files changed, 119 insertions(+), 80 deletions(-) diff --git a/lib/astrosub.f90 b/lib/astrosub.f90 index 49551ce3e..0670d66dc 100644 --- a/lib/astrosub.f90 +++ b/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 diff --git a/widgets/astro.cpp b/widgets/astro.cpp index c1eee0157..8c083a89a 100644 --- a/widgets/astro.cpp +++ b/widgets/astro.cpp @@ -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 (freq_moon / 1000000u)}; - double freq8 {static_cast (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 (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 (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;