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

Thread safety enhancements to jt9

Browse Source 
Serialize thread unsafe FFTW3 calls

Serialize FFTW3 plan initializations in four2a

Serialize decoder results output to file/console

git-svn-id: svn+ssh://svn.code.sf.net/p/wsjt/wsjt/branches/wsjtx@4928 ab8295b8-cf94-4d9e-aec4-7959e3be5d79
This commit is contained in:
Bill Somerville 2015-02-04 01:41:26 +00:00
parent 16452ae32f
commit 91b909b581
7 changed files with 89 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/decjt9.f90
View File

@ -110,9 +110,13 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
if(nqd.eq.0) ndecodes0=ndecodes0+1
if(nqd.eq.1) ndecodes1=ndecodes1+1
!$omp critical(decode_results) ! serialize writes - see also jt65a.f90
write(*,1000) nutc,nsnr,xdt,nint(freq),msg
1000 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22)
write(13,1002) nutc,nsync,nsnr,xdt,freq,ndrift,msg
call flush(6)
!$omp end critical(decode_results)
1000 format(i4.4,i4,f5.1,i5,1x,'@',1x,a22)
1002 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT9')
iaa=max(1,i-1)
@ -122,11 +126,9 @@ subroutine decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol, &
ndecoded=1
ccfok(iaa:ibb)=.false.
done(iaa:ibb)=.true.
call flush(6)
endif
endif
enddo
call flush(6)
if(nagain.ne.0) exit
enddo

12
lib/decoder.f90
View File

@ -49,29 +49,25 @@ subroutine decoder(ss,id2)
if(nmode.eq.65) go to 800
! print*,'A'
!$OMP PARALLEL SECTIONS PRIVATE(id)
!$omp parallel sections
!$OMP SECTION
! print*,'B'
!$omp section
call timer('decjt9 ',0)
call decjt9(ss,id2,nutc,nfqso,newdat,npts8,nfa,nfsplit,nfb,ntol,nzhsym, &
nagain,ndepth,nmode)
call timer('decjt9 ',1)
!$OMP SECTION
!$omp section
if(nmode.ge.65 .and. (.not.done65)) then
if(newdat.ne.0) dd(1:npts65)=id2(1:npts65)
nf1=nfa
nf2=nfb
! print*,'C'
call timer('jt65a ',0)
call jt65a(dd,npts65,newdat,nutc,nf1,nf2,nfqso,ntol65,nagain,ndecoded)
call timer('jt65a ',1)
endif
!$OMP END PARALLEL SECTIONS
! print*,'D'
!$omp end parallel sections
! JT65 is not yet producing info for nsynced, ndecoded.
800 write(*,1010) nsynced,ndecoded

4
lib/downsam9.f90
View File

@ -39,7 +39,11 @@ subroutine downsam9(id2,npts8,nsps8,newdat,nspsd,fpk,c2,nz2)
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
! Plan the FFTs just once
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
plan=fftwf_plan_dft_r2c_1d(nfft1,x1,c1,nflags)
!$omp end critical(fftw)
first=.false.
endif

9
lib/filbig.f90
View File

@ -38,10 +38,13 @@ subroutine filbig(dd,npts,f0,newdat,c4a,n4,sq0)
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
! Plan the FFTs just once
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
plan1=fftwf_plan_dft_r2c_1d(nfft1,rca,ca,nflags)
plan2=fftwf_plan_dft_1d(nfft2,c4a,c4a,-1,nflags)
plan3=fftwf_plan_dft_1d(nfft2,cfilt,cfilt,+1,nflags)
!$omp end critical(fftw)
! Convert impulse response to filter function
do i=1,nfft2
@ -128,9 +131,13 @@ subroutine filbig(dd,npts,f0,newdat,c4a,n4,sq0)
n4=min(npts/8,nfft2)
return
900 call fftwf_destroy_plan(plan1)
900 continue
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
call fftwf_destroy_plan(plan1)
call fftwf_destroy_plan(plan2)
call fftwf_destroy_plan(plan3)
!$omp end critical(fftw)
return
end subroutine filbig

98
lib/four2a.f90
View File

@ -26,6 +26,7 @@ subroutine four2a(a,nfft,ndim,isign,iform)
integer nn(NPMAX),ns(NPMAX),nf(NPMAX) !Params of stored plans
integer*8 nl(NPMAX),nloc !More params of plans
integer*8 plan(NPMAX) !Pointers to stored plans
logical found_plan
data nplan/0/ !Number of stored plans
common/patience/npatience,nthreads !Patience and threads for FFTW plans
include 'fftw3.f90' !FFTW definitions
@ -34,60 +35,81 @@ subroutine four2a(a,nfft,ndim,isign,iform)
if(nfft.lt.0) go to 999
nloc=loc(a)
found_plan = .false.
!$omp critical(four2a_setup)
do i=1,nplan
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and. &
iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
iform.eq.nf(i) .and. nloc.eq.nl(i)) then
found_plan = .true.
exit
end if
enddo
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
if(i.ge.NPMAX) stop 'Too many FFTW plans requested.'
if (.not. found_plan) then
nplan=nplan+1
i=nplan
nn(i)=nfft
ns(i)=isign
nf(i)=iform
nl(i)=nloc
! Planning: FFTW_ESTIMATE, FFTW_ESTIMATE_PATIENT, FFTW_MEASURE,
! FFTW_PATIENT, FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
nflags=FFTW_ESTIMATE
if(npatience.eq.1) nflags=FFTW_ESTIMATE_PATIENT
if(npatience.eq.2) nflags=FFTW_MEASURE
if(npatience.eq.3) nflags=FFTW_PATIENT
if(npatience.eq.4) nflags=FFTW_EXHAUSTIVE
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
aa(1:jz)=a(1:jz)
endif
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
aa(1:jz)=a(1:jz)
endif
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
if(isign.eq.-1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_FORWARD,nflags)
else if(isign.eq.1 .and. iform.eq.1) then
call sfftw_plan_dft_1d(plan(i),nfft,a,a,FFTW_BACKWARD,nflags)
else if(isign.eq.-1 .and. iform.eq.0) then
call sfftw_plan_dft_r2c_1d(plan(i),nfft,a,a,nflags)
else if(isign.eq.1 .and. iform.eq.-1) then
call sfftw_plan_dft_c2r_1d(plan(i),nfft,a,a,nflags)
else
stop 'Unsupported request in four2a'
endif
!$omp end critical(fftw)
i=nplan
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
a(1:jz)=aa(1:jz)
endif
if(nfft.le.NSMALL) then
jz=nfft
if(iform.eq.0) jz=nfft/2
a(1:jz)=aa(1:jz)
endif
end if
!$omp end critical(four2a_setup)
10 continue
call sfftw_execute(plan(i))
return
999 do i=1,nplan
999 continue
!$omp critical(four2a)
do i=1,nplan
! The test is only to silence a compiler warning:
if(ndim.ne.-999) call sfftw_destroy_plan(plan(i))
if(ndim.ne.-999) then
!$omp critical(fftw) ! serialize non thread-safe FFTW3 calls
call sfftw_destroy_plan(plan(i))
!$omp end critical(fftw)
end if
enddo
nplan=0
!$omp end critical(four2a)
return
end subroutine four2a

7
lib/jt65a.f90
View File

@ -76,10 +76,15 @@ subroutine jt65a(dd0,npts,newdat,nutc,nf1,nf2,nfqso,ntol,nagain,ndecoded)
if(nsnr.lt.-30) nsnr=-30
if(nsnr.gt.-1) nsnr=-1
dt=dt-tskip
!$omp critical(decode_results) ! serialize writes - see also decjt9.f90
write(*,1010) nutc,nsnr,dt,nfreq,decoded
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
write(13,1012) nutc,nint(sync1),nsnr,dt,float(nfreq),ndrift, &
decoded,nbmkv
call flush(6)
!$omp end critical(decode_results)
1010 format(i4.4,i4,f5.1,i5,1x,'#',1x,a22)
1012 format(i4.4,i4,i5,f6.1,f8.0,i4,3x,a22,' JT65',i4)
freq0=freq+a(1)
i2=min(NSZ,i+15) !### ??? ###

3
lib/jt9.f90
View File

@ -163,8 +163,9 @@ program jt9
print*,infile
999 continue
!Save wisdom and free memory
iret=fftwf_export_wisdom_to_filename(wisfile)
call four2a(a,-1,1,1,1) !Save wisdom and free memory
call four2a(a,-1,1,1,1)
call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans
call fftwf_cleanup_threads()
call fftwf_cleanup()