1subroutine m65a 2 3 use timer_module, only: timer 4 use timer_impl, only: init_timer !, limtrace 5 use, intrinsic :: iso_c_binding, only: C_NULL_CHAR 6 use FFTW3 7 8 interface 9 function address_m65() 10 integer*1, pointer :: address_m65 11 end function address_m65 12 end interface 13 14 integer*1 attach_m65 15 integer size_m65 16 integer*1, pointer :: p_m65 17 character*80 cwd 18 character wisfile*256 19 logical fileExists 20 21 call getcwd(cwd) 22 call ftninit(trim(cwd)) 23 call init_timer (trim(cwd)//'/timer.out') 24 25 limtrace=0 26 lu=12 27 i1=attach_m65() 28 2910 inquire(file=trim(cwd)//'/.lock',exist=fileExists) 30 if(fileExists) then 31 call sleep_msec(100) 32 go to 10 33 endif 34 35 inquire(file=trim(cwd)//'/.quit',exist=fileExists) 36 if(fileExists) then 37 call timer('decode0 ',101) 38 i=detach_m65() 39 ! Save FFTW wisdom and free memory 40 wisfile=trim(cwd)//'/m65_wisdom.dat'// C_NULL_CHAR 41 if(len(trim(wisfile)).gt.0) iret=fftwf_export_wisdom_to_filename(wisfile) 42 call four2a(a,-1,1,1,1) 43 call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans 44 call fftwf_cleanup_threads() 45 call fftwf_cleanup() 46 go to 999 47 endif 48 49 nbytes=size_m65() 50 if(nbytes.le.0) then 51 print*,'m65a: Shared memory mem_m65 does not exist.' 52 print*,'Program m65a should be started automatically from within map65.' 53 go to 999 54 endif 55 p_m65=>address_m65() 56 call m65b(p_m65,nbytes) 57 call sleep_msec(500) ! wait for .lock to be recreated 58 go to 10 59 60999 return 61end subroutine m65a 62 63subroutine m65b(m65com,nbytes) 64 integer*1 m65com(0:nbytes-1) 65 kss=4*4*60*96000 66 ksavg=kss+4*4*322*32768 67 kfcenter=ksavg+4*4*32768 68 call m65c(m65com(0),m65com(kss),m65com(ksavg),m65com(kfcenter)) 69 return 70end subroutine m65b 71 72subroutine m65c(dd,ss,savg,nparams0) 73 74 include 'njunk.f90' 75 real*4 dd(4,5760000),ss(4,322,32768),savg(4,32768) 76 real*8 fcenter 77 integer nparams0(NJUNK+2),nparams(NJUNK+2) 78 logical ldecoded 79 character*12 mycall,hiscall 80 character*6 mygrid,hisgrid 81 character*20 datetime 82 common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain, & 83 ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift, & 84 mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode, & 85 nfast,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid, & 86 datetime,junk1,junk2 87 common/early/nhsym1,nhsym2,ldecoded(32768) 88 equivalence (nparams,fcenter) 89 90 nparams=nparams0 !Copy parameters into common/npar/ 91 npatience=1 92 if(nhsym.eq.nhsym1 .and. iand(nrxlog,1).ne.0) then 93 write(21,1000) datetime(:17) 941000 format(/'UTC Date: 'a17/78('-')) 95 flush(21) 96 endif 97 if(iand(nrxlog,2).ne.0) rewind(21) 98 if(iand(nrxlog,4).ne.0) then 99 if(nhsym.eq.nhsym1) rewind(26) 100 if(nhsym.eq.nhsym2) backspace(26) 101 endif 102 103 nstandalone=0 104 if(sum(nparams).ne.0) call decode0(dd,ss,savg,nstandalone) 105 106 return 107end subroutine m65c 108